PROGRAM DATMAKER

c	dieses Programm erstellt die Eingabedateien, die mit dem Programm
c	TRIMSP4L gelesen werden.
c	dies ist die Version DATMAK7L(-test)

	IMPLICIT LOGICAL(a-z)

	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,inpext*4
	CHARACTER batchtype*1,name*8
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     Projektilparameter
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 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     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 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 stöchiometrische Dichte
c                 eines Layers. Wichtig: die Dichten fuer H,He,Ne,O,Ar,Kr,Xe sind die Dichten am
c                                        Tripelpunkt fuer die fluessige Phase, die Dichten fuer
c                                        F,Cl,Rn,Fr,Ra sind nicht bekannt und deshalb auf 0.1 gesetzt.
c
c	Mai 1999  : das Programm wurde erweitert. Jetzt koennen in einer Schleife mehrere Eingabefiles
c				fuer TRIMSP (ab Version TRIMSPPc4i) mit verschiedener Startenergie und verschiedenen 
c				Kanalgroessen fuer die Range Profile erstellt werden.
c				Ausserem weden die erstellten 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 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
	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                /'Falsche Eingabe !'/
	DATA inpext                /'.inp'/
	DATA batchtype             /'e'/
c	
	WRITE(*,*)' ----------------------------------------'
	WRITE(*,*)' |  Programm D A T M A K, Version 7L    |'
	WRITE(*,*)' ----------------------------------------'
	WRITE(*,*)
	WRITE(*,*)' Programm erstellt die Eingabedateien fuer das'
	WRITE(*,*)' Programm TRIM.SP (W. Eckstein, IPP Garching)'
	WRITE(*,*)' Eingabedateien koennen nur von Version'
	WRITE(*,*)' TrimSp4L oder spaeter gelesen werden' 
c	WRITE(*,*)' Die am PSI verwendete Version dieses Programmes'
c	WRITE(*,*)' heisst TRIMSPP4i (Stand 28. Mai 1999). Diese Version'
c	WRITE(*,*)' laeuft auf PCs unter WIN95/98 und WIN NT4.'
	PAUSE '  Weiter mit beliebiger Taste '
c
	WRITE(*,*)' Genereller Name der Ausgabedatei (muss A4 sein), '
	WRITE(*,*)' wird von allen erstellten Dateien verwendet. '
	WRITE(*,*)' Werden mehrere Energien gerechnet (Batchtype e),'
	WRITE(*,*)' dann wird die Energie als (A3) angehaengt,'
	WRITE(*,*)' z.B. 30keV=300, 0.5keV=005'
	WRITE(*,*)' Ansonsten muss von Hand die Dateibezeichnung als (A3)'
	WRITE(*,*)' eingegeben werden.'
	WRITE(*,*)' Zwischen dem generellen Namen und der speziellen'
	WRITE(*,*)' Dateibezeichnung wird der Batchtype als (A1)'
	WRITE(*,*)' eingefuegt.'
	WRITE(*,*)' Verstaendlicherweise kann fuer die Batchdateien nur '
	WRITE(*,*)' immer ein Parameter Energie, Esigma, Myonenzahl oder '
	WRITE(*,*)' Layerdicken geaendert werden. '
	PAUSE '  Weiter mit beliebiger Taste '
	WRITE(*,*)' Extension der Ausgabedatei ist *.inp '
	WRITE(*,*)
	WRITE(*,*)' Gib generellen Namen ein (A4)'
	READ(5,'(A4)')inpnam
c
800	WRITE(*,*)' Batchtypes ?'
	WRITE(*,*)' E = Energie (default)'
	WRITE(*,*)' S = Esigma'
	WRITE(*,*)' N = Anzahl Myonen'
	WRITE(*,*)' D = Layerdicken'
	WRITE(*,*)' X = Energie und Esigma'
