]>
Commit | Line | Data |
---|---|---|
fe4da5cc | 1 | * |
2 | * $Id$ | |
3 | * | |
4 | * $Log$ | |
5 | * Revision 1.1.1.1 1995/10/24 10:20:48 cernlib | |
6 | * Geant | |
7 | * | |
8 | * | |
9 | #include "geant321/pilot.h" | |
10 | *CMZ : 3.21/02 29/03/94 15.41.28 by S.Giani | |
11 | *-- Author : | |
12 | SUBROUTINE GFIPAR (JVO, JIN, IN, NPAR, NATT, PAR, ATT) | |
13 | C. | |
14 | C. ****************************************************************** | |
15 | C. * * | |
16 | C. * Routine to fetch internal parameters and attributes for * | |
17 | C. * the volume from volume address JVO. If it was positioned * | |
18 | C. * by GSPOSP or declared with negative dimensional parameters, * | |
19 | C. * then JIN and IN must correspond to its positioning inside * | |
20 | C. * its mother. * | |
21 | C. * * | |
22 | C. * Called by : GCENT, GFCLIM, GSDVN, GSDVN2, GSDVT, GSDVT2 * | |
23 | C. * Authors : S.Banerjee, A.McPherson, P.Zanarini * | |
24 | C. * * | |
25 | C. ****************************************************************** | |
26 | C. | |
27 | #include "geant321/gcbank.inc" | |
28 | #include "geant321/gcunit.inc" | |
29 | PARAMETER (NLVMAX=15) | |
30 | DIMENSION PAR(*), ATT(*), LVOLS(NLVMAX), LINDX(NLVMAX) | |
31 | CHARACTER*4 NAME | |
32 | LOGICAL BTEST | |
33 | C. | |
34 | C. ------------------------------------------------------------------ | |
35 | C. | |
36 | NPAR = Q(JVO+5) | |
37 | NATT = Q(JVO+6) | |
38 | JATT = JVO + 6 + NPAR | |
39 | IF (.NOT.BTEST(IQ(JVO),1)) THEN | |
40 | IF (NPAR.GT.0) THEN | |
41 | JPAR = JVO + 6 | |
42 | ELSE | |
43 | IF (JIN.LE.0) GO TO 910 | |
44 | JPAR = JIN + 9 | |
45 | NPAR = Q(JPAR) | |
46 | ENDIF | |
47 | ELSE | |
48 | IF (JIN.LE.0) GO TO 910 | |
49 | JVOM = LQ(JIN+1) | |
50 | NIN = Q(JVOM+3) | |
51 | IVO = Q(JIN+2) | |
52 | IF (NIN.GT.0) THEN | |
53 | INUM = Q(JIN+3) | |
54 | ELSE | |
55 | INUM = IN | |
56 | ENDIF | |
57 | CALL UHTOC(IQ(JVOLUM+IVO),4,NAME,4) | |
58 | CALL GLMOTH (NAME, INUM, NLDM, LVOLS, LINDX) | |
59 | IF (NLDM.LE.0) GO TO 930 | |
60 | JPAR = LQ(LQ(JVOLUM-LVOLS(1))) | |
61 | IF (NLDM.GT.1) THEN | |
62 | DO 10 ILEV = 2, NLDM | |
63 | IF (IQ(JPAR+1).EQ.0) THEN | |
64 | JPAR = LQ(JPAR-LINDX(ILEV)) | |
65 | IF (JPAR.EQ.0) GO TO 940 | |
66 | ELSE IF (IQ(JPAR-3).GT.1) THEN | |
67 | JPAR = LQ(JPAR-LINDX(ILEV)) | |
68 | ELSE | |
69 | JPAR = LQ(JPAR-1) | |
70 | ENDIF | |
71 | 10 CONTINUE | |
72 | ENDIF | |
73 | IF (NIN.GT.0) THEN | |
74 | JPAR = LQ(JPAR-IN) | |
75 | IF (JPAR.EQ.0) GO TO 940 | |
76 | ELSE IF (IQ(JPAR-3).GT.1) THEN | |
77 | JPAR = LQ(JPAR-IN) | |
78 | ELSE | |
79 | JPAR = LQ(JPAR-1) | |
80 | ENDIF | |
81 | JPAR = JPAR + 5 | |
82 | NPAR = IQ(JPAR) | |
83 | ENDIF | |
84 | * | |
85 | IF (NPAR.LE.0) GO TO 950 | |
86 | CALL UCOPY (Q(JPAR+1), PAR, NPAR) | |
87 | CALL UCOPY (Q(JATT+1), ATT, NATT) | |
88 | * | |
89 | GO TO 999 | |
90 | * | |
91 | 910 CONTINUE | |
92 | WRITE (CHMAIL, 1010) JIN | |
93 | CALL GMAIL (0, 0) | |
94 | 1010 FORMAT (' GFIPAR : Error - JIN = ',I8,' LE 0 where Volume ', | |
95 | + 'parameters not present in JVO') | |
96 | GO TO 999 | |
97 | * | |
98 | 930 CONTINUE | |
99 | WRITE (CHMAIL, 1030) | |
100 | CALL GMAIL (0, 0) | |
101 | 1030 FORMAT (' GFIPAR : Error - NLDM is zero where development ', | |
102 | + 'structure is expected') | |
103 | GO TO 999 | |
104 | * | |
105 | 940 CONTINUE | |
106 | WRITE (CHMAIL, 1040) | |
107 | CALL GMAIL (0, 0) | |
108 | 1040 FORMAT (' GFIPAR : Error - JPAR is zero where development ', | |
109 | + 'structure is expected') | |
110 | GO TO 999 | |
111 | * | |
112 | 950 CONTINUE | |
113 | WRITE (CHMAIL,1050) NPAR | |
114 | CALL GMAIL (0, 0) | |
115 | 1050 FORMAT (' GFIPAR : Error - NPAR = ',I8,' LE zero') | |
116 | 999 CONTINUE | |
117 | * END GFIPAR | |
118 | END |