GEANT321/ggeom/ggppar.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.1.1.1  1995/10/24 10:20:50  cernlib
   6 * Geant
   7 *
   8 *
   9 #include "geant321/pilot.h"
  10 *CMZ :  3.21/02 29/03/94  15.41.28  by  S.Giani
  11 *FCA :          05/01/99  10:04:28  by  Federico Carminati
  12 *               Added the possibility to put TRD1's in TRD1's with
  13 *               negative parameters
  14 *-- Author :
  15       SUBROUTINE GGPPAR (JVOM, IN, NVAR, LVAR, LVOM, NPAR, PAR)
  16 C.
  17 C.    ******************************************************************
  18 C.    *                                                                *
  19 C.    *    SUBR. GGPPAR (JVOM,IN,NVAR,LVAR,LVOM,NPAR*,PAR*)            *
  20 C.    *                                                                *
  21 C.    *   Computes the actual parameters for the INth content inside   *
  22 C.    *    the mother volume at address JVOM                           *
  23 C.    *   Returns them in NPAR, PAR                                    *
  24 C.    *                                                                *
  25 C.    *   Called by : GGDVLP                                           *
  26 C.    *   Authors   : F.Bruyant, S.Banerjee                            *
  27 C.    *               (original algorithms from A.McPherson)           *
  28 C.    *                                                                *
  29 C.    ******************************************************************
  30 C.
  31 #include "geant321/gcbank.inc"
  32 #include "geant321/gcflag.inc"
  33 #include "geant321/gcunit.inc"
  34 C.
  35       PARAMETER (NPAMAX=50)
  36 C.
  37       DIMENSION LVAR(*), PAR(*)
  38       DIMENSION DXYZ(3), PARM(NPAMAX)
  39       DIMENSION IOPT(12,12)
  40       SAVE IOPT
  41 C.
  42       DATA IOPT /  1 ,1 ,1 ,1 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,
  43      +             0 ,1 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,
  44      +             0 ,0 ,1 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,
  45      +             0 ,0 ,0 ,1 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,
  46      +             0 ,0 ,0 ,0 ,1 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,
  47      +             0 ,0 ,0 ,0 ,0 ,1 ,0 ,0 ,0 ,0 ,0 ,0 ,
  48      +             0 ,0 ,0 ,0 ,0 ,0 ,1 ,0 ,0 ,0 ,0 ,0 ,
  49      +             0 ,0 ,0 ,0 ,0 ,0 ,0 ,1 ,0 ,0 ,0 ,0 ,
  50      +             0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,1 ,0 ,0 ,0 ,
  51      +             0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,1 ,0 ,0 ,
  52      +             0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,1 ,0 ,
  53      +             0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,0 ,1 /
  54 C.
  55 C.    ------------------------------------------------------------------
  56 *
  57 * *** Check request
  58 *
  59       JIN  = LQ(JVOM-IN)
  60 *
  61       IVO  = Q(JIN+2)
  62       JVO  = LQ(JVOLUM-IVO)
  63       NPAR = Q(JVO+5)
  64       IF (NPAR.EQ.0) THEN
  65          NPAR = Q(JIN+9)
  66          CALL UCOPY (Q(JIN+10), PAR, NPAR)
  67          IF (NVAR.LT.0) GO TO 999
  68       ELSE
  69          CALL UCOPY (Q(JVO+7), PAR, NPAR)
  70       ENDIF
  71       IROT = Q(JIN+4)
  72       IF (IROT.NE.0) THEN
  73          WRITE (CHMAIL, 10300)
  74          CALL GMAIL (0, 0)
  75          IEORUN = 1
  76       ENDIF
  77 *
  78       ISH  = Q(JVO+2)
  79       ISHM = Q(JVOM+2)
  80       IF(ISH.GT.12.OR.ISHM.GT.12.OR.IOPT(ISHM, ISH).EQ.0) THEN
  81          WRITE (CHMAIL, 10400) ISH, ISHM
  82          CALL GMAIL (0, 0)
  83          IEORUN = 1
  84       ENDIF
  85 *
  86 * *** Prepares parameters for mother, in PARM, for content, in PAR
  87 *      and the translation DXYZ (position of content inside mother)
  88 *
  89       IF (LQ(JVOM).EQ.LVOM) THEN
  90 *
  91 *      Case when current volume is source of local development
  92 *
  93          NPARM = Q(JVOM+5)
  94          CALL UCOPY (Q(JVOM+7), PARM, NPARM)
  95       ELSE
  96 *
  97 *      Other cases
  98 *
  99          NPARM = IQ(LVOM+5)
 100          CALL UCOPY (Q(LVOM+6), PARM, NPARM)
 101       ENDIF
 102 *
 103       DXYZ(1) = Q(JIN+5)
 104       DXYZ(2) = Q(JIN+6)
 105       DXYZ(3) = Q(JIN+7)
 106 *
 107 * *** Compute the actual parameters
 108 *
 109       IF (ISH.EQ.1) THEN
 110 *
 111 * BOX
 112 *
 113          IF (ISHM.EQ.1) THEN
 114 * in BOX
 115             DO 10 I = 1,NVAR
 116                IAX = LVAR(I)
 117                PAR(IAX) = PARM(IAX) -ABS(DXYZ(IAX))
 118                IF (PAR(IAX).LT.0.) THEN
 119                   WRITE (CHMAIL, 10500) ISH, ISHM, IAX
 120                   CALL GMAIL (0, 0)
 121                   IEORUN = 1
 122                ENDIF
 123    10       CONTINUE
 124          ELSE IF (ISHM.EQ.2) THEN
 125 * in TRD1
 126             DO 20 I = 1,NVAR
 127                IAX = LVAR(I)
 128                IF (IAX.EQ.1) THEN
 129                   DZ = PAR(3)
 130                   IF (DZ.LT.0.) DZ = PARM(4)
 131                   DXDZ = 0.5*(PARM(2)-PARM(1))/PARM(4)
 132                   DXME = 0.5*(PARM(2)+PARM(1)) +DXDZ*DXYZ(3)
 133                   DX   = DXME -ABS(DXDZ*DZ)
 134                   PAR(IAX) = DX -ABS(DXYZ(1))
 135                   IF (PAR(IAX).LT.0.) THEN
 136                      WRITE (CHMAIL, 10500) ISH, ISHM, IAX
 137                      CALL GMAIL (0, 0)
 138                      IEORUN = 1
 139                   ENDIF
 140                ELSE
 141                   PAR(IAX) = PARM(IAX+1) -ABS(DXYZ(IAX))
 142                   IF (IAX.EQ.3) THEN
 143                      DXDZ = 0.5*(PARM(2)-PARM(1))/PARM(4)
 144                      DX0  = 0.5*(PARM(2)+PARM(1)) -ABS(DXYZ(1))
 145                      DZ   = (DX0 -PAR(1))/ABS(DXDZ)
 146                      IF (DZ.LT.0.) THEN
 147                         WRITE (CHMAIL, 10600) ISH, ISHM, IAX, DZ
 148                         CALL GMAIL (0, 0)
 149                         IEORUN = 1
 150                      ELSE
 151                         IF (PAR(3).GT.DZ) PAR(3) = DZ
 152                      ENDIF
 153                   ENDIF
 154                ENDIF
 155    20       CONTINUE
 156          ELSE IF (ISHM.EQ.3) THEN
 157 * in TRD2
 158             DO 30 I = 1,NVAR
 159                IAX   = LVAR(I)
 160                IF (IAX .LT. 3) THEN
 161                   DZ  = PAR(3)
 162                   IP  = 2*IAX -1
 163                   IF (DZ .LT. 0.) DZ = PARM(5)
 164                   DXDZ = 0.5*(PARM(IP+1) - PARM(IP))/PARM(5)
 165                   DXME = 0.5*(PARM(IP+1) + PARM(IP)) + DXDZ*DXYZ(3)
 166                   DX   = DXME - ABS(DXDZ*DZ)
 167                   PAR(IAX) = DX - ABS(DXYZ(IAX))
 168                ELSE
 169                   PAR(3) = PARM(5) - ABS(DXYZ(3))
 170                   DXDZ   = 0.5*(PARM(2) - PARM(1))/PARM(5)
 171                   DX0    = 0.5*(PARM(2) + PARM(1)) - ABS(DXYZ(1))
 172                   DZ     = (DX0 - PAR(1))/ABS(DXDZ)
 173                   IF (DZ.LT.0.0) THEN
 174                      WRITE (CHMAIL, 10600) ISH, ISHM, IAX, DZ
 175                      CALL GMAIL (0, 0)
 176                      IEORUN = 1
 177                   ELSE
 178                      IF (PAR(IAX).GT.DZ) PAR(IAX) = DZ
 179                   ENDIF
 180                   DXDZ   = 0.5*(PARM(4) - PARM(3))/PARM(5)
 181                   DX0    = 0.5*(PARM(4) + PARM(3)) - ABS(DXYZ(2))
 182                   DZ     = (DX0 - PAR(2))/ABS(DXDZ)
 183                   IF (DZ.LT.0.0) THEN
 184                      WRITE (CHMAIL, 10600) ISH, ISHM, IAX, DZ
 185                      CALL GMAIL (0, 0)
 186                      IEORUN = 1
 187                   ELSE
 188                      IF (PAR(IAX).GT.DZ) PAR(IAX) = DZ
 189                   ENDIF
 190                ENDIF
 191    30       CONTINUE
 192          ELSE IF (ISHM.EQ.4) THEN
 193 * in TRAP
 194 *
 195 *        Case of box in trap. Let's keep it simple: we just deal with
 196 *        the case in which phi=0 or 180. If theta .ne. 0, the position along
 197 *        x-axis, and the angles parm(7) and parm(11) must be 0.
 198 *
 199             IF(ABS(PARM(3)).GT.0.1E-5) THEN
 200                WRITE(CHMAIL,10000) IQ(JVOLUM+IVO)
 201 10000          FORMAT
 202      +      (' GGPPAR : Cannot use negative parameters for box ',A4)
 203                CALL GMAIL(0,0)
 204                WRITE(CHMAIL,10100)
 205 10100       FORMAT('          in a trap if PAR(2) .ne. 0 or 180')
 206                CALL GMAIL(0,0)
 207                IEORUN=1
 208             ELSEIF(PARM(7).NE.PARM(11)) THEN
 209                WRITE(CHMAIL,10000) IQ(JVOLUM+IVO)
 210                CALL GMAIL(0,0)
 211                WRITE(CHMAIL,10200)
 212 10200       FORMAT('          in a trap if PAR(7) .ne. PAR(11)')
 213                CALL GMAIL(0,0)
 214             ELSE
 215                IVARX=0
 216                IVARY=0
 217                IVARZ=0
 218                DO 40 J=1,NVAR
 219                   IF(LVAR(J).EQ.1) THEN
 220                      IVARX=1
 221                   ELSEIF(LVAR(J).EQ.2) THEN
 222                      IVARY=1
 223                   ELSEIF(LVAR(J).EQ.3) THEN
 224                      IVARZ=1
 225                   ENDIF
 226    40          CONTINUE
 227                DZM = PARM(1)
 228                IF(IVARZ.EQ.1) THEN
 229                   PAR(3) = DZM-ABS(DXYZ(3))
 230                ENDIF
 231                DYDZ=0.5*(PARM(8)-PARM(4))/PARM(1)
 232                DYM =0.5*(PARM(8)+PARM(4))
 233                DY1 = DYM+(DXYZ(3)+PAR(3))*DYDZ
 234                DY2 = DYM+(DXYZ(3)-PAR(3))*DYDZ
 235                IF(IVARY.EQ.1) THEN
 236                   PAR(2) = MIN(DY1,DY2)-ABS(DXYZ(2))
 237                ENDIF
 238                IF(IVARX.EQ.1) THEN
 239                   IF(PARM(7).EQ.0.0.AND.ABS(PARM(2)).LT..1E-5) THEN
 240                      DXDZL = 0.5*(PARM(9)-PARM(5))/PARM(1)
 241                      DXDZH = 0.5*(PARM(10)-PARM(6))/PARM(1)
 242                      DXML = 0.5*(PARM(9)+PARM(5))
 243                      DXMH = 0.5*(PARM(10)+PARM(6))
 244                      DXL1 = DXML+(DXYZ(3)+PAR(3))*DXDZL
 245                      DXL2 = DXML+(DXYZ(3)-PAR(3))*DXDZL
 246                      DXH1 = DXMH+(DXYZ(3)+PAR(3))*DXDZH
 247                      DXH2 = DXMH+(DXYZ(3)-PAR(3))*DXDZH
 248                      DXDY1 = 0.5*(DXH1-DXL1)/DY1
 249                      DXDY2 = 0.5*(DXH2-DXL2)/DY2
 250                      DXM1 = 0.5*(DXH1+DXL1)
 251                      DXM2 = 0.5*(DXH2+DXL2)
 252                      DX1 = DXM1+(DXYZ(2)+PAR(2))*DXDY1
 253                      DX2 = DXM1+(DXYZ(2)-PAR(2))*DXDY1
 254                      DX3 = DXM2+(DXYZ(2)+PAR(2))*DXDY2
 255                      DX4 = DXM2+(DXYZ(2)-PAR(2))*DXDY2
 256                      PAR(1) = MIN(DX1,DX2,DX3,DX4)-ABS(DXYZ(1))
 257 * Note; position along x-axis should be 0, when theta .ne. 0:
 258                   ELSE IF(PARM(7).EQ..0.AND.ABS(PARM(2)).GT..1E-5)THEN
 259 * the maximum length of the lower (DX2) and upper (DX1) lines along x
 260                      DXDZ= 0.5*(PARM(9)-PARM(5))/PARM(1)
 261                      DXM = 0.5*(PARM(9)+PARM(5))
 262                      DX1 = DXM+(DXYZ(3)+PAR(3))*DXDZ
 263                      DX2 = DXM+(DXYZ(3)-PAR(3))*DXDZ
 264 *
 265 * the shift in the endpoints caused by theta angle compared with
 266 * the symmetrical case when theta = 0
 267                      TANTHE = PARM(2)
 268                      SHFX1 = TANTHE*(DXYZ(3)+PAR(3))
 269                      SHFX2 = TANTHE*(DXYZ(3)-PAR(3))
 270 *
 271                      DX1P = DX1 + SHFX1
 272                      DX1N = DX1 - SHFX1
 273                      DX2P = DX2 + SHFX2
 274                      DX2N = DX2 - SHFX2
 275 *
 276 * DXP is the lenght of the box that fits in the positive side
 277 * DXN is the one in the negative side
 278                      DXP  = MIN(DX1P,DX2P)
 279                      DXN  = MIN(DX1N,DX2N)
 280                      XPOS = .5*(DXP-DXN)
 281                      Q(JIN+5) = XPOS
 282                      PAR(1) = .5*(DXP+DXN)
 283                   ELSE
 284                      TANALF = PARM(7)
 285                      DXDZL = 0.5*(PARM(9)-PARM(5))/PARM(1)
 286                      DXDZH = 0.5*(PARM(10)-PARM(6))/PARM(1)
 287                      DXML = 0.5*(PARM(9)+PARM(5))
 288                      DXMH = 0.5*(PARM(10)+PARM(6))
 289                      DXL1 = DXML+(DXYZ(3)+PAR(3))*DXDZL
 290                      DXL2 = DXML+(DXYZ(3)-PAR(3))*DXDZL
 291                      DXH1 = DXMH+(DXYZ(3)+PAR(3))*DXDZH
 292                      DXH2 = DXMH+(DXYZ(3)-PAR(3))*DXDZH
 293                      SHFX1 = TANALF*DY1
 294                      SHFX2 = TANALF*DY2
 295 *
 296                      DXH1P = DXH1+SHFX1
 297                      DXH1N = DXH1-SHFX1
 298                      DXL1P = DXL1-SHFX1
 299                      DXL1N = DXL1+SHFX1
 300                      DXH2P = DXH2+SHFX2
 301                      DXH2N = DXH2-SHFX2
 302                      DXL2P = DXL2-SHFX2
 303                      DXL2N = DXL2+SHFX2
 304 *
 305                      DXDY1P = 0.5*(DXH1P-DXL1P)/DY1
 306                      DXDY2P = 0.5*(DXH2P-DXL2P)/DY2
 307                      DXDY1N = 0.5*(DXH1N-DXL1N)/DY1
 308                      DXDY2N = 0.5*(DXH2N-DXL2N)/DY2
 309 *
 310                      DXM1P = 0.5*(DXH1P+DXL1P)
 311                      DXM2P = 0.5*(DXH2P+DXL2P)
 312                      DXM1N = 0.5*(DXH1N+DXL1N)
 313                      DXM2N = 0.5*(DXH2N+DXL2N)
 314 *
 315                      DX1P = DXM1P+(DXYZ(2)+PAR(2))*DXDY1P
 316                      DX2P = DXM1P+(DXYZ(2)-PAR(2))*DXDY1P
 317                      DX3P = DXM2P+(DXYZ(2)+PAR(2))*DXDY2P
 318                      DX4P = DXM2P+(DXYZ(2)-PAR(2))*DXDY2P
 319                      DX1N = DXM1N+(DXYZ(2)+PAR(2))*DXDY1N
 320                      DX2N = DXM1N+(DXYZ(2)-PAR(2))*DXDY1N
 321                      DX3N = DXM2N+(DXYZ(2)+PAR(2))*DXDY2N
 322                      DX4N = DXM2N+(DXYZ(2)-PAR(2))*DXDY2N
 323 *
 324                      PAR(1) =MAX(0.,MIN( MIN(DX1P,DX2P,DX3P,DX4P)-
 325      +               DXYZ(1), MIN(DX1N,DX2N,DX3N,DX4N)+DXYZ(1)))
 326                   ENDIF
 327                ENDIF
 328             ENDIF
 329          ENDIF
 330       ELSE IF (ISH.EQ.2) THEN
 331 * TRD1
 332          IF(ISHM.EQ.ISH) THEN
 333 * in TRD1
 334             IF (PAR(4).EQ.PARM(4)) THEN
 335                IZCUT = 0
 336             ELSE
 337                IZCUT = 1
 338             ENDIF
 339             DO 51 I = 1,NVAR
 340                IAX = LVAR(I)
 341                PAR(IAX) = PARM(IAX)
 342                IF (IZCUT.EQ.0) GO TO 51
 343                IF (IAX.EQ.1) THEN
 344                   DZ   = DXYZ(3) +PARM(4) -PAR(4)
 345                   DPDZ = 0.5*(PARM(2) -PARM(1))/PARM(4)
 346                   PAR(IAX) = PARM(1) + DPDZ*DZ
 347                ELSE IF (IAX.EQ.2) THEN
 348                   DZ   = DXYZ(3) +PARM(4) +PAR(4)
 349                   DPDZ = 0.5*(PARM(2) -PARM(1))/PARM(4)
 350                   PAR(IAX) = PARM(1) + DPDZ*DZ
 351                ENDIF
 352  51         CONTINUE
 353 *
 354          ENDIF
 355 *
 356       ELSE IF (ISH.EQ.4) THEN
 357 *
 358 * TRAP
 359 *
 360          IF (ISHM.EQ.ISH) THEN
 361 * in TRAP
 362             IF (PAR(1).EQ.PARM(1)) THEN
 363                IZCUT = 0
 364             ELSE
 365                IZCUT = 1
 366             ENDIF
 367             DO 50 I = 1,NVAR
 368                IAX = LVAR(I)
 369                PAR(IAX) = PARM(IAX)
 370                IF (IZCUT.EQ.0) GO TO 50
 371                IF (IAX.NE.1.AND.IAX.LE.6) THEN
 372                   DZ   = DXYZ(3) +PARM(1) -PAR(1)
 373                   DPDZ = 0.5*(PARM(IAX+4) -PARM(IAX))/PARM(1)
 374                   PAR(IAX) = PARM(IAX) + DPDZ*DZ
 375                ELSE IF (IAX.GT.6) THEN
 376                   DZ   = DXYZ(3) +PARM(1) +PAR(1)
 377                   DPDZ = 0.5*(PARM(IAX) -PARM(IAX-4))/PARM(1)
 378                   PAR(IAX) = PARM(IAX-4) + DPDZ*DZ
 379                ENDIF
 380    50       CONTINUE
 381             IF (IZCUT.NE.0) THEN
 382                HTAH = PARM(8)*PARM(11)
 383                HTAL = PARM(4)*PARM(7)
 384                ZZ1  = 0.5*(DXYZ(3) +PARM(1) -PAR(1))/PARM(1)
 385                PAR(7) = (HTAL*(1.-ZZ1) + HTAH*ZZ1)/PAR(4)
 386                ZZ2  = 0.5*(DXYZ(3) +PARM(1) +PAR(1))/PARM(1)
 387                PAR(11)= (HTAL*(1.-ZZ2) + HTAH*ZZ2)/PAR(8)
 388             ENDIF
 389             IF(IAX.EQ.2.AND.IZCUT.EQ.0) THEN
 390                DXDY1 = 0.5*(PARM(6)-PARM(5))/PARM(4)
 391                DXDY2 = 0.5*(PARM(10)-PARM(9))/PARM(8)
 392                DXM1  = 0.5*(PARM(6)+PARM(5))
 393                DXM2  = 0.5*(PARM(10)+PARM(9))
 394                DXH1  = DXM1+(DXYZ(2)+PAR(2))*DXDY1
 395                DXH2  = DXM2+(DXYZ(2)+PAR(2))*DXDY2
 396                DXL1  = DXM1+(DXYZ(2)-PAR(2))*DXDY1
 397                DXL2  = DXM2+(DXYZ(2)-PAR(2))*DXDY2
 398                PAR(5) = DXL1
 399                PAR(6) = DXH1
 400                PAR(9) = DXL2
 401                PAR(10) = DXH2
 402             ENDIF
 403          ENDIF
 404          CALL GNOTR1 (PAR)
 405 *
 406       ELSE IF (ISH.EQ.5) THEN
 407 *
 408 * TUBE
 409 *
 410          IF(ISHM.EQ.ISH) THEN
 411             IRMIN = 0
 412             IRMAX = 0
 413             IDZED = 0
 414             DO 60 JVAR=1,NVAR
 415                IF(LVAR(JVAR).EQ.1) IRMIN=1
 416                IF(LVAR(JVAR).EQ.2) IRMAX=1
 417                IF(LVAR(JVAR).EQ.3) IDZED=1
 418    60       CONTINUE
 419             RPOS = SQRT(DXYZ(1)**2+DXYZ(2)**2)
 420             IF(IRMIN.EQ.1) THEN
 421 *
 422 * Here we settle the minimum radius.
 423 *
 424                IF(PARM(1).GT.0.) THEN
 425                   PAR(1) = PARM(1)+RPOS
 426                ELSE
 427                   PAR(1) = 0.
 428                ENDIF
 429             ENDIF
 430             IF(IRMAX.EQ.1) THEN
 431 *
 432 * Case in which the max radius is variable.
 433 *
 434                IF(PAR(1).LE.RPOS-PARM(1).AND.PARM(1).GT.0.) THEN
 435 *
 436 * This is the case in which the 'hole' in the tube does not
 437 * intersect the 'hole' in the mother.
 438 *
 439                   PAR(2) = MIN(PARM(2)-RPOS,RPOS-PARM(1))
 440                ELSEIF(PAR(1).GE.RPOS+PARM(1).OR.PARM(1).EQ.0.) THEN
 441 *
 442 * This is the case in which the 'hole' in the tube contains the
 443 * 'hole' in the mother, or there is no 'hole' in the mother.
 444 *
 445                   PAR(2) = PARM(2)-RPOS
 446                ELSE
 447 *
 448 * And this is the error condition. The inner tube protrudes in the empty
 449 * space inside the outer one.
 450 *
 451                   WRITE(CHMAIL,11100) IQ(JVOLUM+IVO)
 452                   CALL GMAIL(0,0)
 453                   IEORUN = 1
 454                ENDIF
 455             ENDIF
 456             IF(IDZED.EQ.1) THEN
 457                PAR(3) = PARM(3)-ABS(DXYZ(3))
 458             ENDIF
 459             IF(PAR(1).GE.PAR(2).OR.PAR(2).GT.PARM(2)
 460      +                         .OR.PAR(3).LE.0.) THEN
 461                WRITE(CHMAIL,11000) IQ(JVOLUM+IVO)
 462                CALL GMAIL(0, 0)
 463                IEORUN = 1
 464             ENDIF
 465          ELSE
 466             WRITE (CHMAIL, 10900) ISH, ISHM
 467             CALL GMAIL (0, 0)
 468             IEORUN=1
 469          ENDIF
 470       ELSE IF (ISH.LE.10) THEN
 471 *
 472 * TRD1,TRD2,TUBE,TUBS,CONE,CONS,SPHE,PARA
 473 *
 474          IF (ISHM.EQ.ISH) THEN
 475 * in TRD1,TRD2,TUBE,TUBS,CONE,CONS,SPHE,PARA
 476             IF (DXYZ(1).NE.0..OR.DXYZ(2).NE.0..OR.DXYZ(3).NE.0.)
 477      +      THEN
 478                WRITE (CHMAIL, 10700) ISH, ISHM
 479                CALL GMAIL (0, 0)
 480                IEORUN = 1
 481             ELSE
 482                DO 70 I= 1, NVAR
 483                   IAX = LVAR(I)
 484                   PAR(IAX) = PARM(IAX)
 485    70          CONTINUE
 486             ENDIF
 487          ENDIF
 488 *
 489       ELSE IF (ISH.LE.12) THEN
 490 *
 491 * PGON,PCON
 492 *
 493          IF (ISHM.EQ.ISH) THEN
 494 * in PGON,PCON
 495             IF (ISH.EQ.11) THEN
 496                IPNZ = 4
 497             ELSE
 498                IPNZ = 3
 499             ENDIF
 500             NZ = PAR(IPNZ)
 501             NZ1 = PARM(IPNZ)
 502             IF (NZ.NE.2 .OR. NZ1.NE.2) THEN
 503                WRITE (CHMAIL, 10900) ISH, ISHM
 504                CALL GMAIL (0, 0)
 505                IEORUN = 1
 506             ELSE
 507                ZL = PARM(IPNZ+1)
 508                ZH = PARM(IPNZ+4)
 509                DZ = ZH - ZL
 510                TANLOW = (PARM(IPNZ+5)-PARM(IPNZ+2))/DZ
 511                TANHIG = (PARM(IPNZ+6)-PARM(IPNZ+3))/DZ
 512                Z1 = DXYZ(3) + PAR(IPNZ+1) - PARM(IPNZ+1)
 513                Z2 = DXYZ(3) + PAR(IPNZ+4) - PARM(IPNZ+1)
 514                PAR(IPNZ+2) = PARM(IPNZ+2) + TANLOW * Z1
 515                PAR(IPNZ+3) = PARM(IPNZ+3) + TANHIG * Z1
 516                PAR(IPNZ+5) = PARM(IPNZ+2) + TANLOW * Z2
 517                PAR(IPNZ+6) = PARM(IPNZ+3) + TANHIG * Z2
 518             ENDIF
 519          ENDIF
 520 *
 521       ENDIF
 522 *
 523 10300 FORMAT (' GGPPAR : Rotations not accepted at the moment')
 524 10400 FORMAT (' GGPPAR : Shape association not accepted', 2I5)
 525 10500 FORMAT (' GGPPAR : PAR(IAX) negative, ISH,ISHM,IAX=',3I5)
 526 10600 FORMAT (' GGPPAR : DZ negative, ISH,ISHM,IAX,DZ=',3I5,G12.4)
 527 10700 FORMAT (' GGPPAR : Not yet coded for ISH,ISHM=',2I5)
 528 10800 FORMAT (' GGPPAR : PARM error for ISH,ISHM,IAX=',3I5)
 529 10900 FORMAT (' GGPPAR : Configuration not accepted, ISH,ISHM=',2I5)
 530 11000 FORMAT (' GGPPAR : Tube ',A4,' has inconsistent parameters')
 531 11100 FORMAT (' GGPPAR : Tube ',A4,' protrudes into the inner space ',
 532      +        'of the mother')
 533 *                                                             END GGPPAR
 534   999 END