*
* $Id: gptrdv.F,v 3.1.1.1 2002/07/11 16:02:01 cafagna Exp $
*
* $Log: gptrdv.F,v $
* Revision 3.1.1.1  2002/07/11 16:02:01  cafagna
* First GPAMELA release on CVS
*
*
*CMZ :  2.01/00 05/04/2000  14.35.18  by  Marialuigia Ambriola
*CMZ :  2.00/00 03/03/2000  15.39.05  by  Francesco Cafagna
*CMZ :  1.02/00 09/02/2000  13.11.57  by  Francesco Cafagna
*CMZ :  1.00/02 15/03/96  16.04.21  by  Francesco Cafagna
*-- Author :    Francesco Cafagna   05/12/95
      SUBROUTINE GPTRDV
************************************************************************
*                                                                      *
* Volume definition for TRD                                            *
* Called by: GPGEO                                                     *
* Author: Francesco Cafagna, 05/12/95 17.25.32                         *
*                                                                      *
************************************************************************
#include "gpgeo.inc"
#include "gpmed.inc"
*
      INTEGER IROT,IVOLU,N,NMED,NUM,NAN
      REAL X,Y,Z
*
*  Define the TRDB     volume
*
      NMED=MN2
      CALL GSVOLU('TRDB','BOX ',NMED,TRDB, 3,IVOLU)
*
*  Define the TRAN     volume
*
      NMED=MAL
      CALL GSVOLU('TRAN','BOX ',NMED,TRAN, 3,IVOLU)
*
*  Define the TRAI     volume
*
      NMED=MN2
      CALL GSVOLU('TRAI','BOX ',NMED,TRAI, 3,IVOLU)
*
*  Define the TRBS     volumes
*
      NMED=MN2
      CALL GSVOLU('TRBS','BOX ',NMED,TRBS, 3,IVOLU)
*ml: 10/11/66:
*
* Define the TRAL volumes
*
      NMED=MAL
      CALL GSVOLU('TRAL','BOX ',NMED,TRAL, 3,IVOLU)
*end ml.
*
*  Define the TRSO     volumes
*
      NMED=MKAP
      CALL GSVOLU('TRSO','TUBE',NMED,TRSO, 3,IVOLU)
*
*  Define the TRSI     volumes
*
      NMED=MXE
      CALL GSVOLU('TRSI','TUBE',NMED,TRSI, 3,IVOLU)
*
*  Define the TRRA     volumes
*
      NMED=MTRAD
      CALL GSVOLU('TRRA','BOX ',NMED,TRRA, 3,IVOLU)
c ml: 11/11/04:
*
*  Define the TRR2    volumes
*
      NMED=MTRAD
      CALL GSVOLU('TRR2','BOX ',NMED,TRR2, 3,IVOLU)
*
*   Define the TRR0    volumes
*
      NMED=MCF
      CALL GSVOLU('TRR0','BOX ',NMED,TRR0, 3,IVOLU)
*
*   Define the TRI0    volumes
*
      NMED=MN2
      CALL GSVOLU('TRI0','BOX ',NMED,TRI0, 3,IVOLU)
*
*   Define the TRRF    volumes
*
      NMED=MMAG
      CALL GSVOLU('TRRF','BOX ',NMED,TRRF, 3,IVOLU)
*
*   Define the TRRI    volumes
*
      NMED=MN2
      CALL GSVOLU('TRRI','BOX ',NMED,TRRI, 3,IVOLU)
c end ml.
*
*   Define the TRFR    volumes
*
      NMED=MCF
      CALL GSVOLU('TRFR','BOX ',NMED,TRFR, 3,IVOLU)
c ml: 12/11/04:
c*
c*   Define the TRFI    volumes
c*
c      NMED=MN2
c      CALL GSVOLU('TRFI','BOX ',NMED,TRFI, 3,IVOLU)
*
*   Define the TRFD    volumes
*
      NMED=MCF
      CALL GSVOLU('TRFD','BOX ',NMED,TRFD, 3,IVOLU)
