GEANT321/fluka/berttp.F

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