c	WRITE(*,*)' A = Alpha und Alphasigma'
c	WRITE(*,*)' B = Energie,Esigma,Alpha,Alphasigma'
c
	WRITE(*,*)'Batchtype aendern (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(*,*)' Batchtype eingeben (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(*,*)' Projektilparameter '
	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(*,*)'Projektil aendern ? '
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(*,*)' Atomnummer (Myon = 1)'
810			READ(5,501,ERR=810)zproj
			IF(zproj.EQ.0.0) zproj=1.
			WRITE(*,*)' Projektilmasse (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(*,*)'Projektilenergie aendern ? '
	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(*,*)' Projektilenergie in eV '
814			READ(5,501,ERR=814)eproj
			IF(eproj.EQ.0.0) eproj=1000.
		ELSE
			WRITE(*,*)errcom
			GOTO 1000
		ENDIF	 
10011	WRITE(*,*)'Sigma aendern ? '
	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(*,*)'Projektilwinkel aendern ? '
	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(*,*)' Projektilwinkel (senkrecht=0)'
813			READ(5,501,ERR=813)alphaproj
			alphaproj=ABS(alphaproj)
		ELSE
			WRITE(*,*)errcom
			GOTO 10012
		ENDIF
10013	WRITE(*,*)'Sigma aendern ? '
	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 Projektilwinkel '
8130			READ(5,501,ERR=8130)alphaprojsig
			alphaprojsig=ABS(alphaprojsig)
		ELSE
			WRITE(*,*)errcom
			GOTO 10013
		ENDIF	 	 
c
10014	WRITE(*,*)' weitere Projektilparameter 
     +    (Erklaerung siehe TRVMC95.txt)'
	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(*,*)'Aendern ?'
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(*,*)' Wechselwirkungsparameter 
     +	(Erklaerung siehe TRVMC95.txt)'
	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(*,*)'Aendern ?'
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(*,*)' muss zwischen 0 und 4 liegen '
				GOTO 830
			ENDIF
			WRITE(*,*)' KK0R '
831			READ(5,502,ERR=831)KK0R
			IF(KK0R.LT.0.OR.KK0R.GT.4)THEN
				WRITE(*,*)' muss zwischen 0 und 4 liegen '
				GOTO 831
			ENDIF
			WRITE(*,*)' KDEE1 '
832			READ(5,502,ERR=832)KDEE1
			IF(KDEE1.LT.1.OR.KDEE1.GT.5)THEN
				WRITE(*,*)' muss zwischen 1 und 5 liegen '
				GOTO 832
			ENDIF
			WRITE(*,*)' KDEE2 '
833			READ(5,502,ERR=833)KDEE2
			IF(KDEE2.LT.1.OR.KDEE2.GT.3)THEN
				WRITE(*,*)' muss zwischen 1 und 3 liegen '
				GOTO 833
			ENDIF
			WRITE(*,*)' IPOT '
834			READ(5,502,ERR=834)IPOT
			IF(IPOT.LT.1.OR.IPOT.GT.3)THEN
				WRITE(*,*)' muss zwischen 1 und 3 liegen '
				GOTO 834
			ENDIF
			WRITE(*,*)' IPOTR '
835			READ(5,502,ERR=835)IPOTR
			IF(IPOTR.LT.1.OR.IPOTR.GT.3)THEN
				WRITE(*,*)' muss zwischen 1 und 3 liegen '
				GOTO 835
			ENDIF
			WRITE(*,*)' IRL '
836			READ(5,502,ERR=836)	IRL
			IF(IRL.LT.0.OR.IRL.GT.1)THEN
				WRITE(*,*)' entweder 0 oder 1'
				GOTO 836
			ENDIF
502			FORMAT(I1)
		ELSE
			WRITE(*,*)errcom
			GOTO 1005
		ENDIF	 
c
1004	WRITE(*,*)' Festlegung der Simulationsparameter '
	WRITE(*,'(1x,A18,I6)')'Anzahl Projektile ',nproj
	WRITE(*,*)'Aendern ?'
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(*,*)' wieviele Projektile '
840			READ(5,'(I6)',ERR=840)nproj
		ELSE
			WRITE(*,*)errcom
			GOTO 1007
		ENDIF	 
1006	WRITE(*,'(1x,A11,F7.2)')'Starttiefe ',x0
	WRITE(*,*)'Aendern ?'
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(*,*)' Starttiefe '
841			READ(5,'(F7.0)',ERR=841)x0
		ELSE
			WRITE(*,*)errcom
			GOTO 1009
		ENDIF	 
1008	WRITE(*,'(1x,A13,F7.2)')'Schrittweite ',cw
	WRITE(*,*)'Aendern ?'
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(*,*)' Schrittweite des Tiefenintervals '
842			READ(5,'(F7.0)',ERR=842)cw
		ELSE
			WRITE(*,*)errcom
			GOTO 1011
		ENDIF	 
1010	WRITE(*,'(1x,A27,F12.5)')'Zufallszahleninitialisation',ri
	WRITE(*,*)'Aendern ?'
1013	READ(5,'(A1)')f
		IF(f.EQ.'n'.OR.f.EQ.'N'.OR.f.EQ.'') THEN
			GOTO 1012 
		ELSEIF(f.EQ.'y'.OR.f.EQ.'Y'.OR.f.EQ.'j'.OR.f.EQ.'J') THEN
			WRITE(*,*)' Zufallszahleninitialisation :'
843			READ(5,'(F12.0)',ERR=843)ri
				IF((ri/2.-FLOAT(INT(ri/2.))).ne.0.5) ri=ri+1	            
		ELSE
			WRITE(*,*)errcom
			GOTO 1013
		ENDIF	 
1012	ri2=ri
	ri3=ri
	WRITE(*,*)' Wieviele Layer ? <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 Nummer ',l
			WRITE(*,'(A15,I1)')'Element Nummer ',m
1014			WRITE(*,'(1x,A44)')'Gib Elementnamen (A2) ein QQ fuer Ende'
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(*,*)' Konzentration des Elementes muss kleiner oder'
			WRITE(*,*)' gleich 1. sein. Summe aller Konzentrationen'
			WRITE(*,*)' innerhalb des Layers muss 1. sein.)'
1015			WRITE(*,*)' Gib Konzentration des Elementes ein.'
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(*,*)erccom
				GOTO 1015
			ENDIF
			conzlayer(l)=conz(m,l)+conzlayer(l)
			IF(conzlayer(l).GT.1.0) THEN
				WRITE(*,*)' Summe der Konzentrationen innerhalb des '
			WRITE(*,'(1x,I1,1x,A29)')l,'. Layers ist groesser als 1. '
				WRITE(*,*)' Programm abgebrochen !'
				STOP
			ENDIF
			CALL dichte(p4,n)		
			rho(l)=rho(l)+p4*conz(m,l)	
			IF(m.EQ.5) GOTO 1100
1016			WRITE(*,*)' Noch ein anderes Element im  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(*,*)'Dichte des Layers ? ',rho(l)
		WRITE(*,*)'Dichte in Ordnung ?'
		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(*,*)'Dichte des Layers ? '
860			READ(5,'(F7.0)',ERR=860)rho(l)
		ELSE
			WRITE(*,*)errcom
			GOTO 1100
		ENDIF					
1101		WRITE(*,*)'Dicke des Layers ?'
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(*,*)' spezieller Dateiname (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(*,*)' Noch eine weitere Datei mit anderen Parametern ?'
	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(*,*)' Fehler beim Oeffnen der Datei '
	WRITE(*,*)' Gib neuen Dateinamen ein '
	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
	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
	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
	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)')' alte Energie: ',eproj	
