gpamela/gpcard/gpcardv.F

      SUBROUTINE GPCARDV
************************************************************************
*                                                                      *
* Volumes definition for the side anticoincidence counters             *
* Called by: GPGEO                                                     *
*                                                                      *
* Authors: Francesco Cafagna, 08/02/96 16.58.49                        *
*          Alessandro Bruno, 20/11/06 20.30.00                         *
*                                                                      *
************************************************************************
#include "gconst.inc"
#include "gpgeo.inc"
#include "gpmed.inc"
#include "gprot.inc"
      INTEGER IROT,IVOLU,N,NMED,NUM,I
      REAL X,Y,Z
      REAL CAR1(11),CR1P(11)
      REAL C1D1(11),C2D1(11)
      REAL CAR2(11),CR2P(11)
      REAL C1N1(11),C1N2(11)
      REAL ANGLCAR1,ANGLCAR2
      REAL H1,H2
      REAL A1,B1,C1,D1,F1,ANG1C
      REAL A2,B2,C2,D2,F2,ANG2C
      REAL AA, BB,ZH
*
* Scint sheets
*      
      H1=CAR(2)+CAR(3)
      H2=CAR(1)-H1
*
* Greater Scintillator CAR1 (type B)
*           
      B1=CARB(2)+CAR(4)+CAR(5)+H1/TAN(CAR(7)*DEGRAD)
      C1=H2/TAN(CAR(7)*DEGRAD)
      A1=CARB(1)-C1
      D1=CARB(1)-CARB(2)-CAR(4)-CAR(5)
      F1=C1+H1/TAN(CAR(7)*DEGRAD)
      ANG1C=ATAN((B1/2.+D1-A1/2.)/CAR(1))
      
      C1D1(1) = CAR(1)/2.
      C1D1(2) = -ANG1C*RADDEG
      C1D1(3) = 0.
      C1D1(4) = CAR(6)
      C1D1(5) = A1/2.
      C1D1(6) = A1/2.
      C1D1(7) = 0.
      C1D1(8) = CAR(6)
      C1D1(9) = B1/2.
      C1D1(10) = B1/2.
      C1D1(11) = 0.
      
*      
* Smaller Scintillator CAR2 (type A)
*           
      B2=CARA(2)+CAR(4)+CAR(5)+H1/TAN(CAR(7)*DEGRAD)
      C2=H2/TAN(CAR(7)*DEGRAD)
      A2=CARA(1)-C2
      D2=CARA(1)-CARA(2)-CAR(4)-CAR(5)
      F2=C2+H1/TAN(CAR(7)*DEGRAD)
      ANG2C=ATAN((B2/2.+D2-A2/2.)/CAR(1))

      C2D1(1) = CAR(1)/2.
      C2D1(2) = -ANG2C*RADDEG
      C2D1(3) = 0.
      C2D1(4) = CAR(6)
      C2D1(5) = A2/2.
      C2D1(6) = A2/2.
      C2D1(7) = 0.
      C2D1(8) = CAR(6)
      C2D1(9) = B2/2.
      C2D1(10) = B2/2.
      C2D1(11) = 0.
*
* CAR1 Al box sheet
*
      NMED=MAL
      
      CAR1(1) = C1D1(1)+ATZ
      CAR1(2) = C1D1(2)
      CAR1(3) = 0.
      CAR1(4) = C1D1(4)+ATY
      CAR1(5) = C1D1(5)+ATZ*(1./COS(ATAN(D1/CAR(1)))+
     +                       1./SIN(DEGRAD*CAR(7)))/2.
      CAR1(6) = CAR1(5)
      CAR1(7) = 0.
      CAR1(8) = C1D1(8)+ATY
      CAR1(9) = C1D1(9)+ATZ*(1./COS(ATAN(D1/CAR(1)))+
     +                       1./SIN(DEGRAD*CAR(7)))/2.
      CAR1(10) = CAR1(9)
      CAR1(11) = 0.

      CALL GSVOLU('CAR1','TRAP',NMED,CAR1,11,IVOLU)
*
* CR1P PLASTIC BOX TO CREATE RIM 
*
      NMED=MPLAS
      
      CR1P(1) = C1D1(1)+PT
      CR1P(2) = C1D1(2)
      CR1P(3) = 0.
      CR1P(4) = C1D1(4)
      CR1P(5) = C1D1(5)+PT*(1./COS(ATAN(D1/CAR(1)))+
     +                       1./SIN(DEGRAD*CAR(7)))/2.
      CR1P(6) = CR1P(5)
      CR1P(7) = 0.
      CR1P(8) = C1D1(8)
      CR1P(9) = C1D1(9)+PT*(1./COS(ATAN(D1/CAR(1)))+
     +                       1./SIN(DEGRAD*CAR(7)))/2.
      CR1P(10) = CR1P(9)
      CR1P(11) = 0.
      
      CALL GSVOLU('CR1P','TRAP',NMED,CR1P,11,IVOLU)
*
      NMED=MSCIN
*
      CALL GSVOLU('C1D1','TRAP',NMED,C1D1,11,IVOLU)
*
* Empty volume to be subtracted from C1D1 and C2D1 sheets
*
      NMED=MN2
      
      AA=(ATZ/SIN(DEGRAD*CAR(7)))/(1./TAN(CAR(7)*DEGRAD)+CAR(4)/CAR(2))
      AA=CAR(2)+CAR(3)+ATZ+AA
      BB=AA/TAN(CAR(7)*DEGRAD)+AA*CAR(4)/CAR(2)
            
      C1N1(1) = 0.5*AA
      C1N1(2) = RADDEG*ATAN((BB/2.-AA/TAN(CAR(7)*DEGRAD))/AA)
      C1N1(3) = 0.
      C1N1(4) = CAR1(4)
      C1N1(5) = 0.
      C1N1(6) = C1N1(5)
      C1N1(7) = 0.
      C1N1(8) = CAR1(8)
      C1N1(9) = 0.5*BB
      C1N1(10) = C1N1(9)
      C1N1(11) = 0.
      
      CALL GSVOLU('C1N1','TRAP',NMED,C1N1,11,IVOLU)

      AA=CAR(3) + ATZ
      BB=(ATZ+CAR(3))*(CAR(5)/CAR(3)-CAR(4)/CAR(2))
 
      C1N2(1) = 0.5*AA
      C1N2(2) = RADDEG*ATAN((BB/2.+(CAR(3)+ATZ)*CAR(4)/CAR(2))/AA)
      C1N2(3) = 0.
      C1N2(4) = CAR1(4)
      C1N2(5) = 0.
      C1N2(6) = C1N2(5)
      C1N2(7) = 0.
      C1N2(8) = CAR1(8)
      C1N2(9) = 0.5*BB
      C1N2(10) = C1N2(9)
      C1N2(11) = 0.
      
      CALL GSVOLU('C1N2','TRAP',NMED,C1N2,11,IVOLU)
