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