|
|
|
|
For Windows/XP users > Run SEETRAM ( P:\FRSTOOLS\SEETRAM.BAT ) Source text (FORTRAN) C 00010000
C *********************************************************** 00012000
C *** *** 00013000
C *** DETERMINATION OF SEETRAM CALIBRATION FACTOR *** 00014000
C *** *** 00014100
C *** !!! REPLACES UNIVERSAL CALIBRATION CURVE !!! *** 00014200
C *** *** 00014300
C *** AUTHOR: T. BROHM MAY 1994 *** 00014400
C *** *** 00014500
C *********************************************************** 00015000
C 00022000
C *********************************************************** 00022100
C *** DECLARATION OF VARIABLES *************************** 00022200
C *********************************************************** 00022300
C 00022400
REAL*8 E,EA,DEA,RIN,ROUT,EAOUT,RGIN,ELOSS,YIELD,CALIB
INTEGER*4 AP,ZP,MODE,A,Z
C CHARACTER*1 C$YES /'N'/ 00025000
C 00027000
C *********************************************************** 00109200
C *** INPUT DATA ***************************************** 00109300
C *********************************************************** 00109400
C 00109500
AP = 197
ZP =79
EA = 900.D0
900 write(6,*) ' '
write(6,*) ' EMPIRICAL SYSTEMATICS OF SEETRAM CALIBRATION'
write(6,*) ' BY THOMAS BROHM (MAY 1994)'
write(6,*) ' '
C MASS NUMBER OF BEAM 00109600
write(6,*) ' CHARGE NUMBER OF BEAM: Z = ',ZP
read(5,1002) Z
write(6,*) ' MASS NUMBER OF BEAM: A = ',AP
read(5,1002) A
C write(6,1000) (' CHARGE, MASS NUMBER OF BEAM: Z,A=',ZP,AP)
C1000 format(a,2I5)
C read(5,1002) Z,A
1002 format(2i6)
if (Z.ne.0) ZP=Z
if (A.ne.0) AP=A
C ENERGY OF BEAM (MEV PER NUCLEON)
write(6,*) ' BEAM ENERGY PER NUCLEON: EA=',EA
C write(6,1001) (' BEAM ENERGY PER NUCLEON: EA=',EA)
C1001 format(a,f7.0)
read(5,1003) E
1003 format(D7.0)
if (E.ne.0) EA=E
C 00110200
C *********************************************************** 00110300
C *** VERIFICATION OF INPUT ******************************* 00110400
C *********************************************************** 00110500
C 00110600
IF (AP.LE.0) THEN 00110700
GOTO 100 00110800
ENDIF 00110900
IF (ZP.LE.0) THEN 00111000
GOTO 100 00111100
ENDIF 00111200
IF (EA.LT.100.D0) THEN 00111300
GOTO 100 00111400
ENDIF 00111500
IF (EA.GT.2000.D0) THEN 00111600
GOTO 100 00111700
ENDIF 00111800
C 00112300
C *********************************************************** 00112400
C *** DETERMINE ENERGY LOSS IN 1MG/CM^2 ALUMINUM ********** 00112500
C *********************************************************** 00112600
C 00112700
RIN = EA 00112800
MODE = 1 00112900
CALL RANGE(AP,ZP,RIN,ROUT,MODE) 00113000
RGIN = ROUT 00113100
RIN = ROUT - 1.D0 00113200
MODE = 2 00113300
CALL RANGE(AP,ZP,RIN,ROUT,MODE) 00113400
EAOUT = ROUT 00113500
DEA = EA - EAOUT 00113600
ELOSS = DFLOAT(AP) * DEA 00113700
C 00113800
C *********************************************************** 00113900
C *** POLY-FIT FOR SPECIFIC YIELD (STATUS MAY 1994) ******** 00114000
C *********************************************************** 00114100
C 00114200
YIELD= 00114300
# 41.1718-1.0908*ZP+1.83165D-2*ZP**2-1.07085D-4*ZP**3 00114400
C YIELD= 00114500
C # 88.3989-5.32178*ZP+0.149316*ZP**2-0.0017656*ZP**3+ 00114700
C # 7.35741E-06*ZP**4 00114800
C 00114900
C *********************************************************** 00115000
C *** CALIBRATION FACTOR FOR 10E-09 SENSITIVITY ******** 00115100
C *********************************************************** 00115200
C 00115300
CALIB = 1.D-13 / (ELOSS * YIELD * 1.6D-19) 00115400
C 00115500
C *********************************************************** 00115600
C *** OUTPUT *********************************************** 00115700
C *********************************************************** 00115800
C 00115900
WRITE(6,10) AP,ZP,EA 00116000
10 FORMAT(' PROJECTILE: ',I3,I3,' AT ',F7.0,' MEV/NUCLEON') 00116100
WRITE(6,*) ' ' 00116200
WRITE(6,11) CALIB 00116300
11 FORMAT(' SEETRAM FACTOR:',F9.0,'+-5 % (SENSITIVITY 10E-09)') 00116400
WRITE(6,*) ' ' 00116600
C 00116700
C *********************************************************** 00116800
C *** END OF PROGRAM ************************************** 00116900
C *********************************************************** 00117000
C 00117100
99 GOTO 101 00117200
100 WRITE(6,*) 'INPUT OUT OF RANGE !' 00117300
101 CONTINUE
GOTO 900 00117400
END 00117500
C 00117600
C *********************************************************** 00117700
C *** SUBROUTINE FOR RANGE/ENERGY RELATION **************** 00117800
C *********************************************************** 00117900
C 00118000
SUBROUTINE RANGE(AIN, ZIN, RIN, ROUT, MODEIN) 00118100
REAL*8 EHPAR, EA, RG, ROUT, RIN, A, Z
INTEGER*4 AIN, ZIN, MODEIN, ZT 00118300
DIMENSION EHPAR(13:13,1:11) 00118400
C FITS TO CALCULATIONS FROM 100-2000 MEV/U, 19.1.87, BY E.HANELT 00118500
EHPAR(13, 1) = -0.668659D-04 00118600
EHPAR(13, 2) = -0.185311D-05 00118700
EHPAR(13, 3) = 0.873192D-07 00118800
EHPAR(13, 4) = -0.690141D-09 00118900
EHPAR(13, 5) = -0.530758D+00 00119000
EHPAR(13, 6) = 0.898953D-02 00120000
EHPAR(13, 7) = 0.268916D+01 00130000
EHPAR(13, 8) = -0.533772D-02 00140000
EHPAR(13, 9) = -0.214131D+00 00150000
EHPAR(13,10) = 0.773008D-03 00160000
EHPAR(13,11) = 1.0D0 00170000
C 0.775 FOR PE, 1.0 FOR AL 00171000
C 00172000
ZT=13 00180000
Z = DFLOAT(ZIN) 00190000
A = DFLOAT(AIN) 00200000
C 00210000
IF (MODEIN.EQ.1) THEN 02840000
EA = RIN 02840100
ROUT = EHPAR(ZT,11) * (A/Z**2) * 10.D0** 02850000
# ((1.E0 + EHPAR(ZT,1)*Z + EHPAR(ZT,2)*Z**2 + 02860000
# EHPAR(ZT,3)*Z**3 + EHPAR(ZT,4)*Z**4) * 02870000
# (EHPAR(ZT,5) + EHPAR(ZT,6) *Z + 02880000
# (EHPAR(ZT,7) + EHPAR(ZT,8) *Z) * DLOG10(EA)+ 02890000
# (EHPAR(ZT,9) + EHPAR(ZT,10)*Z) * (DLOG10(EA))**2)) 02900000
ENDIF 02920000
IF (MODEIN.EQ.2) THEN 02940000
RG = RIN 02941000
ROUT = 10.D0**( 02950000
# -(EHPAR(ZT,7)+EHPAR(ZT,8)*Z) / 02960000
# (2.E0*(EHPAR(ZT,9)+EHPAR(ZT,10)*Z)) 02961000
# -DSQRT( ((EHPAR(ZT,7)+EHPAR(ZT,8)*Z) / 02962000
# (2.E0*(EHPAR(ZT,9)+EHPAR(ZT,10)*Z)))**2 02963000
# -(EHPAR(ZT,5)+EHPAR(ZT,6)*Z) / 02964000
# (EHPAR(ZT,9)+EHPAR(ZT,10)*Z) 02965000
# + DLOG10(RG/EHPAR(ZT,11) * Z**2/A) / 02966000
# ( (1.E0+EHPAR(ZT,1)*Z +EHPAR(ZT,2)*Z**2+ 02967000
# EHPAR(ZT,3)*Z**3+EHPAR(ZT,4)*Z**4) 02968000
# * (EHPAR(ZT,9)+EHPAR(ZT,10)*Z) ) 02969000
# )) 02969100
ENDIF 02969300
RETURN 03210000
END 03220000
|