*
* CAR2 Al box sheet
*
      NMED=MAL
      
      CAR2(1) = C2D1(1)+ATZ
      CAR2(2) = C2D1(2)
      CAR2(3) = 0.
      CAR2(4) = C2D1(4)+ATY
      CAR2(5) = C2D1(5)+ATZ*(1./COS(ATAN(D2/CAR(1)))+
     +                       1./SIN(DEGRAD*CAR(7)))/2.
      CAR2(6) = CAR2(5)
      CAR2(7) = 0.
      CAR2(8) = C2D1(8)+ATY
      CAR2(9) = C2D1(9)+ATZ*(1./COS(ATAN(D2/CAR(1)))+
     +                       1./SIN(DEGRAD*CAR(7)))/2.
      CAR2(10) = CAR2(9)
      CAR2(11) = 0.
            
      CALL GSVOLU('CAR2','TRAP',NMED,CAR2,11,IVOLU)
*
* CR1P PLASTIC BOX TO CREATE RIM 
*
      NMED=MPLAS

      CR2P(1) = C2D1(1)+PT
      CR2P(2) = C2D1(2)
      CR2P(3) = 0.
      CR2P(4) = C2D1(4)
      CR2P(5) = C2D1(5)+PT*(1./COS(ATAN(D2/CAR(1)))+
     +                       1./SIN(DEGRAD*CAR(7)))/2.
      CR2P(6) = CR2P(5)
      CR2P(7) = 0.
      CR2P(8) = C2D1(8)
      CR2P(9) = C2D1(9)+PT*(1./COS(ATAN(D2/CAR(1)))+
     +                       1./SIN(DEGRAD*CAR(7)))/2.
      CR2P(10) = CR2P(9)
      CR2P(11) = 0.
      
      CALL GSVOLU('CR2P','TRAP',NMED,CR2P,11,IVOLU)
*
      NMED=MSCIN
*     
      CALL GSVOLU('C2D1','TRAP',NMED,C2D1,11,IVOLU)
*
*
* The zenihtal angle of the paddles
*
      ANGLCAR2=CARA(3)*DEGRAD   !CAR2 inclination
      ANGLCAR1=CARB(3)*DEGRAD   !CAR1 inclination

      NMED=MN2
      CALL GSVOLU('CARD','BOX ',NMED,CARDB, 3,IVOLU)
*
*  Define ANGLCAR rotation around Z axis
*
*    CAR1A
      IRZCAR1B=11
      CALL GSROTM(IRZCAR1B,90.,0.,(90.-ANGLCAR1*RADDEG),
     +     90.,(180.-ANGLCAR1*RADDEG),90.)
*    CAR1B
      IRZCAR1A=12
      CALL GSROTM(IRZCAR1A,90.,180.,(270.-ANGLCAR1*RADDEG),
     +     270.,(180.-ANGLCAR1*RADDEG),270.)
*    CAR2A
      IRZCAR2B=13
      CALL GSROTM(IRZCAR2B,90.,270.,(90.-ANGLCAR2*RADDEG),
     +     0.,(180.-ANGLCAR2*RADDEG),0.)
*    CAR2B
      IRZCAR2A=14
      CALL GSROTM(IRZCAR2A,90.,90.,(90.-ANGLCAR2*RADDEG),
     +     180.,(180.-ANGLCAR2*RADDEG),180.)

*
* Positioning in CAR1
*
      N=1
      X=(ATZ-PT)*(1./COS(ATAN(D1/CAR(1)))-
     +                       1./SIN(DEGRAD*CAR(7)))/2.
      Y=0
      Z=0
      CALL GSPOS('CR1P',N,'CAR1',X,Y,Z,0,'MANY')
      N=1
      Y=0
      Z=CAR1(1)-C1N1(1)
      X=CAR1(9)+CAR1(1)*TAN(ANG1C)-
     +     (C1N1(9)-C1N1(1)*TAN(C1N1(2)*DEGRAD))
      X=-X !ALEX MOD 
      CALL GSPOS('C1N1',N,'CAR1',X,Y,Z,0,'ONLY')
      N=1
      Y=0
      Z=CAR1(1)-C1N2(1)
      X=CAR1(9)+CAR1(1)*TAN(ANG1C)-
     +     (2.*C1N1(9)+C1N2(9)-C1N2(1)*TAN(C1N2(2)*DEGRAD))
      X=-X !ALEX MOD 
      CALL GSPOS('C1N2',N,'CAR1',X,Y,Z,0,'ONLY')
      N=1
      X=PT*(1./COS(ATAN(D1/CAR(1)))-1./SIN(DEGRAD*CAR(7)))/2.
      Y=0
      Z=0
      CALL GSPOS('C1D1',N,'CR1P',X,Y,Z,0,'ONLY')
*
* Positioning in CAR2
*
      N=1
      X=(ATZ-PT)*(1./COS(ATAN(D2/CAR(1)))-
     +                       1./SIN(DEGRAD*CAR(7)))/2.
      Y=0
      Z=0
      CALL GSPOS('CR2P',N,'CAR2',X,Y,Z,0,'MANY')
      N=2
      Y=0
      Z=CAR2(1)-C1N1(1)
      X=CAR2(9)+CAR2(1)*TAN(ANG2C)-
     +     (C1N1(9)-C1N1(1)*TAN(C1N1(2)*DEGRAD))
      X=-X !ALEX MOD 
      CALL GSPOS('C1N1',N,'CAR2',X,Y,Z,0,'ONLY')
      Y=0
      Z=CAR2(1)-C1N2(1)
      X=CAR2(9)+CAR2(1)*TAN(ANG2C)-
     +     (2.*C1N1(9)+C1N2(9)-C1N2(1)*TAN(C1N2(2)*DEGRAD))
      X=-X !ALEX MOD 
      CALL GSPOS('C1N2',N,'CAR2',X,Y,Z,0,'ONLY')
      N=1
      X=PT*(1./COS(ATAN(D2/CAR(1)))-1./SIN(DEGRAD*CAR(7)))/2.
      Y=0
      Z=0
      CALL GSPOS('C2D1',N,'CR2P',X,Y,Z,0,'ONLY')
*
* Positioning in card
*
*
*           CAR1A
* CAR2B                CAR2A
*           CAR1B
*
      ZH=49.229-ZTPLA-TPLA(3)
*--- CAR1B      
      N=1
      Y=-CARB(5)+CAR(8)/2.*SIN(ANGLCAR1)
      Z=CARB(6)+ZH-CARDB(3)-CAR(8)*COS(ANGLCAR1)/2.
      X=((CARB(7)/2.)-TAN(ANG1C)*CAR(8)/2.)-CARB(4)
      CALL GSPOS('CAR1',N,'CARD',X,Y,Z,IRZCAR1B,'ONLY')