*
*   Define the TRFU    volumes
*
      NMED=MCF
      CALL GSVOLU('TRFU','BOX ',NMED,TRFU, 3,IVOLU)
*
*   Define the TRFM    volumes
*
      NMED=MCF
      CALL GSVOLU('TRFM','BOX ',NMED,TRFM, 3,IVOLU)
*
*   Define the TRFL    volumes
*
      NMED=MCF
      CALL GSVOLU('TRFL','BOX ',NMED,TRFL, 3,IVOLU)
c end ml.
*
*   Define the TRDT    volumes
*
      NMED=MAL
      CALL GSVOLU('TRDT','BOX ',NMED,TRDT, 3,IVOLU)
*ml: 10/11/04:
*
* Positioning the volumes TRAL into mothers TRBS 
*
      X=0.
      Z=0.
      DO I=1,2
         Y=(-1)**I*(TRBS(2)-TRAL(2))
C #          print*,'gptrdv.F: tral: y=',y
         CALL GSPOS('TRAL',I,'TRBS',X,Y,Z,0,'ONLY')
      ENDDO
*end ml.

*
* Positioning volumes TRSI     into mothers TRSO
*
      N= 1
      X= 0.
      Y= 0.
      Z= 0.
*      CALL GSPOS('TRSI',N,'TRSO',X,Y,Z,0,'ONLY')
*Positioning volumes TRSO into mothers TRSI, because now TRSO is included in
*TRSI and TRSI is included in TRBS
      CALL GSPOS('TRSO',N,'TRSI',X,Y,Z,0,'ONLY')
*
*
* Positioning volumes TRSO     into mothers TRBS. Remember we have to put
* tubes one over each other
*
      Y=0.
      NUM = 0
      DO II=1,2
#if defined(GPAMELA_UNIX)
         Z= TRSO(2) * COS(30./180.*ACOS(-1.)) * (-1)**II
#endif
#if !defined(GPAMELA_UNIX)
         Z= TRSO(2) * COSD(30.) * (-1)**II
#endif
         DO I=1, 16
            NUM = NUM + 1
            X= -TRBS(1) + II*TRSO(2) + (I-1)*2.*TRSO(2)
