| fe4da5cc |
1 | * |
| 2 | * $Id$ |
| 3 | * |
| 4 | * $Log$ |
| 5 | * Revision 1.1.1.1 1995/10/24 10:19:54 cernlib |
| 6 | * Geant |
| 7 | * |
| 8 | * |
| 9 | #include "geant321/pilot.h" |
| 10 | *CMZ : 3.21/04 22/02/95 12.23.11 by S.Ravndal |
| 11 | *-- Author : |
| 12 | *=== berttp ===========================================================* |
| 13 | * * |
| 14 | SUBROUTINE BERTTP |
| 15 | |
| 16 | #include "geant321/dblprc.inc" |
| 17 | #include "geant321/dimpar.inc" |
| 18 | #include "geant321/iounit.inc" |
| 19 | C--------------------------------------------------------------------- |
| 20 | C SUBNAME = BERTTP --- READ BERTINI DATA |
| 21 | C--------------------------------------------------------------------- |
| 22 | C --------------------------------- EVAPORATION DATA |
| 23 | #include "geant321/eva0.inc" |
| 24 | #include "geant321/hettp.inc" |
| 25 | #include "geant321/inpflg.inc" |
| 26 | #include "geant321/isotop.inc" |
| 27 | #include "geant321/nucgeo.inc" |
| 28 | #include "geant321/nuclev.inc" |
| 29 | #include "geant321/parevt.inc" |
| 30 | #include "geant321/xsepar.inc" |
| 31 | LOGICAL OPENED,EXISTS |
| 32 | LOGICAL LRMSCH, LRD1O2, LTRASP |
| 33 | CHARACTER*100 FILNAM |
| 34 | #if defined(CERNLIB_UNIX)||defined(CERNLIB_VAX)||defined(CERNLIB_CRAY) |
| 35 | CHARACTER*100 CHROOT |
| 36 | #endif |
| 37 | C--------------------------------------------------------------------- |
| 38 | #if defined(CERNLIB_FDEBUG) |
| 39 | WRITE( LUNOUT,'(A,I2)') |
| 40 | & ' -/BERTTP(I): EVAP DATA READ FROM UNIT ', NBERTP |
| 41 | #endif |
| 42 | INQUIRE(UNIT=NBERTP, OPENED=OPENED) |
| 43 | IF(OPENED) THEN |
| 44 | REWIND NBERTP |
| 45 | ELSE |
| 46 | #if defined(CERNLIB_UNIX)||defined(CERNLIB_CRAY) |
| 47 | CHROOT=' ' |
| 48 | CALL GETENVF('CERN_ROOT',CHROOT) |
| 49 | LNROOT = LNBLNK(CHROOT) |
| 50 | IF(LNROOT.LE.0) THEN |
| 51 | FILNAM='flukaaf.dat' |
| 52 | ELSE |
| 53 | FILNAM=CHROOT(1:LNROOT)//'/lib/flukaaf.dat' |
| 54 | ENDIF |
| 55 | INQUIRE(FILE=FILNAM,EXIST=EXISTS) |
| 56 | IF(.NOT.EXISTS) THEN |
| 57 | PRINT*,'**********************************' |
| 58 | PRINT*,'* F I F A C E *' |
| 59 | PRINT*,'* ----------- *' |
| 60 | PRINT*,'* File FLUKAAF.DAT not found *' |
| 61 | PRINT*,'* Program STOP *' |
| 62 | PRINT*,'* Check CERN_ROOT environment *' |
| 63 | PRINT*,'* variable *' |
| 64 | PRINT*,'**********************************' |
| 65 | STOP |
| 66 | ENDIF |
| 67 | OPEN(NBERTP,FILE=FILNAM,STATUS='OLD') |
| 68 | #endif |
| 69 | #if defined(CERNLIB_VAX) |
| 70 | ISTAT = LIB$SYS_TRNLOG ('CERN_ROOT',NALL,CHROOT,,,%VAL(0)) |
| 71 | IF(ISTAT.NE.1) THEN |
| 72 | FILNAM='flukaaf.dat' |
| 73 | ELSE |
| 74 | FILNAM='CERN_ROOT:[LIB]flukaaf.dat' |
| 75 | ENDIF |
| 76 | INQUIRE(FILE=FILNAM,EXIST=EXISTS) |
| 77 | IF(.NOT.EXISTS) THEN |
| 78 | PRINT*,'**********************************' |
| 79 | PRINT*,'* F I F A C E *' |
| 80 | PRINT*,'* ----------- *' |
| 81 | PRINT*,'* File FLUKAAF.DAT not found *' |
| 82 | PRINT*,'* Program STOP *' |
| 83 | PRINT*,'* Check CERN_ROOT environment *' |
| 84 | PRINT*,'* variable *' |
| 85 | PRINT*,'**********************************' |
| 86 | STOP |
| 87 | ENDIF |
| 88 | OPEN(NBERTP,FILE=FILNAM,STATUS='OLD',READONLY) |
| 89 | #endif |
| 90 | #if defined(CERNLIB_IBM) |
| 91 | FILNAM='/FLUKAAF DAT *' |
| 92 | OPEN(NBERTP,FILE=FILNAM,STATUS='OLD') |
| 93 | #endif |
| 94 | ENDIF |
| 95 | |
| 96 | C A. Ferrari: first of all read isotopic data |
| 97 | READ (NBERTP,2100) ISONDX |
| 98 | READ (NBERTP,2100) ISOMNM |
| 99 | READ (NBERTP,2000) ABUISO |
| 100 | READ (NBERTP,2000) (P0(I),P1(I),P2(I),I=1,1001) |
| 101 | READ (NBERTP,2100) IA,IZ |
| 102 | DO 2 I=1,6 |
| 103 | FLA(I)=IA(I) |
| 104 | FLZ(I)=IZ(I) |
| 105 | 2 CONTINUE |
| 106 | READ (NBERTP,2000) RHO,OMEGA |
| 107 | READ (NBERTP,2000) EXMASS |
| 108 | READ (NBERTP,2000) CAM2 |
| 109 | READ (NBERTP,2000) CAM3 |
| 110 | READ (NBERTP,2000) CAM4 |
| 111 | READ (NBERTP,2000) CAM5 |
| 112 | READ (NBERTP,2000) ((T(I,J),J=1,7),I=1,3) |
| 113 | DO 3 I=1,7 |
| 114 | T(4,I)=0.D0 |
| 115 | 3 CONTINUE |
| 116 | READ (NBERTP,2000) RMASS |
| 117 | READ (NBERTP,2000) ALPH |
| 118 | READ (NBERTP,2000) BET |
| 119 | READ (NBERTP,2000) WAPS |
| 120 | READ (NBERTP,2000) APRIME |
| 121 | #if defined(CERNLIB_FDEBUG) |
| 122 | WRITE( LUNOUT,'(A)' ) ' /DRES(I): USING 1977 WAPS DATA ' |
| 123 | #endif |
| 124 | READ (NBERTP,2200) AHELP , BHELP , LRMSCH, LRD1O2, LTRASP |
| 125 | IF ( AHELP .NE. ALPHA0 .OR. BHELP .NE. GAMSK0 ) THEN |
| 126 | WRITE (LUNOUT,*) |
| 127 | & ' *** Inconsistent Nuclear Geometry data on file ***' |
| 128 | STOP |
| 129 | END IF |
| 130 | READ (NBERTP,2000) RHOTAB, RHATAB, ALPTAB, RADTAB, SKITAB, HALTAB, |
| 131 | & EKATAB, PFATAB, PFRTAB |
| 132 | READ (NBERTP,2000) AANXSE, BBNXSE, CCNXSE, DDNXSE, EENXSE, ZZNXSE, |
| 133 | & EMNXSE, XMNXSE |
| 134 | READ (NBERTP,2000) AAPXSE, BBPXSE, CCPXSE, DDPXSE, EEPXSE, FFPXSE, |
| 135 | & ZZPXSE, EMPXSE, XMPXSE |
| 136 | 2000 FORMAT (3(1X,G23.16)) |
| 137 | 2100 FORMAT (18(1X,I3)) |
| 138 | 2200 FORMAT (2(1X,G23.16),3(1X,L1)) |
| 139 | CLOSE (UNIT=NBERTP) |
| 140 | DO 100 JZ = 1, 130 |
| 141 | SHENUC ( JZ, 1 ) = 1.D-03 * ( CAM2 (JZ) + CAM4 (JZ) ) |
| 142 | 100 CONTINUE |
| 143 | DO 200 JA = 1, 200 |
| 144 | SHENUC ( JA, 2 ) = 1.D-03 * ( CAM3 (JA) + CAM5 (JA) ) |
| 145 | 200 CONTINUE |
| 146 | CALL STALIN |
| 147 | ILVMOD = 1 |
| 148 | IB0 = ILVMOD |
| 149 | #if defined(CERNLIB_FDEBUG) |
| 150 | WRITE (LUNOUT,*) |
| 151 | WRITE (LUNOUT,*)' **** Standard EVAP level density used ****' |
| 152 | WRITE (LUNOUT,*) |
| 153 | & ' **** Original Gilbert/Cameron pairing energy used ****' |
| 154 | #endif |
| 155 | ILVMOD = IB0 |
| 156 | DO 500 JZ = 1, 130 |
| 157 | PAENUC ( JZ, 1 ) = 1.D-03 * CAM4 (JZ) |
| 158 | 500 CONTINUE |
| 159 | DO 600 JA = 1, 200 |
| 160 | PAENUC ( JA, 2 ) = 1.D-03 * CAM5 (JA) |
| 161 | 600 CONTINUE |
| 162 | RETURN |
| 163 | END |
git://git.uio.no / u / mrichter / AliRoot.git / blame