c PROGRAM DATMAKER c c------------------------------------------------------------------------------ c dieses Programm erstellt die Eingabedateien, die mit dem Programm c TRIMSP4L gelesen werden. c dies ist die Version DATMAK7L(-test) c c Festlegen der für TRIMSP benötigten Modellparameter c Bezeichnung nach Eckstein's Datei TRVMC95.text c ef,esb,sheath,erc,rd,ca,kk0,kk0r,kdee1,kdee2,ipot,ipotr,irl c c Projektilparameter: c =================== c c zproj = Ordnungszahl des Projektils == fuer myonen = 1 c mproj = Massenzahl des Projektils == fuer Myonen = 0.11 c alphaproj = Winkel zwischen Projektil und Targetnormale == 0 ist c senkrecht c eproj = Projektilenergie in eV c esig = Breite der gaussfoermigen Energieverteilung c thick(n) = Dicke eines Layers in Angstroem c rho(n) = Dichte eines Layers in g/cm^3 c c Simulationsparameter: c ===================== c c ri = Zufallszahleninitialisierung (muss ungerade sein) c ri2 = Zufallszahleninitialisierung, mit der die Energie gewuerfelt wird c x0 = von wo aus werden Projektile implantiert == 0 ist Probenoberflaeche c cw = Dickeninterval in Angstroem c Festlegen der Target-Elemente m(max. 5) in den jeweiligen Layern l(max. 7) c p1 = Ordnungszahl-->ordz(n) c p2 = Massenzahl (amu)-->mass(n) c p3 = Bindungsenergie im Festkoerper (eV)-->elas(n) c p4 = Dichte des Elementes (g/cm^3)-->rho(n) c p(1-5) = Stoppingpowerkoeffizienten fuer H in Materie nach c Andersen-Ziegler-->spower(k,m,l) c conz(m,l) --> Konzentration eines Elementes in einem Layer c conzlayer(n) --> Gesamasskonzentration im Layer == muss 1.0 sein c die Parameter SBE(5) sind auf 30.0 eV und BE(5) auf 0 gesetzt (siehe TRVMC95.txt) c die Parameter CK(3) sind auf 1 gesetzt (siehe TRVMC95.txt) c c April 1999: das Programm berechnet jetzt aus den Konzentrationen die c stöchiometrische Dichte eines Layers. Wichtig: die Dichten fuer c H,He,Ne,O,Ar,Kr,Xe sind die Dichten am Tripelpunkt fuer die c fluessige Phase, die Dichten fuer F,Cl,Rn,Fr,Ra sind nicht bekannt c und deshalb auf 0.1 gesetzt. c c Mai 1999 : das Programm wurde erweitert. Jetzt koennen in einer Schleife c mehrere Eingabefiles fuer TRIMSP (ab Version TRIMSPPc4i) mit c verschiedener Startenergie und verschiedenen Kanalgroessen fuer c die Range Profile erstellt werden. Ausserem weden die erstellten c Files auf Abfrage in eine fuer ab TRIMSPpc4h geeignete c Batch-Datei weggeschrieben. c Juni 1999 : die Stopkoeffizienten aus der ICRU49 Tabelle werden verwendet. c Datei :stopicru.dat c Dez. 1999 : Dichten fuer N2,O2, Ar,Xe,Kr,Ne nun fuer die feste Phase c : Batchtype x eingefuegt c ab Version datmak4k c c ! Eingabedateien, die mit datmak4k erzeugt werden, koennen von aelteren Versionen (vor TrimSpp4k) c ! nicht gelesen werden. c c Dez. 1999 : neu Variable c alphaprojsig (Breite einer Gaussverteilung der Einfallwinkel c ri3 = seed fuer Zufallszahlengenerator fuer Einfallwinkel c Batchtype a,b eingefuegt aber noch nicht implementiert c Jun. 2000: nun sieben layer c c major revision: c c 19-Jun-2002: TP, implicit none, program comments at the beginning, c f77 standard, english output, changed formatting c change extension to .F in order to invole the pre- c compiler to write either a DOS bat file or a bash c shell script. c no longer prompt for random generator seed because c ranlux is used in trimsp7l_tp. c c 14-Jan-2003: TP, replaced format '(I6)' of reading the number of projectiles nproj c by *. c c-------------------------------------------------------------------------------------------- c c check OS c #if defined( _WIN32 ) #define OS_WIN #else #define OS_UNIX #endif c IMPLICIT none INTEGER i,k,l,m,lnum INTEGER nproj,n,lmax INTEGER kk0,kk0r,kdee1,kdee2,ipot,ipotr,irl REAL*4 zproj,mproj,eproj,esig,alphaproj,alphaprojsig REAL*4 ri,ri2,ri3,cw,x0 REAL*4 ef,esb,sheath,erc,rd,ca REAL*4 p2,p3,p4,p(5) REAL*4 ordz(5,7),mass(5,7),elas(5,7),spower(5,5,7),conz(5,7) REAL*4 conzlayer(7),thick(7),rho(7) REAL*4 ck(7),sbe(5,7),be(5,7) CHARACTER errcom*17,en*2,f*1,ausgabe*12,inpnam*4,parchar*3, 1 inpext*4 CHARACTER batchtype*1,name*8 DATA zproj,mproj /1.0,0.11/ DATA alphaproj,alphaprojsig /0.0,0.0/ DATA eproj,esig /1000.0,0.0/ DATA ef,esb,sheath,erc /0.50,0.00,0.00,0.00/ DATA rd,ca /50.00,1.00/ DATA kk0,kk0r,kdee1,kdee2,ipot,ipotr,irl /2,2,4,3,2,1,0/ DATA ri,x0,cw /78741.00,0.00,30.0/ DATA nproj /1000/ DATA lmax /7/ DATA errcom /'Wrong Input !'/ DATA inpext /'.inp'/ DATA batchtype /'e'/ c WRITE(*,*)' ----------------------------------------' WRITE(*,*)' | Program D A T M A K, Version 7L |' WRITE(*,*)' ----------------------------------------' WRITE(*,*) WRITE(*,*)' Program to create the input file for' WRITE(*,*)' TRIM.SP (W. Eckstein, IPP Garching).' write(*,*) WRITE(*,*)' The general name for the output (must be '// 1 'character*4, A4) will be used' WRITE(*,*)' in all output file names. In case of multiple'// 1 ' energies to be simulated (Batchtype e),' WRITE(*,*)' the energy will be appended as character*3 (A3),'// 1 ' for example, 30keV=300, 0.5keV=005.' WRITE(*,*)' Otherwise, the character*3 file name specifier'// 1 ' must be entered manually.' WRITE(*,*)' Between general file name and character*3'// 1 ' specifier the batch type will be inserted' WRITE(*,*)' as character*1.' WRITE(*,*)' In batch mode only one of the paramters energy,'// 1 'energy width, number of muons or layer thickness' WRITE(*,*)' can be changed.' WRITE(*,*) WRITE(*,*)' Enter the general file name (A4)' READ(5,'(A4)')inpnam c 800 WRITE(*,*)' Batchtype ?' WRITE(*,*)' E = energy (default)' WRITE(*,*)' S = sigma energy' WRITE(*,*)' N = number of particles' WRITE(*,*)' D = layer thickness' WRITE(*,*)' X = energy and sigma energy' c WRITE(*,*)' A = alpha and alphasigma' c WRITE(*,*)' B = energy, sigma energy, alpha, alphasigma' c WRITE(*,*)'Change batch type (y/n)? ' READ(5,'(A1)')f IF(f.EQ.'n'.OR.f.EQ.'N'.OR.f.EQ.'') THEN batchtype='e' GOTO 806 ELSEIF(f.EQ.'y'.OR.f.EQ.'Y'.OR.f.EQ.'j'.OR.f.EQ.'J') THEN 805 WRITE(*,*)' Enter batch type (A1) ' READ(*,'(A1)')batchtype IF(batchtype.EQ.'e'.OR.batchtype.EQ.'E')THEN batchtype='e' ELSEIF(batchtype.EQ.'s'.OR.batchtype.EQ.'S')THEN batchtype='s' ELSEIF(batchtype.EQ.'n'.OR.batchtype.EQ.'N')THEN batchtype='n' ELSEIF(batchtype.EQ.'d'.OR.batchtype.EQ.'D')THEN batchtype='d' ELSEIF(batchtype.EQ.'x'.OR.batchtype.EQ.'X')THEN batchtype='x' c ELSEIF(batchtype.EQ.'a'.OR.batchtype.EQ.'A')THEN c batchtype='a' c ELSEIF(batchtype.EQ.'b'.OR.batchtype.EQ.'B')THEN c batchtype='b' ELSE WRITE(*,*)errcom GOTO 805 ENDIF ELSE WRITE(*,*)errcom GOTO 800 ENDIF c 806 WRITE(*,*)' Projectile parameter ' WRITE(*,'(1x,A3,F7.2,1x,A4,F7.2)')'Z: ',zproj,'M: ',mproj WRITE(*,'(1x,A3,F7.2,1x,A6,F7.2)')'E: ',eproj, + 'Esig: ',esig WRITE(*,'(1x,A8,F7.2,1x,A10,F7.2)')'alpha: ',alphaproj, + 'alphasig: ',alphaprojsig WRITE(*,*)'Change projectile ? ' 1001 READ(5,'(A1)')f IF(f.EQ.'n'.OR.f.EQ.'N'.OR.f.EQ.'') THEN GOTO 1000 ELSEIF(f.EQ.'y'.OR.f.EQ.'Y'.OR.f.EQ.'j'.OR.f.EQ.'J') THEN WRITE(*,*)' Charge number (Myon = 1)' 810 READ(5,501,ERR=810)zproj IF(zproj.EQ.0.0) zproj=1. WRITE(*,*)' Projectile mass (Myon=0.113)' 811 READ(5,501,ERR=811)mproj IF(mproj.EQ.0.0) mproj=0.113 ELSE WRITE(*,*)errcom GOTO 1001 ENDIF 1000 WRITE(*,*)'Change projectile energy ? ' READ(5,'(A1)')f IF(f.EQ.'n'.OR.f.EQ.'N'.OR.f.EQ.'') THEN GOTO 10011 ELSEIF(f.EQ.'y'.OR.f.EQ.'Y'.OR.f.EQ.'j'.OR.f.EQ.'J') THEN WRITE(*,*)' Projectile energy in eV ' 814 READ(5,501,ERR=814)eproj IF(eproj.EQ.0.0) eproj=1000. ELSE WRITE(*,*)errcom GOTO 1000 ENDIF 10011 WRITE(*,*)'Change sigma ? ' READ(5,'(A1)')f IF(f.EQ.'n'.OR.f.EQ.'N'.OR.f.EQ.'') THEN GOTO 10012 ELSEIF(f.EQ.'y'.OR.f.EQ.'Y'.OR.f.EQ.'j'.OR.f.EQ.'J') THEN WRITE(*,*)' Sigma in eV ' 815 READ(5,501,ERR=815)esig esig=ABS(esig) ELSE WRITE(*,*)errcom GOTO 10011 ENDIF 10012 WRITE(*,*)'Change angle of projectile ? ' READ(5,'(A1)')f IF(f.EQ.'n'.OR.f.EQ.'N'.OR.f.EQ.'') THEN GOTO 10013 ELSEIF(f.EQ.'y'.OR.f.EQ.'Y'.OR.f.EQ.'j'.OR.f.EQ.'J') THEN WRITE(*,*)' Projectile angle (perpendicular=0)' 813 READ(5,501,ERR=813)alphaproj alphaproj=ABS(alphaproj) ELSE WRITE(*,*)errcom GOTO 10012 ENDIF 10013 WRITE(*,*)'Change sigma ? ' READ(5,'(A1)')f IF(f.EQ.'n'.OR.f.EQ.'N'.OR.f.EQ.'') THEN GOTO 10014 ELSEIF(f.EQ.'y'.OR.f.EQ.'Y'.OR.f.EQ.'j'.OR.f.EQ.'J') THEN WRITE(*,*)' Sigma projectile angle ' 8130 READ(5,501,ERR=8130)alphaprojsig alphaprojsig=ABS(alphaprojsig) ELSE WRITE(*,*)errcom GOTO 10013 ENDIF c 10014 WRITE(*,*)' Other projectile parameters + (see TRVMC95.txt for details)' WRITE(*,'(1x,A3,F7.2,1x,A4,F7.2,1x,A7,F7.2,1x,A4,F7.2)') + 'EF ',ef,'ESB ',esb,'SHEATH ',sheath,'ERC ',erc WRITE(*,'(1x,A3,F7.2,1x,A3,F7.2)')'RD ',rd,'CA ',ca WRITE(*,*)'Change ?' 1003 READ(5,'(A1)')f IF(f.EQ.'n'.OR.f.EQ.'N'.OR.f.EQ.'') THEN GOTO 1002 ELSEIF(f.EQ.'y'.OR.f.EQ.'Y'.OR.f.EQ.'j'.OR.f.EQ.'J') THEN WRITE(*,*)' EF :' 820 READ(5,501,ERR=820)ef WRITE(*,*)' ESB :' 821 READ(5,501,ERR=821)esb WRITE(*,*)' SHEATH :' 822 READ(5,501,ERR=822)sheath WRITE(*,*)' ERC :' 823 READ(5,501,ERR=823)erc WRITE(*,*)' RD :' 824 READ(5,501,ERR=824)rd WRITE(*,*)' CA :' 825 READ(5,501,ERR=825)ca 501 FORMAT(F7.0) ELSE WRITE(*,*)errcom GOTO 1003 ENDIF 1002 WRITE(*,*)' Elastic collision parameters + (see TRVMC95.txt for details)' WRITE(*,'(1x,A4,I1,1x,A5,I1,1x,A6,I1,1x,A6,I1)') + 'KK0 ',KK0,'KK0R ',KK0R,'KDEE1 ',KDEE1,'KDEE2 ',KDEE2 WRITE(*,'(1x,A5,I1,1x,A6,I1,1x,A4,I1)') + 'IPOT ',IPOT,'IPOTR ',IPOTR,'IRL ',IRL WRITE(*,*)'Change ?' 1005 READ(5,'(A1)')f IF(f.EQ.'n'.OR.f.EQ.'N'.OR.f.EQ.'') THEN GOTO 1004 ELSEIF(f.EQ.'y'.OR.f.EQ.'Y'.OR.f.EQ.'j'.OR.f.EQ.'J') THEN WRITE(*,*)' KK0 ' 830 READ(5,502,ERR=830)KK0 IF(KK0.LT.0.OR.KK0.GT.4)THEN WRITE(*,*)' must be in [0,4].' GOTO 830 ENDIF WRITE(*,*)' KK0R ' 831 READ(5,502,ERR=831)KK0R IF(KK0R.LT.0.OR.KK0R.GT.4)THEN WRITE(*,*)' must be in [0,4]. ' GOTO 831 ENDIF WRITE(*,*)' KDEE1 ' 832 READ(5,502,ERR=832)KDEE1 IF(KDEE1.LT.1.OR.KDEE1.GT.5)THEN WRITE(*,*)' must be in [1,5].' GOTO 832 ENDIF WRITE(*,*)' KDEE2 ' 833 READ(5,502,ERR=833)KDEE2 IF(KDEE2.LT.1.OR.KDEE2.GT.3)THEN WRITE(*,*)' must be in [1,3].' GOTO 833 ENDIF WRITE(*,*)' IPOT ' 834 READ(5,502,ERR=834)IPOT IF(IPOT.LT.1.OR.IPOT.GT.3)THEN WRITE(*,*)' must be in [1,3].' GOTO 834 ENDIF WRITE(*,*)' IPOTR ' 835 READ(5,502,ERR=835)IPOTR IF(IPOTR.LT.1.OR.IPOTR.GT.3)THEN WRITE(*,*)' must be in [1,3].' GOTO 835 ENDIF WRITE(*,*)' IRL ' 836 READ(5,502,ERR=836) IRL IF(IRL.LT.0.OR.IRL.GT.1)THEN WRITE(*,*)' must be in [0,1]' GOTO 836 ENDIF 502 FORMAT(I1) ELSE WRITE(*,*)errcom GOTO 1005 ENDIF c 1004 WRITE(*,*)' Parameter for the simulation:' WRITE(*,'(1x,A18,I6)')'Number of projectiles ',nproj WRITE(*,*)'Change ?' 1007 READ(5,'(A1)')f IF(f.EQ.'n'.OR.f.EQ.'N'.OR.f.EQ.'') THEN GOTO 1006 ELSEIF(f.EQ.'y'.OR.f.EQ.'Y'.OR.f.EQ.'j'.OR.f.EQ.'J') THEN WRITE(*,*)'Number of projectiles ? ' 840 READ(5,*,ERR=840)nproj ELSE WRITE(*,*)errcom GOTO 1007 ENDIF 1006 WRITE(*,'(1x,A11,F7.2)')'Start depth ',x0 WRITE(*,*)'Change ?' 1009 READ(5,'(A1)')f IF(f.EQ.'n'.OR.f.EQ.'N'.OR.f.EQ.'') THEN GOTO 1008 ELSEIF(f.EQ.'y'.OR.f.EQ.'Y'.OR.f.EQ.'j'.OR.f.EQ.'J') THEN WRITE(*,*)'Start depth ? ' 841 READ(5,'(F7.0)',ERR=841)x0 ELSE WRITE(*,*)errcom GOTO 1009 ENDIF 1008 WRITE(*,'(1x,A13,F7.2)')'Step size ',cw WRITE(*,*)'Change ?' 1011 READ(5,'(A1)')f IF(f.EQ.'n'.OR.f.EQ.'N'.OR.f.EQ.'') THEN GOTO 1010 ELSEIF(f.EQ.'y'.OR.f.EQ.'Y'.OR.f.EQ.'j'.OR.f.EQ.'J') THEN WRITE(*,*)' Step size ? ' 842 READ(5,'(F7.0)',ERR=842)cw ELSE WRITE(*,*)errcom GOTO 1011 ENDIF 1010 continue c WRITE(*,'(1x,A27,F12.5)')'Random number generator seed',ri c WRITE(*,*)'Change ?' c1013 READ(5,'(A1)')f c IF(f.EQ.'n'.OR.f.EQ.'N'.OR.f.EQ.'') THEN c GOTO 1012 c ELSEIF(f.EQ.'y'.OR.f.EQ.'Y'.OR.f.EQ.'j'.OR.f.EQ.'J') THEN c WRITE(*,*)' Random number seed :' c843 READ(5,'(F12.0)',ERR=843)ri c IF((ri/2.-FLOAT(INT(ri/2.))).ne.0.5) ri=ri+1 c ELSE c WRITE(*,*)errcom c GOTO 1013 c ENDIF 1012 ri2=ri ri3=ri WRITE(*,*)' Number of layers ? <7' 850 READ(5,'(I1)',ERR=850)lnum IF(lnum.LE.0.OR.lnum.GT.7) THEN WRITE(*,*)errcom GOTO 1012 ENDIF c CALL NULLEN(ordz,mass,elas,rho,spower,conz, + conzlayer,thick,ck,sbe,be) DO l=1,lnum DO i=1,5 m=1 10120 WRITE(*,'(A15,I1)')'Layer number ',l WRITE(*,'(A15,I1)')'Element number ',m 1014 WRITE(*,'(1x,A44)')'Enter name of element '// + '(A2), QQ to stop.' 851 READ(5,'(A2)',ERR=851)en CALL element(en,n) c IF(n.EQ.0) THEN WRITE(*,*)errcom GOTO 1014 ENDIF IF(n.EQ.93) GOTO 1100 CALL lese(p2,p3,p,n) ordz(m,l)=FLOAT(n) mass(m,l)=p2 elas(m,l)=p3 sbe(m,l)=30. DO k=1,5 spower(k,m,l)=p(k) ENDDO WRITE(*,*)' Concentration of an element must be '// + 'smaller or equal 1.' WRITE(*,*)' Summe of all concentrations '// + ' within a layer must be 1.)' 1015 WRITE(*,*)' Enter concentration of the element.' 852 READ(5,'(F7.0)',ERR=852)conz(m,l) IF(conz(m,l).LE.0.0.OR.conz(m,l).GT.1.0) THEN WRITE(*,*)errcom GOTO 1015 ENDIF conzlayer(l)=conz(m,l)+conzlayer(l) IF(conzlayer(l).GT.1.0) THEN WRITE(*,*)' Sum of concentration within the ' WRITE(*,'(1x,I1,1x,A29)')l,'. layer is > 1. ' WRITE(*,*)' S T O P !' STOP ENDIF CALL dichte(p4,n) rho(l)=rho(l)+p4*conz(m,l) IF(m.EQ.5) GOTO 1100 1016 WRITE(*,*)' Another element in layer ?' READ(5,'(A1)')f IF(f.EQ.'y'.OR.f.EQ.'Y'.OR.f.EQ.'j'.OR.f.EQ.'J') THEN m=m+1 GOTO 10120 ELSEIF(f.EQ.'n'.OR.f.EQ.'N') THEN ordz(m+1,l)=0.0 mass(m+1,l)=0.0 elas(m+1,l)=0.0 DO k=1,5 spower(k,m+1,l)=0.0 ENDDO IF(m.EQ.1) THEN CALL dichte(p4,n) rho(l)=p4 GOTO 1101 ENDIF GOTO 1100 ELSE WRITE(*,*)errcom GOTO 1016 ENDIF ENDDO 1100 WRITE(*,*)'Density of layer ? ',rho(l) WRITE(*,*)'Density OK ?' READ(5,'(A1)')f IF(f.EQ.'y'.OR.f.EQ.'Y'.OR.f.EQ.'j'.OR.f.EQ.'J') THEN GOTO 1101 ELSEIF(f.EQ.'n'.OR.f.EQ.'N') THEN WRITE(*,*)'Density of layer ? ' 860 READ(5,'(F7.0)',ERR=860)rho(l) ELSE WRITE(*,*)errcom GOTO 1100 ENDIF 1101 WRITE(*,*)'Thickness of layer ?' 861 READ(5,'(F7.0)',ERR=861)thick(l) ENDDO c WRITE(*,*)' Ausgabe der Layerzusammensetzung auf Bildschirm' c DO l=1,lnum c WRITE(*,'(A15,I1)')'Layer Nummer ',l c DO m=1,5 c IF(ordz(m,l).EQ.0.0) GOTO 1200 c WRITE(*,'(A15,I1)')'Element Nummer ',m c WRITE(*,'(A3,F12.5)')'Z: ',ordz(m,l) c WRITE(*,'(A3,F12.5)')'M: ',mass(m,l) c WRITE(*,'(A5,F12.5)')'E-E: ',elas(m,l) c DO k=1,5 c WRITE(*,'(A17,I1,1x,F12.5)') c + 'Stoppkoeffizient ',k,spower(k,m,l) c ENDDO c WRITE(*,'(A20,F7.3)')'Konzentration: ',conz(m,l) c ENDDO c1200 WRITE(*,'(A43,F7.3)') c + 'Gesamtmassenkonzentration Layer ->muss 1. sein !',conzlayer(l) c WRITE(*,'(A30,F7.3)')'Dichte des Layers :',rho(l) c WRITE(*,'(A30,F12.3)')'Dicke des Layers :',thick(l) c ENDDO c c hier faengt die Schleife fuer die Erstellung verschiedener Dateien c mit unterschiedlicher Energie und unterschiedlicher Schrittweite an c DO 1,n=1,100 c IF(n.EQ.1)THEN IF(batchtype.EQ.'e')THEN CALL ausgabenam(eproj,parchar) ELSE 1499 WRITE(*,*)' Specific file name (A3) ' READ(*,'(A3)',ERR=1499)parchar ENDIF ENDIF c 1500 ausgabe=inpnam//batchtype//parchar//inpext 1501 OPEN(UNIT=11,file=ausgabe,STATUS='NEW',ERR=3000) CALL batchcreater(inpnam,batchtype,parchar,inpext) C WRITE(11,2010)zproj,mproj,eproj,esig,alphaproj,alphaprojsig, # ef,esb,sheath,erc WRITE(11,2011)nproj,ri,ri2,ri3,x0,rd,cw,ca,kk0,kk0r,kdee1,kdee2, # ipot,ipotr,irl WRITE(11,2012) thick(1),thick(2),thick(3), # thick(4),thick(5),thick(6),thick(7), # rho(1),rho(2),rho(3),rho(4),rho(5),rho(6),rho(7), # ck(1),ck(2),ck(3),ck(4),ck(5),ck(6),ck(7) DO 2000 I=1,lmax WRITE(11,2013) ordz(1,I),ordz(2,I),ordz(3,I),ordz(4,I),ordz(5,I) WRITE(11,2013) mass(1,I),mass(2,I),mass(3,I),mass(4,I),mass(5,I) WRITE(11,2013) conz(1,I),conz(2,I),conz(3,I),conz(4,I),conz(5,I) WRITE(11,2013) elas(1,I),elas(2,I),elas(3,I),elas(4,I),elas(5,I) WRITE(11,2013) sbe(1,I),sbe(2,I),sbe(3,I),sbe(4,I),sbe(5,I) WRITE(11,2013) be(1,I),be(2,I),be(3,I),be(4,I),be(5,I) c WRITE(11,2017) spower(1,1,I),spower(1,2,I),spower(1,3,I), + spower(1,4,I),spower(1,5,I) WRITE(11,2017) spower(2,1,I),spower(2,2,I),spower(2,3,I), + spower(2,4,I),spower(2,5,I) WRITE(11,2017) spower(3,1,I),spower(3,2,I),spower(3,3,I), + spower(3,4,I),spower(3,5,I) WRITE(11,2017) spower(4,1,I),spower(4,2,I),spower(4,3,I), + spower(4,4,I),spower(4,5,I) WRITE(11,2017) spower(5,1,I),spower(5,2,I),spower(5,3,I), + spower(5,4,I),spower(5,5,I) 2000 CONTINUE c CLOSE(UNIT=11) 1502 WRITE(*,*)' Another file with new parameters ?' READ(*,'(A1)')f IF(f.EQ.'n'.OR.f.EQ.'N'.OR.f.EQ.'') THEN GOTO 9000 ELSEIF(f.EQ.'y'.OR.f.EQ.'Y'.OR.f.EQ.'j'.OR.f.EQ.'J') THEN c1507 WRITE(*,*)' Welche Parameter sollen geaendert werden ?' c WRITE(*,*)' E = Energie (default)' c WRITE(*,*)' S = Esigma' c WRITE(*,*)' N = Anzahl Myonen' c WRITE(*,*)' D = Layerdicken' c READ(*,'(A1)')batchtype IF(batchtype.EQ.'e'.OR.batchtype.EQ.'E'.or.batchtype.EQ.'') + THEN CALL changE(eproj,cw) CALL ausgabenam(eproj,parchar) ELSEIF(batchtype.EQ.'s'.OR.batchtype.EQ.'S') THEN CALL changS(esig) 1520 WRITE(*,*)' spezieller Dateiname (A3) ' READ(*,'(A3)',ERR=1520)parchar ELSEIF(batchtype.EQ.'n'.OR.batchtype.EQ.'N') THEN CALL changN(nproj) 1521 WRITE(*,*)' spezieller Dateiname (A3) ' READ(*,'(A3)',ERR=1521)parchar ELSEIF(batchtype.EQ.'d'.OR.batchtype.EQ.'D') THEN CALL changD(thick,cw,lnum) 1522 WRITE(*,*)' spezieller Dateiname (A3) ' READ(*,'(A3)',ERR=1522)parchar ELSEIF(batchtype.EQ.'x'.OR.batchtype.EQ.'X') THEN CALL changX(eproj,esig) 1523 WRITE(*,*)' spezieller Dateiname (A3) ' READ(*,'(A3)',ERR=1523)parchar ELSE WRITE(*,*)errcom STOP ENDIF GOTO 1500 ELSE WRITE(*,*)errcom GOTO 1502 ENDIF 3000 WRITE(*,*)' Error during file open. ' WRITE(*,*)' Enter new file name: ' READ(*,'(A8)')name ausgabe=name//inpext GOTO 1501 c 1 CONTINUE c 2010 FORMAT(2F7.2,1F12.2,7F9.2) 2011 FORMAT(I9,3F8.0,1F7.2,1F7.0,2F7.2,6I4,I3) 2012 FORMAT(7F9.2,14F7.2) 2013 FORMAT(5F9.4) 2017 FORMAT(5F12.6) c 9000 CALL batchexit(inpnam,batchtype) END c c hier werden die Parameter der Elemente eingelesen c SUBROUTINE param c INTEGER i,n REAL p2,p3,p4 REAL p(5) CHARACTER str2*17,str3*17,str4*69,str5*12 c Masse der Elemente, Stoppingpowerdaten nach Andersen-Ziegler und Bindungsenergie c der Elemente im bulk ENTRY lese(p2,p3,p,n) c OPEN(UNIT=31,FILE='masse.dat',STATUS='OLD') OPEN(UNIT=32,FILE='elast.dat',STATUS='OLD') OPEN(UNIT=33,FILE='stopicru.dat',STATUS='OLD') c DO i=1,n READ(31,'(A17)')str2 READ(32,'(A17)')str3 READ(33,'(A69)')str4 ENDDO c READ(str2(8:16),'(F12.0)')p2 READ(str3(9:16),'(F12.0)')p3 READ(str4(4:16),'(F12.0)')p(1) READ(str4(17:29),'(F12.0)')p(2) READ(str4(30:42),'(F12.0)')p(3) READ(str4(43:55),'(F12.0)')p(4) READ(str4(56:68),'(F12.0)')p(5) c CLOSE(UNIT=31) CLOSE(UNIT=32) CLOSE(UNIT=33) c c OPEN(UNIT=31,POSITION='rewind') c OPEN(UNIT=32,POSITION='rewind') c OPEN(UNIT=33,POSITION='rewind') c RETURN c c die elementaren Dichten c ENTRY dichte(p4,n) c OPEN(UNIT=34,FILE='dichte.dat',STATUS='OLD') c DO i=1,n READ(34,'(A12)')str5 ENDDO c READ(str5(4:11),'(F12.0)')p4 c CLOSE(UNIT=34) c RETURN END c c diese Subroutine erkennt das/die Elemente c SUBROUTINE element(en,n) c INTEGER n CHARACTER en*2 c n=0 c IF(en.EQ.' H'.OR.en.EQ.'H') n=1 IF(en.EQ.'He') n=2 IF(en.EQ.'Li') n=3 IF(en.EQ.'Be') n=4 IF(en.EQ.' B'.OR.en.EQ.'B') n=5 IF(en.EQ.' C'.OR.en.EQ.'C') n=6 IF(en.EQ.' N'.OR.en.EQ.'N') n=7 IF(en.EQ.' O'.OR.en.EQ.'O') n=8 IF(en.EQ.' F'.OR.en.EQ.'F') n=9 IF(en.EQ.'Ne') n=10 IF(en.EQ.'Na') n=11 IF(en.EQ.'Mg') n=12 IF(en.EQ.'Al') n=13 IF(en.EQ.'Si') n=14 IF(en.EQ.' P'.OR.en.EQ.'P') n=15 IF(en.EQ.' S'.OR.en.EQ.'S') n=16 IF(en.EQ.'Cl') n=17 IF(en.EQ.'Ar') n=18 IF(en.EQ.' K'.OR.en.EQ.'K') n=19 IF(en.EQ.'Ca') n=20 IF(en.EQ.'Sc') n=21 IF(en.EQ.'Ti') n=22 IF(en.EQ.' V'.OR.en.EQ.'V') n=23 IF(en.EQ.'Cr') n=24 IF(en.EQ.'Mn') n=25 IF(en.EQ.'Fe') n=26 IF(en.EQ.'Co') n=27 IF(en.EQ.'Ni') n=28 IF(en.EQ.'Cu') n=29 IF(en.EQ.'Zn') n=30 IF(en.EQ.'Ga') n=31 IF(en.EQ.'Ge') n=32 IF(en.EQ.'As') n=33 IF(en.EQ.'Se') n=34 IF(en.EQ.'Br') n=35 IF(en.EQ.'Kr') n=36 IF(en.EQ.'Rb') n=37 IF(en.EQ.'Sr') n=38 IF(en.EQ.' Y'.OR.en.EQ.'Y') n=39 IF(en.EQ.'Zr') n=40 IF(en.EQ.'Nb') n=41 IF(en.EQ.'Mo') n=42 IF(en.EQ.'Tc') n=43 IF(en.EQ.'Ru') n=44 IF(en.EQ.'Rh') n=45 IF(en.EQ.'Pd') n=46 IF(en.EQ.'Ag') n=47 IF(en.EQ.'Cd') n=48 IF(en.EQ.'In') n=49 IF(en.EQ.'Sn') n=50 IF(en.EQ.'Sb') n=51 IF(en.EQ.'Te') n=52 IF(en.EQ.' I'.OR.en.EQ.'I') n=53 IF(en.EQ.'Xe') n=54 IF(en.EQ.'Cs') n=55 IF(en.EQ.'Ba') n=56 IF(en.EQ.'La') n=57 IF(en.EQ.'Ce') n=58 IF(en.EQ.'Pr') n=59 IF(en.EQ.'Nd') n=60 IF(en.EQ.'Pm') n=61 IF(en.EQ.'Sm') n=62 IF(en.EQ.'Eu') n=63 IF(en.EQ.'Gd') n=64 IF(en.EQ.'Tb') n=65 IF(en.EQ.'Dy') n=66 IF(en.EQ.'Ho') n=67 IF(en.EQ.'Er') n=68 IF(en.EQ.'Tm') n=69 IF(en.EQ.'Yb') n=70 IF(en.EQ.'Lu') n=71 IF(en.EQ.'Hf') n=72 IF(en.EQ.'Ta') n=73 IF(en.EQ.' W'.OR.en.EQ.'W') n=74 IF(en.EQ.'Re') n=75 IF(en.EQ.'Os') n=76 IF(en.EQ.'Ir') n=77 IF(en.EQ.'Pt') n=78 IF(en.EQ.'Au') n=79 IF(en.EQ.'Hg') n=80 IF(en.EQ.'Tl') n=81 IF(en.EQ.'Pb') n=82 IF(en.EQ.'Bi') n=83 IF(en.EQ.'Po') n=84 IF(en.EQ.'At') n=85 IF(en.EQ.'Rn') n=86 IF(en.EQ.'Fr') n=87 IF(en.EQ.'Ra') n=88 IF(en.EQ.'Ac') n=89 IF(en.EQ.'Th') n=90 IF(en.EQ.'Pa') n=91 IF(en.EQ.' U'.OR.en.EQ.'U') n=92 IF(en.EQ.'qq'.OR.en.EQ.'QQ') n=93 c RETURN END c c fuers gute Gewissen, die Subroutine nullt alle Parameter c SUBROUTINE NULLEN(ordz,mass,elas,rho,spower,conz, + conzlayer,thick,ck,sbe,be) c implicit none INTEGER i,k,l REAL*4 ordz(5,7),mass(5,7),elas(5,7),spower(5,5,7),conz(5,7) REAL*4 conzlayer(7),thick(7),rho(7) REAL*4 ck(7),sbe(5,7),be(5,7) c DO 10 i=1,7 conzlayer(i)=0.0 thick(i)=0.0 rho(i)=0.0 ck(i)=1.0 DO 11 k=1,5 ordz(k,i)=0.0 mass(k,i)=0.0 elas(k,i)=0.0 conz(k,i)=0.0 sbe(k,i)=0.0 be(k,i)=0.0 DO 12 l=1,5 spower(l,k,i)=0.0 12 ENDDO 11 ENDDO 10 ENDDO c RETURN END c c Subroutine, die die Energie in ein 3zeichigen Character umwandelt c SUBROUTINE AUSGABENAM(eproj,parchar) c implicit none REAL eproj INTEGER etmp CHARACTER parchar*3,c1*1,c2*1 c DATA c1/'0'/,c2/'0'/ c etmp=INT(eproj/1.E2) IF(etmp.LT.100) THEN IF(etmp.LT.10) THEN WRITE(99,'(A1,A1,I1)')c1,c2,etmp GOTO 10 ENDIF WRITE(99,'(A1,I2)')c1,etmp GOTO 10 ENDIF WRITE(99,'(I3)')etmp 10 CLOSE(99) READ(99,'(A3)')parchar WRITE(*,'(A3)')parchar CLOSE(99,STATUS='DELETE') c RETURN END c c Subroutine, in der die Parameter Energie, SigmaE, Teilchenanzahl, c Kanalweite und Schichtdicken geaendert werden koennen c (nicht aber die Layerzusammensetzung !) c SUBROUTINE changes c implicit none INTEGER i,lnum,nproj REAL eproj,esig,thick(3),cw CHARACTER errcom*21,f*1 c DATA errcom/'Fehlerhafte Eingabe !'/ c andere Energie und/oder Kanalweite ENTRY changE(eproj,cw) WRITE(*,'(A15,F9.2)')' Old energy: ',eproj 100 WRITE(*,*)' New energy (E < 100.000 eV)' READ(*,'(F7.0)',ERR=100)eproj 110 WRITE(*,*)' Other step size ?' READ(*,'(A1)')f IF(f.EQ.'y'.OR.f.EQ.'Y'.OR.f.EQ.'j'.OR.f.EQ.'J') THEN WRITE(*,'(A25,F7.2)')' Old step size: ',cw 115 WRITE(*,*)' New step size' READ(*,'(F7.0)',ERR=115)cw ELSEIF(f.EQ.'n'.OR.f.EQ.'N'.OR.f.EQ.'') THEN RETURN ELSE WRITE(*,*)errcom GOTO 110 ENDIF RETURN c andere Energie und anderes Sigma ENTRY changX(eproj,esig) WRITE(*,'(A15,F9.2)')' old energy: ',eproj 105 WRITE(*,*)' new energy (E < 100.000 eV)' READ(*,'(F7.0)',ERR=105)eproj WRITE(*,'(A15,F7.2)')' old Esigma: ',esig 106 WRITE(*,*)' new Esigma' READ(*,'(F7.0)',ERR=106)esig RETURN c anderes Esigma ENTRY changS(esig) WRITE(*,'(A15,F7.2)')' old Esigma: ',esig 120 WRITE(*,*)' new Esigma' READ(*,'(F7.0)',ERR=120)esig RETURN c andere Anzahl Myonen ENTRY changN(nproj) WRITE(*,'(A20,I6)')' old number of projectiles: ',nproj 130 WRITE(*,*)' new number of projectiles' READ(*,'(I6)',ERR=130)nproj RETURN c andere Layerdicken und/oder Kanalweite ENTRY changD(thick,cw,lnum) WRITE(*,*)lnum DO i=1,lnum WRITE(*,'(A23,I1,2x,F7.2)')' old layer thickness ',i, + thick(i) 140 WRITE(*,'(A23,I1)')' new layer thickness ',i READ(*,'(F7.0)',ERR=140)thick(i) 150 WRITE(*,*)' Do you want to change the '// + 'layer thickness ? ' READ(*,'(A1)')f IF(f.EQ.'n'.OR.f.EQ.'N'.OR.f.EQ.'') THEN GOTO 160 ELSEIF(f.EQ.'y'.OR.f.EQ.'Y'.OR.f.EQ.'j'.OR.f.EQ.'J')THEN CONTINUE ELSE WRITE(*,*)errcom GOTO 150 ENDIF ENDDO 160 WRITE(*,*)' Other step size ?' READ(*,'(A1)')f IF(f.EQ.'y'.OR.f.EQ.'Y'.OR.f.EQ.'j'.OR.f.EQ.'J') THEN WRITE(*,'(A25,F7.2)')' old step size: ',cw WRITE(*,*)' new step size' READ(*,'(F7.0)',ERR=130)cw ELSEIF(f.EQ.'n'.OR.f.EQ.'N'.OR.f.EQ.'') THEN RETURN ELSE WRITE(*,*)errcom GOTO 160 ENDIF RETURN END c c Subroutine, in der die Batchkommandos in die Batch-Datei c geschrieben werden c SUBROUTINE batchcreater(inpnam,batchtype,parchar,inpext) implicit none CHARACTER inpnam*4,parchar*3,batchtype*1 CHARACTER inpext*4,rgeext*4,outext*4,batext*4,errext*4 CHARACTER batchnam*9 c DATA rgeext /'.rge'/ DATA outext /'.out'/ DATA errext /'.err'/ DATA batext /'.bat'/ 100 continue #if defined (OS_UNIX) batchnam=inpnam//batchtype #else batchnam=inpnam//batchtype//batext #endif OPEN(UNIT=19,FILE=batchnam,STATUS='NEW',ERR=900) GOTO 200 900 WRITE(*,*)' Batch script already existing, enter new name (A4).' READ(*,'(A4)')inpnam GOTO 100 c 200 continue #if defined (OS_UNIX) write(19,'(a)') '#!/bin/csh ' write(19,'(a)') '#' WRITE(19,'(a,a,a,a,a,a)') + 'cp ',inpnam,batchtype,parchar,inpext,' eingabe1.inp' WRITE(19,'(a)')'trimsp7l_tp' WRITE(19,'(a,a,a,a,a)') + 'cp ausgabe1.out ',inpnam,batchtype,parchar,outext WRITE(19,'(a,a,a,a,a)') + 'cp ausgabe1.rge ',inpnam,batchtype,parchar,rgeext WRITE(19,'(a,a,a,a,a)') + 'cp ausgabe1.err ',inpnam,batchtype,parchar,errext WRITE(19,'(a)')'rm -f ausgabe1.out' WRITE(19,'(a)')'rm -f ausgabe1.rge' WRITE(19,'(a)')'rm -f ausgabe1.err' #else WRITE(19,500)'copy',inpnam,batchtype,parchar,inpext, + 'eingabe1.inp' WRITE(19,501)'trimsp7l_tp' WRITE(19,502)'copy ausgabe1.out',inpnam,batchtype,parchar,outext WRITE(19,502)'copy ausgabe1.rge',inpnam,batchtype,parchar,rgeext WRITE(19,502)'copy ausgabe1.err',inpnam,batchtype,parchar,errext WRITE(19,505)'del ausgabe1.out' WRITE(19,505)'del ausgabe1.rge' WRITE(19,505)'del ausgabe1.err' #endif RETURN c ENTRY batchexit(inpnam,batchtype) #if defined (OS_UNIX) WRITE(19,'(a,a,a,a)')'mv fort.33 ',inpnam,batchtype,'.dat' WRITE(19,'(a)')'rm -f eingabe1.inp' WRITE(19,'(a)')'rm -f edist' #else WRITE(19,510)'ren fort.33',inpnam,batchtype,'.dat' WRITE(19,505)'del eingabe1.inp' WRITE(19,506)'del edist' WRITE(19,511)'exit' #endif RETURN c 500 FORMAT(A4,1x,A4,A1,A3,A4,1x,A12) 501 FORMAT(A8) 502 FORMAT(A17,1x,A4,A1,A3,A4) 505 FORMAT(A16) 506 FORMAT(A9) 510 FORMAT(A11,1x,A4,A1,A4) 511 FORMAT(A4) END