GEANT321/gxint/gdrmat.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.1.1.1  1995/10/24 10:21:47  cernlib
   6 * Geant
   7 *
   8 *
   9 #include "geant321/pilot.h"
  10 *CMZ :  3.21/03 10/10/94  15.45.50  by  S.Ravndal
  11 *-- Author :
  12       SUBROUTINE GDRMAT(IMATES,IPART,CHMECA,MMEC)
  13 C.    ******************************************************************
  14 C.    *                                                                *
  15 C.    *       DRAW cross sections and energy loss tables               *
  16 C.    *       material IMATE, particle IPART, mecanism name CHMECA,    *
  17 C.    *                                                                *
  18 C.    *      The CHMECAnism name can be :                              *
  19 C.    *      'HADF'   'INEF'   'ELAF'   'FISF'   'CAPF'                *
  20 C.    *      'HADG'   'INEG'   'ELAG'   'FISG'   'CAPG'                *
  21 C.    *      'LOSS'   'PHOT'   'ANNI'   'COMP'   'BREM'                *
  22 C.    *      'PAIR'   'DRAY'   'PFIS'   'RAYL'   'HADG'                *
  23 C.    *      'MUNU'   'RANG'   'STEP'                                  *
  24 C.    *                                                                *
  25 C.    *       For Hadronic particles it also computes the              *
  26 C.    *       hadronic cross section from FLUKA ( '***F' ) or          *
  27 C.    *       GHEISHA ( '***G' ) programs:                             *
  28 C.    *       HADF or HADG -- total                                    *
  29 C.    *       INEF or INEG -- inelastic                                *
  30 C.    *       ELAF or ELAG -- elastic                                  *
  31 C.    *       FISF or FISG -- fission (0.0 for FLUKA)                  *
  32 C.    *       CAPF or CAPG -- neutron capture (0.0 for FLUKA)          *
  33 C.    *                                                                *
  34 C.    *             Input parameters                                   *
  35 C.    *  IMATE   Geant material number                                 *
  36 C.    *  IPART   Geant particle number                                 *
  37 C.    *  CHMECA   mechanism name of the bank to be fetched             *
  38 C.    *                                                                *
  39 C.    *    ==>Called by : <USER>  GXCONT                               *
  40 C.    *       Authors    R.Brun, M.Maire    *********                  *
  41 C.    *                                                                *
  42 C.    ******************************************************************
  43 #include "geant321/gcbank.inc"
  44 #include "geant321/gcmulo.inc"
  45 #include "geant321/gconsp.inc"
  46 *
  47       CHARACTER*4 CHMECA(MMEC)
  48       CHARACTER*20 MESSGE,NAMEM,NAMEP
  49       CHARACTER*64 TITLE
  50       LOGICAL HEXIST,LXBARN
  51 #include "geant321/gcnmec.inc"
  52       DIMENSION CRY(201),IYES(NMECA+2),XC(2)
  53 *
  54       IF(IMATES.LT.0) THEN
  55          LXBARN=.TRUE.
  56       ELSE
  57          LXBARN=.FALSE.
  58       ENDIF
  59       IMATE=ABS(IMATES)
  60       IDM=-1
  61       CALL IGSA(0)
  62       DO 10 JMEC=1,MMEC
  63          CALL GPLMAT(IMATES,IPART,CHMECA(JMEC),NEKBIN,ELOW,IDM)
  64    10 CONTINUE
  65       YMIN=BIG
  66       YMAX=-BIG
  67       IOK=0
  68       IBASE = 10000*IMATE+100*IPART
  69       DO 30 IDB=1,NMECA+2
  70          IYES(IDB)=0
  71          ID=IBASE+IDB
  72          IF(HEXIST(ID)) THEN
  73             CALL HNOENT(ID,NOENT)
  74             IF(NOENT.LE.0)THEN
  75                CALL HDELET(ID)
  76             ELSE
  77                IYES(IDB)=1
  78                IOK=1
  79                DO 20 I=1,NEKBIN
  80                   CRS=HI(ID,I)
  81                   IF(CRS.LE.0.)GO TO 20
  82                   IF(CRS.GT.1.E10)GO TO 20
  83                   IF(CRS.LT.YMIN)YMIN=CRS
  84                   IF(CRS.GT.YMAX)YMAX=CRS
  85    20          CONTINUE
  86             ENDIF
  87          ENDIF
  88    30 CONTINUE
  89       IF(IOK.EQ.0)GO TO 999
  90 *
  91       CALL HPLOPT('LOGX',1)
  92       CALL HPLOPT('LOGY',1)
  93       CALL IGSET('MSCF',0.8)
  94       CALL IGSET('TXAL',10.)
  95       YLI=LOG10(YMIN)
  96       YLA=LOG10(YMAX)
  97       DELTA=0.05*(YLA-YLI)
  98       YMIN=10.**(YLI-DELTA)
  99       YMAX=10.**(YLA+DELTA)
 100       CALL HPLFRA(ELOW(1),ELOW(NEKBIN+1),YMIN,YMAX,' ')
 101       XC(1)=ELOW(8)
 102       XC(2)=ELOW(NEKBIN/2)
 103       JMA=LQ(JMATE-IMATE)
 104       CALL UHTOC(IQ(JMA+1),4,NAMEM,20)
 105       NCHM=LNBLNK(NAMEM)
 106       IF(NAMEM(NCHM:NCHM).EQ.'$')THEN
 107          NCHM=NCHM-1
 108       ENDIF
 109       JPA=LQ(JPART-IPART)
 110       CALL UHTOC(IQ(JPA+1),4,NAMEP,20)
 111       NCHP=LNBLNK(NAMEP)
 112       IF(NAMEP(NCHP:NCHP).EQ.'$')THEN
 113          NCHP=NCHP-1
 114       ENDIF
 115       TITLE='Tables for '//NAMEP(1:NCHP)//' in '//NAMEM(1:NCHM)
 116       XCT=XC(1)
 117       CALL HPLTOC(XCT,YMAX,XCTT,YCTT,NT)
 118       YCTT=YCTT+0.3
 119       CALL ISELNT(1)
 120       CALL IGSET('CHHE',0.28)
 121       CALL ITX(XCTT,YCTT,TITLE)
 122       CALL ISELNT(NT)
 123 *
 124       CALL IGSA(0)
 125       NSHIF=0
 126       NPLOT=0
 127       HSYM = 20
 128       HCOL = 0
 129       DO 50 IDB=1,NMECA+2
 130          IF(IYES(IDB).NE.0)THEN
 131             IF(HSYM.EQ.31) HSYM = 20
 132             HSYM = HSYM+1
 133             IF(HCOL.EQ.7) HCOL = 0
 134             HCOL = HCOL+1
 135             ID=10000*IMATE+100*IPART+IDB
 136             CALL HUNPAK(ID,CRY,'HIST',1)
 137             CALL HDELET(ID)
 138             CALL IGSET('MTYP',HSYM)
 139             CALL IGSET('PMCI',HCOL)
 140             CALL IGSET('PLCI',HCOL)
 141             KMIN = 0
 142             KMAX = 0
 143             DO 40 IBIN=1,NEKBIN
 144                IF(CRY(IBIN).GT.0.) THEN
 145                   IF(KMIN.EQ.0) THEN
 146                      KMIN = IBIN
 147                   ENDIF
 148                   KMAX = IBIN
 149                ENDIF
 150    40       CONTINUE
 151             IF(KMIN.NE.0) THEN
 152                CALL IGRAPH(KMAX-KMIN+1,ELOW(KMIN),CRY(KMIN),'PLGXY')
 153             ENDIF
 154             NPLOT = NPLOT+1
 155             IND=2-MOD(NPLOT,2)
 156             IF(IND.EQ.1) THEN
 157                NSHIF = NSHIF+1
 158             ENDIF
 159             YC=10.**(YLA-(NSHIF-1)*0.8*DELTA)
 160             CALL HPLTOC(XC(IND),YC,XCM,YCM,NT)
 161             CALL ISELNT(1)
 162             CALL IPM(1,XCM,YCM)
 163             IF(IDB.LE.NMECA) THEN
 164                IF (CHNMEC(IDB).EQ.'LOSS') THEN
 165                   MESSGE=CHNMEC(IDB)//' (MeV/cm)'
 166                ELSEIF (CHNMEC(IDB).EQ.'RANG') THEN
 167                   MESSGE=CHNMEC(IDB)//' (cm)'
 168                ELSEIF (CHNMEC(IDB).EQ.'STEP') THEN
 169                   MESSGE=CHNMEC(IDB)//' (cm)'
 170                ELSE
 171                   MESSGE=CHNMEC(IDB)//' X-sec'
 172                   IF(LXBARN) THEN
 173                     MESSGE(LNBLNK(MESSGE)+1:) = ' (barn)'
 174                   ELSE
 175                     MESSGE(LNBLNK(MESSGE)+1:) = ' (1/cm)'
 176                   ENDIF
 177                ENDIF
 178             ELSEIF(IDB.EQ.NMECA+1) THEN
 179                MESSGE='Tot X-sec'
 180                   IF(LXBARN) THEN
 181                     MESSGE(LNBLNK(MESSGE)+1:) = ' (barn)'
 182                   ELSE
 183                     MESSGE(LNBLNK(MESSGE)+1:) = ' (1/cm)'
 184                   ENDIF
 185             ELSEIF(IDB.EQ.NMECA+2) THEN
 186                MESSGE='Mean free path (cm)'
 187             ENDIF
 188             CALL IGSET('CHHE',0.28)
 189             CALL ITX(XCM+0.5,YCM,MESSGE)
 190             CALL ISELNT(NT)
 191          ENDIF
 192    50 CONTINUE
 193       CALL HPLOPT('LINX',1)
 194       CALL HPLOPT('LINY',1)
 195       CALL IGSET('PMCI',1.)
 196       CALL IGSET('PLCI',1.)
 197   999 END