+++ /dev/null
-*
-* $Id$
-*
-* $Log$
-* Revision 1.1.1.1 1995/10/24 10:20:49 cernlib
-* Geant
-*
-*
-#include "geant321/pilot.h"
-*CMZ : 3.21/02 29/03/94 15.41.28 by S.Giani
-*-- Author :
- SUBROUTINE GGDPAR (JVOM, IN, NVAR, LVAR, LVOM, NPAR, PAR)
-C.
-C. ******************************************************************
-C. * *
-C. * SUBR. GGDPAR (JVOM,IN,NVAR,LVAR,LVOM,NPAR*,PAR*) *
-C. * *
-C. * Computes the actual parameters for the IN'th division of the *
-C. * mother volume at address JVOM *
-C. * Returns the set of actual parameters in NPAR, PAR *
-C. * *
-C. * Called by : GGDVLP *
-C. * Author : S.Banerjee *
-C. * (Original algorithms of A.McPherson) *
-C. * *
-C. ******************************************************************
-C.
-#include "geant321/gcbank.inc"
-#include "geant321/gcflag.inc"
-#include "geant321/gcunit.inc"
-C.
- PARAMETER (NPAMAX=50)
-C.
- DIMENSION LVAR(*), PAR(*)
-C.
- REAL PARM(NPAMAX)
- INTEGER LAX(10,12)
- SAVE LAX
-C.
- DATA LAX / 1, 2, 3, 7*0, 1, 1, 2, 3, 6*0, 1, 1, 2, 2, 3, 5*0,
- + 3, 0, 0, 2, 1, 1, 0, 2, 1, 1, 1, 1, 3, 7*0,
- + 1, 1, 3, 2, 2, 5*0, 3, 1, 1, 1, 1, 5*0,
- + 3, 1, 1, 1, 1, 2, 2, 3*0, 1, 1, 2, 2, 6*0,
- + 1, 2, 3, 7*0, 2, 2, 0, 0, 3, 1, 1, 3, 1, 1,
- + 2, 2, 0, 3, 1, 1, 3, 1, 1, 0/
-C.
-C. ------------------------------------------------------------------
-*
-* *** Prepares parameters for mother, in PARM, for division, in PAR
-* and the division parameters
-*
- JIN = LQ(JVOM-1)
- IF (LQ(JVOM).EQ.LVOM) THEN
-*
-* Case when current volume is source of local development
-*
- NPARM = Q(JVOM+5)
- CALL UCOPY (Q(JVOM+7), PARM, NPARM)
- NDIV = Q(JIN+3)
- ORIG = Q(JIN+4)
- STEP = Q(JIN+5)
- ELSE
-*
-* Other cases
-*
- NPARM = IQ(LVOM+5)
- CALL UCOPY (Q(LVOM+6), PARM, NPARM)
- NDIV = IQ(LVOM+1)
- ORIG = Q(LVOM+2)
- STEP = Q(LVOM+3)
- ENDIF
-*
- ISHM = Q(JVOM+2)
-*
- ORI = ORIG + (IN - 1) * STEP
- IAXIS = Q(JIN+1)
- IVO = Q(JIN+2)
- JVO = LQ(JVOLUM-IVO)
- ISH = Q(JVO+2)
- NPAR = Q(JVO+5)
-*
-* *** Prepare the division parameters
-*
- IF (NPAR.GT.0) THEN
- CALL UCOPY (Q(JVO+7), PAR, NPAR)
- ELSE
- NPAR = NPARM
- CALL UCOPY (PARM, PAR, NPARM)
-*
-* ** Special treatment for phi divisions (when NPAR=0)
-*
- IF ((ISHM.GE.5.AND.ISHM.LE.8.AND.IAXIS.EQ.2) .OR.
- + (ISHM.GE.11.AND.ISHM.LE.12.AND.IAXIS.EQ.2) .OR.
- + (ISHM.EQ.9.AND.IAXIS.EQ.3)) THEN
- IF (ISHM.EQ.5.OR.ISHM.EQ.7) THEN
- NPAR = NPARM + 2
- PAR(NPAR-1) = -0.5 * STEP
- PAR(NPAR) = 0.5 * STEP
- ELSE IF (ISHM.EQ.6.OR.ISHM.EQ.8) THEN
- DP = PARM(NPAR) - PARM(NPAR-1)
- IF (DP.LT.0.0) DP = DP + 360.0
- IF (ORIG-PARM(NPAR-1).LT.0.0) ORIG = ORIG + 360.0
- IF (ORIG-PARM(NPAR-1).GT.DP ) GO TO 910
- DP = PARM(NPAR) - ORIG
- IF (DP.LT.0.0) DP = DP + 360.0
- PAR(NPAR-1) = -0.5 * DP / NDIV
- PAR(NPAR ) = 0.5 * DP / NDIV
- ELSE IF (ISHM.EQ.11.OR.ISHM.EQ.12) THEN
- IF (ISHM.EQ.11) NDIV = PARM(3)
- STEP = PARM(2) / NDIV
- PAR(1) = -0.5 * STEP
- PAR(2) = STEP
- PAR(3) = 1.
- ELSE IF (ISHM.EQ.9) THEN
- DP = PARM(6) - PARM(5)
- IF (DP.LT.0.0) DP = DP + 360.0
- IF (ORIG-PARM(5).LT.0.0) ORIG = ORIG + 360.0
- IF (ORIG-PARM(5).GT.DP ) GO TO 910
- DP = PARM(6) - ORIG
- IF (DP.LT.0.0) DP = DP + 360.0
- PAR(5) = -0.5 * DP / NDIV
- PAR(6) = 0.5 * DP / NDIV
- ENDIF
- ENDIF
- ENDIF
- IF (NVAR.LE.0) GO TO 999
-*
-* *** Compute the actual parameters
-*
- IF (ISHM.EQ.1) THEN
-*
-* BOX
-*
- IF (ISH.EQ.1) THEN
- DO 10 I = 1, NVAR
- IAX = LVAR(I)
- IF (IAX.EQ.IAXIS) THEN
- PAR(IAX) = 0.5 *STEP
- ELSE
- PAR(IAX) = PARM(IAX)
- ENDIF
- 10 CONTINUE
- ELSE
- GO TO 900
- ENDIF
-*
- ELSE IF (ISHM.EQ.2) THEN
-*
-* TRD1
-*
- IF (ISH.EQ.2) THEN
- DO 20 I = 1, NVAR
- IAX = LVAR(I)
- IF (LAX(IAX,ISH).EQ.IAXIS) THEN
- PAR(IAX) = 0.5 * STEP
- ELSE IF (LAX(IAX,ISH).EQ.1.AND.IAXIS.EQ.3) THEN
- ZZ = ORI + PARM(4)
- DXDZ = 0.5 * (PARM(2) - PARM(1)) / PARM(4)
- IF (IAX.EQ.2) ZZ = ZZ + STEP
- PAR(IAX) = PARM(1) + DXDZ * ZZ
- ELSE
- PAR(IAX) = PARM(IAX)
- ENDIF
- 20 CONTINUE
- ELSE
- GO TO 900
- ENDIF
-*
- ELSE IF (ISHM.EQ.3) THEN
-*
-* TRD2
-*
- IF (ISH.EQ.3.AND.IAXIS.EQ.3) THEN
- DO 30 I = 1, NVAR
- IAX = LVAR(I)
- IF (LAX(IAX,ISH).EQ.IAXIS) THEN
- PAR(IAX) = 0.5 * STEP
- ELSE
- IP1 = 2 * LAX(IAX,ISH) - 1
- IP2 = IP1 + 1
- ZZ = ORI + PARM(5)
- DXDZ = 0.5 * (PARM(IP2) - PARM(IP1)) / PARM(5)
- IF (IAX.EQ.IP2) ZZ = ZZ + STEP
- PAR(IAX) = PARM(IP1) + DXDZ * ZZ
- ENDIF
- 30 CONTINUE
- ELSE IF (ISH.EQ.3) THEN
- GO TO 910
- ELSE
- GO TO 900
- ENDIF
-*
- ELSE IF (ISHM.EQ.4) THEN
-*
-* TRAP
-*
- IF (ISH.EQ.4.AND.IAXIS.NE.1) THEN
- IF(IAXIS.EQ.3) THEN
- DO 40 I = 1, NVAR
- IAX = LVAR(I)
- IF (IAX.EQ.1) THEN
- PAR(IAX) = 0.5 * STEP
- ELSE IF (IAX.LE.6) THEN
- ZZ = ORI + PARM(1)
- DPDZ = 0.5 * (PARM(IAX+4) - PARM(IAX)) / PARM(1)
- PAR(IAX) = PARM(IAX) + DPDZ * ZZ
- ELSE
- ZZ = ORI + PARM(1) + STEP
- DPDZ = 0.5 * (PARM(IAX) - PARM(IAX-4)) / PARM(1)
- PAR(IAX) = PARM(IAX-4) + DPDZ * ZZ
- ENDIF
- 40 CONTINUE
- HTAL = PARM(8) * PARM(11)
- HTAH = PARM(4) * PARM(7)
- ZZ1 = 0.5 * (ORI + PARM(1)) / PARM(1)
- ZZ2 = 0.5 * (ORI + PARM(1) + STEP) / PARM(1)
- PAR(7) = (HTAL*(1.0-ZZ1) + HTAH*ZZ1) / PARM(4)
- PAR(11)= (HTAL*(1.0-ZZ2) + HTAH*ZZ2) / PARM(8)
- CALL GNOTR1(PAR)
- ELSE IF (IAXIS.EQ.2) THEN
- DO 41 I = 1, NVAR
- PAR(LVAR(I)) = PARM(LVAR(I))
- 41 CONTINUE
- DXDY1 = 0.5*(PARM(6)-PARM(5))/PARM(4)
- DXDY2 = 0.5*(PARM(10)-PARM(9))/PARM(8)
- DXM1 = 0.5*(PARM(6)+PARM(5))
- DXM2 = 0.5*(PARM(10)+PARM(9))
- DXH1 = DXM1+(ORI+STEP)*DXDY1
- DXH2 = DXM2+(ORI+STEP)*DXDY2
- DXL1 = DXM1+ORI*DXDY1
- DXL2 = DXM2+ORI*DXDY2
- PAR(5) = DXL1
- PAR(6) = DXH1
- PAR(9) = DXL2
- PAR(10) = DXH2
- ENDIF
- ELSE IF (ISH.EQ.4) THEN
- GO TO 910
- ELSE
- GO TO 900
- ENDIF
-*
- ELSE IF (ISHM.EQ.5 .OR. ISHM.EQ.6) THEN
-*
-* TUBE or TUBS
-*
- IF (ISH.EQ.5 .OR. ISH.EQ.6) THEN
- DO 50 I = 1, NVAR
- IAX = LVAR(I)
- IF (LAX(IAX,ISH).EQ.IAXIS) THEN
- IF (IAXIS.EQ.3) THEN
- PAR(IAX) = 0.5 * STEP
- ELSE IF (IAXIS.EQ.1) THEN
- IF (IAX.EQ.1) THEN
- PAR(IAX) = ORI
- ELSE
- PAR(IAX) = ORI + STEP
- ENDIF
- ELSE
- GO TO 910
- ENDIF
- ELSE
- PAR(IAX) = PARM(IAX)
- ENDIF
- 50 CONTINUE
- ELSE
- GO TO 900
- ENDIF
-*
- ELSE IF (ISHM.EQ.7 .OR. ISHM.EQ.8) THEN
-*
-* CONE or CONS
-*
- IF (ISH.EQ.7 .OR. ISH.EQ.8) THEN
- DO 60 I = 1, NVAR
- IAX = LVAR(I)
- IF (LAX(IAX,ISH).EQ.IAXIS .AND. IAXIS.EQ.3) THEN
- PAR(IAX) = 0.5 * STEP
- ELSE IF (IAXIS.EQ.3.AND.IAX.GT.1.AND.IAX.LT.6) THEN
- IF (IAX.EQ.2.OR.IAX.EQ.4) THEN
- DP = 0.5 * (PARM(4) - PARM(2)) / PARM(1)
- PM = 0.5 * (PARM(4) + PARM(2))
- ELSE
- DP = 0.5 * (PARM(5) - PARM(3)) / PARM(1)
- PM = 0.5 * (PARM(5) + PARM(3))
- ENDIF
- IF (IAX.GT.3) THEN
- DZ = ORI + STEP
- ELSE
- DZ = ORI
- ENDIF
- PAR(IAX) = PM + DP * DZ
- ELSE IF (IAXIS.EQ.1.AND.LAX(IAX,ISH).EQ.IAXIS) THEN
- IF (IAX.EQ.2) THEN
- PAR(IAX) = ORI
- ELSE IF (IAX.EQ.3) THEN
- PAR(IAX) = ORI + STEP
- ELSE IF (IAX.EQ.4) THEN
- PAR(IAX) = ORI * PARM(IAX) / PARM(2)
- ELSE
- PAR(IAX) = (ORI + STEP) * PARM(IAX) / PARM(3)
- ENDIF
- ELSE
- PAR(IAX) = PARM(IAX)
- ENDIF
- 60 CONTINUE
- ELSE
- GO TO 900
- ENDIF
-*
- ELSE IF (ISHM.EQ.9) THEN
-*
-* SPHE
-*
- IF (ISH.EQ.9) THEN
- DO 70 I = 1, NVAR
- IAX = LVAR(I)
- IF (LAX(IAX,ISH).EQ.IAXIS) THEN
- IF (MOD(IAX,2).NE.0) THEN
- PAR(IAX) = ORI
- ELSE
- PAR(IAX) = ORI + STEP
- ENDIF
- ELSE
- PAR(IAX) = PARM(IAX)
- ENDIF
- 70 CONTINUE
- ELSE
- GO TO 900
- ENDIF
-*
- ELSE IF (ISHM.EQ.10) THEN
-*
-* PARA
-*
- IF (ISH.EQ.10) THEN
- DO 80 I = 1, NVAR
- IAX = LVAR(I)
- IF (LAX(IAX,ISH).EQ.IAXIS) THEN
- PAR(IAX) = 0.5 * STEP
- ENDIF
- 80 CONTINUE
- ELSE
- GO TO 900
- ENDIF
-*
- ELSE IF (ISHM.EQ.11 .OR. ISHM.EQ.12) THEN
-*
-* PGON or PCON
-*
- IF (ISH.EQ.ISHM) THEN
- IF (ISH.EQ.11) THEN
- IPNZ = 4
- ELSE
- IPNZ = 3
- ENDIF
- NZ = PAR(IPNZ)
- NZ1 = PARM(IPNZ)
- IF (NZ.EQ.NZ1) THEN
- IF (IAXIS.EQ.1) THEN
- RMN = ORI
- RMX = ORI + STEP
- DO 90 I = 1, NZ
- IAX1 = IPNZ + 3*I - 1
- IAX2 = IAX1 + 1
- IF (I.EQ.1) THEN
- PAR(IAX1) = RMN
- PAR(IAX2) = RMX
- ELSE
- PAR(IAX1) = RMN * PARM(IAX1) / PARM(IPNZ+2)
- PAR(IAX2) = RMX * PARM(IAX2) / PARM(IPNZ+3)
- ENDIF
- 90 CONTINUE
- ELSE IF (IAXIS.EQ.2) THEN
- DO 100 I = 1, NVAR
- IAX = LVAR(I)
- PAR(IAX) = PARM(IAX)
- 100 CONTINUE
- ELSE IF (NZ.EQ.2.AND.IAXIS.EQ.3) THEN
- ZL = PARM(IPNZ+1)
- ZH = PARM(IPNZ+4)
- DZ = ZH - ZL
- DRMIDZ = (PARM(IPNZ+5)-PARM(IPNZ+2))/DZ
- DRMADZ = (PARM(IPNZ+6)-PARM(IPNZ+3))/DZ
- PAR(IPNZ+1) = -0.5 * STEP
- PAR(IPNZ+4) = 0.5 * STEP
- DO 110 I = 1, NVAR
- IAX = LVAR(I)-IPNZ
- IF(IAX.EQ.2) THEN
- RAD = PARM(IPNZ+2)+(IN-1)*STEP*DRMIDZ
- ELSEIF (IAX.EQ.3) THEN
- RAD = PARM(IPNZ+3)+(IN-1)*STEP*DRMADZ
- ELSEIF (IAX.EQ.5) THEN
- RAD = PARM(IPNZ+2)+IN*STEP*DRMIDZ
- ELSEIF (IAX.EQ.6) THEN
- RAD = PARM(IPNZ+3)+IN*STEP*DRMADZ
- ENDIF
- PAR(IPNZ+IAX) = RAD
- 110 CONTINUE
- ELSE
- GO TO 920
- ENDIF
- ELSE
- GO TO 920
- ENDIF
- ELSE
- GO TO 900
- ENDIF
-*
- ELSE
- GO TO 900
- ENDIF
-*
- GO TO 999
-*
- 900 WRITE (CHMAIL, 1001) ISH, ISHM
- GO TO 990
-*
- 910 WRITE (CHMAIL, 1002) ISH, ISHM, IAXIS
- GO TO 990
-*
- 920 WRITE (CHMAIL, 1003) ISH, NZ, ISHM, NZ1
-*
- 990 CALL GMAIL( 0, 0)
- IEORUN = 1
-*
- 1001 FORMAT (' GGDPAR : Not accepted ISH,ISHM=',2I5)
- 1002 FORMAT (' GGDPAR : Not accepted ISH,ISHM,IAXIS=',3I5)
- 1003 FORMAT (' GGDPAR : Not accepted ISH,NZ,ISHM,NZ1=',4I5)
-* END GGDPAR
- 999 END
git://git.uio.no / u / mrichter / AliRoot.git / blobdiff