From 6b949a284136f7826479d858864621165832b0c0 Mon Sep 17 00:00:00 2001 From: Zaher Salman Date: Thu, 21 Feb 2013 12:43:31 +0000 Subject: [PATCH] Cleanup code in progress. --- trimsp/src/trimsp7l.F | 1549 +++++++++++++++-------------------------- 1 file changed, 544 insertions(+), 1005 deletions(-) diff --git a/trimsp/src/trimsp7l.F b/trimsp/src/trimsp7l.F index 4344e1d..38c1fe5 100644 --- a/trimsp/src/trimsp7l.F +++ b/trimsp/src/trimsp7l.F @@ -3466,295 +3466,282 @@ C & 8X,'ION OUT , SECOND. KO(',I1,') = ',I7,1F9.4,4X & ,'ENERGY = ',E10.4,' EV',1F9.4,4X,'MEAN ENERGY = ',E10.4) WRITE(21,1577) - DO 1738 J=1,NJ(1) - WRITE(21,1582) J,SPYT(J),J,SPET(J),J,REYT(J),J,EMSPT(J) - 1738 CONTINUE + DO J=1,NJ(1) + WRITE(21,1582) J,SPYT(J),J,SPET(J),J,REYT(J),J,EMSPT(J) + ENDDO 1719 IF(L.EQ.1) GO TO 1749 IF(ISPALT(2).EQ.0) GO TO 1744 WRITE(21,1720) 1720 FORMAT(/1X,'2.LAYER') - DO 1722 J=NJ(1)+1,JT(3) - WRITE(21,1564) J-NJ(1),ITSP(J),J-NJ(1),ETSP(J) - 1722 CONTINUE - DO 1746 J=NJ(1)+1,JT(3) - WRITE(21,1581) J-NJ(1),ISPIPT(J),RIPT(J),ESPIPT(J),REIPT(J) - 1 ,ESPMIPT(J) - 2 ,J-NJ(1),ISPIST(J),RIST(J),ESPIST(J),REIST(J) - 3 ,ESPMIST(J) - 4 ,J-NJ(1),ISPOPT(J),ROPT(J),ESPOPT(J),REOPT(J) - 5 ,ESPMOPT(J) - 6 ,J-NJ(1),ISPOST(J),ROST(J),ESPOST(J),REOST(J) - 7 ,ESPMOST(J) - 1746 CONTINUE + DO J=NJ(1)+1,JT(3) + WRITE(21,1564) J-NJ(1),ITSP(J),J-NJ(1),ETSP(J) + ENDDO + DO J=NJ(1)+1,JT(3) + WRITE(21,1581) J-NJ(1),ISPIPT(J),RIPT(J),ESPIPT(J),REIPT(J) + & ,ESPMIPT(J) ,J-NJ(1),ISPIST(J),RIST(J),ESPIST(J),REIST(J) + & ,ESPMIST(J) ,J-NJ(1),ISPOPT(J),ROPT(J),ESPOPT(J),REOPT(J) + & ,ESPMOPT(J) ,J-NJ(1),ISPOST(J),ROST(J),ESPOST(J),REOST(J) + & ,ESPMOST(J) + ENDDO WRITE(21,1577) - DO 1748 J=NJ(1)+1,JT(3) - WRITE(21,1582) J-NJ(1),SPYT(J),J-NJ(1),SPET(J),J-NJ(1),REYT(J) - 1 ,J-NJ(1),EMSPT(J) - 1748 CONTINUE + DO J=NJ(1)+1,JT(3) + WRITE(21,1582) J-NJ(1),SPYT(J),J-NJ(1),SPET(J),J-NJ(1),REYT(J) + & ,J-NJ(1),EMSPT(J) + ENDDO 1744 IF(L.EQ.2) GO TO 1749 IF(ISPALT(3).EQ.0) GO TO 1749 WRITE(21,1726) 1726 FORMAT(/1X,'3.LAYER') - DO 1728 J=JT(3)+1,LJ - WRITE(21,1564) J-JT(3),ITSP(J),J-JT(3),ETSP(J) - 1728 CONTINUE - DO 1750 J=JT(3)+1,LJ - WRITE(21,1581) J-JT(3),ISPIPT(J),RIPT(J),ESPIPT(J),REIPT(J) - 1 ,ESPMIPT(J) - 2 ,J-JT(3),ISPIST(J),RIST(J),ESPIST(J),REIST(J) - 3 ,ESPMIST(J) - 4 ,J-JT(3),ISPOPT(J),ROPT(J),ESPOPT(J),REOPT(J) - 5 ,ESPMOPT(J) - 6 ,J-JT(3),ISPOST(J),ROST(J),ESPOST(J),REOST(J) - 7 ,ESPMOST(J) - 1750 CONTINUE + DO J=JT(3)+1,LJ + WRITE(21,1564) J-JT(3),ITSP(J),J-JT(3),ETSP(J) + ENDDO + DO J=JT(3)+1,LJ + WRITE(21,1581) J-JT(3),ISPIPT(J),RIPT(J),ESPIPT(J),REIPT(J) + & ,ESPMIPT(J) ,J-JT(3),ISPIST(J),RIST(J),ESPIST(J),REIST(J) + & ,ESPMIST(J) ,J-JT(3),ISPOPT(J),ROPT(J),ESPOPT(J),REOPT(J) + & ,ESPMOPT(J) ,J-JT(3),ISPOST(J),ROST(J),ESPOST(J),REOST(J) + & ,ESPMOST(J) + ENDDO WRITE(21,1577) - DO 1752 J=JT(3)+1,LJ - WRITE(21,1582) J-JT(3),SPYT(J),J-JT(3),SPET(J),J-JT(3),REYT(J) - 1 ,J-JT(3),EMSPT(J) - 1752 CONTINUE + DO J=JT(3)+1,LJ + WRITE(21,1582) J-JT(3),SPYT(J),J-JT(3),SPET(J),J-JT(3),REYT(J) + & ,J-JT(3),EMSPT(J) + ENDDO 1749 CONTINUE C C TRANSMISSION SPUTTERING : ANGULAR DISTRIBUTIONS C WRITE(21,1760) 1760 FORMAT(///5X,'POLAR ANGULAR DISTRIBUTION OF ALL TRANSMISSION '// - 1 'SPUTTERED PARTICLES'//) -cTR 1760 FORMAT(///5X,'POLAR ANGULAR DISTRIBUTION OF ALL TRANSMISSION SPUTT -cTR 1ERED PARTICLES'//) - DO 1762 I=1,20 - 1762 RKADST(I)=KADST(I)*20.D0/ISPAT + & 'SPUTTERED PARTICLES'//) + DO I=1,20 + RKADST(I)=KADST(I)*20.D0/ISPAT + ENDDO WRITE(21,1518) (AI(I),I=1,20),(KADST(I),I=1,20),(RKADST(I),I=1,20) IF(L.EQ.3) GO TO 1764 - DO 1766 I=1,20 - DO 1768 J=1,NJ(1) - 1768 KDSTL(I,1)=KDSTL(I,1)+KDSTJ(I,J) - DO 1770 J=NJ(1)+1,JT(3) - 1770 KDSTL(I,2)=KDSTL(I,2)+KDSTJ(I,J) + DO I=1,20 + DO J=1,NJ(1) + KDSTL(I,1)=KDSTL(I,1)+KDSTJ(I,J) + ENDDO + ENDDO + DO J=NJ(1)+1,JT(3) + KDSTL(I,2)=KDSTL(I,2)+KDSTJ(I,J) + ENDDO 1766 CONTINUE - DO 1753 J=1,2 - IF(ISPAL(J).EQ.0) GO TO 1754 - DO 1772 I=1,20 - 1772 RKDSTL(I,J)=KDSTL(I,J)*20.D0/ISPAL(J) - 1754 CONTINUE - 1753 CONTINUE - DO 1755 J=1,JT(3) - IF(ITSP(J).EQ.0) GO TO 1756 - DO 1774 I=1,20 - 1774 RKDSTJ(I,J)=KDSTJ(I,J)*20.D0/ITSP(J) - 1756 CONTINUE - 1755 CONTINUE + DO J=1,2 + IF(ISPAL(J).EQ.0) GO TO 1754 + DO I=1,20 + RKDSTL(I,J)=KDSTL(I,J)*20.D0/ISPAL(J) + ENDDO + 1754 CONTINUE + ENDDO + DO J=1,JT(3) + IF(ITSP(J).EQ.0) GO TO 1756 + DO I=1,20 + RKDSTJ(I,J)=KDSTJ(I,J)*20.D0/ITSP(J) + ENDDO + 1756 CONTINUE + ENDDO WRITE(21,1776) 1776 FORMAT(///5X,'POLAR ANGULAR DISTRIBUTION OF SPUTTERED ', - 1 'PARTICLES ; LAYER 1'//) -cTR 1776 FORMAT(///5X,'POLAR ANGULAR DISTRIBUTION OF SPUTTERED PARTICLES ; -cTR 1LAYER 1'//) + & 'PARTICLES ; LAYER 1'//) WRITE(21,1518) (AI(I),I=1,20),(KDSTL(I,1),I=1,20) - 1 ,(RKDSTL(I,1),I=1,20) + & ,(RKDSTL(I,1),I=1,20) IF(NJ(1).EQ.1) GO TO 1778 DO 1780 J=1,NJ(1) - IF(ITSP(J).EQ.0) GO TO 1780 - WRITE(21,1782) J - 1782 FORMAT(///5X,'POLAR ANGULAR DISTRIBUTION OF SPUTTERED ', - 1 'PARTICLES ; LAYER 1 , SPECIES ',I1//) -cTR 1782 FORMAT(///5X,'POLAR ANGULAR DISTRIBUTION OF SPUTTERED PARTICLES ; -cTR 1LAYER 1 , SPECIES ',I1//) - WRITE(21,1518) (AI(I),I=1,20),(KDSTJ(I,J),I=1,20) - 1 ,(RKDSTJ(I,J),I=1,20) + IF(ITSP(J).EQ.0) GO TO 1780 + WRITE(21,1782) J + 1782 FORMAT(///5X,'POLAR ANGULAR DISTRIBUTION OF SPUTTERED ', + & 'PARTICLES ; LAYER 1 , SPECIES ',I1//) + WRITE(21,1518) (AI(I),I=1,20),(KDSTJ(I,J),I=1,20) + & ,(RKDSTJ(I,J),I=1,20) 1780 CONTINUE 1778 IF(L.EQ.1) GO TO 1800 WRITE(21,1786) 1786 FORMAT(///5X,'POLAR ANGULAR DISTRIBUTION OF SPUTTERED ', - 1 'PARTICLES ; LAYER 2'//) -cTR 1786 FORMAT(///5X,'POLAR ANGULAR DISTRIBUTION OF SPUTTERED PARTICLES ; -cTR 1LAYER 2'//) + & 'PARTICLES ; LAYER 2'//) WRITE(21,1518) (AI(I),I=1,20),(KDSTL(I,2),I=1,20) - 1 ,(RKDSTL(I,2),I=1,20) + & ,(RKDSTL(I,2),I=1,20) IF(NJ(2).EQ.1) GO TO 1800 - DO 1788 J=NJ(1)+1,JT(3) - WRITE(21,1790) J-NJ(1) - 1790 FORMAT(///5X,'POLAR ANGULAR DISTRIBUTION OF SPUTTERED ', - 1 'PARTICLES ; LAYER 2 , SPECIES ',I1//) -cTR 1790 FORMAT(///5X,'POLAR ANGULAR DISTRIBUTION OF SPUTTERED PARTICLES ; -cTR 1LAYER 2 , SPECIES ',I1//) - WRITE(21,1518) (AI(I),I=1,20),(KDSTJ(I,J),I=1,20) - 1 ,(RKDSTJ(I,J),I=1,20) - 1788 CONTINUE + DO J=NJ(1)+1,JT(3) + WRITE(21,1790) J-NJ(1) + 1790 FORMAT(///5X,'POLAR ANGULAR DISTRIBUTION OF SPUTTERED ', + & 'PARTICLES ; LAYER 2 , SPECIES ',I1//) + WRITE(21,1518) (AI(I),I=1,20),(KDSTJ(I,J),I=1,20) + & ,(RKDSTJ(I,J),I=1,20) + ENDDO GO TO 1800 - 1764 DO 1761 I=1,20 - DO 1763 J=1,NJ(2) - 1763 KDSTL(I,1)=KDSTL(I,1)+KDSTJ(I,J) - DO 1765 J=NJ(2)+1,LJ-NJ(1) - 1765 KDSTL(I,2)=KDSTL(I,2)+KDSTJ(I,J) - 1761 CONTINUE + 1764 DO I=1,20 + DO J=1,NJ(2) + KDSTL(I,1)=KDSTL(I,1)+KDSTJ(I,J) + ENDDO + DO J=NJ(2)+1,LJ-NJ(1) + KDSTL(I,2)=KDSTL(I,2)+KDSTJ(I,J) + ENDDO + ENDDO DO 1799 J=1,2 - IF(ISPALT(J+1).EQ.0) GO TO 1799 - DO 1767 I=1,20 - 1767 RKDSTL(I,J)=KDSTL(I,J)*20.D0/ISPALT(J+1) + IF(ISPALT(J+1).EQ.0) GO TO 1799 + DO I=1,20 + RKDSTL(I,J)=KDSTL(I,J)*20.D0/ISPALT(J+1) + ENDDO 1799 CONTINUE DO 1797 J=1,LJ-NJ(1) - IF(ITSP(J+NJ(1)).EQ.0) GO TO 1797 - DO 1769 I=1,20 - 1769 RKDSTJ(I,J)=KDSTJ(I,J)*20.D0/ITSP(J+NJ(1)) + IF(ITSP(J+NJ(1)).EQ.0) GO TO 1797 + DO I=1,20 + RKDSTJ(I,J)=KDSTJ(I,J)*20.D0/ITSP(J+NJ(1)) + ENDDO 1797 CONTINUE WRITE(21,1771) 1771 FORMAT(///5X,'POLAR ANGULAR DISTRIBUTION OF SPUTTERED ', - 1 'PARTICLES ; LAYER 2'//) -cTR 1771 FORMAT(///5X,'POLAR ANGULAR DISTRIBUTION OF SPUTTERED PARTICLES ; -cTR 1LAYER 2'//) + & 'PARTICLES ; LAYER 2'//) WRITE(21,1518) (AI(I),I=1,20),(KDSTL(I,1),I=1,20) - 1 ,(RKDSTL(I,1),I=1,20) + & ,(RKDSTL(I,1),I=1,20) IF(NJ(2).EQ.1) GO TO 1773 DO 1775 J=1,NJ(2) - IF(ITSP(J+NJ(1)).EQ.0) GO TO 1775 - WRITE(21,1777) J - 1777 FORMAT(///5X,'POLAR ANGULAR DISTRIBUTION OF SPUTTERED ', - 1 'PARTICLES ; LAYER 2 ; SPECIES ',I1//) -cTR 1777 FORMAT(///5X,'POLAR ANGULAR DISTRIBUTION OF SPUTTERED PARTICLES ; -cTR 1LAYER 2 ; SPECIES ',I1//) - WRITE(21,1518) (AI(I),I=1,20),(KDSTJ(I,J),I=1,20) - 1 ,(RKDSTJ(I,J),I=1,20) + IF(ITSP(J+NJ(1)).EQ.0) GO TO 1775 + WRITE(21,1777) J + 1777 FORMAT(///5X,'POLAR ANGULAR DISTRIBUTION OF SPUTTERED ', + & 'PARTICLES ; LAYER 2 ; SPECIES ',I1//) + WRITE(21,1518) (AI(I),I=1,20),(KDSTJ(I,J),I=1,20) + & ,(RKDSTJ(I,J),I=1,20) 1775 CONTINUE 1773 CONTINUE WRITE(21,1779) 1779 FORMAT(///5X,'POLAR ANGULAR DISTRIBUTION OF SPUTTERED ', - 1 'PARTICLES ; LAYER 3'//) -cTR 1779 FORMAT(///5X,'POLAR ANGULAR DISTRIBUTION OF SPUTTERED PARTICLES ; -cTR 1LAYER 3'//) + & 'PARTICLES ; LAYER 3'//) WRITE(21,1518) (AI(I),I=1,20),(KDSTL(I,2),I=1,20) - 1 ,(RKDSTL(I,2),I=1,20) + & ,(RKDSTL(I,2),I=1,20) IF(NJ(2).EQ.1) GO TO 1800 - DO 1781 J=NJ(2)+1,LJ-NJ(1) - WRITE(21,1783) J-NJ(2) - 1783 FORMAT(///5X,'POLAR ANGULAR DISTRIBUTION OF SPUTTERED ', - 1 'PARTICLES ; LAYER 3 ; SPECIES ',I1//) -cTR 1783 FORMAT(///5X,'POLAR ANGULAR DISTRIBUTION OF SPUTTERED PARTICLES ; -cTR 1LAYER 3 ; SPECIES ',I1//) - WRITE(21,1518) (AI(I),I=1,20),(KDSTJ(I,J),I=1,20) - 1 ,(RKDSTJ(I,J),I=1,20) - 1781 CONTINUE + DO J=NJ(2)+1,LJ-NJ(1) + WRITE(21,1783) J-NJ(2) + 1783 FORMAT(///5X,'POLAR ANGULAR DISTRIBUTION OF SPUTTERED ', + & 'PARTICLES ; LAYER 3 ; SPECIES ',I1//) + WRITE(21,1518) (AI(I),I=1,20),(KDSTJ(I,J),I=1,20) + & ,(RKDSTJ(I,J),I=1,20) + ENDDO 1800 CONTINUE c -c hier wird der File for33 erzeugt +c The file for33 is created here c - DO i=1,100 - READ(33,'(A246)',ERR=7800,END=7800)COLUMN(i) - ENDDO + DO i=1,100 + READ(33,'(A246)',ERR=7800,END=7800)COLUMN(i) + ENDDO 7800 COLCOUNT=i-1 - CLOSE(33,STATUS='DELETE') - WRITE(33,7802) + CLOSE(33,STATUS='DELETE') + WRITE(33,7802) 7802 FORMAT(6x,'Energy',4x,'SigmaE',5x,'Alpha',2x,'SigAlpha',4x,'ntot', - 1 5x,'imp',2x,'backsc',3x,'trans',3x,'tried',4x,'negE',3x, - 2 'impL1',3x,'impL2',3x,'impL3',3x,'impL4',3x,'impL5',3x,'impL6', - 3 3x,'impL7',3x, - 4 'range',6x,'straggeling',2x, - 5 'Eback',7x,'sigEback',4x,'Etrans',6x,'SigEtrans',3x, - 6 'red. E',6x,'PRC') - DO i=2,COLCOUNT - WRITE(33,'(A246)')COLUMN(i) - ENDDO - IF(l.EQ.1) THEN - number_in_layer(1)=IIM - DO k=2,7 - number_in_layer(k)=0 - ENDDO - ELSEIF(l.EQ.2) THEN - DO k=3,7 - number_in_layer(k)=0 - ENDDO - ELSEIF(l.EQ.3) THEN - DO k=4,7 - number_in_layer(k)=0 - ENDDO - ELSEIF(l.EQ.4) THEN - DO k=5,7 - number_in_layer(k)=0 - ENDDO - ELSEIF(l.EQ.5) THEN - DO k=6,7 - number_in_layer(k)=0 - ENDDO - ELSEIF(l.EQ.6) THEN - number_in_layer(7)=0 - ENDIF - WRITE(33,7801)E0keV,EsigkeV,ALPHA,ALPHASIG, - 1 NH,IIM,IB,IT,tryE,negE, - 2 (number_in_layer(k),k=1,7), - 3 FIX0,SIGMAX,FIB0,SIGMAB,FIT0,SIGMAT,epsilon,prcoeff + & 5x,'imp',2x,'backsc',3x,'trans',3x,'tried',4x,'negE',3x, + & 'impL1',3x,'impL2',3x,'impL3',3x,'impL4',3x,'impL5',3x + & ,'impL6', 3x,'impL7',3x, 'range',6x,'straggeling',2x, 'Eback' + & ,7x,'sigEback',4x,'Etrans',6x,'SigEtrans',3x, 'red. E',6x + & ,'PRC') + DO i=2,COLCOUNT + WRITE(33,'(A246)')COLUMN(i) + ENDDO + IF(l.EQ.1) THEN + number_in_layer(1)=IIM + DO k=2,7 + number_in_layer(k)=0 + ENDDO + ELSEIF(l.EQ.2) THEN + DO k=3,7 + number_in_layer(k)=0 + ENDDO + ELSEIF(l.EQ.3) THEN + DO k=4,7 + number_in_layer(k)=0 + ENDDO + ELSEIF(l.EQ.4) THEN + DO k=5,7 + number_in_layer(k)=0 + ENDDO + ELSEIF(l.EQ.5) THEN + DO k=6,7 + number_in_layer(k)=0 + ENDDO + ELSEIF(l.EQ.6) THEN + number_in_layer(7)=0 + ENDIF + WRITE(33,7801)E0keV,EsigkeV,ALPHA,ALPHASIG,NH,IIM,IB,IT,tryE,negE + & ,(number_in_layer(k),k=1,7),FIX0,SIGMAX,FIB0,SIGMAB,FIT0 + & ,SIGMAT,epsilon,prcoeff 7801 FORMAT(F12.2,3(1x,F9.2),1x,13(I7,1x),6(E12.4),2(E12.4)) CLOSE(33) c -c hier endet File for33 +c End of file for33 C C TOP AND FRONT LINES FOR MATRICES C JE=DE JA=DA JG=DG - DO 32 J=2,NG1 - MAGB(J,1) = (J-1)*JG - MAGT(J,1) = (J-1)*JG - EMA(J,1)=DBLE(J-1)*DG - EMAT(J,1)=DBLE(J-1)*DG - 32 CONTINUE - DO 77 J=2,21 - MEAB(1,J) = J-1 - MEAT(1,J) = J-1 - MAGB(1,J) = J-1 - MAGT(1,J) = J-1 - EMA(1,J) = J-1 - EMAT(1,J) = J-1 - 77 CONTINUE - DO 1828 J=2,101 - MEAB(J,1) = J-1 - MEAT(J,1) = J-1 - MEPB(J,1) = J-1 - MEPB(1,J) = J-1 - MEPT(J,1) = J-1 - MEPT(1,J) = J-1 - 1828 CONTINUE - DO 1830 K=1,JT(3) - DO 1832 J=2,NG1 - MAGS(J,1,K) = (J-1)*JG - MAGST(J,1,K) = (J-1)*JG - MAGSA(J,1,K) = (J-1)*JG - 1832 CONTINUE - DO 1826 J=2,NA1 - MAGSA(1,J,K) = (J-1)*JA - 1826 CONTINUE - DO 1834 J=2,21 - MEAS(1,J,K) = J-1 - MEAST(1,J,K) = J-1 - MAGS(1,J,K) = J-1 - MAGST(1,J,K) = J-1 - 1834 CONTINUE - DO 1836 J=2,101 - MEAS(J,1,K) = J-1 - MEAST(J,1,K) = J-1 - 1836 CONTINUE - DO 1838 J=1,20 - MEASL(1,J,K)=J - MEASTL(1,J,K)=J - 1838 CONTINUE - DO 1841 IG2=1,NGIK,1 - DO 1843 J=2,21 - MEAGS(1,IG2,J,K) = J-1 - 1843 CONTINUE - DO 1845 J=2,101 - MEAGS(J,IG2,1,K) = J-1 - 1845 CONTINUE - 1841 CONTINUE - 1830 CONTINUE - DO 1840 IG2=1,NGIK,1 - DO 1842 J=2,21 - MEAGB(1,IG2,J) = J-1 - 1842 MEAGT(1,IG2,J) = J-1 - DO 1844 J=2,101 - MEAGB(J,IG2,1) = J-1 - 1844 MEAGT(J,IG2,1) = J-1 - 1840 CONTINUE - DO 1846 I=2,74 - 1846 ELOG(I)=10.D0**(I/12.D0)*10.D0**(-7.D0/6.D0) + DO J=2,NG1 + MAGB(J,1) = (J-1)*JG + MAGT(J,1) = (J-1)*JG + EMA(J,1)=DBLE(J-1)*DG + EMAT(J,1)=DBLE(J-1)*DG + ENDDO + DO J=2,21 + MEAB(1,J) = J-1 + MEAT(1,J) = J-1 + MAGB(1,J) = J-1 + MAGT(1,J) = J-1 + EMA(1,J) = J-1 + EMAT(1,J) = J-1 + ENDDO + DO J=2,101 + MEAB(J,1) = J-1 + MEAT(J,1) = J-1 + MEPB(J,1) = J-1 + MEPB(1,J) = J-1 + MEPT(J,1) = J-1 + MEPT(1,J) = J-1 + ENDDO + DO K=1,JT(3) + DO J=2,NG1 + MAGS(J,1,K) = (J-1)*JG + MAGST(J,1,K) = (J-1)*JG + MAGSA(J,1,K) = (J-1)*JG + ENDDO + DO J=2,NA1 + MAGSA(1,J,K) = (J-1)*JA + ENDDO + DO J=2,21 + MEAS(1,J,K) = J-1 + MEAST(1,J,K) = J-1 + MAGS(1,J,K) = J-1 + MAGST(1,J,K) = J-1 + ENDDO + DO J=2,101 + MEAS(J,1,K) = J-1 + MEAST(J,1,K) = J-1 + ENDDO + DO J=1,20 + MEASL(1,J,K)=J + MEASTL(1,J,K)=J + ENDDO + DO IG2=1,NGIK,1 + DO J=2,21 + MEAGS(1,IG2,J,K) = J-1 + ENDDO + DO J=2,101 + MEAGS(J,IG2,1,K) = J-1 + ENDDO + ENDDO + ENDDO + DO IG2=1,NGIK,1 + DO J=2,21 + MEAGB(1,IG2,J) = J-1 + MEAGT(1,IG2,J) = J-1 + ENDDO + DO J=2,101 + MEAGB(J,IG2,1) = J-1 + MEAGT(J,IG2,1) = J-1 + ENDDO + ENDDO + DO I=2,74 + ELOG(I)=10.D0**(I/12.D0)*10.D0**(-7.D0/6.D0) + ENDDO TEMP=(10.D0**(1.D0/12.D0)-1.D0)*10.D0**(-7.D0/6.D0) TEMPNH=TEMP*DBLE(NH) C @@ -3762,126 +3749,99 @@ C BACKWARD SPUTTERING : MATRICES , ENERGY - ANGLE CORRELATIONS C IF(ISPA.LT.10000) GO TO 1900 DO 1850 J=1,JT(3) - EASL(2,J)=DBLE(MEASL(2,21,J))/(DBLE(NH)*0.1) - DO 1850 IESLOG=3,74 - 1850 EASL(IESLOG,J)=DBLE(MEASL(IESLOG,21,J))/(TEMPNH* - 1 10.D0**((IESLOG-1)/12.D0)) + EASL(2,J)=DBLE(MEASL(2,21,J))/(DBLE(NH)*0.1) + DO 1850 IESLOG=3,74 + 1850 EASL(IESLOG,J)=DBLE(MEASL(IESLOG,21,J))/(TEMPNH*10.D0 + & **((IESLOG-1)/12.D0)) DO 1852 J=1,NJ(1) WRITE(21,1854) J 1854 FORMAT(//,' LOG ENERGY - COS OF EMISSION ANGLE (0.05 STEPS) (BAC - 1KWARD SPUTTERED PARTICLES) ; 1. LAYER ; SPECIES',I2/) - do ima = 74,2,-1 - if(measl(ima,21,j).ne.0) goto 1855 - enddo - ima = 1 - 1855 ima = min(ima+2,74) - do ies = 1, ima - write (6, 1858) elog(ies), (measl(ies,ias,j),ias=1,21), - 1 easl(ies,j) - end do - write (6, 1858) elog(75), (measl(75,ias,j),ias=1,21), - 1 easl(75,j) -c DO 1856 IES=1,75 -c1856 WRITE(6,1858) ELOG(IES),(MEASL(IES,IAS,J),IAS=1,21),EASL(IES,J) + &KWARD SPUTTERED PARTICLES) ; 1. LAYER ; SPECIES',I2/) + do ima = 74,2,-1 + if(measl(ima,21,j).ne.0) goto 1855 + enddo + ima = 1 + 1855 ima = min(ima+2,74) + do ies = 1, ima + write (6, 1858) elog(ies), (measl(ies,ias,j),ias=1,21), + & easl(ies,j) + enddo + write (6, 1858) elog(75), (measl(75,ias,j),ias=1,21),easl(75,j) 1858 FORMAT(1X,1E12.4,20I5,I6,1E12.4) WRITE(21,1884) J 1884 FORMAT(//,' ENERGY(E/E0 IN %) - ', - 1 'POLAR ANGLE IN COS-INTERVALS (0.05) ', - 2 '(BACKWARD SPUTTERED PARTICLES) , 1.LAYER , SPECIES',I2/) -cTR 1884 FORMAT(//,' ENERGY(E/E0 IN %) - POLAR ANGLE IN COS-INTERVALS (0.05 -cTR 1) (BACKWARD SPUTTERED PARTICLES) , 1.LAYER , SPECIES',I2/) - do ima = 101,1,-1 - if(meas(ima,22,j).ne.0) goto 1883 - enddo - ima = 1 - 1883 ima = min(ima+2,101) - write (6, 1886) ((meas(iesp,iags,j),iags=1,22),iesp=1,ima) - write (6, 1886) (meas(102,iags,j),iags=1,22) + & 'POLAR ANGLE IN COS-INTERVALS (0.05) ', + & '(BACKWARD SPUTTERED PARTICLES) , 1.LAYER , SPECIES',I2/) + do ima = 101,1,-1 + if(meas(ima,22,j).ne.0) goto 1883 + enddo + ima = 1 + 1883 ima = min(ima+2,101) + write (6, 1886) ((meas(iesp,iags,j),iags=1,22),iesp=1,ima) + write (6, 1886) (meas(102,iags,j),iags=1,22) 1886 FORMAT(1X,I3,20I6,I8) -c WRITE(6,1886) ((MEAS(IESP,IAGS,J),IAGS=1,22),IESP=1,102) -c1886 FORMAT(1X,21I5,I7) IF(ALPHA.LT.1.) GO TO 1878 - DO 1870 IG2=1,NGIK,1 - EEE = IG2*DGI - WRITE(21,1872) EEE,J - 1872 FORMAT(//,' ENERGY(E/E0 IN %) - ', - & 'POLAR ANGLE IN COS-INTERVALS (0.05) ', - 1 'AT AZIMUTHAL ANGLE =',F5.1, - 2 ' (BACKWARD SPUTTERED ATOMS) , 1.LAYER , SPECIES',I2/) -cTR 1872 FORMAT(//,' ENERGY(E/E0 IN %) - POLAR ANGLE IN COS-INTERVALS (0.05 -cTR 1) AT AZIMUTHAL ANGLE =',F5.1,' (BACKWARD SPUTTERED ATOMS) , 1.LAYE -CTR 2R , SPECIES',I2/) - do ima = 101,1,-1 - if(meags(ima,ig2,22,j).ne.0) goto 1885 - enddo - ima = 1 - 1885 ima = min(ima+2,101) - do iesp = 1, ima - write (6, 1886) (meags(iesp,ig2,iags,j),iags=1,22) - end do - write (6, 1886) (meags(102,ig2,iags,j),iags=1,22) -c DO 1870 IE=1,102 -c WRITE(6,1886) (MEAGS(IE,IG2,IAGS,J),IAGS=1,22) + DO 1870 IG2=1,NGIK,1 + EEE = IG2*DGI + WRITE(21,1872) EEE,J + 1872 FORMAT(//,' ENERGY(E/E0 IN %) - ', + & 'POLAR ANGLE IN COS-INTERVALS (0.05) ', + & 'AT AZIMUTHAL ANGLE =',F5.1, + & ' (BACKWARD SPUTTERED ATOMS) , 1.LAYER , SPECIES',I2/) + do ima = 101,1,-1 + if(meags(ima,ig2,22,j).ne.0) goto 1885 + enddo + ima = 1 + 1885 ima = min(ima+2,101) + do iesp = 1, ima + write (6, 1886) (meags(iesp,ig2,iags,j),iags=1,22) + end do + write (6, 1886) (meags(102,ig2,iags,j),iags=1,22) 1870 CONTINUE WRITE(21,1889) J 1889 FORMAT(//,' AZIMUTHAL ANGLE - POLAR ANGLE IN DEGREES ', - 1 '(BACKWARD SPUTTERED PARTICLES) , 1.LAYER , SPECIES',I2/) -c 1889 FORMAT(//,' AZIMUTHAL ANGLE - POLAR ANGLE IN DEGREES (BACKWARD -c 1 SPUTTERED PARTICLES) , 1.LAYER , SPECIES',I2/) + & '(BACKWARD SPUTTERED PARTICLES) , 1.LAYER , SPECIES',I2/) WRITE(21,1887) ((MAGSA(IG,IA,J),IA=1,32),IG=1,62) 1887 FORMAT(1X,31I4,I6) 1878 CONTINUE WRITE(21,1888) J 1888 FORMAT(//,' AZIMUTHAL ANGLE - POLAR ANGLE IN COS-INTERVALS ', - & '(0.05) ', - 1 ' (BACKWARD SPUTTERED PARTICLES) , 1.LAYER , SPECIES',I2/) + & '(0.05) ', + & ' (BACKWARD SPUTTERED PARTICLES) , 1.LAYER , SPECIES',I2/) WRITE(21,1886) ((MAGS(IG,IAGS,J),IAGS=1,22),IG=1,62) -cTR 1888 FORMAT(//,' AZIMUTHAL ANGLE - POLAR ANGLE IN COS-INTERVALS (0.05) -cTR 1 (BACKWARD SPUTTERED PARTICLES) , 1.LAYER , SPECIES',I2/) -cTR WRITE(21,1886) ((MAGS(IG,IAGS,J),IAGS=1,22),IG=1,62) 1852 CONTINUE IF(L.EQ.1) GO TO 1900 if(ispal(2).eq.0) goto 1900 DO 1862 J=NJ(1)+1,JT(3) - WRITE(21,1864) J-NJ(1) - 1864 FORMAT(//,' LOG ENERGY - COS OF EMISSION ANGLE (0.05 STEPS) ', - 1 '(BACKWARD SPUTTERED PARTICLES) , 2. LAYER , SPECIES',I2/) -cTR 1864 FORMAT(//,' LOG ENERGY - COS OF EMISSION ANGLE (0.05 STEPS) (BAC -cTR 1KWARD SPUTTERED PARTICLES) , 2. LAYER , SPECIES',I2/) - do ima = 74,1,-1 - if(measl(ima,21,j).ne.0) goto 1865 - enddo - ima = 1 - 1865 ima = min(ima+2,74) - do ies = 1, ima - write (6, 1858) elog(ies), (measl(ies,ias,j),ias=1,21) - 1 , easl(ies,j) - end do - write (6, 1858) elog(75), (measl(75,ias,j),ias=1,21) - 1 , easl(75,j) -c DO 1866 IES=1,75 -c1866 WRITE(6,1858) ELOG(IES),(MEASL(IES,IAS,J),IAS=1,21),EASL(IES,J) - WRITE(21,1894) J-NJ(1) - 1894 FORMAT(//,' ENERGY(E/E0 IN %) - POLAR ANGLE IN COS-INTERVALS ', - 1 '(0.05) (BACKWARD SPUTTERED PARTICLES) , 2.LAYER , SPECIES', - 2 I2/) -cTR 1894 FORMAT(//,' ENERGY(E/E0 IN %) - POLAR ANGLE IN COS-INTERVALS (0.05 -cTR 1) (BACKWARD SPUTTERED PARTICLES) , 2.LAYER , SPECIES',I2/) - do ima = 101,1,-1 - if(meas(ima,22,j).ne.0) goto 1895 - enddo - ima = 1 - 1895 ima = min(ima+2,101) - WRITE(21,1886)((meas(iesp,iags,j),iags=1,22),iesp=1,ima) - WRITE(21,1886)(meas(102,iags,j),iags=1,22) -c WRITE(6,1886) ((MEAS(IESP,IAGS,J),IAGS=1,22),IESP=1,102) - WRITE(21,1898) J-NJ(1) - 1898 FORMAT(//,' AZIMUTHAL ANGLE - POLAR ANGLE IN COS-INTERVALS ', + WRITE(21,1864) J-NJ(1) + 1864 FORMAT(//,' LOG ENERGY - COS OF EMISSION ANGLE (0.05 STEPS) ', + & '(BACKWARD SPUTTERED PARTICLES) , 2. LAYER , SPECIES',I2/) + do ima = 74,1,-1 + if(measl(ima,21,j).ne.0) goto 1865 + enddo + ima = 1 + 1865 ima = min(ima+2,74) + do ies = 1, ima + write (6, 1858) elog(ies),(measl(ies,ias,j),ias=1,21), + & easl(ies,j) + enddo + write (6, 1858) elog(75),(measl(75,ias,j),ias=1,21),easl(75,j) + WRITE(21,1894) J-NJ(1) + 1894 FORMAT(//,' ENERGY(E/E0 IN %) - POLAR ANGLE IN COS-INTERVALS ', + & '(0.05) (BACKWARD SPUTTERED PARTICLES) , 2.LAYER , SPECIES', + & I2/) + do ima = 101,1,-1 + if(meas(ima,22,j).ne.0) goto 1895 + enddo + ima = 1 + 1895 ima = min(ima+2,101) + WRITE(21,1886)((meas(iesp,iags,j),iags=1,22),iesp=1,ima) + WRITE(21,1886)(meas(102,iags,j),iags=1,22) + WRITE(21,1898) J-NJ(1) + 1898 FORMAT(//,' AZIMUTHAL ANGLE - POLAR ANGLE IN COS-INTERVALS ', & '(0.05) ', 1 ' (BACKWARD SPUTTERED PARTICLES) , 2.LAYER , SPECIES',I2/) -cTR 1898 FORMAT(//,' AZIMUTHAL ANGLE - POLAR ANGLE IN COS-INTERVALS (0.05) -cTR 1 (BACKWARD SPUTTERED PARTICLES) , 2.LAYER , SPECIES',I2/) - WRITE(21,1886) ((MAGS(IG,IAGS,J),IAGS=1,22),IG=1,62) + WRITE(21,1886) ((MAGS(IG,IAGS,J),IAGS=1,22),IG=1,62) 1862 CONTINUE 1900 CONTINUE C @@ -3891,51 +3851,41 @@ C JTJ=JT(3) IF(L.EQ.3) JTJ=LJ-NJ(1) DO 1950 J=1,JTJ - EASTL(2,J)=DBLE(MEASTL(2,21,J))/(DBLE(NH)*0.1D0) - DO 1950 IESLOG=3,74 - 1950 EASTL(IESLOG,J)=DBLE(MEASTL(IESLOG,21,J))/(TEMPNH* - 1 10.D0**((IESLOG-1)/12.D0)) - IF(L.EQ.3) GO TO 1953 - DO 1952 J=1,NJ(1) - WRITE(21,1954) J + EASTL(2,J)=DBLE(MEASTL(2,21,J))/(DBLE(NH)*0.1D0) + DO 1950 IESLOG=3,74 + 1950 EASTL(IESLOG,J)=DBLE(MEASTL(IESLOG,21,J))/(TEMPNH*10.D0 + & **((IESLOG-1)/12.D0)) + IF(L.EQ.3) GO TO 1953 + DO 1952 J=1,NJ(1) + WRITE(21,1954) J 1954 FORMAT(//,' LOG ENERGY - COS OF EMISSION ANGLE (0.05 STEPS) ', - & '(FORWARD SPUTTERED PARTICLES) ', - 1 ', 1. LAYER , SPECIES',I2/) -cTR 1954 FORMAT(//,' LOG ENERGY - COS OF EMISSION ANGLE (0.05 STEPS) (FOR -cTR 1WARD SPUTTERED PARTICLES) , 1. LAYER , SPECIES',I2/) - do ima = 74,2,-1 - if(meastl(ima,21,j).ne.0) goto 1955 - enddo - ima = 1 - 1955 ima = min(ima+2,74) - do ies = 1, ima - write (6, 1858) elog(ies), (meastl(ies,ias,j),ias=1,21), - 1 eastl(ies,j) - end do - write (6, 1858) elog(75), (meastl(75,ias,j),ias=1,21), - 1 eastl(75,j) -c DO 1956 IES=1,75 -c1956 WRITE(6,1858) ELOG(IES),(MEASTL(IES,IAS,J),IAS=1,21),EASTL(IES,J) + & '(FORWARD SPUTTERED PARTICLES) ', + & ', 1. LAYER , SPECIES',I2/) + do ima = 74,2,-1 + if(meastl(ima,21,j).ne.0) goto 1955 + enddo + ima = 1 + 1955 ima = min(ima+2,74) + do ies = 1, ima + write (6, 1858) elog(ies), (meastl(ies,ias,j),ias=1,21), + & eastl(ies,j) + enddo + write (6, 1858) elog(75), (meastl(75,ias,j),ias=1,21),eastl(75,j) WRITE(21,1984) J 1984 FORMAT(//,' ENERGY(E/E0 IN %) - POLAR ANGLE IN COS-INTERVALS ', & '(0.05) ', - 1 '(FORWARD SPUTTERED PARTICLES) , 1.LAYER , SPECIES',I2/) -cTR 1984 FORMAT(//,' ENERGY(E/E0 IN %) - POLAR ANGLE IN COS-INTERVALS (0.05 -cTR 1) (FORWARD SPUTTERED PARTICLES) , 1.LAYER , SPECIES',I2/) - do ima = 101,1,-1 - if(meast(ima,22,j).ne.0) goto 1983 - enddo - ima = 1 - 1983 ima = min(ima+2,101) - write (6, 1886) ((meast(iesp,iags,j),iags=1,22),iesp=1,ima) - write (6, 1886) (meast(102,iags,j),iags=1,22) -c WRITE(6,1886) ((MEAST(IESP,IAGS,J),IAGS=1,22),IESP=1,102) + & '(FORWARD SPUTTERED PARTICLES) , 1.LAYER , SPECIES',I2/) + do ima = 101,1,-1 + if(meast(ima,22,j).ne.0) goto 1983 + enddo + ima = 1 + 1983 ima = min(ima+2,101) + write (6, 1886) ((meast(iesp,iags,j),iags=1,22),iesp=1,ima) + write (6, 1886) (meast(102,iags,j),iags=1,22) WRITE(21,1988) J 1988 FORMAT(//,' AZIMUTHAL ANGLE - POLAR ANGLE IN COS-INTERVALS ', - & '(0.05) ', - 1 ' (FORWARD SPUTTERED PARTICLES) , 1.LAYER , SPECIES',I2/) -cTR 1988 FORMAT(//,' AZIMUTHAL ANGLE - POLAR ANGLE IN COS-INTERVALS (0.05) -cTR 1 (FORWARD SPUTTERED PARTICLES) , 1.LAYER , SPECIES',I2/) + & '(0.05) ', + & ' (FORWARD SPUTTERED PARTICLES) , 1.LAYER , SPECIES',I2/) WRITE(21,1886) ((MAGST(IG,IAGS,J),IAGS=1,22),IG=1,62) 1952 CONTINUE 1953 CONTINUE @@ -3947,220 +3897,143 @@ cTR 1 (FORWARD SPUTTERED PARTICLES) , 1.LAYER , SPECIES',I2/) 1961 JTK=1 JTL=NJ(2) 1963 DO 1962 J=JTK,JTL - WRITE(21,1964) J-JTK+1 - 1964 FORMAT(//,' LOG ENERGY - COS OF EMISSION ANGLE (0.05 STEPS) ', - & '(FORWARD SPUTTERED PARTICLES) ,', - 1 ' 2. LAYER , SPECIES',I2/) -cTR 1964 FORMAT(//,' LOG ENERGY - COS OF EMISSION ANGLE (0.05 STEPS) (FOR -cTR 1WARD SPUTTERED PARTICLES) , 2. LAYER , SPECIES',I2/) - do ima = 74,1,-1 - if(meastl(ima,21,j).ne.0) goto 1965 - enddo - ima = 1 - 1965 ima = min(ima+2,74) - do ies = 1, ima - write (6, 1858) elog(ies), (meastl(ies,ias,j),ias=1,21) - 1 , eastl(ies,j) - end do - write (6, 1858) elog(75), (meastl(75,ias,j),ias=1,21) - 1 , eastl(75,j) -c DO 1966 IES=1,75 -c1966 WRITE(6,1858) ELOG(IES),(MEASTL(IES,IAS,J),IAS=1,21),EASTL(IES,J) - WRITE(21,1994) J-JTK+1 - 1994 FORMAT(//,' ENERGY(E/E0 IN %) - POLAR ANGLE IN COS-INTERVALS ', - 1 '(0.05) (FORWARD SPUTTERED PARTICLES) , 2.LAYER , SPECIES',I2/) -cTR 1994 FORMAT(//,' ENERGY(E/E0 IN %) - POLAR ANGLE IN COS-INTERVALS (0.05 -cTR 1) (FORWARD SPUTTERED PARTICLES) , 2.LAYER , SPECIES',I2/) - do ima = 101,1,-1 - if(meast(ima,22,j).ne.0) goto 1995 - enddo - ima = 1 - 1995 ima = min(ima+2,101) - WRITE(21,1886)((meast(iesp,iags,j),iags=1,22),iesp=1,ima) - WRITE(21,1886)(meast(102,iags,j),iags=1,22) -c WRITE(6,1886) ((MEAST(IESP,IAGS,J),IAGS=1,22),IESP=1,102) - WRITE(21,1998) J-JTK+1 - 1998 FORMAT(//,' AZIMUTHAL ANGLE - POLAR ANGLE IN COS-INTERVALS ', - 1 '(0.05) (FORWARD SPUTTERED PARTICLES) , 2.LAYER , SPECIES',I2/) -cTR 1998 FORMAT(//,' AZIMUTHAL ANGLE - POLAR ANGLE IN COS-INTERVALS (0.05) -cTR 1 (FORWARD SPUTTERED PARTICLES) , 2.LAYER , SPECIES',I2/) - WRITE(21,1886) ((MAGST(IG,IAGS,J),IAGS=1,22),IG=1,62) + WRITE(21,1964) J-JTK+1 + 1964 FORMAT(//,' LOG ENERGY - COS OF EMISSION ANGLE (0.05 STEPS) ', + & '(FORWARD SPUTTERED PARTICLES) ,', + & ' 2. LAYER , SPECIES',I2/) + do ima = 74,1,-1 + if(meastl(ima,21,j).ne.0) goto 1965 + enddo + ima = 1 + 1965 ima = min(ima+2,74) + do ies = 1, ima + write (6, 1858) elog(ies), (meastl(ies,ias,j),ias=1,21), + & eastl(ies,j) + enddo + write (6, 1858) elog(75), (meastl(75,ias,j),ias=1,21) , + & eastl(75,j) + WRITE(21,1994) J-JTK+1 + 1994 FORMAT(//,' ENERGY(E/E0 IN %) - POLAR ANGLE IN COS-INTERVALS ', + & '(0.05) (FORWARD SPUTTERED PARTICLES) , 2.LAYER , SPECIES',I2/) + do ima = 101,1,-1 + if(meast(ima,22,j).ne.0) goto 1995 + enddo + ima = 1 + 1995 ima = min(ima+2,101) + WRITE(21,1886)((meast(iesp,iags,j),iags=1,22),iesp=1,ima) + WRITE(21,1886)(meast(102,iags,j),iags=1,22) + WRITE(21,1998) J-JTK+1 + 1998 FORMAT(//,' AZIMUTHAL ANGLE - POLAR ANGLE IN COS-INTERVALS ', + & '(0.05) (FORWARD SPUTTERED PARTICLES) , 2.LAYER , SPECIES',I2/) + WRITE(21,1886) ((MAGST(IG,IAGS,J),IAGS=1,22),IG=1,62) 1962 CONTINUE IF(L.LT.3) GO TO 2000 DO 1972 J=NJ(2)+1,LJ-NJ(1) - WRITE(21,1974) J-NJ(2) - 1974 FORMAT(//,' LOG ENERGY - COS OF EMISSION ANGLE (0.05 STEPS) ', - 1 '(FORWARD SPUTTERED PARTICLES) , 3. LAYER , SPECIES',I2/) -cTR 1974 FORMAT(//,' LOG ENERGY - COS OF EMISSION ANGLE (0.05 STEPS) (FOR -cTR 1WARD SPUTTERED PARTICLES) , 3. LAYER , SPECIES',I2/) - do ima = 74,1,-1 - if(meastl(ima,21,j).ne.0) goto 1973 - enddo - ima = 1 - 1973 ima = min(ima+2,74) - do ies = 1, ima - write (6, 1858) elog(ies), (meastl(ies,ias,j),ias=1,21) - 1 , eastl(ies,j) - end do - write (6, 1858) elog(75), (meastl(75,ias,j),ias=1,21) - 1 , eastl(75,j) -c DO 1976 IES=1,75 -c1976 WRITE(6,1858) ELOG(IES),(MEASTL(IES,IAS,J),IAS=1,21),EASTL(IES,J) - WRITE(21,1975) J-NJ(2) - 1975 FORMAT(//,' ENERGY(E/E0 IN %) - POLAR ANGLE IN COS-INTERVALS ', - 1 '(0.05) (FORWARD SPUTTERED PARTICLES) , 3.LAYER , SPECIES',I2/) -cTR 1975 FORMAT(//,' ENERGY(E/E0 IN %) - POLAR ANGLE IN COS-INTERVALS (0.05 -cTR 1) (FORWARD SPUTTERED PARTICLES) , 3.LAYER , SPECIES',I2/) - do ima = 101,1,-1 - if(meast(ima,22,j).ne.0) goto 1977 - enddo - ima = 1 - 1977 ima = min(ima+2,101) - WRITE(21,1886)((meast(iesp,iags,j),iags=1,22),iesp=1,ima) - WRITE(21,1886)(meast(102,iags,j),iags=1,22) -c WRITE(6,1886) ((MEAST(IESP,IAGS,J),IAGS=1,22),IESP=1,102) - WRITE(21,1978) J-NJ(2) - 1978 FORMAT(//,' AZIMUTHAL ANGLE - POLAR ANGLE IN COS-INTERVALS ', - 1 '(0.05) (FORWARD SPUTTERED PARTICLES) , 3.LAYER , SPECIES',I2/) -cTR 1978 FORMAT(//,' AZIMUTHAL ANGLE - POLAR ANGLE IN COS-INTERVALS (0.05) -cTR 1 (FORWARD SPUTTERED PARTICLES) , 3.LAYER , SPECIES',I2/) - WRITE(21,1886) ((MAGST(IG,IAGS,J),IAGS=1,22),IG=1,62) + WRITE(21,1974) J-NJ(2) + 1974 FORMAT(//,' LOG ENERGY - COS OF EMISSION ANGLE (0.05 STEPS) ', + & '(FORWARD SPUTTERED PARTICLES) , 3. LAYER , SPECIES',I2/) + do ima = 74,1,-1 + if(meastl(ima,21,j).ne.0) goto 1973 + enddo + ima = 1 + 1973 ima = min(ima+2,74) + do ies = 1, ima + write (6, 1858) elog(ies), (meastl(ies,ias,j),ias=1,21) , + & eastl(ies,j) + end do + write (6, 1858) elog(75), (meastl(75,ias,j),ias=1,21) , + & eastl(75,j) + WRITE(21,1975) J-NJ(2) + 1975 FORMAT(//,' ENERGY(E/E0 IN %) - POLAR ANGLE IN COS-INTERVALS ', + & '(0.05) (FORWARD SPUTTERED PARTICLES) , 3.LAYER , SPECIES',I2/) + do ima = 101,1,-1 + if(meast(ima,22,j).ne.0) goto 1977 + enddo + ima = 1 + 1977 ima = min(ima+2,101) + WRITE(21,1886)((meast(iesp,iags,j),iags=1,22),iesp=1,ima) + WRITE(21,1886)(meast(102,iags,j),iags=1,22) + WRITE(21,1978) J-NJ(2) + 1978 FORMAT(//,' AZIMUTHAL ANGLE - POLAR ANGLE IN COS-INTERVALS ', + & '(0.05) (FORWARD SPUTTERED PARTICLES) , 3.LAYER , SPECIES',I2/) + WRITE(21,1886) ((MAGST(IG,IAGS,J),IAGS=1,22),IG=1,62) 1972 CONTINUE -C DO 34 IG2=1,NGIK,1 -C EEE = IG2*DGI -C WRITE(6,912) EEE -C 912 FORMAT(1H1,' ENERGY(E/E0 IN %) - POLAR ANGLE IN COS-INTERVALS (0.0 -C 15) AT AZIMUTHAL ANGLE =',F5.1,' (SPUTTERED ATOMS)'//) -C DO 42 IE=2,101 -C 42 MEAGS(102,IG2,22) = MEAGS(102,IG2,22)+MEAGS(IE,IG2,22) -C DO 34 IE=1,102 -C WRITE(6,980) (MEAGS(IE,IG2,IAGS),IAGS=1,22) -C 34 CONTINUE -C IF(ALPHA.LT.1.) GO TO 8009 -C DO 8001 IG3=1,NGIK,1 -C EE1 = IG3*DGI -C WRITE(6,8002) EE1 -C8002 FORMAT(1H1,' LOG ENERGY - POLAR ANGLE IN COS-INTERVALS (0.05) AT -C 1 AZIMUTHAL ANGLE =',F5.1,' (SPUTTERED ATOMS)'//) -C DO 8003 J=1,20 -C8003 MEAGSL(1,IG3,J)=J -C IF(MEAGS(102,IG3,22).EQ.0) MEAGS(102,IG3,22)=1 -C EAGSL(2)=DFLOAT(MEAGSL(2,IG3,21))/(DFLOAT(MEAGS(102,IG3,22))*0.1) -C DO 8004 IESLOG=3,74 -C8004 EAGSL(IESLOG)=DFLOAT(MEAGSL(IESLOG,IG3,21))/(DFLOAT(MEAGS(102,IG3,22 -C ?))*TEMP*10.**((IESLOG-1)/12.)) -C DO 8005 IES=1,75 -C8005 WRITE(6,8600) ELOG(IES),(MEAGSL(IES,IG3,IAS),IAS=1,21),EAGSL(IES) -C8001 CONTINUE 2000 CONTINUE C C BACKSCATTERING : MATRICES , ENERGY - ANGULAR CORRELATIONS C IF(IB.LT.10000) GO TO 2100 - DO 2002 J=1,20 - 2002 MEABL(1,J)=J + DO J=1,20 + MEABL(1,J)=J + ENDDO EABL(2)=DBLE(MEABL(2,21))/(DBLE(NH)*0.1D0) - DO 2004 IERLOG=3,74 - 2004 EABL(IERLOG)=DBLE(MEABL(IERLOG,21))/(TEMPNH* - #10.D0**((IERLOG-1)/12.D0)) + DO IERLOG=3,74 + EABL(IERLOG)=DBLE(MEABL(IERLOG,21))/(TEMPNH*10.D0**((IERLOG-1) + & /12.D0)) + ENDDO WRITE(21,2006) 2006 FORMAT(//,' LOG ENERGY - COS OF EMISSION ANGLE (0.05 STEPS) ', - 1 '(BACKSCATTERED PROJECTILES)'/) -cTR 2006 FORMAT(//,' LOG ENERGY - COS OF EMISSION ANGLE (0.05 STEPS) (BAC -cTR 1KSCATTERED PROJECTILES)'/) - do ima = 74,1,-1 - if(meabl(ima,21).ne.0) goto 2005 - enddo - ima = 1 - 2005 ima = min(ima+2,74) - do ies = 1, ima - WRITE(21,1858)elog(ies),(meabl(ies,iag),iag=1,21),eabl(ies) - end do - WRITE(21,1858)elog(75),(meabl(75,iag),iag=1,21),eabl(75) -c DO 2008 IES=1,75 -c2008 WRITE(6,1858) ELOG(IES),(MEABL(IES,IAG),IAG=1,21),EABL(IES) + & '(BACKSCATTERED PROJECTILES)'/) + do ima = 74,1,-1 + if(meabl(ima,21).ne.0) goto 2005 + enddo + ima = 1 + 2005 ima = min(ima+2,74) + do ies = 1, ima + WRITE(21,1858)elog(ies),(meabl(ies,iag),iag=1,21),eabl(ies) + end do + WRITE(21,1858)elog(75),(meabl(75,iag),iag=1,21),eabl(75) IF(ALPHA.LT.1.) GO TO 2010 - DO 2012 IG2=1,NGIK,1 - EEE = IG2*DGI - WRITE(21,2014) EEE - 2014 FORMAT(//,' ENERGY(E/E0 IN %) - POLAR ANGLE IN COS-INTERVALS ', - 1 '(0.05) AT AZIMUTHAL ANGLE =',F5.1, - 2 ' (BACKSCATTERED PROJECTILES)'/) -cTR 2014 FORMAT(//,' ENERGY(E/E0 IN %) - POLAR ANGLE IN COS-INTERVALS (0.05 -cTR 1) AT AZIMUTHAL ANGLE =',F5.1,' (BACKSCATTERED PROJECTILES)'/) - do ima = 101,1,-1 - if(meagb(ima,ig2,22).ne.0) goto 2015 - enddo - ima = 1 - 2015 ima = min(ima+2,101) - write (6, 1886) ((meagb(ie,ig2,iagb),iagb=1,22),ie=1,ima) - write (6, 1886) (meagb(102,ig2,iagb),iagb=1,22) -c2012 WRITE(6,1886) ((MEAGB(IE,IG2,IAGB),IAGB=1,22),IE=1,102) - 2012 continue + DO IG2=1,NGIK,1 + EEE = IG2*DGI + WRITE(21,2014) EEE + 2014 FORMAT(//,' ENERGY(E/E0 IN %) - POLAR ANGLE IN COS-INTERVALS ', + & '(0.05) AT AZIMUTHAL ANGLE =',F5.1, + & ' (BACKSCATTERED PROJECTILES)'/) + do ima = 101,1,-1 + if(meagb(ima,ig2,22).ne.0) goto 2015 + enddo + ima = 1 + 2015 ima = min(ima+2,101) + write (6, 1886) ((meagb(ie,ig2,iagb),iagb=1,22),ie=1,ima) + write (6, 1886) (meagb(102,ig2,iagb),iagb=1,22) + ENDDO 2010 CONTINUE IF(E0.LT.0.) GO TO 2052 WRITE(21,2016) 2016 FORMAT(//,' ENERGY(E/E0 IN %) - POLAR ANGLE IN COS-INTERVALS ', - 1 '(0.05) (BACKSCATTERED PROJECTILES)'/) -cTR 2016 FORMAT(//,' ENERGY(E/E0 IN %) - POLAR ANGLE IN COS-INTERVALS (0.05 -cTR 1) (BACKSCATTERED PROJECTILES)'/) + & '(0.05) (BACKSCATTERED PROJECTILES)'/) GO TO 2054 2052 WRITE(21,2056) 2056 FORMAT(//,' ENERGY(E IN 0.1*TI) - POLAR ANGLE IN COS-INTERVALS ', - 1 '(0.05) (BACKSCATTERED PROJECTILES)'/) -cTR 2056 FORMAT(//,' ENERGY(E IN 0.1*TI) - POLAR ANGLE IN COS-INTERVALS (0. -cTR 105) (BACKSCATTERED PROJECTILES)'/) - do ima = 101,1,-1 - if(meab(ima,22).ne.0) goto 2017 - enddo - ima = 1 - 2017 ima = min(ima+2,101) - write (6, 1886) ((meab(ie,iagb),iagb=1,22),ie=1,ima) - write (6, 1886) (meab(102,iagb),iagb=1,22) -c2054 WRITE(6,1886) ((MEAB(IE,IAGB),IAGB=1,22),IE=1,NE) + & '(0.05) (BACKSCATTERED PROJECTILES)'/) + do ima = 101,1,-1 + if(meab(ima,22).ne.0) goto 2017 + enddo + ima = 1 + 2017 ima = min(ima+2,101) + write (6, 1886) ((meab(ie,iagb),iagb=1,22),ie=1,ima) + write (6, 1886) (meab(102,iagb),iagb=1,22) 2054 continue WRITE(21,2018) 2018 FORMAT(//,' AZIMUTHAL ANGLE - POLAR ANGLE IN COS-INTERVALS ', - 1 '(0.05) (BACKSCATTERED PROJECTILES)'/) -cTR 2018 FORMAT(//,' AZIMUTHAL ANGLE - POLAR ANGLE IN COS-INTERVALS (0.05) -cTR 1 (BACKSCATTERED PROJECTILES)'/) + & '(0.05) (BACKSCATTERED PROJECTILES)'/) WRITE(21,1886) ((MAGB(IG,IAGB),IAGB=1,22),IG=1,62) WRITE(21,2022) 2022 FORMAT(//,' AZIMUTH.ANGLE - POLAR ANGLE IN COS-INTERVALS ', - 1 '(0.05) (BACKSCATTERED ENERGY)'/) -cTR 2022 FORMAT(//,' AZIMUTH.ANGLE - POLAR ANGLE IN COS-INTERVALS (0.05) -cTR 1 (BACKSCATTERED ENERGY)'/) + & '(0.05) (BACKSCATTERED ENERGY)'/) WRITE(21,2027) (EMA(01,IAGB),IAGB=1,11) WRITE(21,2025) ((EMA(IG,IAGB),IAGB=1,11),IG=2,NG) WRITE(21,2028) WRITE(21,2031) EMA(1,1),(EMA(1,IAGB),IAGB=12,22) - DO 2029 IG=2,NG - WRITE(21,2026) EMA(IG,1),(EMA(IG,IAGB),IAGB=12,22) - 2029 CONTINUE + DO IG=2,NG + WRITE(21,2026) EMA(IG,1),(EMA(IG,IAGB),IAGB=12,22) + ENDDO 2025 FORMAT(1X,1F5.0,10E11.4) 2026 FORMAT(1X,1F5.0,11E11.4) 2027 FORMAT(1X,1F5.0,10F11.0) 2028 FORMAT(/) 2031 FORMAT(1H1,1X,1F5.0,11F11.0) -C IF(E0.LT.0.) GO TO 2058 -C WRITE(6,2032) -C2032 FORMAT(1H1,1X,'ENERGY(IN % OF E0) - PATHLENGTH(IN UNITS OF CW) -C 1 (BACKSCATTERED PROJECTILES)'/) -C GO TO 2060 -C2058 WRITE(6,2062) -C2062 FORMAT(1H1,1X,'ENERGY(E IN 0.1*TI) - PATHLENGTH(IN UNITS OF CW) -C 1 (BACKSCATTERED PROJECTILES)'/) -C2060 DO 2034 II=1,3 -C INE=II*25+1 -C INA=INE-24 -C DO 2040 IE=1,NE -C WRITE(6,2036) MEPB(IE,1),(MEPB(IE,IPB),IPB=INA,INE) -C2040 CONTINUE -C WRITE(6,2028) -C2034 CONTINUE -C DO 2042 IE=1,NE -C WRITE(6,2038) MEPB(IE,1),(MEPB(IE,IPB),IPB=77,102) -C2042 CONTINUE 2036 FORMAT(1X,26I4) 2038 FORMAT(1X,26I4,I6) 2100 CONTINUE @@ -4168,372 +4041,88 @@ C C TRANSMISSION : MATRICES , ENERGY - ANGULAR CORRELATIONS C IF(IT.LT.10000) GO TO 9000 - DO 2102 J=1,20 - 2102 MEATL(1,J)=J + DO J=1,20 + MEATL(1,J)=J + ENDDO EATL(2)=DBLE(MEATL(2,21))/(DBLE(NH)*0.1D0) - DO 2104 IERLOG=3,74 - 2104 EATL(IERLOG)=DBLE(MEATL(IERLOG,21))/(TEMPNH* - 1 10.D0**((IERLOG-1)/12.D0)) + DO IERLOG=3,74 + EATL(IERLOG)=DBLE(MEATL(IERLOG,21))/(TEMPNH* 10.D0**((IERLOG-1) + & /12.D0)) + ENDDO WRITE(21,2106) 2106 FORMAT(//,' LOG ENERGY - COS OF EMISSION ANGLE (0.05 STEPS) ', - 1 '(TRANSMITTED PROJECTILES)'/) -cTR 2106 FORMAT(//,' LOG ENERGY - COS OF EMISSION ANGLE (0.05 STEPS) (TRA -cTR 1NSMITTED PROJECTILES)'/) - do ima = 74,1,-1 - if(meatl(ima,21).ne.0) goto 2105 - enddo - ima = 1 - 2105 ima = min(ima+2,74) - do ies = 1, ima - WRITE(21,1858)elog(ies),(meatl(ies,iag),iag=1,21),eatl(ies) - end do - WRITE(21,1858)elog(75),(meatl(75,iag),iag=1,21),eatl(75) -c DO 2108 IES=1,75 -c2108 WRITE(21,1858) ELOG(IES),(MEATL(IES,IAG),IAG=1,21),EATL(IES) + & '(TRANSMITTED PROJECTILES)'/) + do ima = 74,1,-1 + if(meatl(ima,21).ne.0) goto 2105 + enddo + ima = 1 + 2105 ima = min(ima+2,74) + do ies = 1, ima + WRITE(21,1858)elog(ies),(meatl(ies,iag),iag=1,21),eatl(ies) + enddo + WRITE(21,1858)elog(75),(meatl(75,iag),iag=1,21),eatl(75) IF(ALPHA.LT.1.) GO TO 2110 - DO 2112 IG2=1,NGIK,1 - EEE = IG2*DGI - WRITE(21,2114) EEE - 2114 FORMAT(//,' ENERGY(E/E0 IN %) - POLAR ANGLE IN COS-INTERVALS ', - 1 '(0.05) AT AZIMUTHAL ANGLE =',F5.1, - 2 ' (TRANSMITTED PROJECTILES)'/) -cTR 2114 FORMAT(//,' ENERGY(E/E0 IN %) - POLAR ANGLE IN COS-INTERVALS (0.05 -cTR 1) AT AZIMUTHAL ANGLE =',F5.1,' (TRANSMITTED PROJECTILES)'/) - do ima = 101,1,-1 - if(meagt(ima,ig2,22).ne.0) goto 2115 - enddo - ima = 1 - 2115 ima = min(ima+2,101) - write (21,1886) ((meagt(ie,ig2,iagb),iagb=1,22),ie=1,ima) - write (21,1886) (meagt(102,ig2,iagb),iagb=1,22) -c2112 WRITE(6,1886) ((MEAGT(IE,IG2,IAGB),IAGB=1,22),IE=1,102) - 2112 continue + DO IG2=1,NGIK,1 + EEE = IG2*DGI + WRITE(21,2114) EEE + 2114 FORMAT(//,' ENERGY(E/E0 IN %) - POLAR ANGLE IN COS-INTERVALS ', + & '(0.05) AT AZIMUTHAL ANGLE =',F5.1, + & ' (TRANSMITTED PROJECTILES)'/) + do ima = 101,1,-1 + if(meagt(ima,ig2,22).ne.0) goto 2115 + enddo + ima = 1 + 2115 ima = min(ima+2,101) + write (21,1886) ((meagt(ie,ig2,iagb),iagb=1,22),ie=1,ima) + write (21,1886) (meagt(102,ig2,iagb),iagb=1,22) + ENDDO 2110 CONTINUE WRITE(21,2116) 2116 FORMAT(//,' ENERGY(E/E0 IN %) - POLAR ANGLE IN COS-INTERVALS ', - 1 '(0.05) (TRANSMITTED PROJECTILES)'/) -cTR 2116 FORMAT(//,' ENERGY(E/E0 IN %) - POLAR ANGLE IN COS-INTERVALS (0.05 -cTR 1) (TRANSMITTED PROJECTILES)'/) - do ima = 101,1,-1 - if(meat(ima,22).ne.0) goto 2117 - enddo - ima = 1 - 2117 ima = min(ima+2,101) - write (6, 1886) ((meat(ie,iagb),iagb=1,22),ie=1,ima) - write (6, 1886) (meat(102,iagb),iagb=1,22) -c WRITE(6,1886) ((MEAT(IE,IAGB),IAGB=1,22),IE=1,NE) + & '(0.05) (TRANSMITTED PROJECTILES)'/) + do ima = 101,1,-1 + if(meat(ima,22).ne.0) goto 2117 + enddo + ima = 1 + 2117 ima = min(ima+2,101) + write (6, 1886) ((meat(ie,iagb),iagb=1,22),ie=1,ima) + write (6, 1886) (meat(102,iagb),iagb=1,22) WRITE(21,2118) 2118 FORMAT(//,' AZIMUTHAL ANGLE - POLAR ANGLE IN COS-INTERVALS ', - 1 '(0.05) (TRANSMITTED PROJECTILES)'/) -cTR 2118 FORMAT(//,' AZIMUTHAL ANGLE - POLAR ANGLE IN COS-INTERVALS (0.05) -cTR 1 (TRANSMITTED PROJECTILES)'/) + & '(0.05) (TRANSMITTED PROJECTILES)'/) WRITE(21,1886) ((MAGT(IG,IAGB),IAGB=1,22),IG=1,62) WRITE(21,2122) 2122 FORMAT(//,' AZIMUTH.ANGLE - POLAR ANGLE IN COS-INTERVALS ', - 1 '(0.05) (TRANSMITTED ENERGY)'/) -cTR 2122 FORMAT(//,' AZIMUTH.ANGLE - POLAR ANGLE IN COS-INTERVALS (0.05) -cTR 1 (TRANSMITTED ENERGY)'/) + & '(0.05) (TRANSMITTED ENERGY)'/) WRITE(21,2127) (EMAT(01,IAGB),IAGB=1,11) WRITE(21,2125) ((EMAT(IG,IAGB),IAGB=1,11),IG=2,NG) WRITE(21,2028) WRITE(21,2131) EMAT(1,1),(EMAT(1,IAGB),IAGB=12,22) - DO 2129 IG=2,NG - WRITE(21,2126) EMAT(IG,1),(EMAT(IG,IAGB),IAGB=12,22) - 2129 CONTINUE + DO IG=2,NG + WRITE(21,2126) EMAT(IG,1),(EMAT(IG,IAGB),IAGB=12,22) + ENDDO 2125 FORMAT(1X,1F5.0,10E11.4) 2126 FORMAT(1X,1F5.0,11E11.4) 2127 FORMAT(1X,1F5.0,10F11.0) 2131 FORMAT(1H1,1X,1F5.0,11F11.0) - GO TO 9000 -C WRITE(6,2132) -C2132 FORMAT(1H1,1X,'ENERGY(IN % OF E0) - PATHLENGTH(IN UNITS OF CW) -C 1 (TRANSMITTED PROJECTILES)'/) -C DO 2134 II=1,3 -C INE=II*25+1 -C INA=INE-24 -C DO 2140 IE=1,NE -C WRITE(6,2036) MEPT(IE,1),(MEPT(IE,IPT),IPT=INA,INE) -C2140 CONTINUE -C WRITE(6,2028) -C2134 CONTINUE -C DO 2142 IE=1,NE -C WRITE(6,2038) MEPT(IE,1),(MEPT(IE,IPT),IPT=77,102) -C2142 CONTINUE 9000 CONTINUE -C WRITE(6,*) INEL,L,LJ -C DO 9875 J=1,180 -C IANF=J*7-6 -C IEND=(J+1)*7-7 -C WRITE(6,9876) (ESVDL(I),I=IANF,IEND) -C9876 FORMAT(1X,7E11.4) -C9875 CONTINUE -CC -CC DATA ON DISC -CC -c WRITE(17) Z1,M1,E0,ALPHA,EF,ESB,SHEATH -c 1 ,NH,RI,X0,RD,CW,CA,KK0,KK0R,KDEE1,KDEE2 -c WRITE(17) (DX(I),I=1,3),(RHO(I),I=1,3),(CK(I),I=1,3) -c 1 ,((ZT(I,J),J=1,5),I=1,3),((MT(I,J),J=1,5),I=1,3) -c 2 ,((CO(I,J),J=1,5),I=1,3),((SBE(I,J),J=1,5),I=1,3) -c 3 ,((ED(I,J),J=1,5),I=1,3),((BE(I,J),J=1,5),I=1,3) -c WRITE(17) TI,ZARG,VELC -c 1 ,HLM,HLMT,SU,SUT,XC,RT,INEL,L,LJ -c 2 ,NPROJ,KIB,KIT,MAXA,NALL,NPA,NSA,KIS,KIST -c 3 ,IIM,EIM,IB,EB,IT,ET,ISPA,ESPA,ISPAT,ESPAT -c 4 ,FIX0,SEX,THX,FOX,SIGMAX,DFIX0,DSEX,DTHX -c 5 ,FIR0,SER,THR,FOR,SIGMAR,DFIR0,DSER,DTHR -c 6 ,FIP0,SEP,THP,FOP,SIGMAP,DFIP0,DSEP,DTHP -c 7 ,AVNLI,VANLI,SIGNLI,DFINLI -c 8 ,AVILI,VAILI,SIGILI,DFIILI -c WRITE(17) AVCSUM,AVCDIS -c 1 ,FIE0,SEE,THE,FOE,SIGMAE,DFIE0,DSEE,DTHE -c 2 ,FIW0,SEW,THW,FOW,SIGMAW,DFIW0,DSEW,DTHW -c 3 ,FII0,SEI,THI,FOI,SIGMAI,DFII0,DSEI,DTHI -c 4 ,FIS0,SES,THS,FOS,SIGMAS,DFIS0,DSES,DTHS -c 5 ,IIRP,TRIRP,IIPL,TION,TDMGN,TCASMO,TPHON,TDENT -c WRITE(17) RN,RE,EMEANR,EMEAN,TN,TE,TMEANR,EMEANT -c 1 ,FIB0,SEB,THB,FOB,SIGMAB,DFIB0,DSEB,DTHB -c 2 ,FIPB0,SEPB,THPB,FOPB,SIGMPB,DFIPB0,DSEPB,DTHPB -c 3 ,AVNLB,VANLB,SIGNLB,DFINLB -c 4 ,AVILB,VAILB,SIGILB,DFIILB -c WRITE(17) FIT0,SET,THT,FOT,SIGMAT,DFIT0,DSET,DTHT -c 1 ,FIPT0,SEPT,THPT,FOPT,SIGMPT,DFIPT0,DSEPT,DTHPT -c 2 ,AVNLT,VANLT,SIGNLT,DFINLT -c 3 ,AVILT,VAILT,SIGILT,DFIILT -c WRITE(17) (IRP(I),I=0,100),(RIRP(I),I=0,100) -c 1 ,(IPL(I),I=1,100),(ION(I),I=1,100),(DMGN(I),I=1,100) -c 2 ,(CASMOT(I),I=1,100),(PHON(I),I=1,100),(DENT(I),I=1,100) -c WRITE(17) (FIESB(J),J=1,10),(SEESB(J),J=1,10),(THESB(J),J=1,10) -c 1 ,(FOESB(J),J=1,10),(SGMESB(J),J=1,10) -c 2 ,(DFIESB(J),J=1,10),(DSEESB(J),J=1,10) -c 3 ,(DTHESB(J),J=1,10) -c WRITE(17) ((ELE(I,J),J=1,15),I=1,100),((ELI(I,J),J=1,15),I=1,100) -c 1 ,((ELP(I,J),J=1,15),I=1,100) -c 2 ,(ELET(J),J=1,15),(ELIT(J),J=1,15),(ELPT(J),J=1,15) -c WRITE(17) (AI(I),I=1,20),(KADB(I),I=1,20),(KADT(I),I=1,20) -c 1 ,(RKADB(I),I=1,20),(RKADT(I),I=1,20) -c WRITE(17) (KADS(I),I=1,20),(KADST(I),I=1,20) -c 1 ,(RKADS(I),I=1,20),(RKADST(I),I=1,20) -c WRITE(17) ((KADRIP(I,J),J=1,10),I=1,20) -c 1 ,((KADRIS(I,J),J=1,10),I=1,20) -c 2 ,((KADROP(I,J),J=1,10),I=1,20) -c 3 ,((KADROS(I,J),J=1,10),I=1,20) -cC 4 ,RKDRIP(20),RKDRIS(20),RKDROP(20),RKDROS(20) -c WRITE(17) ((KADSJ(I,J),J=1,10),I=1,20) -c 1 ,((RKADSJ(I,J),J=1,10),I=1,20) -c 2 ,((KADSL(I,J),J=1,2),I=1,20) -c 3 ,((RKADSL(I,J),J=1,2),I=1,20) -c WRITE(17) ((KDSTJ(I,J),J=1,10),I=1,20) -c 1 ,((RKDSTJ(I,J),J=1,10),I=1,20) -c 2 ,((KDSTL(I,J),J=1,2),I=1,20) -c 3 ,((RKDSTL(I,J),J=1,2),I=1,20) -c WRITE(17) (IBSP(I),I=1,15),(EBSP(I),I=1,15) -c 1 ,(SPY(I),I=1,15),(SPE(I),I=1,15) -c 2 ,(REY(I),I=1,15),(EMSP(I),I=1,15) -c 3 ,(ISPAL(I),I=1,3),(ESPAL(I),I=1,3) -c WRITE(17) (ISPIP(I),I=1,15),(ISPIS(I),I=1,15) -c 1 ,(ISPOP(I),I=1,15),(ISPOS(I),I=1,15) -c 2 ,(ESPIP(I),I=1,15),(ESPIS(I),I=1,15) -c 3 ,(ESPOP(I),I=1,15),(ESPOS(I),I=1,15) -c 4 ,(RIP(I),I=1,15),(RIS(I),I=1,15) -c 5 ,(ROP(I),I=1,15),(ROS(I),I=1,15) -c 6 ,(REIP(I),I=1,15),(REIS(I),I=1,15) -c 7 ,(REOP(I),I=1,15),(REOS(I),I=1,15) -c WRITE(17) (ITSP(I),I=1,15),(ETSP(I),I=1,15) -c 1 ,(SPYT(I),I=1,15),(SPET(I),I=1,15) -c 2 ,(REYT(I),I=1,15),(EMSPT(I),I=1,15) -c 3 ,(ISPALT(I),I=1,3),(ESPALT(I),I=1,3) -c WRITE(17) (ISPIPT(I),I=1,15),(ISPIST(I),I=1,15) -c 1 ,(ISPOPT(I),I=1,15),(ISPOST(I),I=1,15) -c 2 ,(ESPIPT(I),I=1,15),(ESPIST(I),I=1,15) -c 3 ,(ESPOPT(I),I=1,15),(ESPOST(I),I=1,15) -c 4 ,(RIPT(I),I=1,15),(RIST(I),I=1,15) -c 5 ,(ROPT(I),I=1,15),(ROST(I),I=1,15) -c 6 ,(REIPT(I),I=1,15),(REIST(I),I=1,15) -c 7 ,(REOPT(I),I=1,15),(REOST(I),I=1,15) -c WRITE(17) ((MEAB(I,J),J=1,22),I=1,102) -c 1 ,((MAGB(I,J),J=1,22),I=1,62) -c 2 ,(((MEAGB(I,J,K),K=1,22),J=1,36),I=1,102) -c 3 ,((EMA(I,J),J=1,22),I=1,62),(ELOG(I),I=1,75) -c 4 ,(EABL(I),I=1,75),((MEABL(I,J),J=1,21),I=1,75) -c 5 ,((MEPB(I,J),J=1,102),I=1,102) -c WRITE(17) ((MEAT(I,J),J=1,22),I=1,102) -c 1 ,((MAGT(I,J),J=1,22),I=1,62) -c 2 ,(((MEAGT(I,J,K),K=1,22),J=1,36),I=1,102) -c 3 ,((EMAT(I,J),J=1,22),I=1,62) -c 4 ,(EATL(I),I=1,75),((MEATL(I,J),J=1,21),I=1,75) -c 5 ,((MEPT(I,J),J=1,102),I=1,102) -c WRITE(17) (((MEAS(I,J,K),K=1,10),J=1,22),I=1,102) -c 1 ,(((MAGS(I,J,K),K=1,10),J=1,22),I=1,62) -c 2 ,((EASL(I,J),J=1,10),I=1,75) -c 3 ,(((MEASL(I,J,K),K=1,10),J=1,21),I=1,75) -c WRITE(17) (((MEAST(I,J,K),K=1,10),J=1,22),I=1,102) -c 1 ,(((MAGST(I,J,K),K=1,10),J=1,22),I=1,62) -c 2 ,((EASTL(I,J),J=1,10),I=1,75) -c 3 ,(((MEASTL(I,J,K),K=1,10),J=1,21),I=1,75) -c WRITE(17) ((((MEAGS(I,J,K,MN),MN=1,10),K=1,22),J=1,12),I=1,102) -c 1 ,(((MAGSA(I,J,K),K=1,10),J=1,32),I=1,62) -CC 1 ,((((MEAGST(I,J,K,L),L=1,10),K=1,22),J=1,36),I=1,102) -c WRITE(17) ((ELD(I,J),I=1,100),J=1,15) -c WRITE(17) XSUM,X2SUM,X3SUM,X4SUM,X5SUM,X6SUM -c WRITE(17) EB,EB2SUM,EB3SUM,EB4SUM,EB5SUM,EB6SUM -c 1 ,EB1SUL,EB2SUL,EB3SUL,EB4SUL,EB5SUL,EB6SUL -c WRITE(17) (EBSP(J),J=1,15),(SPE2S(J),J=1,15),(SPE3S(J),J=1,15) -c 1 ,(SPE4S(J),J=1,15),(SPE5S(J),J=1,15),(SPE6S(J),J=1,15) -c WRITE(17) (SPE1SL(J),J=1,15),(SPE2SL(J),J=1,15),(SPE3SL(J),J=1,15) -c 1 ,(SPE4SL(J),J=1,15),(SPE5SL(J),J=1,15) -c 2 ,(SPE6SL(J),J=1,15) -c WRITE(17) ((ICD(I,J),J=1,15),I=1,100),((ICDR(I,J),J=1,15),I=1,100) -c WRITE(17) (((ICDIRI(I,J,K),K=1,15),J=1,15),I=1,100) -c 1 ,((ICDIRN(I,J),J=1,15),I=1,100) -c write(17) exi1s,exi2s,exi3s,exi4s,exi5s,exi6s -c 1 ,coss1s,coss2s,coss3s,coss4s,coss5s,coss6s -c write(17) ibl,(ibsp(i),i=1,15) -C CLOSE(UNIT=21) CLOSE(UNIT=22) - CLOSE(UNIT=99) + CLOSE(UNIT=99) 8000 STOP END -C -C SUBROUTINE MAGICKRC(C2,S2,B,R,EPS,N) -C DIMENSION C2(N),S2(N),B(N),R(N),EPS(N),V(N),V1(N),TEST(N) -C DIMENSION EX1(N),EX2(N),EX3(N) -C IVMIN=1 -C IVMAX=N -C -C MAGIC (DETERMINATION OF SCATTERING ANGLE : KRYPTON-CARBON POT.) -C -C DO 105 IV=IVMIN,IVMAX -C KRYPTON-CARBON POTENTIAL -C EX1(IV)=DEXP(-.278544*R(IV)) -C EX2(IV)=DEXP(-.637174*R(IV)) -C EX3(IV)=DEXP(-1.919249*R(IV)) -C RR1=1./R(IV) -C V(IV)=(.190945*EX1(IV)+.473674*EX2(IV)+.335381*EX3(IV))*RR1 -C V1(IV)=-(V(IV)+.053186584080*EX1(IV)+.301812757276*EX2(IV)+ -C 1 .643679648869*EX3(IV))*RR1 -C FR=B(IV)*B(IV)*RR1+V(IV)*R(IV)/EPS(IV)-R(IV) -C FR1=-B(IV)*B(IV)*RR1*RR1+(V(IV)+V1(IV)*R(IV))/EPS(IV)-1. -C Q=FR/FR1 -C R(IV)=R(IV)-Q -C TEST(IV)=DABS(Q/R(IV)).GT.0.001 -C 105 CONTINUE -C GET MAX AND MIN INDEX OF TEST FAILURES -C IVMIN=IVMIN+ILLZ(IVMAX-IVMIN+1,TEST(IVMIN),1) -C IF(IVMIN.GT.IVMAX) GO TO 106 -C IVMAX=IVMAX-ILLZ(IVMAX-IVMIN+1,TEST(IVMIN),-1) -C IF(IVMIN.GT.IVMAX) GO TO 106 -C GO TO 104 -C 106 DO 108 IV=1,IH1 -C ROCINV=-0.5*V1(IV)/(EPS(IV)-V(IV)) -C SQE=DSQRT(EPS(IV)) -C CC=(.235800+SQE)/(.126000+SQE) -C AA=2.*EPS(IV)*(1.+(1.0144/SQE))*B(IV)**CC -C FF=(DSQRT(AA*AA+1.)-AA)*((69350.+EPS(IV))/(83550.+EPS(IV))) -C DELTA=(R(IV)-B(IV))*AA*FF/(FF+1.) -C C=(ROCINV*(B(IV)+DELTA)+1.)/(ROCINV*R(IV)+1.) -C C2(IV)=DMIN1(1.0,C*C) -C 108 S2(IV)=1.-C2(IV) -C RETURN -C END -C -C SUBROUTINE MAGICMOL(C2,S2,B,R,EPS,N) -C DIMENSION C2(N),S2(N),B(N),R(N),EPS(N),V(N),V1(N),TEST(N) -C DIMENSION EX1(N),EX2(N),EX3(N) -C IVMIN=1 -C IVMAX=N -C -C MAGIC (DETERMINATION OF SCATTERING ANGLE : MOLIERE POT.) -C -C DO 105 IV=IVMIN,IVMAX -C MOLIERE POTENTIAL -C EX1(IV)=DEXP(-.3*R(IV)) -C EX2(IV)=DEXP(-1.2*R(IV)) -C EX3(IV)=DEXP(-6.0*R(IV)) -C RR1=1./R(IV) -C V(IV)=(.35*EX1(IV)+.55*EX2(IV)+.10*EX3(IV))*RR1 -C V1(IV)=-(V(IV)+.105*EX1(IV)+.66*EX2(IV)+.6*EX3(IV))*RR1 -C FR=B(IV)*B(IV)*RR1+V(IV)*R(IV)/EPS(IV)-R(IV) -C FR1=-B(IV)*B(IV)*RR1*RR1+(V(IV)+V1(IV)*R(IV))/EPS(IV)-1. -C Q=FR/FR1 -C R(IV)=R(IV)-Q -C TEST(IV)=DABS(Q/R(IV)).GT.0.001 -C 105 CONTINUE -C GET MAX AND MIN INDEX OF TEST FAILURES -C IVMIN=IVMIN+ILLZ(IVMAX-IVMIN+1,TEST(IVMIN),1) -C IF(IVMIN.GT.IVMAX) GO TO 106 -C IVMAX=IVMAX-ILLZ(IVMAX-IVMIN+1,TEST(IVMIN),-1) -C IF(IVMIN.GT.IVMAX) GO TO 106 -C GO TO 104 -C 106 DO 108 IV=1,IH1 -C ROCINV=-0.5*V1(IV)/(EPS(IV)-V(IV)) -C SQE=DSQRT(EPS(IV)) -C CC=(.009611+SQE)/(.005175+SQE) -C AA=2.*EPS(IV)*(1.+(0.6743/SQE))*B(IV)**CC -C FF=(DSQRT(AA*AA+1.)-AA)*((6.314+EPS(IV))/(10.+EPS(IV))) -C DELTA=(R(IV)-B(IV))*AA*FF/(FF+1.) -C C=(ROCINV*(B(IV)+DELTA)+1.)/(ROCINV*R(IV)+1.) -C C2(IV)=DMIN1(1.0,C*C) -C 108 S2(IV)=1.-C2(IV) -C RETURN -C END -C -C SUBROUTINE MAGICZBL(C2,S2,B,R,EPS,N) -C DIMENSION C2(N),S2(N),B(N),R(N),EPS(N),V(N),V1(N),TEST(N) -C DIMENSION EX1(N),EX2(N),EX3(N),EX4(N) -C IVMIN=1 -C IVMAX=N -C -C MAGIC (DETERMINATION OF SCATTERING ANGLE : ZBL POT.) -C -C DO 105 IV=IVMIN,IVMAX -C ZBL POTENTIAL -C EX1(IV)=DEXP(-.20162*R(IV)) -C EX2(IV)=DEXP(-.4029*R(IV)) -C EX3(IV)=DEXP(-.94229*R(IV)) -C EX4(IV)=DEXP(-3.1998*R(IV)) -C RR1=1./R(IV) -C V(IV)=(.02817*EX1(IV)+.28022*EX2(IV)+.50986*EX3(IV)+ -C 1 .18175*EX4(IV))*RR1 -C V1(IV)=-(V(IV)+.0056796354*EX1(IV)+.112900638*EX2(IV)+ -C 1 .4804359794*EX3(IV)+.581563650*EX4(IV))*RR1 -C FR=B(IV)*B(IV)*RR1+V(IV)*R(IV)/EPS(IV)-R(IV) -C FR1=-B(IV)*B(IV)*RR1*RR1+(V(IV)+V1(IV)*R(IV))/EPS(IV)-1. -C Q=FR/FR1 -C R(IV)=R(IV)-Q -C TEST(IV)=DABS(Q/R(IV)).GT.0.001 -C 105 CONTINUE -C GET MAX AND MIN INDEX OF TEST FAILURES -C IVMIN=IVMIN+ILLZ(IVMAX-IVMIN+1,TEST(IVMIN),1) -C IF(IVMIN.GT.IVMAX) GO TO 106 -C IVMAX=IVMAX-ILLZ(IVMAX-IVMIN+1,TEST(IVMIN),-1) -C IF(IVMIN.GT.IVMAX) GO TO 106 -C GO TO 104 -C 106 DO 108 IV=1,IH1 -C ROCINV=-0.5*V1(IV)/(EPS(IV)-V(IV)) -C SQE=DSQRT(EPS(IV)) -C CC=(.011615+SQE)/(.0071222+SQE) -C AA=2.*EPS(IV)*(1.+(0.99229/SQE))*B(IV)**CC -C FF=(DSQRT(AA*AA+1.)-AA)*((9.3066+EPS(IV))/(14.813+EPS(IV))) -C DELTA=(R(IV)-B(IV))*AA*FF/(FF+1.) -C C=(ROCINV*(B(IV)+DELTA)+1.)/(ROCINV*R(IV)+1.) -C C2(IV)=DMIN1(1.0,C*C) -C 108 S2(IV)=1.-C2(IV) -C RETURN -C END -C + + + SUBROUTINE MOMENTS(FIM0,SEM,THM,FOM,FIM,SIM,SIGMA,DFIM0,DSEM,DTHM, # X1S,X2S,X3S,X4S,X5S,X6S,Y) -c TR !DEC$REAL:8 IMPLICIT NONE REAL*8 FIM0,SEM,THM,FOM,FIM,SIM,SIGMA,DFIM0,DSEM,DTHM, # X1S,X2S,X3S,X4S,X5S,X6S,Y REAL*8 U,U2,U3,U4,SIGMA3 REAL*8 X3SP,X4SP,X5SP,X6SP LOGICAL EQUAL -C -C IF(Y.EQ.0.D0.OR.Y.EQ.1.D0) GO TO 10 + IF(EQUAL(Y,0.D0))GOTO 10 IF(EQUAL(Y,1.D0))GOTO 10 FIM0=X1S/Y @@ -4551,27 +4140,25 @@ C IF(Y.EQ.0.D0.OR.Y.EQ.1.D0) GO TO 10 THM=X3SP-U*(3.D0+U2) FOM=X4SP-4.D0*U*X3SP+3.D0*U2*(2.D0+U2) FIM=X5SP-5.D0*U*X4SP+10.D0*U2*X3SP-2.D0*U3*(5.D0+3.D0*U2) - SIM=X6SP-6.D0*U*X5SP+15.D0*U2*X4SP-20.D0*U3*X3SP+ - # 5.D0*U4*(3.D0+2.D0*U2) + SIM=X6SP-6.D0*U*X5SP+15.D0*U2*X4SP-20.D0*U3*X3SP+ 5.D0*U4*(3.D0+2 + & .D0*U2) DFIM0=SIGMA/DSQRT(Y) DSEM=SEM*DSQRT(DMAX1(1.D-20,FOM-1.D0)/(Y)) - DTHM=DSQRT(DMAX1(1.D-20, - # (9.D0+8.75D0*THM*THM+2.25D0*THM*THM*FOM- - # 6.D0*FOM-3.D0*THM*FIM+SIM))/Y) + DTHM=DSQRT(DMAX1(1.D-20, (9.D0+8.75D0*THM*THM+2.25D0*THM*THM*FOM- + & 6.D0*FOM-3.D0*THM*FIM+SIM))/Y) 10 CONTINUE RETURN END -C + SUBROUTINE MOMENTN(FIM0,SEM,THM,FOM,FIM,SIM,SIGMA,DFIM0,DSEM,DTHM, - # X1SY,X2SY,X3SY,X4SY,X5SY,X6SY,X1S,X2S,X3S,X4S,X5S,X6S,Y) -c TR !DEC$REAL:8 + & X1SY,X2SY,X3SY,X4SY,X5SY,X6SY,X1S,X2S,X3S,X4S,X5S,X6S,Y) IMPLICIT NONE - REAL*8 FIM0,SEM,THM,FOM,FIM,SIM,SIGMA,DFIM0,DSEM,DTHM, - # X1SY,X2SY,X3SY,X4SY,X5SY,X6SY,X1S,X2S,X3S,X4S,X5S,X6S,Y + REAL*8 FIM0,SEM,THM,FOM,FIM,SIM,SIGMA,DFIM0,DSEM,DTHM, X1SY,X2SY + & ,X3SY,X4SY,X5SY,X6SY,X1S,X2S,X3S,X4S,X5S,X6S,Y REAL*8 X3SP,X4SP,X5SP,X6SP REAL*8 U,U2,U3,U4,SIGMA3 LOGICAL EQUAL -C IF(Y.EQ.0.D0.OR.Y.EQ.1.D0) GO TO 10 + IF(EQUAL(Y,0.D0))GOTO 10 IF(EQUAL(Y,1.D0))GOTO 10 X1SY=X1S/Y @@ -4595,24 +4182,22 @@ C IF(Y.EQ.0.D0.OR.Y.EQ.1.D0) GO TO 10 THM=X3SP-U*(3.D0+U2) FOM=X4SP-4.D0*U*X3SP+3.D0*U2*(2.D0+U2) FIM=X5SP-5.D0*U*X4SP+10.D0*U2*X3SP-2.D0*U3*(5.D0+3.D0*U2) - SIM=X6SP-6.D0*U*X5SP+15.D0*U2*X4SP-20.D0*U3*X3SP+ - # 5.D0*U4*(3.D0+2.D0*U2) + SIM=X6SP-6.D0*U*X5SP+15.D0*U2*X4SP-20.D0*U3*X3SP+ 5.D0*U4*(3.D0+2 + & .D0*U2) DFIM0=SIGMA/DSQRT(Y) DSEM=SEM*DSQRT(DMAX1(1.D-20,FOM-1.D0)/(Y)) - DTHM=DSQRT(DMAX1(1.D-20, - # (9.D0+8.75D0*THM*THM+2.25D0*THM*THM*FOM- - # 6.D0*FOM-3.D0*THM*FIM+SIM))/Y) + DTHM=DSQRT(DMAX1(1.D-20, (9.D0+8.75D0*THM*THM+2.25D0*THM*THM*FOM- + & 6.D0*FOM-3.D0*THM*FIM+SIM))/Y) 10 CONTINUE RETURN END -C - SUBROUTINE MOMENT(X1SY,X2SY,X3SY,X4SY,X5SY,X6SY - # ,X1S,X2S,X3S,X4S,X5S,X6S,Y) -c TR !DEC$REAL:8 + + SUBROUTINE MOMENT(X1SY,X2SY,X3SY,X4SY,X5SY,X6SY ,X1S,X2S,X3S,X4S + & ,X5S,X6S,Y) IMPLICIT NONE REAL*8 X1SY,X2SY,X3SY,X4SY,X5SY,X6SY,X1S,X2S,X3S,X4S,X5S,X6S,Y LOGICAL EQUAL -C IF(Y.EQ.0.0D0) GO TO 10 + IF(EQUAL(Y,0.D0))GOTO 10 X1SY=X1S/Y X2SY=X2S/Y @@ -4622,34 +4207,32 @@ C IF(Y.EQ.0.0D0) GO TO 10 X6SY=X6S/Y 10 RETURN END -C + SUBROUTINE DIRCOS(COSX,COSY,COSZ,SINE,CPSI,SPSI,CPHI,SPHI,N) -c TR !DEC$REAL:8 IMPLICIT NONE INTEGER N,IV - REAL*8 COSX(N),COSY(N),COSZ(N),SINE(N),CPSI(N),SPSI(N) - # ,CPHI(N),SPHI(N) + REAL*8 COSX(N),COSY(N),COSZ(N),SINE(N),CPSI(N),SPSI(N) ,CPHI(N) + & ,SPHI(N) REAL*8 SRAT,CX2,CY2,CZ2,UNIT -C - DO 1 IV=1,N + + DO IV=1,N SRAT=SPSI(IV)/SINE(IV) CX2=CPSI(IV)*COSX(IV)+SPSI(IV)*SINE(IV)*CPHI(IV) - CY2=CPSI(IV)*COSY(IV)-SRAT*(COSY(IV)*COSX(IV)*CPHI(IV) - # -COSZ(IV)*SPHI(IV)) - CZ2=CPSI(IV)*COSZ(IV)-SRAT*(COSZ(IV)*COSX(IV)*CPHI(IV) - # +COSY(IV)*SPHI(IV)) + CY2=CPSI(IV)*COSY(IV)-SRAT*(COSY(IV)*COSX(IV)*CPHI(IV)-COSZ(IV) + & *SPHI(IV)) + CZ2=CPSI(IV)*COSZ(IV)-SRAT*(COSZ(IV)*COSX(IV)*CPHI(IV)+COSY(IV) + & *SPHI(IV)) UNIT = 1.0D0/DSQRT(CX2**2+CY2**2+CZ2**2) COSX(IV)=CX2*UNIT COSY(IV)=CY2*UNIT C MAKE SURE COSZ.NE.0. COSZ(IV)=DSIGN(DABS(CZ2*UNIT)+1.D-12,CZ2) SINE(IV)=DSQRT(COSY(IV)*COSY(IV)+COSZ(IV)*COSZ(IV)) - 1 CONTINUE + ENDDO RETURN END -C + SUBROUTINE VELOCV(FG,FFG,E,COSX,COSY,COSZ,SINE,N) -c TR !DEC$REAL:8 IMPLICIT NONE INTEGER n,I C @@ -4660,14 +4243,13 @@ C DIMENSIOM E(N),COSX(N),COSY(N),COSZ(N),SINE(N) REAL*8 M1,VELC,ZARG REAL*8 VELX,VELY,VELZ,VELQ,VEL COMMON/A/ M1,VELC,ZARG -C + CALL FGAUSS(FG,2*N,N,FFG,N) -C - DO 10 I=1,N + + DO I=1,N VELX=DSQRT((FFG(I)*ZARG)**2+VELC) VELY=FG(I)*ZARG VELZ=FG(I+N)*ZARG -C VELQ=VELX*VELX+VELY*VELY+VELZ*VELZ VEL=DSQRT(VELQ) COSX(I)=VELX/VEL @@ -4675,15 +4257,14 @@ C COSZ(I)=VELZ/VEL SINE(I)=DSQRT(1.D0-COSX(I)*COSX(I)) E(I)=M1*VELQ - 10 CONTINUE + ENDDO RETURN END -C + SUBROUTINE VELOC(E,COSX,COSY,COSZ,SINE) C C FETCH A NEW VELOCITY FROM A MAXWELLIAN FLUX AT A SURFACE C -c TR !DEC$REAL:8 IMPLICIT NONE INTEGER INIV1,INIV3 REAL*8 FG(128),FFG(64) @@ -4691,19 +4272,17 @@ c TR !DEC$REAL:8 REAL*8 M1,VELC,ZARG REAL*8 VELX,VELY,VELZ,VELQ,VEL,E COMMON/A/ M1,VELC,ZARG -C + IF (INIV1.EQ.0) CALL FGAUSS(FG,INIV1,64,FFG,INIV3) -C + VELX=FFG(INIV3)*ZARG VELY=FG(INIV1)*ZARG VELZ=FG(INIV1-1)*ZARG -C SHEATH CONTRIBUTION IF (VELC.GT.0.) THEN VELX=DSQRT(VELC+VELX**2) ENDIF INIV1=INIV1-2 INIV3=INIV3-1 -C VELQ=VELX*VELX+VELY*VELY+VELZ*VELZ VEL=DSQRT(VELQ) COSX=VELX/VEL @@ -4717,7 +4296,6 @@ C SUBROUTINE FGAUSS (FG,IND,IANZ,FFG,IND2) -c TR !DEC$REAL:8 C C RETURN IANZ PAIRS OF RANDOM NUMBER FROM A GAUSSIAN, I.E. IANZ*2 C NUMBERS, AND RETURN THEM IN THE ARRAY FG @@ -4737,44 +4315,32 @@ C real*4 random, ran2(2) DATA PI2/6.28318530717598D0/ IND=IANZ+IANZ -C -C DIR$ IVDEP - DO 1 JJ=1,IANZ + + DO JJ=1,IANZ C 1. COMPUTE THE SINE AND COSINE OF 2*PI*RAN(1) C -C ZZ=PI2*RANF() -C ZZ=PI2*DRAND48() -C ZZ=PI2*DBLE(RAN(ISEED)) call ranlux(ran2, 2) ZZ=PI2*DBLE(ran2(1)) ZSIN=DSIN(ZZ) ZCOS=DCOS(ZZ) -C -C AR=DLOG(RANF()) -C AR=DLOG(DRAND48()) -C AR=DLOG(DBLE(RAN(ISEED))) AR=DLOG(DBLE(ran2(2))) ZT=DSQRT(-1.0D0*(AR+AR)) FG(JJ+IANZ)=ZT*ZSIN FG(JJ)=ZT*ZCOS - 1 CONTINUE + ENDDO C C RETURN IANZ RANDOM NUMBERS FROM A GAUSSIAN FLUX IN THE ARRAY FFG C IND2=IANZ - DO 2 JJ=1,IANZ -C AR=DLOG(RANF()) -C AR=DLOG(DRAND48()) -C AR=DLOG(DBLE(RAN(ISEED))) + DO JJ=1,IANZ call ranlux(random, 1) AR=DLOG(DBLE(random)) - - 2 FFG(JJ)=DSQRT(-1.D0*(AR+AR)) + FFG(JJ)=DSQRT(-1.D0*(AR+AR)) + ENDDO RETURN END -C + SUBROUTINE ENERGV(FE,E,COSX,COSY,COSZ,SINE,N) -c TR !DEC$REAL:8 C C FETCH A NEW ENERGY FROM A MAXWELLIAN FLUX AT A SURFACE C @@ -4784,23 +4350,21 @@ C REAL*8 M1,EMT REAL*8 TI,SHEATH,CALFA COMMON/B/ TI,SHEATH,CALFA -C + CALL EMAXW(FE,N) -C - DO 10 I=1,N + + DO I=1,N EMT=TI*FE(I)**2 COSX(I) = DSQRT((EMT*CALFA*CALFA +SHEATH)/(EMT +SHEATH)) SINE(I) = DSQRT( 1.D0 -COSX(I)*COSX(I)) COSY(I) = SINE(I) COSZ(I) = 0.D0 E(I) = EMT + SHEATH - 10 CONTINUE -C WRITE(6,*) (E(I),I=1,N),(COSX(I),I=1,N) + ENDDO RETURN END -C + SUBROUTINE ENERG(E,COSX,COSY,COSZ,SINE) -c TR !DEC$REAL:8 C C FETCH A NEW ENERGY FROM A MAXWELLIAN FLUX AT A SURFACE C @@ -4810,23 +4374,20 @@ C REAL*8 TI,SHEATH,CALFA COMMON/B/ TI,SHEATH,CALFA -C + CALL EMAXW(FE,16) -C + EMT=TI*FE(9)**2 COSX = DSQRT((EMT*CALFA*CALFA +SHEATH)/(EMT +SHEATH)) SINE = DSQRT( 1.D0 -COSX*COSX) COSY = SINE COSZ = 0.D0 E = EMT + SHEATH - 10 CONTINUE -C WRITE(6,*) E,COSX RETURN END SUBROUTINE EMAXW (FE,NUMB) -c TR !DEC$REAL:8 C C THIS FUNCTION SAMPLES FROM A MAXWELLIAN (ENERGY) OF THE C FORM X**2*DEXP(-X**2)*4/DSQRT(PI)) @@ -4840,27 +4401,18 @@ C REAL*8 PI,AR1,AR2 real*4 random(3) DATA PI/3.14159265358979D0/ -C -C DIR$ IVDEP - DO 1 I=1,NUMB -C AR1=DLOG(RANF()) -C AR1=DLOG(DRAND48()) -C AR1=DLOG(DBLE(RAN(ISEED))) + + DO I=1,NUMB call ranlux(random, 3) AR1=DLOG(DBLE(random(1))) -C AR2=DLOG(RANF())*(DCOS(PI*0.5*RANF()))**2 -C AR2=DLOG(DRAND48())*(DCOS(PI*0.5*DRAND48()))**2 -C AR2=DLOG(DBLE(RAN(ISEED)))*(DCOS(PI*0.5*DBLE(RAN(ISEED))))**2 AR2=DLOG(DBLE(random(2)))*(DCOS(PI*0.5*DBLE(random(3))))**2 FE(I)=DSQRT(-1.D0*(AR1+AR2)) - 1 CONTINUE + ENDDO RETURN END REAL*8 FUNCTION CVMGT(A, B, C) -c TR FUNCTION CVMGT(A, B, C) -c TR !DEC$REAL:8 IMPLICIT NONE REAL*8 A,B LOGICAL C @@ -4868,7 +4420,7 @@ c TR !DEC$REAL:8 IF ( C ) CVMGT = A RETURN END -C + SUBROUTINE SCOPY(IM,A,INCA,B,INCB) IMPLICIT NONE INTEGER*4 INCA,INCB,IM,JA,JB @@ -4878,37 +4430,36 @@ C IF (INCA .GT. 0) JA = 1 JB = IM * IABS(INCB) IF (INCB .GT. 0) JB = 1 - DO 10 J = 1,IM + DO J = 1,IM B(JB) = A(JA) JA = JA + INCA JB = JB + INCB - 10 CONTINUE + ENDDO RETURN END -C + FUNCTION ILLZ(N,A,K) -c TR !DEC$REAL:8 IMPLICIT NONE LOGICAL A(*) INTEGER K,L,N,I INTEGER*4 ILLZ IF(K.GT.0) THEN L=N+1 - DO 100 I=N,1,-1 - 100 IF(A(I)) L=I + DO I=N,1,-1 + IF(A(I)) L=I + ENDDO ELSE L=0 - DO 200 I=1,N - 200 IF(A(I)) L=I + DO I=1,N + IF(A(I)) L=I + ENDDO L=N+1-L ENDIF ILLZ=L-1 RETURN END -C + INTEGER FUNCTION ISRCHFGE(N,ARRAY,INC,TARGT) -c TR FUNCTION ISRCHFGE(N,ARRAY,INC,TARGT) -c TR !DEC$REAL:8 IMPLICIT NONE INTEGER I,N,J,INC REAL*8 ARRAY(N) @@ -4916,50 +4467,45 @@ c TR !DEC$REAL:8 J=1 IF(INC.LT.0) J=N*(-INC) - DO 100 I=1,N + DO I=1,N IF(ARRAY(J).GE.TARGT) GO TO 200 J=J+INC - 100 CONTINUE + ENDDO 200 ISRCHFGE=I RETURN END -C + INTEGER FUNCTION ISRCHFGT(N,ARRAY,INC,TARGT) -c TR FUNCTION ISRCHFGT(N,ARRAY,INC,TARGT) -c TR !DEC$REAL:8 IMPLICIT NONE INTEGER I,N,J,INC REAL*8 ARRAY(N),TARGT -C WRITE(*,*)targt + J=1 IF(INC.LT.0) J=N*(-INC) - DO 100 I=1,N + DO I=1,N IF(ARRAY(J).GT.TARGT) GO TO 200 J=J+INC - 100 CONTINUE + ENDDO 200 ISRCHFGT=I RETURN END -C + INTEGER FUNCTION ISRCHEQ(N,ARRAY,INC,TARGT) -c TR FUNCTION ISRCHEQ(N,ARRAY,INC,TARGT) -c TR !DEC$REAL:8 IMPLICIT NONE INTEGER I,N,J,INC REAL*8 ARRAY(N),TARGT -C WRITE(*,*)targt + J=1 IF(INC.LT.0) J=N*(-INC) - DO 100 I=1,N + DO I=1,N IF(ARRAY(J).EQ.TARGT) GO TO 200 J=J+INC - 100 CONTINUE + ENDDO 200 ISRCHEQ=I RETURN END -C + SUBROUTINE ENERGGAUSS(ISEED2,Esig,Epar,E0) -c TR !DEC$REAL:8 IMPLICIT NONE INTEGER*4 ISEED2 REAL*8 E0,Esig,Epar @@ -4971,15 +4517,11 @@ c TR !DEC$REAL:8 p2 = 2.D0*pi*DBLE(random(2)) p3 = p1*DCOS(p2) Epar= E0-p3 -C WRITE(*,*)E0,Esig,Epar -C WRITE(31,100)E0,Esig,Epar -C 100 FORMAT(1x,F12.5,2x,F12.5,2x,F12.5) RETURN END -C - SUBROUTINE ALPHAGAUSS(ISEED3,ALPHASIG,ALPHA,ALFA,ALPHApar, - # CALFA,SALFA,BW) -c TR !DEC$REAL:8 + + SUBROUTINE ALPHAGAUSS(ISEED3,ALPHASIG,ALPHA,ALFA,ALPHApar, CALFA + & ,SALFA,BW) IMPLICIT NONE INTEGER*4 ISEED3 REAL*8 ALPHA,ALPHASIG,ALPHApar @@ -4998,12 +4540,9 @@ c TR !DEC$REAL:8 ALFA = ALPHApar/BW CALFA = DCOS(ALFA) SALFA = DSIN(ALFA) -C WRITE(*,*)ALPHA,ALPHASIG,ALPHApar -C WRITE(31,100)ALPHA,ALPHASIG,ALPHApar -C 100 FORMAT(1x,F12.5,2x,F12.5,2x,F12.5) RETURN END -C + LOGICAL FUNCTION EQUAL(F1,F2) IMPLICIT NONE REAL*8 F1,F2