GEANT321/ggeom/ggppar.F.ori

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