5 * Revision 1.1.1.1 1995/10/24 10:20:56 cernlib
9 #include "geant321/pilot.h"
10 *CMZ : 3.21/02 29/03/94 15.41.30 by S.Giani
12 SUBROUTINE GSPOS(CHNAME,NR,CHMOTH,X,Y,Z,IROT,CHONLY)
14 C. ******************************************************************
16 C. * PLACE A COPY OF VOLUME 'CHNAME' WITH USER NUMBER 'NUMBER' *
17 C. * INSIDE 'CHMOTH' *
19 C. * JVO=POINTER TO CHMOTH VOLUME *
20 C. * JIN=POINTER TO THE COPY 'CHNAME','NUMBER' *
23 C. * Q(JIN+1)=NENTRY *
24 C. * Q(JIN+2)=VOLUME NUMBER *
25 C. * Q(JIN+3)=USER NUMBER *
32 C. * ==>Called by : <USER> *
33 C. * Authors R.Brun, A.McPherson ********* *
35 C. ******************************************************************
37 #include "geant321/gcbank.inc"
38 #include "geant321/gcflag.inc"
39 #include "geant321/gcunit.inc"
40 #include "geant321/gcnum.inc"
41 CHARACTER*4 CHNAME,CHMOTH,CHONLY
43 C. ------------------------------------------------------------------
45 C CHECK IF VOLUME MASTER BANK EXISTS
47 IF(JVOLUM.GT.0)GO TO 10
52 C CHECK IF CHMOTH VOLUME EXISTS
54 10 CALL GLOOK(CHMOTH,IQ(JVOLUM+1),NVOLUM,IVO)
56 WRITE(CHMAIL,2000)CHMOTH
60 C CHECK IF CHNAME VOLUME EXISTS
62 20 CALL GLOOK(CHNAME,IQ(JVOLUM+1),NVOLUM,IN)
64 WRITE(CHMAIL,2000)CHNAME
68 C CHECK IF ROTATION MATRIX EXISTS
70 30 IF(IROT.LE.0)GO TO 50
71 IF(JROTM.GT.0)GO TO 40
72 WRITE(CHMAIL,3000)IROT
75 40 IF(LQ(JROTM-IROT).GT.0)GO TO 50
76 WRITE(CHMAIL,3000)IROT
80 C CHECK IF MOTHER IS NOT DIVIDED
86 WRITE(CHMAIL,4000)CHMOTH
90 C CHECK IF ('NAME',NUMBER') EXISTS
92 60 IF(NIN.EQ.0)GO TO 80
95 IF(Q(JIN+2).NE.IN)GO TO 70
96 IF(Q(JIN+3).NE.NR)GO TO 70
97 WRITE(CHMAIL,5000)CHNAME,NR
103 C CREATE BANK FOR THAT COPY
106 IF(ICOPY.GT.NINL)CALL MZPUSH(IXCONS,JVO,50,0,'I')
107 CALL MZBOOK(IXCONS,JIN,JVO,-ICOPY,'VOPO',1,1,8,3,0)
108 IF(IEOTRI.NE.0)GO TO 95
109 IQ(JIN-5)=100*IVO+ICOPY
112 C NOW STORE PARAMETERS INTO BANK AREA
120 IF(CHONLY.EQ.'ONLY')Q(JIN+8)=1.
125 95 WRITE(CHMAIL,6000)CHNAME,NR,CHMOTH
128 1000 FORMAT(' ***** GSPOS called and no volumes defined')
129 2000 FORMAT(' ***** GSPOS volume ',A4,' does not exist')
130 3000 FORMAT(' ***** GSPOS rotation matrix',I5,' does not exist')
131 4000 FORMAT(' ***** GSPOS mother ',A4,' already divided')
132 5000 FORMAT(' ***** GSPOS copy ',A4,' number ',I5,
133 + ' already created in ',A4,' *****')
134 6000 FORMAT(' ***** GSPOS not enough space to store copy ',A4,
135 + ' number ',I5,' in ',A4,' *****')