*
* $Id$
*
* $Log$
*
*CMZ :  3.00/00 13/11/2000  09.03.11  by  Emiliano Mocchiutti
*CMZ :  2.01/00 05/04/2000  14.35.17  by  Marialuigia Ambriola
*CMZ :  2.00/00 03/03/2000  15.39.05  by  Francesco Cafagna
*CMZ :  1.02/00 08/11/99  18.44.50  by  Francesco Cafagna
*CMZ :  1.01/00 13/05/96  09.16.26  by  Francesco Cafagna
*CMZ :  1.00/02 04/04/96  12.00.53  by  Francesco Cafagna
*-- Author :    Francesco Cafagna   05/12/95
      SUBROUTINE GPGEO
************************************************************************
*                                                                      *
* Volumes definition for PAMELA                                        *
*                                                                      *
* Called by: UGINIT                                                    *
* Author: Francesco Cafagna, 05/12/95 13.21.27                         *
*                                                                      *
************************************************************************
#include "gpgeo.inc"
#include "gpmed.inc"
#include "gpkey.inc"
*
      INTEGER IROT,IVOLU,N,NMED,NUM
      REAL X,Y,Z
*
*  Define 90 degree rotation around Z axis
*
      IROT=1
      CALL GSROTM(IROT,90.,90.,90.,180.,0.,0.)
*
*  Define 90 degree rotation around X axis
*
      IROT=2
      CALL GSROTM(IROT,90.,0.,180.,90.,90.,90.)
*
*  Define 90 degree rotation around Z axis and 180 along X
*
      IROT=3
      CALL GSROTM(IROT,90.,90.,90.,360.,180.,0.)
*
*  Define 180 degree rotation around Z axis
*
      IROT=4
      CALL GSROTM(IROT,90.,180.,90.,270.,0.,0.)
*
*  Define the PAMELA   volume
*
      NMED=MN2
      CALL GSVOLU('PAME','TUBE',NMED,PAME, 3,IVOLU)
*
*  Define the Aluminium shell volumes
*
      NMED=MAL
      CALL GSVOLU('SHEL','TUBE',NMED,SHEL, 3,IVOLU)
*
*  Define the Aluminium inner shell volumes
*
      IF(SPH) THEN
         NMED=MAL
         CALL GSVOLU('TSPH','SPHE',NMED,TSPH, 6,IVOLU)
      ELSE
         NMED=MAL
         CALL GSVOLU('TFLA','TUBE',NMED,TFLA, 3,IVOLU)
      ENDIF
*
* Volume definition for scintillators, TOF and anticoincidence counter
*
      IF(TOF) CALL GPTOFV
      IF(CAT) CALL GPCATV
      IF(CAS) CALL GPCASV
*
* Volume definition for TRD
*
      IF(TRD) CALL GPTRDV
*
* Volume definition for Spectrometer
*
      IF(SPE) CALL GPSPEV
*
* Volume definition for Calorimeter
*
      IF(CAL) CALL GPCALV
*
*  Volume positioning starting from the TOP
*
      X= 0.
      Y= 0.
*
* Positioning volume SHEL     into the mother PAME
*
      N= 1
      Z= ZSHEL
      CALL GSPOS('SHEL',N,'PAME',X,Y,Z,0,'ONLY')
*
* Positioning volume SHEI     into the mother PAME
*
C         N= 1
C         Z= ZSHEI
c         CALL GSPOS('SHEI',N,'PAME',X,Y,Z,0,'ONLY')
      IF(SPH) THEN
*
* Positioning volume TSPH     into the mother PAME
*
         N= 1
         Z= ZTSPH
         CALL GSPOS('TSPH',N,'PAME',X,Y,Z,0,'ONLY')
      ELSE
*
* Positioning volume TFLA     into the mother PAME
*
         N= 1
         Z= ZTFLA
         CALL GSPOS('TFLA',N,'PAME',X,Y,Z,0,'ONLY')
      ENDIF
*
* Positioning volume S11     into the mother PAME
*
      N= 1
      Z= ZS11
      IF(TOF) CALL GSPOS('S11 ',N,'PAME',X,Y,Z,0,'ONLY')
*
* Positioning volume S12     into the mother PAME
*
      N= 1
      Z= ZS12
      IF(TOF) CALL GSPOS('S12 ',N,'PAME',X,Y,Z,0,'ONLY')