*--- CAR1A      
      N=2
      X=-X
      Y=-Y
      CALL GSPOS('CAR1',N,'CARD',X,Y,Z,IRZCAR1A,'ONLY')
*--- CAR2A
      N=1
      X=CARA(4)-CAR(8)/2.*SIN(ANGLCAR2)
      Z=CARA(6)+ZH-CARDB(3)-CAR(8)*COS(ANGLCAR2)/2.
      Y=(CARA(7)/2.-TAN(ANG2C)*CAR(8)/2.)-CARA(5)
      CALL GSPOS('CAR2',N,'CARD',X,Y,Z,IRZCAR2A,'ONLY')
*--- CAR2B      
      N=2
      X=-X
      Y=-Y
      CALL GSPOS('CAR2',N,'CARD',X,Y,Z,IRZCAR2B ,'ONLY')
c---------------------------------------------------------------
*
*     LEGS
*
      NMED=MAL
      CALL GSVOLU('LEGB','BOX ',NMED,LEGB, 3,IVOLU)
*
*     empty volumes to be subtracted from LEGB      
      NMED=MN2
*
      CALL GSVOLU('LEG1','TRAP',NMED,LEG1, 11,IVOLU)            
      X=-LEGB(1)+LEG1(1)
      Y=-LEGB(2)+LEG1(4)
      Z=0.
      CALL GSPOS('LEG1',1,'LEGB',X,Y,Z,RY90,'ONLY')      
      Y=-LEGB(2)+2.*1.95-LEG1(4)
      CALL GSPOS('LEG1',2,'LEGB',X,Y,Z,RY90,'ONLY')       
*      
      CALL GSVOLU('LEG2','BOX ',NMED,LEG2, 3,IVOLU)      
      X=-LEGB(1)+LEG2(1)
      Y=-LEGB(2)+1.95
      Z=0.
      CALL GSPOS('LEG2',1,'LEGB',X,Y,Z,0,'ONLY')
*
      CALL GSVOLU('LEG3','BOX ',NMED,LEG3, 3,IVOLU)      
      X=-LEGB(1)+0.65*2.+LEG3(1)+2./10
      Y=LEGB(2)-LEG3(2)
      Z=LEGB(3)-LEG3(3)
      CALL GSPOS('LEG3',1,'LEGB',X,Y,Z,0,'ONLY')
      Z=-LEGB(3)+LEG3(3)
      CALL GSPOS('LEG3',2,'LEGB',X,Y,Z,0,'ONLY')      
*
      CALL GSVOLU('LEG4','BOX ',NMED,LEG4, 3,IVOLU)      
      X=-LEGB(1)+LEG4(1)
      Y=LEGB(2)-LEG4(2)
      Z=0.
      CALL GSPOS('LEG4',1,'LEGB',X,Y,Z,0,'ONLY')
*      
      CALL GSVOLU('LEG5','BOX ',NMED,LEG5, 3,IVOLU)      
      X=LEGB(1)-LEG5(1)
      Y=LEGB(2)-LEG5(2)
      Z=0.
      CALL GSPOS('LEG5',1,'LEGB',X,Y,Z,0,'ONLY')
*
      CALL GSVOLU('LEG6','BOX ',NMED,LEG6, 3,IVOLU)      
      X=-LEGB(1)+0.65*2.+LEG3(1)
      Y=LEGB(2)-LEG6(2)
      Z=0.
      CALL GSPOS('LEG6',1,'LEGB',X,Y,Z,0,'ONLY')      
*
      CALL GSVOLU('LEG7','BOX ',NMED,LEG7, 3,IVOLU)      
      X=LEGB(1)-1.125-0.375
      Y=-LEGB(2)+LEG7(2)
      Z=11.85-.6-LEG7(3)
      CALL GSPOS('LEG7',1,'LEGB',X,Y,Z,0,'ONLY')      
*
      CALL GSVOLU('LEG8','BOX ',NMED,LEG8, 3,IVOLU)      
      Z=0.
      CALL GSPOS('LEG8',1,'LEGB',X,Y,Z,0,'ONLY')      
*
      CALL GSVOLU('LEG9','BOX ',NMED,LEG9, 3,IVOLU)      
      Z=-(11.85-.6-LEG7(3))
      CALL GSPOS('LEG9',1,'LEGB',X,Y,Z,0,'ONLY')      
*
*     Positioning LEG BOXES in CARD
*
      N=1
      X=-CARDB(1)+LEGB(1)+3.8
      Y=-CARDB(2)+LEGB(2)+0.7
      Z=-0.5
      CALL GSPOS('LEGB',N,'CARD',X,Y,Z,0,'MANY')
      N=2
      X=X
      Y=-Y
      CALL GSPOS('LEGB',N,'CARD',X,Y,Z,RX180,'MANY')
      N=3
      X=-X
      Y=Y
      CALL GSROTM(RZALEX180,90.,180.,90.,
     +     270.,180.,0.)
      CALL GSPOS('LEGB',N,'CARD',X,Y,Z,RZ180,'MANY')
      N=4
      X=X
      Y=-Y
      CALL GSPOS('LEGB',N,'CARD',X,Y,Z,RY180,'MANY')
*
c---------------------------------------------------------------
*
*     CARD TOP PLATE
*
*     TPLT
*
      NMED=MAL
      CALL GSVOLU('TPLT','BOX ',NMED,TPLT, 3,IVOLU)
*
* Empty volumes to be subtracted from TPLT
*
      NMED=MN2
      CALL GSVOLU('TOPC','BOX ',NMED,TOPC, 3,IVOLU)
*
      CALL GSVOLU('TH11','BOX ',NMED,TH11, 3,IVOLU)
      CALL GSVOLU('TH12','BOX ',NMED,TH12, 3,IVOLU)
      CALL GSVOLU('TH21','BOX ',NMED,TH21, 3,IVOLU)      
      CALL GSVOLU('TH22','BOX ',NMED,TH22, 3,IVOLU)                      
*
*     XY plane
      CALL GSVOLU('TOPT','TRAP',NMED,TOPT,11,IVOLU)
*
      CALL GSVOLU('TOHO','TUBE',NMED,TOHO,3,IVOLU)

*
*     Positioning empty volumes...
*
*     Positioning TOPC in TPLT
*
      N=1
      X=0.
      Y=0.
      Z=0.     
      CALL GSPOS('TOPC',N,'TPLT',X,Y,Z,0,'ONLY')      
*
*
*     Positioning H11 in TPLT
*
      N=1
      X=-23.6
      Y=14.4
      Z=0.
      CALL GSPOS('TH11',N,'TPLT',X,Y,Z,0,'ONLY')                
      N=2
      X=-23.6
      Y=-14.4
      CALL GSPOS('TH11',N,'TPLT',X,Y,Z,0,'ONLY')                
      N=3
      X=23.6
      Y=14.4
      CALL GSPOS('TH11',N,'TPLT',X,Y,Z,0,'ONLY')                
      N=4
      X=23.6
      Y=-14.4
      CALL GSPOS('TH11',N,'TPLT',X,Y,Z,0,'ONLY')                
