GEANT321/ggeom/gspos.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.1.1.1  1995/10/24 10:20:56  cernlib
   6 * Geant
   7 *
   8 *
   9 #include "geant321/pilot.h"
  10 *CMZ :  3.21/02 29/03/94  15.41.30  by  S.Giani
  11 *-- Author :
  12       SUBROUTINE GSPOS(CHNAME,NR,CHMOTH,X,Y,Z,IROT,CHONLY)
  13 C.
  14 C.    ******************************************************************
  15 C.    *                                                                *
  16 C.    *      PLACE A COPY OF VOLUME 'CHNAME' WITH USER NUMBER 'NUMBER'   *
  17 C.    *      INSIDE 'CHMOTH'                                           *
  18 C.    *                                                                *
  19 C.    *          JVO=POINTER TO CHMOTH VOLUME                          *
  20 C.    *          JIN=POINTER TO THE COPY 'CHNAME','NUMBER'               *
  21 C.    *          JIN=LQ(JVO-IN)                                        *
  22 C.    *                                                                *
  23 C.    *             Q(JIN+1)=NENTRY                                    *
  24 C.    *             Q(JIN+2)=VOLUME NUMBER                             *
  25 C.    *             Q(JIN+3)=USER NUMBER                               *
  26 C.    *             Q(JIN+4)=IROT                                      *
  27 C.    *             Q(JIN+5)=X                                         *
  28 C.    *             Q(JIN+6)=Y                                         *
  29 C.    *             Q(JIN+7)=Z                                         *
  30 C.    *             Q(JIN+8)=ONLY                                      *
  31 C.    *                                                                *
  32 C.    *    ==>Called by : <USER>                                       *
  33 C.    *         Authors R.Brun,  A.McPherson  *********                *
  34 C.    *                                                                *
  35 C.    ******************************************************************
  36 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
  42 C.
  43 C.    ------------------------------------------------------------------
  44 C.
  45 C              CHECK IF VOLUME MASTER BANK EXISTS
  46 C
  47       IF(JVOLUM.GT.0)GO TO 10
  48       WRITE(CHMAIL,1000)
  49       CALL GMAIL(0,0)
  50       GO TO 99
  51 C
  52 C              CHECK IF CHMOTH VOLUME EXISTS
  53 C
  54   10  CALL GLOOK(CHMOTH,IQ(JVOLUM+1),NVOLUM,IVO)
  55       IF(IVO.GT.0)GO TO 20
  56       WRITE(CHMAIL,2000)CHMOTH
  57       CALL GMAIL(0,0)
  58       GO TO 99
  59 C
  60 C              CHECK IF CHNAME VOLUME EXISTS
  61 C
  62   20  CALL GLOOK(CHNAME,IQ(JVOLUM+1),NVOLUM,IN)
  63       IF(IN.GT.0)GO TO 30
  64       WRITE(CHMAIL,2000)CHNAME
  65       CALL GMAIL(0,0)
  66       GO TO 99
  67 C
  68 C              CHECK IF ROTATION MATRIX EXISTS
  69 C
  70   30  IF(IROT.LE.0)GO TO 50
  71       IF(JROTM.GT.0)GO TO 40
  72       WRITE(CHMAIL,3000)IROT
  73       CALL GMAIL(0,0)
  74       GO TO 99
  75   40  IF(LQ(JROTM-IROT).GT.0)GO TO 50
  76       WRITE(CHMAIL,3000)IROT
  77       CALL GMAIL(0,0)
  78       GO TO 99
  79 C
  80 C              CHECK IF MOTHER IS NOT DIVIDED
  81 C
  82   50  JVO=LQ(JVOLUM-IVO)
  83       ICOPY=1
  84       NIN=Q(JVO+3)
  85       IF(NIN.GE.0)GO TO 60
  86       WRITE(CHMAIL,4000)CHMOTH
  87       CALL GMAIL(0,0)
  88       GO TO 99
  89 C
  90 C              CHECK IF ('NAME',NUMBER') EXISTS
  91 C
  92   60  IF(NIN.EQ.0)GO TO 80
  93       DO 70 I=1,NIN
  94       JIN=LQ(JVO-I)
  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
  98       CALL GMAIL(0,0)
  99       GO TO 90
 100   70  CONTINUE
 101       ICOPY=NIN+1
 102 C
 103 C               CREATE BANK FOR THAT COPY
 104 C
 105   80  NINL=IQ(JVO-2)
 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
 110       Q(JVO+3)=Q(JVO+3)+1
 111 C
 112 C               NOW STORE PARAMETERS INTO BANK AREA
 113 C
 114   90  Q(JIN+2)=IN
 115       Q(JIN+3)=NR
 116       Q(JIN+4)=IROT
 117       Q(JIN+5)=X
 118       Q(JIN+6)=Y
 119       Q(JIN+7)=Z
 120       IF(CHONLY.EQ.'ONLY')Q(JIN+8)=1.
 121       GO TO 99
 122 C
 123 C              NOT ENOUGH SPACE
 124 C
 125   95  WRITE(CHMAIL,6000)CHNAME,NR,CHMOTH
 126       CALL GMAIL(0,0)
 127 C
 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,' *****')
 136   99  END