100		WRITE(*,*)' neue Energie (E < 100.000 eV)'
		READ(*,'(F7.0)',ERR=100)eproj
110		WRITE(*,*)' Andere Kanalschrittweite ?'
		READ(*,'(A1)')f
		IF(f.EQ.'y'.OR.f.EQ.'Y'.OR.f.EQ.'j'.OR.f.EQ.'J') THEN
			WRITE(*,'(A25,F7.2)')' alte Kanalschrittweite: ',cw
115			WRITE(*,*)' neue Kanalschrittweite'
			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)')' alte Energie: ',eproj	
105		WRITE(*,*)' neue Energie (E < 100.000 eV)'
		READ(*,'(F7.0)',ERR=105)eproj
		WRITE(*,'(A15,F7.2)')' altes Esigma: ',esig
106		WRITE(*,*)' neues Esigma'
		READ(*,'(F7.0)',ERR=106)esig
	RETURN
c anderes Esigma
	ENTRY changS(esig)
		WRITE(*,'(A15,F7.2)')' altes Esigma: ',esig
120		WRITE(*,*)' neues Esigma'
		READ(*,'(F7.0)',ERR=120)esig
	RETURN
c andere Anzahl Myonen
	ENTRY changN(nproj)
		WRITE(*,'(A20,I6)')' alte Myonenanzahl: ',nproj
130		WRITE(*,*)' neue Myonenanzahl'
		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)')' alte Layerdicke Layer ',i,thick(i)
140		WRITE(*,'(A23,I1)')' neue Layerdicke Layer ',i
		READ(*,'(F7.0)',ERR=140)thick(i)
150		WRITE(*,*)' Soll die Dicke der anderen Layer geaendert werden '
		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(*,*)' Andere Kanalschrittweite ?'
		READ(*,'(A1)')f
		IF(f.EQ.'y'.OR.f.EQ.'Y'.OR.f.EQ.'j'.OR.f.EQ.'J') THEN
			WRITE(*,'(A25,F7.2)')' alte Kanalschrittweite: ',cw
			WRITE(*,*)' neue Kanalschrittweite'
			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)

	CHARACTER inpnam*4,parchar*3,batchtype*1
	CHARACTER inpext*4,rgeext*4,outext*4,batext*4
	CHARACTER batchnam*9
c
	DATA rgeext /'.rge'/
	DATA outext /'.out'/
	DATA errext /'.err'/
	DATA batext /'.bat'/

100	batchnam=inpnam//batchtype//batext

	OPEN(UNIT=19,FILE=batchnam,STATUS='NEW',ERR=900)
	GOTO 200
900	WRITE(*,*)' Batchdatei existiert schon, gib neuen Namen (A4) ein.'
	READ(*,'(A4)')inpnam
	GOTO 100
c
200	WRITE(19,500)'copy',inpnam,batchtype,parchar,inpext,'eingabe1.inp'
	WRITE(19,501)'TrimSp7L'
	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'
	RETURN
c
	ENTRY batchexit(inpnam,batchtype)
	WRITE(19,510)'ren fort.33',inpnam,batchtype,'.dat'
	WRITE(19,505)'del eingabe1.inp'
	WRITE(19,506)'del edist'
	WRITE(19,511)'exit'
	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