*
*     Positioning H12 in TPLT
*
      N=1
      X=-23.6
      Y=5.5
      Z=0.
      CALL GSPOS('TH12',N,'TPLT',X,Y,Z,0,'ONLY')                
      N=2
      X=-23.6
      Y=-5.5
      CALL GSPOS('TH12',N,'TPLT',X,Y,Z,0,'ONLY')                
      N=3
      X=23.6
      Y=5.5
      CALL GSPOS('TH12',N,'TPLT',X,Y,Z,0,'ONLY')                
      N=4
      X=23.6
      Y=-5.5
      CALL GSPOS('TH12',N,'TPLT',X,Y,Z,0,'ONLY')                
*
*     Positioning H21 in TPLT
*
      N=1
      X=-17.2
      Y=19.4
      Z=0.
      CALL GSPOS('TH21',N,'TPLT',X,Y,Z,0,'ONLY')                
      N=2
      X=-17.2
      Y=-19.4
      CALL GSPOS('TH21',N,'TPLT',X,Y,Z,0,'ONLY')                
      N=3
      X=17.2
      Y=19.4
      CALL GSPOS('TH21',N,'TPLT',X,Y,Z,0,'ONLY')                
      N=4
      X=17.2
      Y=-19.4
      CALL GSPOS('TH21',N,'TPLT',X,Y,Z,0,'ONLY')                
*
*     Positioning H22 in TPLT
*
      N=1
      X=-10.2
      Y=19.4
      Z=0.
      CALL GSPOS('TH22',N,'TPLT',X,Y,Z,0,'ONLY')                
      N=2
      X=-10.2
      Y=-19.4
      CALL GSPOS('TH22',N,'TPLT',X,Y,Z,0,'ONLY')                
      N=3
      X=10.2
      Y=19.4
      CALL GSPOS('TH22',N,'TPLT',X,Y,Z,0,'ONLY')                
      N=4
      X=10.2
      Y=-19.4
      CALL GSPOS('TH22',N,'TPLT',X,Y,Z,0,'ONLY')                
      N=5
      X=0.
      Y=19.4
      CALL GSPOS('TH22',N,'TPLT',X,Y,Z,0,'ONLY')                
      N=6
      X=0.
      Y=-19.4
      CALL GSPOS('TH22',N,'TPLT',X,Y,Z,0,'ONLY')                
*
*     Positioning TOPT in TPLT
*
      N=1
      X=-CARDB(1)+4.5/4.
      Y=-CARDB(2)+4.5/2.
      Z=0.
      CALL GSPOS('TOPT',N,'TPLT',X,Y,Z,0,'ONLY')
      N=2
      X=X
      Y=-Y
      CALL GSPOS('TOPT',N,'TPLT',X,Y,Z,RX180,'ONLY')
      N=3
      X=-X
      Y=Y
      CALL GSPOS('TOPT',N,'TPLT',X,Y,Z,RZ180,'ONLY')
      N=4
      X=X
      Y=-Y
      CALL GSPOS('TOPT',N,'TPLT',X,Y,Z,RY180,'ONLY')
*
*     Positioning TOHO in TPLT
*
      N=1
      X=TPLT(1)-6.2-TOHO(1)
      Y=TPLT(2)-4.1-TOHO(2)
      CALL GSPOS('TOHO',N,'TPLT',X,Y,Z,0,'ONLY')
      N=2
      X=-X
      Y=Y
      CALL GSPOS('TOHO',N,'TPLT',X,Y,Z,0,'ONLY')
      N=3
      X=X
      Y=-Y
      CALL GSPOS('TOHO',N,'TPLT',X,Y,Z,0,'ONLY')
      N=4
      X=-X
      Y=Y
      CALL GSPOS('TOHO',N,'TPLT',X,Y,Z,0,'ONLY')
*
*     Positioning TPLT in CARD volume
* 
      N=1
      X=0.
      Y=0.
      Z=CARDB(3)-TPLT(3)
      CALL GSPOS('TPLT',N,'CARD',X,Y,Z,0,'ONLY')    
C---------------------------------------------------------------      
*
*     MAGNETIC SCREEN
*
      NMED=10
      CALL GSVOLU('MGSC','BOX ',NMED,MGSC, 3,IVOLU)      
* Empty volume to be subtracted from MGSC
      NMED=MN2
      CALL GSVOLU('MGSH','BOX ',NMED,MGSH, 3,IVOLU)      

*
*     Positioning in CARD...
*     
      N=1
      X=0.
      Y=0.
      Z=0.
      CALL GSPOS('MGSH',N,'MGSC',X,Y,Z,0,'ONLY')
      Z=-CARDB(3)+MGSC(3)
      CALL GSPOS('MGSC',N,'CARD',X,Y,Z,0,'ONLY') 
c---------------------------------------------------------------      
      RETURN
      END
