SUBROUTINE GUHADR C=========== This will work only with GCALOR V1.01/15 and up ====== C*************************************************************** C C CALOR-GEANT Interface common C C parameters of incident particle : C IPinc = particle type a la CALOR C Einc = kinetic energy C Uinc(3) = direction cosines C material parameters: C NCEL = number of elements in mixture (NMTC) C GEANT material no. for MICAP C Amed(I) = mass number C Zmed(I) = charge number C Dmed(I) = Atoms/cm**3 * 1E-24 C Hden = Atoms/cm**3 * 1E-24 C of H-Atoms in mixture C C particle stack: C NPHETC = number of particles C Ekinet(1:NPHETC) = kinetic energy of part. C IPCAL(1:NPHETC) = particle type a la CALOR (extended) C UCAL(1:NPHETC,3) = direction cosines C CALTIM(1:NPHETC) = age of particle (nsec) C C ATARGT = A no. of target nucleus C ZTARGT = Z no of target nucleus C C return of residual nucleus information C NRECOL = no. of heavy recoil products C Amed(I) = mass number of residual nucleus C Zmed(I) = charge number " " C EXmed = exitation energy of nucleus C ERmed(I)= recoil energy of nucleus C IntCal = type of interaction (GEANT NAMEC index) C return of cross section of hadronic interaction (CALSIG called) C SIG = x-section C C set by CALSIG: C ICPROC = -1 undefined C = 0 NMTC called for cross-section C = 1 MICAP called for cross-section C = 2 SKALE(NMTC at 3 GeV) called for cross-section C = 3 FLUKA called for cross-section C KCALL : same coding as ICPROC, but is only valid after a C call to GCALOR C 19/5/92 C.Zeitnitz University of Arizona C**************************************************************** C PARAMETER(EMAXP = 3.495) PARAMETER(EMAXPI = 2.495) C transition upper limit (GeV) NMTC-FLUKA PARAMETER(ESKALE = 10.0) PARAMETER(MXCP = 300) C COMMON/ CALGEA / IPINC , EINC , UINC(3) ,NCEL , + HDEN , AMED(100) , ZMED(100) ,DMED(100) , + NPHETC ,EKINET(MXCP),IPCAL(MXCP),UCAL(MXCP,3), + INTCAL , EXMED , ERMED(100),SIG , + CALTIM(MXCP), ICPROC, NRECOL ,KCALL , + ATARGT , ZTARGT C C Real*8 AMNTAR, AMMTAR, AMNZM1, AMMZM1, AMNNM1, AMMNM1, & ANOW, ZNOW, ANCOLL, ZNCOLL, ERES, EKRES, & AMNRES, AMMRES, PTRES, PXRES, PYRES, PZRES, & PTRES2 COMMON /FKRESN/ AMNTAR, AMMTAR, AMNZM1, AMMZM1, AMNNM1, AMMNM1, & ANOW, ZNOW, ANCOLL, ZNCOLL, ERES, EKRES, & AMNRES, AMMRES, PTRES, PXRES, PYRES, PZRES, & PTRES2, KTARP, KTARN, IGREYP, IGREYN, ICRES, & IBRES, IEVAPL, IEVAPH, IEVNEU, IEVPRO, IEVDEU, & IEVTRI, IEV3HE, IEV4HE, IDEEXG, IBTAR, ICHTAR, & IOTHER C *KEEP,GCKING. INTEGER MXGKIN PARAMETER (MXGKIN=100) COMMON/GCKING/KCASE,NGKINE,GKIN(5,MXGKIN), + TOFD(MXGKIN),IFLGK(MXGKIN) INTEGER KCASE,NGKINE ,IFLGK REAL GKIN,TOFD C C Logical FFLUKA,FMICAP,FNMTC,FSKALE SAVE C C now call GEANT-CALOR interface CALL GCALOR C which program has been called ? FFLUKA = KCALL .EQ. 3 .and. ngkine .gt. 0 FMICAP = KCALL .EQ. 1 .and. ngkine .gt. 0 FNMTC = KCALL .EQ. 0 .and. ngkine .gt. 0 FSKALE = KCALL .EQ. 2 .and. ngkine .gt. 0 IF(FFLUKA) THEN C Fluka calculated the interaction C Recoil nucleus information in: C EKRES : kinetic energy (GeV) C ANOW : A of recoil nucleus C ZNOW : Z of recoil nucleus Call Hfill(100+kcall,sngl(ekres),1.,1.) Call Hfill(200+kcall,sngl(anow),1.,1.) Call Hfill(300+kcall,sngl(znow),1.,1.) ELSE IF(FMICAP.or.FNMTC.or.FSKALE) THEN C HETC or MICAP calculated the interaction C Recoil nucleus information in: C ERMED(I) : kinetic energy (MeV) C AMED(I) : A of recoil nucleus C ZMED(I) : Z of recoil nucleus C NRECOL : number of heavy recoil products C ATARGT : A of target nucleus C ZTARGT : Z of target nucleus do i=1,nrecol Call Hfill(100+kcall,ermed(i)/1000.,1.,1.) Call Hfill(200+kcall,amed(i),1.,1.) Call Hfill(300+kcall,zmed(i),1.,1.) enddo ENDIF RETURN END