LMU/musrsim
LMU/musrsim
5
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Increased the range in depth profiles to 200. Still needs testing.

Browse Source
This commit is contained in:
salman 2013-04-02 11:23:27 +00:00
parent d38ad5f9ce
commit 435f3ceb13
1 changed files with 56 additions and 52 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

108
trimsp/src/trimspNL.F
View File

@ -205,13 +205,17 @@ c
IMPLICIT NONE
C These parameters are related to the maximum number of layers MAXNL
C and define the number of points in the depth distribution MAXD
INTEGER MAXD,MAXD1,MAXD2,MAXD5,MAXDNL5
INTEGER MAXD,MAXD1,MAXD2,MAXD5,MAXDNL5,MAXD2p2,MAXD2meagb
& ,MAXD2meab
INTEGER MAXNL,MAXNL5,MAXNLp25,MAXNL5p2,MAXNLm15
PARAMETER (MAXD=200)
PARAMETER (MAXNL=100)
PARAMETER (MAXD1=MAXD+1)
PARAMETER (MAXD2=MAXD+2)
PARAMETER (MAXD5=MAXD*5)
INTEGER MAXNL,MAXNL5,MAXNLp25,MAXNL5p2,MAXNLm15
PARAMETER (MAXNL=100)
PARAMETER (MAXD2p2=MAXD2*MAXD2)
PARAMETER (MAXD2meagb=MAXD2*36*22)
PARAMETER (MAXD2meab=MAXD2*22)
PARAMETER (MAXNL5=MAXNL*5)
PARAMETER (MAXNLp25=MAXNL*MAXNL5)
PARAMETER (MAXDNL5=MAXNL*MAXD5)
@ -246,13 +250,13 @@ C and define the number of points in the depth distribution MAXD
INTEGER*4 ITSP(MAXNL5),ISPALT(MAXNL)
& ,ISPIPT(MAXNL5),ISPIST(MAXNL5),ISPOPT(MAXNL5),ISPOST(MAXNL5)
INTEGER*4 KO(600,MAXNL5,2)
INTEGER*4 MEAB(102,22),MAGB(62,22),MEAGB(102,36,22) ,MEABL(75,21)
& ,MEPB(102,102)
INTEGER*4 MEAT(102,22),MAGT(62,22),MEAGT(102,36,22),
& MEATL(75,21),MEPT(102,102)
INTEGER*4 MEAS(102,22,MAXNLm15),MAGS(62,22,MAXNLm15),MAGSA(62,32
& ,MAXNLm15),MEAGS(102,12,22,MAXNLm15) ,MEASL(75,21,MAXNLm15)
INTEGER*4 MEAST(102,22,MAXNLm15),MAGST(62,22,MAXNLm15),MEASTL(75
INTEGER*4 MEAB(MAXD2,22),MAGB(62,22),MEAGB(MAXD2,36,22)
& ,MEABL(75,21),MEPB(MAXD2,MAXD2)
INTEGER*4 MEAT(MAXD2,22),MAGT(62,22),MEAGT(MAXD2,36,22),
& MEATL(75,21),MEPT(MAXD2,MAXD2)
INTEGER*4 MEAS(MAXD2,22,MAXNLm15),MAGS(62,22,MAXNLm15),MAGSA(62,32
& ,MAXNLm15),MEAGS(MAXD2,12,22,MAXNLm15) ,MEASL(75,21,MAXNLm15)
INTEGER*4 MEAST(MAXD2,22,MAXNLm15),MAGST(62,22,MAXNLm15),MEASTL(75
& ,21,MAXNLm15)
INTEGER*4 NJ(MAXNL),JT(MAXNL),ILD(MAXNL),NJJ
INTEGER*4 LLL(64),JJJ(64),IK(64)
@ -468,8 +472,8 @@ C CHARACTER Variables
DATA KADB/20*0/
DATA coss1s/0.D0/,coss2s/0.D0/,coss3s/0.D0/,coss4s/0.D0/
DATA coss5s/0.D0/,coss6s/0.D0/
DATA MEAB/2244*0/,MEABL/1575*0/,MAGB/1364*0/
DATA MEPB/10404*0/,MEAGB/80784*0/,EMA/1364*0.D0/
DATA MEAB/MAXD2meab*0/,MEABL/1575*0/,MAGB/1364*0/
DATA MEPB/MAXD2p2*0/,MEAGB/MAXD2meagb*0/,EMA/1364*0.D0/
DATA X2SUM/0.D0/,X3SUM/0.D0/,X4SUM/0.D0/,X5SUM/0.D0/
DATA X6SUM/0.D0/,XSUM/0.D0/
DATA R2SUM/0.D0/,R3SUM/0.D0/,R4SUM/0.D0/,R5SUM/0.D0/
@ -2025,9 +2029,9 @@ C
C
C PROJECTILE HAS STOPPED (PATHLENGTH,RANGE,SPREAD AND MOMENTS)
C
IP = MAX0( MIN0( IDINT(PL(IV)/CW+1.D0), 100), 1)
IP = MAX0( MIN0( IDINT(PL(IV)/CW+1.D0), MAXD), 1)
IPL(IP)=IPL(IP)+1
I1 = MAX0( MIN0( IDINT(X(IV)/CW+1.D0), 101), 0)
I1 = MAX0( MIN0( IDINT(X(IV)/CW+1.D0), MAXD1), 0)
IRP(I1)=IRP(I1)+1
C
C Berechnung der gestoppten Teilchen im jeweiligen Layer
@ -2820,7 +2824,7 @@ C
write(22,'(a)') ' DEPTH PARTICLES'
#endif
IF(YH.LT.1.D0) GO TO 603
DO I=0,101
DO I=0,MAXD1
RIRP(I) = DBLE(IRP(I))/YH
ENDDO
603 D1=0.
@ -2828,23 +2832,23 @@ C
WRITE(21,601) D1,IRP(0),RIRP(0)
601 FORMAT(4X,3H-SU,1H-,F6.0,I10,E12.4)
DO J=1,LJ
DO I=1,100
DO I=1,MAXD
ICDT(I)=ICDT(I)+ICD(I,J)
ICDTR(I)=ICDTR(I)+ICDR(I,J)
ENDDO
ENDDO
DO K=1,NJ(1)
DO J=1,NJ(1)
DO I=1,100
DO I=1,MAXD
ICDIRN(I,J)=ICDIRN(I,J)+ICDIRI(I,K,J)
ENDDO
ENDDO
ENDDO
DO I=0,101
DO I=0,MAXD1
IIRP=IIRP+IRP(I)
TRIRP=TRIRP+RIRP(I)
ENDDO
DO I=1,100
DO I=1,MAXD
IIPL=IIPL+IPL(I)
TION=TION+ION(I)
TDENT=TDENT+DENT(I)
@ -2860,11 +2864,11 @@ C
TPHONR=TPHONR+PHONR(I)
ICDTTR=ICDTTR+ICDTR(I)
ENDDO
do im1=100,1,-1
do im1=MAXD,1,-1
if(ipl(im1).ne.0.or.(.NOT.EQUAL(ion(im1),0.D0))) goto 20
enddo
im1=1
20 im1=min0(im1+2,100)
20 im1=min0(im1+2,MAXD)
DO 11 I=1,im1
WRITE(21,700) D1,D2,IRP(I),RIRP(I),IPL(I),ION(I),DENT(I),
& DMGN(I),ELGD(I),PHON(I),CASMOT(I),ICDT(I)
@ -2874,13 +2878,13 @@ C
701 FORMAT(1X,F6.0,2x,I10)
D1=D2
11 D2=D2+CW
WRITE(21,604) D2-CW,IRP(101),RIRP(101)
WRITE(21,604) D2-CW,IRP(MAXD1),RIRP(MAXD1)
604 FORMAT(1X,F6.0,1H-,3X,3HSUT,I10,E12.4)
WRITE(21,710) IIRP,TRIRP,IIPL,TION,TDENT,TDMGN,TELGD,TPHON,TCASMO
& ,ICDTT
710 FORMAT(/14X,I10,1P1E12.4,I10,1E14.4,5E12.4,I8)
DO J=1,NJ(1)
DO I=1,100
DO I=1,MAXD
ELET(J)=ELET(J)+ELE(I,J)
ELIT(J)=ELIT(J)+ELI(I,J)
ELPT(J)=ELPT(J)+ELP(I,J)
@ -2898,13 +2902,13 @@ C
& ,2X,'DPA(1)',2X,'DPA(2)'/)
D1=0.
D2=CW
do im2=100,1,-1
do im2=MAXD,1,-1
if(.NOT.EQUAL(eli(im2,1),0.D0).or.(.NOT.EQUAL(eli(im2,2),0.D0))
& ) goto 30
enddo
im2=1
30 im2=MIN0(im2+2,100)
30 im2=MIN0(im2+2,MAXD)
DO 1525 I=1,im2
WRITE(21,1523) D1,D2,ELI(I,1),ELE(I,1),ELD(I,1),ELP(I,1),
& ELI(I,2),ELE(I,2),ELD(I,2),ELP(I,2),ICD(I,1),ICD(I,2)
@ -2917,7 +2921,7 @@ C
1533 FORMAT(/14X,1P8E12.4,2I8///)
DO I=1,L-1
ILD(I)=IDINT(XX(I)/CW+0.01D0)
IF(ILD(I).GT.100) ILD(I)=100
IF(ILD(I).GT.MAXD) ILD(I)=MAXD
DO J=1,ILD(I)
DLI(I)=DLI(I)+DMGN(J)
ENDDO
@ -2941,11 +2945,11 @@ C
& ,5H(2-2)/)
D1=0.D0
D2=CW
do im3=100,1,-1
do im3=MAXD,1,-1
if (.not.equal(ionr(im3),0.D0)) go to 31
enddo
im3=1
31 im3=MIN0(im3+2,100)
31 im3=MIN0(im3+2,MAXD)
DO I=1,im3
WRITE(21,1595) D1,D2,IONR(I),DENTR(I),DMGNR(I),ELGDR(I),
& PHONR(I),ICDTR(I),ICDIRN(I,1),ICDIRN(I,2)
@ -3596,7 +3600,7 @@ C
EMA(1,J) = J-1
EMAT(1,J) = J-1
ENDDO
DO J=2,101
DO J=2,MAXD1
MEAB(J,1) = J-1
MEAT(J,1) = J-1
MEPB(J,1) = J-1
@ -3619,7 +3623,7 @@ C
MAGS(1,J,K) = J-1
MAGST(1,J,K) = J-1
ENDDO
DO J=2,101
DO J=2,MAXD1
MEAS(J,1,K) = J-1
MEAST(J,1,K) = J-1
ENDDO
@ -3631,7 +3635,7 @@ C
DO J=2,21
MEAGS(1,IG2,J,K) = J-1
ENDDO
DO J=2,101
DO J=2,MAXD1
MEAGS(J,IG2,1,K) = J-1
ENDDO
ENDDO
@ -3641,7 +3645,7 @@ C
MEAGB(1,IG2,J) = J-1
MEAGT(1,IG2,J) = J-1
ENDDO
DO J=2,101
DO J=2,MAXD1
MEAGB(J,IG2,1) = J-1
MEAGT(J,IG2,1) = J-1
ENDDO
@ -3679,11 +3683,11 @@ C
1884 FORMAT(//,' ENERGY(E/E0 IN %) - ',
& 'POLAR ANGLE IN COS-INTERVALS (0.05) ',
& '(BACKWARD SPUTTERED PARTICLES) , 1.LAYER , SPECIES',I2/)
do ima = 101,1,-1
do ima = MAXD1,1,-1
if(meas(ima,22,j).ne.0) goto 1883
enddo
ima = 1
1883 ima = min(ima+2,101)
1883 ima = min(ima+2,MAXD1)
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)
@ -3695,11 +3699,11 @@ C
& 'POLAR ANGLE IN COS-INTERVALS (0.05) ',
& 'AT AZIMUTHAL ANGLE =',F5.1,
& ' (BACKWARD SPUTTERED ATOMS) , 1.LAYER , SPECIES',I2/)
do ima = 101,1,-1
do ima = MAXD1,1,-1
if(meags(ima,ig2,22,j).ne.0) goto 1885
enddo
ima = 1
1885 ima = min(ima+2,101)
1885 ima = min(ima+2,MAXD1)
do iesp = 1, ima
write (6, 1886) (meags(iesp,ig2,iags,j),iags=1,22)
end do
@ -3737,11 +3741,11 @@ C
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
do ima = MAXD1,1,-1
if(meas(ima,22,j).ne.0) goto 1895
enddo
ima = 1
1895 ima = min(ima+2,101)
1895 ima = min(ima+2,MAXD1)
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)
@ -3782,11 +3786,11 @@ C
1984 FORMAT(//,' ENERGY(E/E0 IN %) - POLAR ANGLE IN COS-INTERVALS ',
& '(0.05) ',
& '(FORWARD SPUTTERED PARTICLES) , 1.LAYER , SPECIES',I2/)
do ima = 101,1,-1
do ima = MAXD1,1,-1
if(meast(ima,22,j).ne.0) goto 1983
enddo
ima = 1
1983 ima = min(ima+2,101)
1983 ima = min(ima+2,MAXD1)
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
@ -3822,11 +3826,11 @@ C
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
do ima = MAXD1,1,-1
if(meast(ima,22,j).ne.0) goto 1995
enddo
ima = 1
1995 ima = min(ima+2,101)
1995 ima = min(ima+2,MAXD1)
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
@ -3853,11 +3857,11 @@ C
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
do ima = MAXD1,1,-1
if(meast(ima,22,j).ne.0) goto 1977
enddo
ima = 1
1977 ima = min(ima+2,101)
1977 ima = min(ima+2,MAXD1)
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)
@ -3897,11 +3901,11 @@ C
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
do ima = MAXD1,1,-1
if(meagb(ima,ig2,22).ne.0) goto 2015
enddo
ima = 1
2015 ima = min(ima+2,101)
2015 ima = min(ima+2,MAXD1)
write (6, 1886) ((meagb(ie,ig2,iagb),iagb=1,22),ie=1,ima)
write (6, 1886) (meagb(102,ig2,iagb),iagb=1,22)
ENDDO
@ -3914,11 +3918,11 @@ C
2052 WRITE(21,2056)
2056 FORMAT(//,' ENERGY(E IN 0.1*TI) - POLAR ANGLE IN COS-INTERVALS ',
& '(0.05) (BACKSCATTERED PROJECTILES)'/)
do ima = 101,1,-1
do ima = MAXD1,1,-1
if(meab(ima,22).ne.0) goto 2017
enddo
ima = 1
2017 ima = min(ima+2,101)
2017 ima = min(ima+2,MAXD1)
write (6, 1886) ((meab(ie,iagb),iagb=1,22),ie=1,ima)
write (6, 1886) (meab(102,iagb),iagb=1,22)
2054 continue
@ -3975,11 +3979,11 @@ C
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
do ima = MAXD1,1,-1
if(meagt(ima,ig2,22).ne.0) goto 2115
enddo
ima = 1
2115 ima = min(ima+2,101)
2115 ima = min(ima+2,MAXD1)
write (21,1886) ((meagt(ie,ig2,iagb),iagb=1,22),ie=1,ima)
write (21,1886) (meagt(102,ig2,iagb),iagb=1,22)
ENDDO
@ -3987,11 +3991,11 @@ C
WRITE(21,2116)
2116 FORMAT(//,' ENERGY(E/E0 IN %) - POLAR ANGLE IN COS-INTERVALS ',
& '(0.05) (TRANSMITTED PROJECTILES)'/)
do ima = 101,1,-1
do ima = MAXD1,1,-1
if(meat(ima,22).ne.0) goto 2117
enddo
ima = 1
2117 ima = min(ima+2,101)
2117 ima = min(ima+2,MAXD1)
write (6, 1886) ((meat(ie,iagb),iagb=1,22),ie=1,ima)
write (6, 1886) (meat(102,iagb),iagb=1,22)
WRITE(21,2118)