*            CALL GSPOS('TRSO',NUM,'TRBS',X,Y,Z,2,'ONLY')
*now TRSI is into TRBS (I don't change TRSO(2) in TRSI(2) because they
*are equal and the velue of X does not change:
            CALL GSPOS('TRSI',NUM,'TRBS',X,Y,Z,2,'ONLY')
         ENDDO
      ENDDO
c ml: 11/11/04:
C*
C* Positioning volumes TRFI     into mothers TRFR
C*
C      N= 1
C      X= 0.
C      Y= 0.
C      Z= 0.
C      CALL GSPOS('TRFI',N,'TRFR',X,Y,Z,0,'ONLY')
*
* Positioning volume TRI0     into mother TRR0
*
      N= 1
      X= 0.
      Y= 0.
c      Z= 0.
c      CALL GSPOS('TRI0',N,'TRR0',X,Y,Z,0,'ONLY')
      ZTRI0=TRR0(3)-TRI0(3)
      CALL GSPOS('TRI0',N,'TRR0',X,Y,ZTRI0,0,'MANY')
*
* Positioning volume TRRI     into mother TRRF
*
      N= 1
      X= 0.
      Y= 0.
      Z= 0.
      CALL GSPOS('TRRI',N,'TRRF',X,Y,Z,0,'ONLY')
*
* Positioning volume TRRF     into mother TRR0
*
      N= 1
      X= 0.
      Y= 0.
C      Z= 0.
      Z=-TRR0(3)+TRRF(3)
      CALL GSPOS('TRRF',N,'TRR0',X,Y,Z,0,'ONLY')
c end ml.
*
* Positioning volumes TRAI     into mothers TRAN
*
c ml: 17/11/04:
      N= 1
c      X= 0.
c      Y= TRAN(2)-TRAI(2)
      X=0.8
      Y=0.8
      Z= 0.
      CALL GSPOS('TRAI',N,'TRAN',X,Y,Z,0,'ONLY')
*end ml.
*
* Positioning volumes TRAI, TRFR, TRBS&TRRA     into the mother TRDB
*
      NAN = 0
c ml: 12/11/04:
c     positioning TRRO (frame 0 del TRD)
      X=0.
      Y=0.
c      Z= -TRDB(3) + TRAN(3)    
      Z= -TRDB(3) + TRR0(3)
C      CALL GSPOS('TRR0',1,'TRDB',X,Y,Z,0,'ONLY')
      CALL GSPOS('TRR0',1,'TRDB',X,Y,Z,0,'MANY')
C      Z=Z+TRR0(3)
      Z=Z+TRR0(3)-0.1
      M=3
      num=0
      DO I=1,4
C #          print*,'z,ztrfu=',z,ztrfu
         Z=Z+TRAN(3)
         ZTRBS=Z
c     positioning TRAN:
c ml:17/11/04:
c     DO III = 1,2
c     X = (-1)**(III-1)*TRAN(1)+ (-1)**III*TRDB(1)
c     Y = -TRAN(2)+ TRDB(2)
c     NAN = NAN + 1
c     CALL GSPOS('TRAN',NAN,'TRDB',X,Y,Z,0,'ONLY')
c     Y = +TRAN(2)- TRDB(2)
c            NAN = NAN + 1
c     CALL GSPOS('TRAN',NAN,'TRDB',X,Y,Z,4,'ONLY')
c     ENDDO
         X = -TRFR(1)+TRAN(1)
         Y = -TRFR(2)+ TRAN(2)
         NAN = NAN + 1
         CALL GSPOS('TRAN',NAN,'TRDB',X,Y,Z,0,'ONLY')
         X = -TRFR(1)+TRAN(1)
         Y = +TRFR(2)- TRAN(2)
         NAN = NAN + 1
         CALL GSPOS('TRAN',NAN,'TRDB',X,Y,Z,6,'ONLY')
         X = TRFR(1)-TRAN(1)
         Y = +TRFR(2)- TRAN(2)
         NAN = NAN + 1
         CALL GSPOS('TRAN',NAN,'TRDB',X,Y,Z,4,'ONLY')
         X = TRFR(1)-TRAN(1)
         Y = -TRFR(2)+ TRAN(2)
         NAN = NAN + 1
         CALL GSPOS('TRAN',NAN,'TRDB',X,Y,Z,1,'ONLY')
         Z= Z + TRAN(3)
c     positioning TRBS (the modules):
         Y=0.
         DO II=1, M
            NUM = NUM + 1
*     shift of modules to have the right overlap:
            X= (II-1)*2.*TRBS(1) - ( M*TRBS(1) - TRBS(1) ) -
     +           (II-2)*TRSI(2)
*     now there two different volumes interested at same time:
*     CALL GSPOS('TRBS',NUM,'TRDB',X,Y,Z,0,'ONLY')
            CALL GSPOS('TRBS',NUM,'TRDB',X,Y,ZTRBS,0,'MANY')
         ENDDO
c end ml.
c     positioning TRFD:
         X=0.
         ZTRFD=Z-TRFD(3)
         CALL GSPOS('TRFD',I,'TRDB',X,Y,ZTRFD,0,'MANY')
C #          print*,'gptrdv: n. of trfd: i=',i
c     positioning TRFR:
         Z= Z + TRFR(3)
         ZRAD=Z
         CALL GSPOS('TRFR',I,'TRDB',X,Y,Z,0,'MANY')
C     Z= Z + TRFR(3) + TRBS(3)
         Z=Z+TRFR(3)
c     positioning TRFU:
         ZTRFU= Z + TRFU(3)
         CALL GSPOS('TRFU',I,'TRDB',X,Y,ZTRFU,0,'MANY')
         X = 0.
         Y = 0.
cc         Z = Z + TRSO(2)*( 1 + COS(30./180.*ACOS(-1.))) + TRRA(3)
cc         print*,'z del radiatore=',z
C #          print*,'cos(1+....)=',1 + COS(30./180.*ACOS(-1.))
C     #          Z= Z + 2*TRSO(2) + TRRA(3)
c     CALL GSPOS('TRRA',I,'TRDB',X,Y,Z,0,'ONLY')
         CALL GSPOS('TRRA',I,'TRDB',X,Y,ZRAD,0,'ONLY')
C     #          Z= Z - (2*TRSO(2) + TRRA(3)) + TRBS(3)
CC         Z = Z - ( TRSO(2)*( 1 + COS(30./180.*ACOS(-1.))) + TRRA(3))
CC     +        + TRBS(3)
cc         GOTO 151
cc        DO III = 1,2
cc            X = (-1)**(III-1)*TRAN(1)+ (-1)**III*TRDB(1)
cc            Y = -TRAN(2)+ TRDB(2)
cc            NAN = NAN + 1
cc            CALL GSPOS('TRAN',NAN,'TRDB',X,Y,Z,0,'ONLY')
cc            Y = TRAN(2) - TRDB(2)
cc            NAN = NAN + 1
cc            CALL GSPOS('TRAN',NAN,'TRDB',X,Y,Z,4,'ONLY')
cc         ENDDO
cc         X = 0.
cc         Y = 0.
cc         Z = Z + TRSO(2)*( 1 + COS(30./180.*ACOS(-1.))) + TRRA(3)
C #          Z= Z + 2*TRSO(2) + TRRA(3)
cc         CALL GSPOS('TRRA',I,'TRDB',X,Y,Z,0,'ONLY')
C #          Z= Z - (2*TRSO(2) + TRRA(3)) + TRBS(3)
cc         Z = Z - ( TRSO(2)*( 1 + COS(30./180.*ACOS(-1.))) + TRRA(3))
cc     +        + TRBS(3)
      ENDDO
      M=4
      DO I=1,5
         Z=Z+TRAN(3)
         ZTRBS=Z
c     positioning TRAN:
c ml:17/11/04:
c         DO III = 1,2
c            X = (-1)**(III-1)*TRAN(1)+ (-1)**III*TRDB(1)
c            Y = -TRAN(2)+ TRDB(2)
c            NAN = NAN + 1
c            CALL GSPOS('TRAN',NAN,'TRDB',X,Y,Z,0,'ONLY')
c            Y = +TRAN(2)- TRDB(2)
c            NAN = NAN + 1
c            CALL GSPOS('TRAN',NAN,'TRDB',X,Y,Z,4,'ONLY')
c         ENDDO
            X = -TRFR(1)+TRAN(1)
            Y = -TRFR(2)+ TRAN(2)
            NAN = NAN + 1
            CALL GSPOS('TRAN',NAN,'TRDB',X,Y,Z,0,'ONLY')
            X = -TRFR(1)+TRAN(1)
            Y = +TRFR(2)- TRAN(2)
            NAN = NAN + 1
            CALL GSPOS('TRAN',NAN,'TRDB',X,Y,Z,6,'ONLY')
            X = TRFR(1)-TRAN(1)
            Y = +TRFR(2)- TRAN(2)
            NAN = NAN + 1
            CALL GSPOS('TRAN',NAN,'TRDB',X,Y,Z,4,'ONLY')
            X = TRFR(1)-TRAN(1)
            Y = -TRFR(2)+ TRAN(2)
            NAN = NAN + 1
            CALL GSPOS('TRAN',NAN,'TRDB',X,Y,Z,1,'ONLY')
            Z=Z+TRAN(3)
c     positioning TRBS (the modules): 
            Y=0.
            DO II=1, M
               NUM = NUM + 1
*     shift of modules to have the right overlap:
               X= (II-1)*2.*TRBS(1) - ( M*TRBS(1) - TRBS(1) ) -
     +              (II-2)*TRSI(2)
*     now there two different volumes interested at same time:
*     CALL GSPOS('TRBS',NUM,'TRDB',X,Y,Z,0,'ONLY')
               CALL GSPOS('TRBS',NUM,'TRDB',X,Y,ZTRBS,0,'MANY')
            ENDDO
c end ml.
c            IF((I+4).LE.8)THEN
c     positioning TRFD:
            X=0.
            ZTRFD=Z-TRFD(3)
            CALL GSPOS('TRFD',I+4,'TRDB',X,Y,ZTRFD,0,'MANY')
C #             print*,'gptrdv: n. of trfd: i+4=',i+4,ztrfd
            IF((I+4).LE.8)THEN
c     positioning TRFR:
               Z= Z + TRFR(3)
               ZRAD=Z
               CALL GSPOS('TRFR',I+4,'TRDB',X,Y,Z,0,'MANY')
C     Z= Z + TRFR(3) + TRBS(3)
               Z=Z+TRFR(3)
c     positioning TRFU:
               ZTRFU= Z + TRFU(3)
               CALL GSPOS('TRFU',I+4,'TRDB',X,Y,ZTRFU,0,'MANY')
            ELSE
               ZRAD=Z-TRFD(3)+TRFM(3)+TRFL(3)
c     positioning TRFD:
c               X=0.
c               ZTRFD=Z-TRFD(3)
c               CALL GSPOS('TRFD',I+4,'TRDB',X,Y,ZTRFD,0,'MANY')
c               print*,'gptrdv: n. of trfd: i+4=',i+4,ztrfd
c     positioning TRFM:
               Z= Z + TRFM(3)
C     ZRAD=Z
               CALL GSPOS('TRFM',I+4,'TRDB',X,Y,Z,0,'MANY')
C     Z= Z + TRFR(3) + TRBS(3)
               Z=Z+TRFM(3)
c     positioning TRFL:
               ZTRFL= Z + TRFL(3)
               CALL GSPOS('TRFL',I+4,'TRDB',X,Y,ZTRFL,0,'MANY')
         ENDIF
         X = 0.
         Y = 0.
cc         Z = Z + TRSO(2)*( 1 + COS(30./180.*ACOS(-1.))) + TRRA(3)
cc         print*,'z del radiatore=',z
C #          print*,'cos(1+....)=',1 + COS(30./180.*ACOS(-1.))
C     #          Z= Z + 2*TRSO(2) + TRRA(3)
c     CALL GSPOS('TRRA',I,'TRDB',X,Y,Z,0,'ONLY')
         IF((I+4).LE.8) THEN
            CALL GSPOS('TRRA',I+4,'TRDB',X,Y,ZRAD,0,'ONLY')
         ELSE
            CALL GSPOS('TRR2',I+4,'TRDB',X,Y,ZRAD,0,'ONLY')
         ENDIF
      ENDDO
      goto 151
      M=4
      DO I=1,5
         X= 0.
         Z= Z + TRFR(3)
         CALL GSPOS('TRFR',(I+4),'TRDB',X,Y,Z,0,'ONLY')
         Z= Z + TRFR(3) + TRBS(3)
         DO II=1, M
            NUM = NUM + 1
*shift of modules to have the right overlap:
            X= (II-1)*2.*TRBS(1) - ( M*TRBS(1) - TRBS(1) )
     +           + (3/2 -(II-1))*TRSI(2)
*now there two different volumes interested at same time:
*            CALL GSPOS('TRBS',NUM,'TRDB',X,Y,Z,0,'ONLY')
            CALL GSPOS('TRBS',NUM,'TRDB',X,Y,Z,0,'MANY')
         ENDDO
         DO III = 1,2
            X = (-1)**(III-1)*TRAN(1)+ (-1)**III*TRDB(1)
            Y = -TRAN(2)+ TRDB(2)
            NAN = NAN + 1
            CALL GSPOS('TRAN',NAN,'TRDB',X,Y,Z,0,'ONLY')
            Y = TRAN(2) - TRDB(2)
            NAN = NAN + 1
            CALL GSPOS('TRAN',NAN,'TRDB',X,Y,Z,4,'ONLY')
         ENDDO
         X= 0.
         Y= 0.
c ml: 12/11/04:
         IF((I+4).LE.8) THEN 
c end ml.
            Z = Z + TRSO(2)*( 1 + COS(30./180.*ACOS(-1.))) + TRRA(3)
            CALL GSPOS('TRRA',(I+4),'TRDB',X,Y,Z,0,'ONLY')
            Z = Z - (TRSO(2)*( 1 + COS(30./180.*ACOS(-1.))) + TRRA(3) )
     +           + TRBS(3)
c ml:
         ELSE
*
* Positioning an extra radiator plane on top
*
            Z = Z + TRSO(2)*( 1 + COS(30./180.*ACOS(-1.))) + TRR2(3)
            NUM=1
            CALL GSPOS('TRR2',NUM,'TRDB',X,Y,Z,0,'ONLY')
            Z = Z + TRBS(3) -( TRSO(2)*( 1 + COS(30./180.*ACOS(-1.)))
     +           + 3*TRR2(3) )
         ENDIF
C     end ml.
         ENDDO
c ml: 12/11/04:
C*
C* Positioning an extra radiator plane on top
C*
C      Z = Z - TRBS(3) + TRSO(2)*( 1 + COS(30./180.*ACOS(-1.)))
C     +     + 3*TRRA(3)
C      CALL GSPOS('TRRA',NUM,'TRDB',X,Y,Z,0,'ONLY')
C      Z = Z + TRBS(3) -( TRSO(2)*( 1 + COS(30./180.*ACOS(-1.)))
C     +     + 3*TRRA(3) )
C end ml.
*
* Positioning the TOP frame
*
      X = 0.
      Y = 0.
      Z = Z + TRFR(3)
      CALL GSPOS('TRFR',10,'TRDB',X,Y,Z,0,'ONLY')
*
* Positioning the angular pieces to hold the TOF. TRAN & TRDT
*
      Z = Z + TRFR(3) + TRAN(3)
      DO I = 1,2
         X = (-1)**(I-1)*TRAN(1)+ (-1)**I*TRDB(1)
         Y = -TRAN(2)+ TRDB(2)
         NAN = NAN + 1
         CALL GSPOS('TRAN',NAN,'TRDB',X,Y,Z,0,'ONLY')
         Y = +TRAN(2)- TRDB(2)
         NAN = NAN + 1
         CALL GSPOS('TRAN',NAN,'TRDB',X,Y,Z,4,'ONLY')
      ENDDO
      Z = Z + TRAN(3) + TRDT(3)
      NDT = 0
      DO I = 1,2
         X = (-1)**(I-1)*(2*TRAN(1)-TRDT(1))+ (-1)**I*TRDB(1)
         Y = -(2*TRAN(2)-TRDT(2)) + TRDB(2)
         NDT = NDT + 1
         CALL GSPOS('TRDT',NDT,'TRDB',X,Y,Z,0,'ONLY')
         Y = +(2*TRAN(2)-TRDT(2)) - TRDB(2)
         NDT = NDT + 1
         CALL GSPOS('TRDT',NDT,'TRDB',X,Y,Z,0,'ONLY')
      ENDDO
 151  continue
      RETURN
      END
