Bugfix in AliPoints2Memory
[u/mrichter/AliRoot.git] / GEANT321 / ggeom / gsposp.F
1 *
2 * $Id$
3 *
4 * $Log$
5 * Revision 1.1.1.1  1999/05/18 15:55:17  fca
6 * AliRoot sources
7 *
8 * Revision 1.1.1.1  1995/10/24 10:20:56  cernlib
9 * Geant
10 *
11 *
12 #include "geant321/pilot.h"
13 *CMZ :  3.21/02 29/03/94  15.41.30  by  S.Giani
14 *-- Author :
15       SUBROUTINE GSPOSP(NAME,NR,MOTHER,X,Y,Z,IROT,KONLY,UPAR,NP)
16 C.
17 C.    ******************************************************************
18 C.    *                                                                *
19 C.    *      Place a copy of generic volume 'NAME' with user number    *
20 C.    *      'NR' inside 'MOTHER', with its parameters UPAR(1..NP)     *
21 C.    *                                                                *
22 C.    *          JVO=pointer to mother volume                          *
23 C.    *          JIN=pointer to the copy 'NAME','NR'                   *
24 C.    *          JIN=LQ(JVO-IN)                                        *
25 C.    *                                                                *
26 C.    *             Q(JIN+1)=NENTRY                                    *
27 C.    *             Q(JIN+2)=VOLUME NUMBER                             *
28 C.    *             Q(JIN+3)=USER NUMBER                               *
29 C.    *             Q(JIN+4)=IROT                                      *
30 C.    *             Q(JIN+5)=X                                         *
31 C.    *             Q(JIN+6)=Y                                         *
32 C.    *             Q(JIN+7)=Z                                         *
33 C.    *             Q(JIN+8)=ONLY                                      *
34 C.    *             Q(JIN+9)=NPAR                                      *
35 C.    *             Q(JIN+10 ..)=PAR ..                                *
36 C.    *                                                                *
37 C.    *    ==>Called by : <USER>                                       *
38 C.    *         Authors R.Brun, F.Bruyant,  A.McPherson  *********     *
39 C.    *                                                                *
40 C.    ******************************************************************
41 C.
42 #include "geant321/gcbank.inc"
43 #include "geant321/gcflag.inc"
44 #include "geant321/gcunit.inc"
45 #include "geant321/gcnum.inc"
46 #include "geant321/gconsp.inc"
47       CHARACTER*4 NAME,MOTHER,KONLY
48       DIMENSION UPAR(*),PAR(100)
49 C.
50 C.    ------------------------------------------------------------------
51 C.
52 C              Check if volume master bank exists
53 C
54       IF(JVOLUM.GT.0)GO TO 10
55       WRITE(CHMAIL,1000)
56       CALL GMAIL(0,0)
57       GO TO 99
58 C
59 C              Check if mother volume exists
60 C
61   10  CALL GLOOK(MOTHER,IQ(JVOLUM+1),NVOLUM,IVO)
62       IF(IVO.GT.0)GO TO 20
63       WRITE(CHMAIL,2000)MOTHER
64       CALL GMAIL(0,0)
65       GO TO 99
66 C
67 C              Check if NAME volume exists
68 C
69   20  CALL GLOOK(NAME,IQ(JVOLUM+1),NVOLUM,IN)
70       IF(IN.GT.0)GO TO 30
71       WRITE(CHMAIL,2000)NAME
72       CALL GMAIL(0,0)
73       GO TO 99
74 C
75 C              Check if rotation matrix exists
76 C
77   30  IF(IROT.LE.0)GO TO 50
78       IF(JROTM.GT.0)GO TO 40
79       WRITE(CHMAIL,3000)IROT
80       CALL GMAIL(0,0)
81       GO TO 99
82   40  IF(LQ(JROTM-IROT).GT.0)GO TO 50
83       WRITE(CHMAIL,3000)IROT
84       CALL GMAIL(0,0)
85       GO TO 99
86 C
87 C              Check if mother is not divided
88 C
89   50  JIN=LQ(JVOLUM-IN)
90       ISH=Q(JIN+2)
91       JVO=LQ(JVOLUM-IVO)
92       ICOPY=1
93       NIN=Q(JVO+3)
94       IF(NIN.GE.0)GO TO 60
95       WRITE(CHMAIL,4000)MOTHER
96       CALL GMAIL(0,0)
97       GO TO 99
98 *
99 * *** Copy user parameters into local array PAR
100   60  NPAR=NP
101       IF (ISH.EQ. 4) NPAR=35
102       IF (ISH.EQ.28) NPAR=30
103       CALL UCOPY(UPAR,PAR,NP)
104 *
105 * *** Check if ('NAME',NUMBER') exists
106       IF(NIN.EQ.0)GO TO 80
107       DO 70 I=1,NIN
108       JIN=LQ(JVO-I)
109       IF(Q(JIN+2).NE.IN)GO TO 70
110       IF(Q(JIN+3).NE.NR)GO TO 70
111       WRITE(CHMAIL,5000)NAME,NR
112       CALL GMAIL(0,0)
113       GO TO 90
114   70  CONTINUE
115       ICOPY=NIN+1
116 *
117 * *** Create bank for that copy
118   80  NINL=IQ(JVO-2)
119       IF(ICOPY.GT.NINL)CALL MZPUSH(IXCONS,JVO,50,0,'I')
120       CALL MZBOOK(IXCONS,JIN,JVO,-ICOPY,'VOPP',1,1,NPAR+9,3,0)
121       IF(IEOTRI.NE.0)GO TO 95
122       IQ(JIN-5)=100*IVO+ICOPY
123       Q(JVO+3)=Q(JVO+3)+1
124 *
125 * *** Now store parameters into bank area
126   90  Q(JIN+2)=IN
127       Q(JIN+3)=NR
128       Q(JIN+4)=IROT
129       Q(JIN+5)=X
130       Q(JIN+6)=Y
131       Q(JIN+7)=Z
132       IF(KONLY.EQ.'ONLY')Q(JIN+8)=1.
133       Q(JIN+9) = NPAR
134 *
135       IF (ISH.EQ.4) THEN
136 *        Trapezoid
137          TTH= TAN(PAR(2)*DEGRAD)
138          PHI    = PAR(3)*DEGRAD
139          PAR(2) = TTH*COS(PHI)
140          PAR(3) = TTH*SIN(PHI)
141          PAR(7) = TAN(PAR(7) *DEGRAD)
142          PAR(11)= TAN(PAR(11)*DEGRAD)
143          CALL GNOTR1 (PAR)
144       ELSE IF (ISH.EQ.10) THEN
145 *        Parallelepiped.
146          PAR(4)=TAN(PAR(4)*DEGRAD)
147          TTH=TAN(PAR(5)*DEGRAD)
148          PH=PAR(6)*DEGRAD
149          PAR(5)=TTH*COS(PH)
150          PAR(6)=TTH*SIN(PH)
151       ELSE IF (ISH.EQ.28) THEN
152 *        General twisted trapezoid.
153          CALL GTRAIN(UPAR,PAR)
154       ENDIF
155 *
156       CALL UCOPY(PAR,Q(JIN+10),NPAR)
157       GO TO 99
158 *
159 *     Not enough space
160   95  WRITE(CHMAIL,6000)NAME,NR,MOTHER
161       CALL GMAIL(0,0)
162 C
163  1000 FORMAT(' ***** GSPOSP CALLED AND NO VOLUMES DEFINED *****')
164  2000 FORMAT(' ***** GSPOSP VOLUME ',A4,' DOES NOT EXISTS *****')
165  3000 FORMAT(' ***** GSPOSP ROTATION MATRIX',I5,' DOES NOT EXIST *****')
166  4000 FORMAT(' ***** GSPOSP MOTHER ',A4,' ALREADY DIVIDED *****')
167  5000 FORMAT(' ***** GSPOSP COPY ',A4,' NUMBER ',I5,
168      +       ' ALREADY CREATED IN ',A4,' *****')
169  6000 FORMAT(' ***** GSPOSP NOT ENOUGH SPACE TO STORE COPY ',A4,
170      +       ' NUMBER ',I5,' IN ',A4,' *****')
171   99  RETURN
172       END