* * $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