This commit was generated by cvs2svn to compensate for changes in r2,
[u/mrichter/AliRoot.git] / 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