1	cafagna	1.1	SUBROUTINE GPCARDV
2			************************************************************************
3			* *
4			* Volumes definition for the side anticoincidence counters *
5			* Called by: GPGEO *
6			* *
7	cafagna	1.2	* Authors: Francesco Cafagna, 08/02/96 16.58.49 *
8			* Alessandro Bruno, 20/11/06 20.30.00 *
9	cafagna	1.1	* *
10			************************************************************************
11			#include "gconst.inc"
12			#include "gpgeo.inc"
13			#include "gpmed.inc"
14			#include "gprot.inc"
15	cafagna	1.2	INTEGER IROT,IVOLU,N,NMED,NUM,I
16	cafagna	1.1	REAL X,Y,Z
17			REAL CAR1(11),CR1P(11)
18	cafagna	1.2	REAL C1D1(11),C2D1(11)
19	cafagna	1.1	REAL CAR2(11),CR2P(11)
20	cafagna	1.2	REAL C1N1(11),C1N2(11)
21			REAL ANGLCAR1,ANGLCAR2
22			REAL H1,H2
23			REAL A1,B1,C1,D1,F1,ANG1C
24			REAL A2,B2,C2,D2,F2,ANG2C
25			REAL AA, BB,ZH
26			*
27			* Scint sheets
28			*
29			H1=CAR(2)+CAR(3)
30			H2=CAR(1)-H1
31			*
32			* Greater Scintillator CAR1 (type B)
33			*
34			B1=CARB(2)+CAR(4)+CAR(5)+H1/TAN(CAR(7)*DEGRAD)
35			C1=H2/TAN(CAR(7)*DEGRAD)
36			A1=CARB(1)-C1
37			D1=CARB(1)-CARB(2)-CAR(4)-CAR(5)
38			F1=C1+H1/TAN(CAR(7)*DEGRAD)
39			ANG1C=ATAN((B1/2.+D1-A1/2.)/CAR(1))
40
41			C1D1(1) = CAR(1)/2.
42			C1D1(2) = -ANG1C*RADDEG
43			C1D1(3) = 0.
44			C1D1(4) = CAR(6)
45			C1D1(5) = A1/2.
46			C1D1(6) = A1/2.
47			C1D1(7) = 0.
48			C1D1(8) = CAR(6)
49			C1D1(9) = B1/2.
50			C1D1(10) = B1/2.
51			C1D1(11) = 0.
52
53			*
54			* Smaller Scintillator CAR2 (type A)
55			*
56			B2=CARA(2)+CAR(4)+CAR(5)+H1/TAN(CAR(7)*DEGRAD)
57			C2=H2/TAN(CAR(7)*DEGRAD)
58			A2=CARA(1)-C2
59			D2=CARA(1)-CARA(2)-CAR(4)-CAR(5)
60			F2=C2+H1/TAN(CAR(7)*DEGRAD)
61			ANG2C=ATAN((B2/2.+D2-A2/2.)/CAR(1))
62
63			C2D1(1) = CAR(1)/2.
64			C2D1(2) = -ANG2C*RADDEG
65			C2D1(3) = 0.
66			C2D1(4) = CAR(6)
67			C2D1(5) = A2/2.
68			C2D1(6) = A2/2.
69			C2D1(7) = 0.
70			C2D1(8) = CAR(6)
71			C2D1(9) = B2/2.
72			C2D1(10) = B2/2.
73			C2D1(11) = 0.
74	cafagna	1.1	*
75			* CAR1 Al box sheet
76			*
77			NMED=MAL
78	cafagna	1.2
79			CAR1(1) = C1D1(1)+ATZ
80			CAR1(2) = C1D1(2)
81	cafagna	1.1	CAR1(3) = 0.
82	cafagna	1.2	CAR1(4) = C1D1(4)+ATY
83			CAR1(5) = C1D1(5)+ATZ*(1./COS(ATAN(D1/CAR(1)))+
84			+ 1./SIN(DEGRAD*CAR(7)))/2.
85	cafagna	1.1	CAR1(6) = CAR1(5)
86			CAR1(7) = 0.
87	cafagna	1.2	CAR1(8) = C1D1(8)+ATY
88			CAR1(9) = C1D1(9)+ATZ*(1./COS(ATAN(D1/CAR(1)))+
89			+ 1./SIN(DEGRAD*CAR(7)))/2.
90	cafagna	1.1	CAR1(10) = CAR1(9)
91			CAR1(11) = 0.
92	cafagna	1.2
93	cafagna	1.1	CALL GSVOLU('CAR1','TRAP',NMED,CAR1,11,IVOLU)
94			*
95			* CR1P PLASTIC BOX TO CREATE RIM
96			*
97			NMED=MPLAS
98	cafagna	1.2
99			CR1P(1) = C1D1(1)+PT
100			CR1P(2) = C1D1(2)
101	cafagna	1.1	CR1P(3) = 0.
102	cafagna	1.2	CR1P(4) = C1D1(4)
103			CR1P(5) = C1D1(5)+PT*(1./COS(ATAN(D1/CAR(1)))+
104			+ 1./SIN(DEGRAD*CAR(7)))/2.
105	cafagna	1.1	CR1P(6) = CR1P(5)
106			CR1P(7) = 0.
107	cafagna	1.2	CR1P(8) = C1D1(8)
108			CR1P(9) = C1D1(9)+PT*(1./COS(ATAN(D1/CAR(1)))+
109			+ 1./SIN(DEGRAD*CAR(7)))/2.
110	cafagna	1.1	CR1P(10) = CR1P(9)
111			CR1P(11) = 0.
112	cafagna	1.2
113	cafagna	1.1	CALL GSVOLU('CR1P','TRAP',NMED,CR1P,11,IVOLU)
114			*
115	cafagna	1.2	NMED=MSCIN
116	cafagna	1.1	*
117			CALL GSVOLU('C1D1','TRAP',NMED,C1D1,11,IVOLU)
118			*
119	cafagna	1.2	* Empty volume to be subtracted from C1D1 and C2D1 sheets
120	cafagna	1.1	*
121			NMED=MN2
122	cafagna	1.2
123			AA=(ATZ/SIN(DEGRADCAR(7)))/(1./TAN(CAR(7)DEGRAD)+CAR(4)/CAR(2))
124			AA=CAR(2)+CAR(3)+ATZ+AA
125			BB=AA/TAN(CAR(7)DEGRAD)+AACAR(4)/CAR(2)
126
127			C1N1(1) = 0.5*AA
128			C1N1(2) = RADDEGATAN((BB/2.-AA/TAN(CAR(7)DEGRAD))/AA)
129	cafagna	1.1	C1N1(3) = 0.
130	cafagna	1.2	C1N1(4) = CAR1(4)
131	cafagna	1.1	C1N1(5) = 0.
132			C1N1(6) = C1N1(5)
133			C1N1(7) = 0.
134	cafagna	1.2	C1N1(8) = CAR1(8)
135			C1N1(9) = 0.5*BB
136	cafagna	1.1	C1N1(10) = C1N1(9)
137			C1N1(11) = 0.
138	cafagna	1.2
139	cafagna	1.1	CALL GSVOLU('C1N1','TRAP',NMED,C1N1,11,IVOLU)
140
141	cafagna	1.2	AA=CAR(3) + ATZ
142			BB=(ATZ+CAR(3))*(CAR(5)/CAR(3)-CAR(4)/CAR(2))
143
144			C1N2(1) = 0.5*AA
145			C1N2(2) = RADDEGATAN((BB/2.+(CAR(3)+ATZ)CAR(4)/CAR(2))/AA)
146	cafagna	1.1	C1N2(3) = 0.
147	cafagna	1.2	C1N2(4) = CAR1(4)
148	cafagna	1.1	C1N2(5) = 0.
149			C1N2(6) = C1N2(5)
150			C1N2(7) = 0.
151	cafagna	1.2	C1N2(8) = CAR1(8)
152			C1N2(9) = 0.5*BB
153	cafagna	1.1	C1N2(10) = C1N2(9)
154			C1N2(11) = 0.
155	cafagna	1.2
156	cafagna	1.1	CALL GSVOLU('C1N2','TRAP',NMED,C1N2,11,IVOLU)
157			*
158			* CAR2 Al box sheet
159			*
160			NMED=MAL
161	cafagna	1.2
162			CAR2(1) = C2D1(1)+ATZ
163			CAR2(2) = C2D1(2)
164	cafagna	1.1	CAR2(3) = 0.
165	cafagna	1.2	CAR2(4) = C2D1(4)+ATY
166			CAR2(5) = C2D1(5)+ATZ*(1./COS(ATAN(D2/CAR(1)))+
167			+ 1./SIN(DEGRAD*CAR(7)))/2.
168	cafagna	1.1	CAR2(6) = CAR2(5)
169			CAR2(7) = 0.
170	cafagna	1.2	CAR2(8) = C2D1(8)+ATY
171			CAR2(9) = C2D1(9)+ATZ*(1./COS(ATAN(D2/CAR(1)))+
172			+ 1./SIN(DEGRAD*CAR(7)))/2.
173	cafagna	1.1	CAR2(10) = CAR2(9)
174			CAR2(11) = 0.
175	cafagna	1.2
176	cafagna	1.1	CALL GSVOLU('CAR2','TRAP',NMED,CAR2,11,IVOLU)
177			*
178			* CR1P PLASTIC BOX TO CREATE RIM
179			*
180			NMED=MPLAS
181	cafagna	1.2
182			CR2P(1) = C2D1(1)+PT
183			CR2P(2) = C2D1(2)
184	cafagna	1.1	CR2P(3) = 0.
185	cafagna	1.2	CR2P(4) = C2D1(4)
186			CR2P(5) = C2D1(5)+PT*(1./COS(ATAN(D2/CAR(1)))+
187			+ 1./SIN(DEGRAD*CAR(7)))/2.
188	cafagna	1.1	CR2P(6) = CR2P(5)
189			CR2P(7) = 0.
190	cafagna	1.2	CR2P(8) = C2D1(8)
191			CR2P(9) = C2D1(9)+PT*(1./COS(ATAN(D2/CAR(1)))+
192			+ 1./SIN(DEGRAD*CAR(7)))/2.
193	cafagna	1.1	CR2P(10) = CR2P(9)
194			CR2P(11) = 0.
195	cafagna	1.2
196	cafagna	1.1	CALL GSVOLU('CR2P','TRAP',NMED,CR2P,11,IVOLU)
197			*
198			NMED=MSCIN
199	cafagna	1.2	*
200	cafagna	1.1	CALL GSVOLU('C2D1','TRAP',NMED,C2D1,11,IVOLU)
201			*
202			*
203	cafagna	1.2	* The zenihtal angle of the paddles
204			*
205			ANGLCAR2=CARA(3)*DEGRAD !CAR2 inclination
206			ANGLCAR1=CARB(3)*DEGRAD !CAR1 inclination
207	cafagna	1.1
208			NMED=MN2
209			CALL GSVOLU('CARD','BOX ',NMED,CARDB, 3,IVOLU)
210			*
211			* Define ANGLCAR rotation around Z axis
212			*
213	cafagna	1.2	* CAR1A
214			IRZCAR1B=11
215			CALL GSROTM(IRZCAR1B,90.,0.,(90.-ANGLCAR1*RADDEG),
216			+ 90.,(180.-ANGLCAR1*RADDEG),90.)
217			* CAR1B
218			IRZCAR1A=12
219			CALL GSROTM(IRZCAR1A,90.,180.,(270.-ANGLCAR1*RADDEG),
220			+ 270.,(180.-ANGLCAR1*RADDEG),270.)
221			* CAR2A
222			IRZCAR2B=13
223			CALL GSROTM(IRZCAR2B,90.,270.,(90.-ANGLCAR2*RADDEG),
224			+ 0.,(180.-ANGLCAR2*RADDEG),0.)
225			* CAR2B
226			IRZCAR2A=14
227			CALL GSROTM(IRZCAR2A,90.,90.,(90.-ANGLCAR2*RADDEG),
228			+ 180.,(180.-ANGLCAR2*RADDEG),180.)
229
230	cafagna	1.1	*
231			* Positioning in CAR1
232			*
233			N=1
234	cafagna	1.2	X=(ATZ-PT)*(1./COS(ATAN(D1/CAR(1)))-
235			+ 1./SIN(DEGRAD*CAR(7)))/2.
236	cafagna	1.1	Y=0
237			Z=0
238			CALL GSPOS('CR1P',N,'CAR1',X,Y,Z,0,'MANY')
239			N=1
240			Y=0
241			Z=CAR1(1)-C1N1(1)
242	cafagna	1.2	X=CAR1(9)+CAR1(1)*TAN(ANG1C)-
243			+ (C1N1(9)-C1N1(1)TAN(C1N1(2)DEGRAD))
244			X=-X !ALEX MOD
245	cafagna	1.1	CALL GSPOS('C1N1',N,'CAR1',X,Y,Z,0,'ONLY')
246			N=1
247			Y=0
248			Z=CAR1(1)-C1N2(1)
249	cafagna	1.2	X=CAR1(9)+CAR1(1)*TAN(ANG1C)-
250			+ (2.C1N1(9)+C1N2(9)-C1N2(1)TAN(C1N2(2)*DEGRAD))
251			X=-X !ALEX MOD
252	cafagna	1.1	CALL GSPOS('C1N2',N,'CAR1',X,Y,Z,0,'ONLY')
253			N=1
254	cafagna	1.2	X=PT(1./COS(ATAN(D1/CAR(1)))-1./SIN(DEGRADCAR(7)))/2.
255	cafagna	1.1	Y=0
256			Z=0
257			CALL GSPOS('C1D1',N,'CR1P',X,Y,Z,0,'ONLY')
258			*
259			* Positioning in CAR2
260			*
261			N=1
262	cafagna	1.2	X=(ATZ-PT)*(1./COS(ATAN(D2/CAR(1)))-
263			+ 1./SIN(DEGRAD*CAR(7)))/2.
264	cafagna	1.1	Y=0
265			Z=0
266			CALL GSPOS('CR2P',N,'CAR2',X,Y,Z,0,'MANY')
267	cafagna	1.2	N=2
268	cafagna	1.1	Y=0
269	cafagna	1.2	Z=CAR2(1)-C1N1(1)
270			X=CAR2(9)+CAR2(1)*TAN(ANG2C)-
271			+ (C1N1(9)-C1N1(1)TAN(C1N1(2)DEGRAD))
272			X=-X !ALEX MOD
273			CALL GSPOS('C1N1',N,'CAR2',X,Y,Z,0,'ONLY')
274	cafagna	1.1	Y=0
275	cafagna	1.2	Z=CAR2(1)-C1N2(1)
276			X=CAR2(9)+CAR2(1)*TAN(ANG2C)-
277			+ (2.C1N1(9)+C1N2(9)-C1N2(1)TAN(C1N2(2)*DEGRAD))
278			X=-X !ALEX MOD
279			CALL GSPOS('C1N2',N,'CAR2',X,Y,Z,0,'ONLY')
280	cafagna	1.1	N=1
281	cafagna	1.2	X=PT(1./COS(ATAN(D2/CAR(1)))-1./SIN(DEGRADCAR(7)))/2.
282	cafagna	1.1	Y=0
283			Z=0
284			CALL GSPOS('C2D1',N,'CR2P',X,Y,Z,0,'ONLY')
285			*
286			* Positioning in card
287			*
288	cafagna	1.2	*
289			* CAR1A
290			* CAR2B CAR2A
291			* CAR1B
292			*
293			ZH=49.229-ZTPLA-TPLA(3)
294			*--- CAR1B
295			N=1
296			Y=-CARB(5)+CAR(8)/2.*SIN(ANGLCAR1)
297			Z=CARB(6)+ZH-CARDB(3)-CAR(8)*COS(ANGLCAR1)/2.
298			X=((CARB(7)/2.)-TAN(ANG1C)*CAR(8)/2.)-CARB(4)
299			CALL GSPOS('CAR1',N,'CARD',X,Y,Z,IRZCAR1B,'ONLY')
300			*--- CAR1A
301			N=2
302			X=-X
303			Y=-Y
304			CALL GSPOS('CAR1',N,'CARD',X,Y,Z,IRZCAR1A,'ONLY')
305			*--- CAR2A
306			N=1
307			X=CARA(4)-CAR(8)/2.*SIN(ANGLCAR2)
308			Z=CARA(6)+ZH-CARDB(3)-CAR(8)*COS(ANGLCAR2)/2.
309			Y=(CARA(7)/2.-TAN(ANG2C)*CAR(8)/2.)-CARA(5)
310			CALL GSPOS('CAR2',N,'CARD',X,Y,Z,IRZCAR2A,'ONLY')
311			*--- CAR2B
312			N=2
313			X=-X
314			Y=-Y
315			CALL GSPOS('CAR2',N,'CARD',X,Y,Z,IRZCAR2B ,'ONLY')
316			c---------------------------------------------------------------
317			*
318			* LEGS
319			*
320			NMED=MAL
321			CALL GSVOLU('LEGB','BOX ',NMED,LEGB, 3,IVOLU)
322			*
323			* empty volumes to be subtracted from LEGB
324			NMED=MN2
325			*
326			CALL GSVOLU('LEG1','TRAP',NMED,LEG1, 11,IVOLU)
327			X=-LEGB(1)+LEG1(1)
328			Y=-LEGB(2)+LEG1(4)
329			Z=0.
330			CALL GSPOS('LEG1',1,'LEGB',X,Y,Z,RY90,'ONLY')
331			Y=-LEGB(2)+2.*1.95-LEG1(4)
332			CALL GSPOS('LEG1',2,'LEGB',X,Y,Z,RY90,'ONLY')
333			*
334			CALL GSVOLU('LEG2','BOX ',NMED,LEG2, 3,IVOLU)
335			X=-LEGB(1)+LEG2(1)
336			Y=-LEGB(2)+1.95
337			Z=0.
338			CALL GSPOS('LEG2',1,'LEGB',X,Y,Z,0,'ONLY')
339			*
340			CALL GSVOLU('LEG3','BOX ',NMED,LEG3, 3,IVOLU)
341			X=-LEGB(1)+0.65*2.+LEG3(1)+2./10
342			Y=LEGB(2)-LEG3(2)
343			Z=LEGB(3)-LEG3(3)
344			CALL GSPOS('LEG3',1,'LEGB',X,Y,Z,0,'ONLY')
345			Z=-LEGB(3)+LEG3(3)
346			CALL GSPOS('LEG3',2,'LEGB',X,Y,Z,0,'ONLY')
347			*
348			CALL GSVOLU('LEG4','BOX ',NMED,LEG4, 3,IVOLU)
349			X=-LEGB(1)+LEG4(1)
350			Y=LEGB(2)-LEG4(2)
351			Z=0.
352			CALL GSPOS('LEG4',1,'LEGB',X,Y,Z,0,'ONLY')
353			*
354			CALL GSVOLU('LEG5','BOX ',NMED,LEG5, 3,IVOLU)
355			X=LEGB(1)-LEG5(1)
356			Y=LEGB(2)-LEG5(2)
357			Z=0.
358			CALL GSPOS('LEG5',1,'LEGB',X,Y,Z,0,'ONLY')
359			*
360			CALL GSVOLU('LEG6','BOX ',NMED,LEG6, 3,IVOLU)
361			X=-LEGB(1)+0.65*2.+LEG3(1)
362			Y=LEGB(2)-LEG6(2)
363			Z=0.
364			CALL GSPOS('LEG6',1,'LEGB',X,Y,Z,0,'ONLY')
365			*
366			CALL GSVOLU('LEG7','BOX ',NMED,LEG7, 3,IVOLU)
367			X=LEGB(1)-1.125-0.375
368			Y=-LEGB(2)+LEG7(2)
369			Z=11.85-.6-LEG7(3)
370			CALL GSPOS('LEG7',1,'LEGB',X,Y,Z,0,'ONLY')
371			*
372			CALL GSVOLU('LEG8','BOX ',NMED,LEG8, 3,IVOLU)
373			Z=0.
374			CALL GSPOS('LEG8',1,'LEGB',X,Y,Z,0,'ONLY')
375			*
376			CALL GSVOLU('LEG9','BOX ',NMED,LEG9, 3,IVOLU)
377			Z=-(11.85-.6-LEG7(3))
378			CALL GSPOS('LEG9',1,'LEGB',X,Y,Z,0,'ONLY')
379			*
380			* Positioning LEG BOXES in CARD
381			*
382			N=1
383			X=-CARDB(1)+LEGB(1)+3.8
384			Y=-CARDB(2)+LEGB(2)+0.7
385			Z=-0.5
386			CALL GSPOS('LEGB',N,'CARD',X,Y,Z,0,'MANY')
387			N=2
388			X=X
389			Y=-Y
390			CALL GSPOS('LEGB',N,'CARD',X,Y,Z,RX180,'MANY')
391			N=3
392			X=-X
393			Y=Y
394			CALL GSROTM(RZALEX180,90.,180.,90.,
395			+ 270.,180.,0.)
396			CALL GSPOS('LEGB',N,'CARD',X,Y,Z,RZ180,'MANY')
397			N=4
398			X=X
399			Y=-Y
400			CALL GSPOS('LEGB',N,'CARD',X,Y,Z,RY180,'MANY')
401			*
402			c---------------------------------------------------------------
403			*
404			* CARD TOP PLATE
405			*
406			* TPLT
407			*
408			NMED=MAL
409			CALL GSVOLU('TPLT','BOX ',NMED,TPLT, 3,IVOLU)
410			*
411			* Empty volumes to be subtracted from TPLT
412			*
413			NMED=MN2
414			CALL GSVOLU('TOPC','BOX ',NMED,TOPC, 3,IVOLU)
415			*
416			CALL GSVOLU('TH11','BOX ',NMED,TH11, 3,IVOLU)
417			CALL GSVOLU('TH12','BOX ',NMED,TH12, 3,IVOLU)
418			CALL GSVOLU('TH21','BOX ',NMED,TH21, 3,IVOLU)
419			CALL GSVOLU('TH22','BOX ',NMED,TH22, 3,IVOLU)
420			*
421			* XY plane
422			CALL GSVOLU('TOPT','TRAP',NMED,TOPT,11,IVOLU)
423			*
424			CALL GSVOLU('TOHO','TUBE',NMED,TOHO,3,IVOLU)
425	cafagna	1.1
426	cafagna	1.2	*
427			* Positioning empty volumes...
428			*
429			* Positioning TOPC in TPLT
430			*
431			N=1
432			X=0.
433			Y=0.
434			Z=0.
435			CALL GSPOS('TOPC',N,'TPLT',X,Y,Z,0,'ONLY')
436			*
437			*
438			* Positioning H11 in TPLT
439			*
440			N=1
441			X=-23.6
442			Y=14.4
443			Z=0.
444			CALL GSPOS('TH11',N,'TPLT',X,Y,Z,0,'ONLY')
445			N=2
446			X=-23.6
447			Y=-14.4
448			CALL GSPOS('TH11',N,'TPLT',X,Y,Z,0,'ONLY')
449			N=3
450			X=23.6
451			Y=14.4
452			CALL GSPOS('TH11',N,'TPLT',X,Y,Z,0,'ONLY')
453			N=4
454			X=23.6
455			Y=-14.4
456			CALL GSPOS('TH11',N,'TPLT',X,Y,Z,0,'ONLY')
457			*
458			* Positioning H12 in TPLT
459			*
460	cafagna	1.1	N=1
461	cafagna	1.2	X=-23.6
462			Y=5.5
463			Z=0.
464			CALL GSPOS('TH12',N,'TPLT',X,Y,Z,0,'ONLY')
465			N=2
466			X=-23.6
467			Y=-5.5
468			CALL GSPOS('TH12',N,'TPLT',X,Y,Z,0,'ONLY')
469			N=3
470			X=23.6
471			Y=5.5
472			CALL GSPOS('TH12',N,'TPLT',X,Y,Z,0,'ONLY')
473			N=4
474			X=23.6
475			Y=-5.5
476			CALL GSPOS('TH12',N,'TPLT',X,Y,Z,0,'ONLY')
477			*
478			* Positioning H21 in TPLT
479			*
480			N=1
481			X=-17.2
482			Y=19.4
483			Z=0.
484			CALL GSPOS('TH21',N,'TPLT',X,Y,Z,0,'ONLY')
485			N=2
486			X=-17.2
487			Y=-19.4
488			CALL GSPOS('TH21',N,'TPLT',X,Y,Z,0,'ONLY')
489			N=3
490			X=17.2
491			Y=19.4
492			CALL GSPOS('TH21',N,'TPLT',X,Y,Z,0,'ONLY')
493			N=4
494			X=17.2
495			Y=-19.4
496			CALL GSPOS('TH21',N,'TPLT',X,Y,Z,0,'ONLY')
497			*
498			* Positioning H22 in TPLT
499			*
500			N=1
501			X=-10.2
502			Y=19.4
503			Z=0.
504			CALL GSPOS('TH22',N,'TPLT',X,Y,Z,0,'ONLY')
505			N=2
506			X=-10.2
507			Y=-19.4
508			CALL GSPOS('TH22',N,'TPLT',X,Y,Z,0,'ONLY')
509			N=3
510			X=10.2
511			Y=19.4
512			CALL GSPOS('TH22',N,'TPLT',X,Y,Z,0,'ONLY')
513			N=4
514			X=10.2
515			Y=-19.4
516			CALL GSPOS('TH22',N,'TPLT',X,Y,Z,0,'ONLY')
517			N=5
518			X=0.
519			Y=19.4
520			CALL GSPOS('TH22',N,'TPLT',X,Y,Z,0,'ONLY')
521			N=6
522			X=0.
523			Y=-19.4
524			CALL GSPOS('TH22',N,'TPLT',X,Y,Z,0,'ONLY')
525			*
526			* Positioning TOPT in TPLT
527			*
528			N=1
529			X=-CARDB(1)+4.5/4.
530			Y=-CARDB(2)+4.5/2.
531			Z=0.
532			CALL GSPOS('TOPT',N,'TPLT',X,Y,Z,0,'ONLY')
533	cafagna	1.1	N=2
534	cafagna	1.2	X=X
535			Y=-Y
536			CALL GSPOS('TOPT',N,'TPLT',X,Y,Z,RX180,'ONLY')
537			N=3
538			X=-X
539			Y=Y
540			CALL GSPOS('TOPT',N,'TPLT',X,Y,Z,RZ180,'ONLY')
541			N=4
542			X=X
543			Y=-Y
544			CALL GSPOS('TOPT',N,'TPLT',X,Y,Z,RY180,'ONLY')
545			*
546			* Positioning TOHO in TPLT
547			*
548	cafagna	1.1	N=1
549	cafagna	1.2	X=TPLT(1)-6.2-TOHO(1)
550			Y=TPLT(2)-4.1-TOHO(2)
551			CALL GSPOS('TOHO',N,'TPLT',X,Y,Z,0,'ONLY')
552	cafagna	1.1	N=2
553	cafagna	1.2	X=-X
554			Y=Y
555			CALL GSPOS('TOHO',N,'TPLT',X,Y,Z,0,'ONLY')
556			N=3
557			X=X
558			Y=-Y
559			CALL GSPOS('TOHO',N,'TPLT',X,Y,Z,0,'ONLY')
560			N=4
561			X=-X
562			Y=Y
563			CALL GSPOS('TOHO',N,'TPLT',X,Y,Z,0,'ONLY')
564			*
565			* Positioning TPLT in CARD volume
566			*
567			N=1
568			X=0.
569			Y=0.
570			Z=CARDB(3)-TPLT(3)
571			CALL GSPOS('TPLT',N,'CARD',X,Y,Z,0,'ONLY')
572			C---------------------------------------------------------------
573			*
574			* MAGNETIC SCREEN
575			*
576			NMED=10
577			CALL GSVOLU('MGSC','BOX ',NMED,MGSC, 3,IVOLU)
578			* Empty volume to be subtracted from MGSC
579			NMED=MN2
580			CALL GSVOLU('MGSH','BOX ',NMED,MGSH, 3,IVOLU)
581	cafagna	1.1
582	cafagna	1.2	*
583			* Positioning in CARD...
584			*
585			N=1
586			X=0.
587			Y=0.
588			Z=0.
589			CALL GSPOS('MGSH',N,'MGSC',X,Y,Z,0,'ONLY')
590			Z=-CARDB(3)+MGSC(3)
591			CALL GSPOS('MGSC',N,'CARD',X,Y,Z,0,'ONLY')
592			c---------------------------------------------------------------
593	cafagna	1.1	RETURN
594			END