GEANT321/gxint/gxscan.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.1.1.1  1995/10/24 10:21:51  cernlib
   6 * Geant
   7 *
   8 *
   9 #include "geant321/pilot.h"
  10 *CMZ :  3.21/02 29/03/94  15.41.33  by  S.Giani
  11 *-- Author :
  12       SUBROUTINE GXSCAN
  13 C.
  14 C.    ******************************************************************
  15 C.    *                                                                *
  16 C.    *      Scan Geometry control commands                            *
  17 C.    *                                                                *
  18 C.    *       Author:    R.Brun      **********                        *
  19 C.    *                                                                *
  20 C.    ******************************************************************
  21 C.
  22 #include "geant321/gcbank.inc"
  23 #include "geant321/gcscal.inc"
  24 #include "geant321/gcscan.inc"
  25 #include "geant321/gcunit.inc"
  26 #include "geant321/gcparm.inc"
  27       COMMON/QUEST/IQUEST(100)
  28       CHARACTER*20 CHOPT
  29       CHARACTER*32 CHPATL
  30       CHARACTER*4 NAME
  31 C.
  32 C.    ------------------------------------------------------------------
  33 C.
  34       CALL KUPATL(CHPATL,NPAR)
  35 *
  36       IF(CHPATL.EQ.'STURN')THEN
  37 *
  38          IF(NPAR.LE.0) THEN
  39             IF(SCANFL) THEN
  40                CHOPT='ON'
  41             ELSE
  42                CHOPT='OFF'
  43             END IF
  44             WRITE(CHMAIL,10000) CHOPT
  45 10000       FORMAT(' SCAN Parameters: SCAN mode is: ',A3)
  46             CALL GMAIL(0,0)
  47          ELSE
  48             CALL KUGETC(CHOPT,NCH)
  49             IF(CHOPT.EQ.'ON') THEN
  50                SCANFL=.TRUE.
  51             ELSE IF (CHOPT.EQ.'OFF') THEN
  52                SCANFL=.FALSE.
  53             ELSE IF (CHOPT.EQ.'INIT') THEN
  54                SCANFL=.TRUE.
  55                CALL GSCANI
  56             END IF
  57          END IF
  58       ELSEIF(CHPATL.EQ.'TETA')THEN
  59 *
  60          IF(NPAR.LE.0) THEN
  61             WRITE(CHMAIL, 10100) NTETA, TETMIN, TETMAX, MODTET
  62 10100       FORMAT(' SCAN Parameters: NTETA = ',I5,' MIN = ',G10.3,
  63      +             ' MAX = ',G10.3, ' MODE = ',I2)
  64             CALL GMAIL(0,0)
  65          ELSE
  66             CALL KUGETI(NTETA)
  67             CALL KUGETR(TETMIN)
  68             CALL KUGETR(TETMAX)
  69             IF(NSLMAX.EQ.0)NSLMAX=5
  70             CALL KUGETI(MODTET)
  71          END IF
  72       ELSEIF(CHPATL.EQ.'PHI')THEN
  73 *
  74          IF(NPAR.LE.0) THEN
  75             WRITE(CHMAIL, 10200) NPHI, PHIMIN, PHIMAX
  76 10200       FORMAT(' SCAN Parameters: NPHI  = ',I5,' MIN = ',G10.3,
  77      +             ' MAX = ',G10.3)
  78             CALL GMAIL(0,0)
  79          ELSE
  80             CALL KUGETI(NPHI)
  81             CALL KUGETR(PHIMIN)
  82             CALL KUGETR(PHIMAX)
  83             IPHI1=1
  84             IPHIL=NPHI
  85             IF(NSLMAX.EQ.0)NSLMAX=5
  86          END IF
  87       ELSEIF(CHPATL.EQ.'SLIST')THEN
  88 *
  89          IF(NPAR.LE.0) THEN
  90             NPADON=MIN(NSLIST,8)
  91             NPAWRI=NPADON
  92             WRITE(CHMAIL,10300) NSLIST, (ISLIST(J), J=1, NPAWRI)
  93 10300       FORMAT(' SCAN Parameters: ',I3,' Scan volumes :',8(1X,A4))
  94             CALL GMAIL(0,0)
  95    10       IF(NSLIST.GT.NPADON) THEN
  96                NPAWRI=MIN(NSLIST-NPADON,15)
  97                WRITE(CHMAIL,10400)(ISLIST(J),J=NPADON+1,NPADON+NPAWRI)
  98 10400          FORMAT((1X,15(1X,A4)))
  99                CALL GMAIL(0,0)
 100                NPADON=NPADON+NPAWRI
 101                GO TO 10
 102             ENDIF
 103          ELSE
 104             CALL VBLANK(ISLIST, MSLIST)
 105             IF(NPAR.GT.MSLIST) THEN
 106                WRITE(CHMAIL,10500) MSLIST
 107 10500          FORMAT(' Warning! Only first ',I3,' scan volumes ',
 108      +                'accepted')
 109                CALL GMAIL(0,0)
 110             ENDIF
 111             NSLIST=0
 112             NVOL=IQ(JVOLUM-1)
 113             DO 20 I=1,MIN(NPAR,MSLIST)
 114                CALL KUGETC(CHOPT,NCH)
 115                IF(I.EQ.1) THEN
 116                   IF(NPAR.EQ.1.AND.CHOPT.EQ.'.') THEN
 117                      CALL MZDROP(IXCONS,LSCAN,' ')
 118                      GO TO 999
 119                   END IF
 120                END IF
 121                NCH=MIN(4,NCH)
 122                NSLIST=NSLIST+1
 123                CALL UCTOH(CHOPT,ISLIST(NSLIST),4,NCH)
 124                JVOL=IUCOMP(ISLIST(NSLIST),IQ(JVOLUM+1),NVOL)
 125                IF(JVOL.LE.0) THEN
 126                   WRITE(CHMAIL,10600) ISLIST(NSLIST)
 127 10600             FORMAT(' Warning: volume ',A4,' does not exist;',
 128      +                   ' skipped')
 129                   CALL GMAIL(0,0)
 130                   NSLIST=NSLIST-1
 131                END IF
 132    20       CONTINUE
 133             IF(NSLIST.LE.0) THEN
 134                WRITE(CHMAIL,10700)
 135 10700          FORMAT(' Warning! No valid volume defined')
 136                CALL GMAIL(0,0)
 137             ENDIF
 138          ENDIF
 139       ELSEIF(CHPATL.EQ.'VERTEX')THEN
 140 *
 141          IF(NSLMAX.EQ.0)NSLMAX=5
 142          CALL KUGETR(VSCAN(1))
 143          CALL KUGETR(VSCAN(2))
 144          CALL KUGETR(VSCAN(3))
 145       ELSEIF(CHPATL.EQ.'PCUTS')THEN
 146 *
 147          IF(NPAR.LE.0) THEN
 148             WRITE(CHMAIL,10800) IPARAM
 149 10800       FORMAT(' Parametrization flag = ',I2,
 150      +             ' Parametrization cuts:')
 151             CALL GMAIL(0,0)
 152             WRITE(CHMAIL,10900)
 153 10900       FORMAT('         Gamma     Electrons   Ch. Hadrons',
 154      +             '  Neu. Hadrons         Muons')
 155             CALL GMAIL(0,0)
 156             WRITE(CHMAIL,11000) PACUTS
 157 11000       FORMAT(5(1X,G13.4))
 158             CALL GMAIL(0,0)
 159          ELSE
 160             CALL KUGETI(IPARAM)
 161             DO 30 JPACUT=1, 5
 162                CALL KUGETR(PACUTS(JPACUT))
 163    30       CONTINUE
 164          ENDIF
 165       ELSEIF(CHPATL.EQ.'SFACTORS')THEN
 166 *
 167          CALL KUGETR(FACTX0)
 168          CALL KUGETR(FACTL)
 169          CALL KUGETR(FACTR)
 170       ELSEIF(CHPATL.EQ.'LSCAN')THEN
 171 *
 172          CALL KUGETI(IDPHI)
 173          CALL KUGETC(NAME,NCH)
 174          CALL KUGETC(CHOPT,NCH)
 175          CALL GXSCAL(IDPHI,NAME,CHOPT)
 176          IF(INDEX(CHOPT,'P').NE.0)THEN
 177             IF(IDPHI.NE.0)CALL HPLEGO(IDPHI,30.,30.)
 178          ENDIF
 179       ELSEIF(CHPATL.EQ.'HSCAN')THEN
 180 *
 181          CALL KUGETI(IDPHI)
 182          CALL KUGETC(NAME,NCH)
 183          CALL KUGETC(CHOPT,NCH)
 184          CALL GXSCAH(IDPHI,NAME,CHOPT)
 185          IF(INDEX(CHOPT,'P').NE.0)THEN
 186             IF(IDPHI.NE.0)CALL HPLOT(IDPHI,' ',' ',0)
 187          ENDIF
 188       ENDIF
 189 *
 190   999 END