*
* Positioning volume TRDB     into the mother PAME
*
      N= 1
      Z= ZTRD
      IF(TRD) THEN
         CALL GSPOS('TRDB',N,'PAME',X,Y,Z,0,'ONLY')
C FC commented out on 21-10-1999 by caf
c         CALL GSPOS('TRDS',N,'PAME',X,Y,Z,0,'ONLY')
c         Z= ZTRD - TRDS(3) - TRDT(3)
c         CALL GSPOS('TRDT',N,'PAME',X,Y,Z,0,'ONLY')
c         N= 2
c         Z= ZTRD + TRDS(3) + TRDT(3)
c         CALL GSPOS('TRDT',N,'PAME',X,Y,Z,0,'ONLY')
C FC end of comment on 21-10-1999
      ENDIF
*
* Positioning volume S21     into the mother PAME
*
      N= 1
      Z= ZS21
      IF(TOF) CALL GSPOS('S21 ',N,'PAME',X,Y,Z,0,'ONLY')
*
* Positioning volume S22     into the mother PAME
*
      N= 1
      Z= ZS22
      IF(TOF) CALL GSPOS('S22 ',N,'PAME',X,Y,Z,0,'ONLY')
*
* Positioning volume CATB     into the mother PAME
*
      N= 1
      Z= ZCAT
      IF(CAT) CALL GSPOS('CATB',N,'PAME',X,Y,Z,0,'ONLY')
*
* Positioning volume CAS      into the mother PAME
*
*EM:
      Z= ZCAS
      IF(CAS) THEN
C         X = 0
         N = 0
         DO I = 1,2
            X = ((-1)**(I+1))*CASXD
C            Y = ((-1)**I)*( CASY(2) + CASX(2) )
            Y = ((-1)**I)*CASY(2)
c fc mod by caf on 21-10-1999
c            DO II=1, 5
c               Z = ZCAS - 4.*CASX(3) + (II-1) * 2*CASX(3)
c               N = N + 1
c               CALL GSPOS('CASX',N,'PAME',X,Y,Z,0,'ONLY')
c            ENDDO
c fc end mod
            Z = ZCAS
            N = N + 1
*
            CALL GSPOS('CSSX',N,'PAME',X,Y,Z,0,'ONLY')
         ENDDO
*
C         Y = 0
         N = 0
         DO I = 1,2
            X = ((-1)**I)*(CASX(1)+0.1)
C            X = ((-1)**I)*(CASX(1)+CASY(1))
            Y = ((-1)**I)*CASYD
c fc mod by caf on 21-10-1999
c            DO II=1, 5
c               Z = ZCAS - 4.*CASY(3) + (II-1) * 2*CASY(3)
c               N = N + 1
c               CALL GSPOS('CASY',N,'PAME',X,Y,Z,0,'ONLY')
c            ENDDO
c fc end mod
            Z = ZCAS
            N = N + 1
            CALL GSPOS('CSSY',N,'PAME',X,Y,Z,0,'ONLY')
         ENDDO
      ENDIF
*END: EM.
*
* Positioning volume SPEB     into the mother PAME
*
      N= 1
      X= 0.
      Y= 0.
      Z= ZSPEC
      IF(SPE) CALL GSPOS('SPEB',N,'PAME',X,Y,Z,0,'ONLY')
*
* Positioning volume S31     into the mother PAME
*
      N= 1
      X= 0.
      Y= 0.
      Z= ZS31
      IF(TOF) CALL GSPOS('S31 ',N,'PAME',X,Y,Z,0,'ONLY')
*
* Positioning volume S32     into the mother PAME
*
      N= 1
      X= 0.
      Y= 0.
      Z= ZS32
      IF(TOF) CALL GSPOS('S32 ',N,'PAME',X,Y,Z,0,'ONLY')
*
* Positioning volume CALB     into the mother PAME
*
      N= 1
      X= 0.
      Y= 0.
      Z= ZCAL
      IF(CAL) CALL GSPOS('CALS',N,'PAME',X,Y,Z,0,'ONLY')
*
* Positioning volume S4     into the mother PAME
*
      N= 1
      Z= ZS4
      IF(TOF) CALL GSPOS('S4  ',N,'PAME',X,Y,Z,0,'ONLY')
*
* User action
*
      CALL GPUGEO
      RETURN
      END
