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