GEANT321/giopa/gfin.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.1.1.1  1995/10/24 10:21:16  cernlib
   6 * Geant
   7 *
   8 *
   9 #include "geant321/pilot.h"
  10 *CMZ :  3.21/02 29/03/94  15.41.20  by  S.Giani
  11 *-- Author :
  12       SUBROUTINE GFIN(LUN,CHOBJ,NKEYS,IDVERS,CHOPT,IER)
  13 C.
  14 C.    ******************************************************************
  15 C.    *                                                                *
  16 C.    *       Routine to read GEANT object(s) fromin the FZ file       *
  17 C.    *       The data structures from disk are read in memory         *
  18 C.    *                                                                *
  19 C.    *       LUN    Logical unit                                      *
  20 C.    *                                                                *
  21 C.    *       CHOBJ  The type of data structure to be read:            *
  22 C.    *              MATE material                                     *
  23 C.    *              TMED tracking medium                              *
  24 C.    *              VOLU volumes                                      *
  25 C.    *              ROTM rotation matrix                              *
  26 C.    *              SETS detector set                                 *
  27 C.    *              PART particle                                     *
  28 C.    *              SCAN geometry                                     *
  29 C.    *              INIT read all above                               *
  30 C.    *              KINE this keyword will trigger the read of        *
  31 C.    *                   KINE and VERT unless the flag 'S' is set     *
  32 C.    *              DIGI digitisation                                 *
  33 C.    *              DRAW drawing                                      *
  34 C.    *              HEAD event header                                 *
  35 C.    *              HITS hits                                         *
  36 C.    *              RUNG run                                          *
  37 C.    *              STAK particle temporary stack                     *
  38 C.    *              STAT volume statistic                             *
  39 C.    *              VERT vertex                                       *
  40 C.    *              JXYZ track points                                 *
  41 C.    *              TRIG this keyword will trigger the read of        *
  42 C.    *                   DIGI, HEAD, HITS, KINE, VERT abd JXYZ        *
  43 C.    *                   unless the 'S' flag is set                   *
  44 C.    *                                                                *
  45 C.    *       NKEYS  number of keys in vector CHOBJ                    *
  46 C.    *                                                                *
  47 C.    *       IDVERS version of the data structure to be read in       *
  48 C.    *                                                                *
  49 C.    *       CHOPT  List of options                                   *
  50 C.    *                   'I'      read only initialisation data       *
  51 C.    *                            structures                          *
  52 C.    *                   'K'      read only KINE and TRIG data        *
  53 C.    *                            structures                          *
  54 C.    *                   'T'      read only DIGI, HEAD, HITS, KINE,   *
  55 C.    *                            VERT and JXYZ data structures       *
  56 C.    *              even if other keys are specified in CHOBJ         *
  57 C.    *                                                                *
  58 C.    *                   'S'       interpret KINE to mean only        *
  59 C.    *                             KINE and TRIG and INIT to mean     *
  60 C.    *                             nothing                            *
  61 C.    *                   'Q'       quiet option, no message is        *
  62 C.    *                             printed                            *
  63 C.    *                                                                *
  64 C.    *       IER    error flag. <0 ZEBRA error flag as returned in    *
  65 C.    *                             IQUEST(1)                          *
  66 C.    *                           0 read completed successfully        *
  67 C.    *                          >0 if only IER structures read in     *
  68 C.    *                                                                *
  69 C.    *    The FZ data base has been created via GOPEN/GFOUT           *
  70 C.    *                                                                *
  71 C.    *                                                                *
  72 C.    *      Example.                                                  *
  73 C.    *                                                                *
  74 C.    *      CALL GOPEN(1,'I',1024,IER)                                *
  75 C.    *      CALL GFIN (1,'VOLU',1,0,' ',IER)                          *
  76 C.    *      CALL GFIN (1,'MATE',1,0,' ',IER)                          *
  77 C.    *      CALL GFIN (1,'TMED',1,0,' ',IER)                          *
  78 C.    *      CALL GFIN (1,'ROTM',1,0,' ',IER)                          *
  79 C.    *      CALL GFIN (1,'PART',1,0,' ',IER)                          *
  80 C.    *      CALL GFIN (1,'SCAN',1,0,' ',IER)                          *
  81 C.    *      CALL GFIN (1,'SETS',1,0,' ',IER)                          *
  82 C.    *                                                                *
  83 C.    *    ==>Called by : <USER> ,GOPEN                                *
  84 C.    *       Author    F.Carminati *******                            *
  85 C.    *                                                                *
  86 C.    ******************************************************************
  87 C.
  88 #include "geant321/gcbank.inc"
  89 #include "geant321/gcflag.inc"
  90 #include "geant321/gconsp.inc"
  91 #include "geant321/gcnum.inc"
  92 #include "geant321/gccuts.inc"
  93 #include "geant321/gcscal.inc"
  94 #include "geant321/gcdraw.inc"
  95 #include "geant321/gcvolu.inc"
  96 #include "geant321/gcunit.inc"
  97 #include "geant321/gctime.inc"
  98 *      COMMON/GCLINK/JDIGI ,JDRAW ,JHEAD ,JHITS ,JKINE ,JMATE ,JPART
  99 *     +      ,JROTM ,JRUNG ,JSET  ,JSTAK ,JGSTAT,JTMED ,JTRACK,JVERTX
 100 *     +      ,JVOLUM,JXYZ  ,JGPAR ,JGPAR2,JSKLT
 101       COMMON/QUEST/IQUEST(100)
 102       PARAMETER (NLINIT=9,NLKINE=2,NLTRIG=6,NMKEY=22)
 103       DIMENSION JNAMES(20),LINIT(NLINIT),LKINE(NLKINE)
 104       DIMENSION LTRIG(NLTRIG),IXD(NMKEY)
 105       DIMENSION LINK(NMKEY),IVERSI(NMKEY),LDIV(2),IRESUL(NMKEY)
 106       DIMENSION IDOLD(8), IDNEW(8), VEROLD(8), VERNEW(8)
 107       DIMENSION IUHEAD(2),ITRAN(23)
 108       EQUIVALENCE (JNAMES(1),JDIGI)
 109       CHARACTER*4 KNAMES(NMKEY),CHOBJ(*)
 110       CHARACTER*(*) CHOPT
 111       DATA KNAMES/'DIGI','DRAW','HEAD','HITS','KINE','MATE','PART',
 112      +     'ROTM','RUNG','SETS','STAK','STAT','TMED','NULL','VERT',
 113      +     'VOLU','JXYZ','NULL','NULL','NULL','SCAN','NULL'/
 114       DATA ITRAN/7,6,13,16,8,10,2,9,8*0,3,15,5,17,4,1,21/
 115       DATA IXD/2,1,2,2,2,8*1,2,2,1,2,3*0,1,0/
 116       DATA LINIT/2,6,7,8,9,10,13,16,21/
 117       DATA LKINE/5,15/
 118       DATA LTRIG/1,3,4,5,15,17/
 119       DATA IDNEW / 8*0 /
 120       DATA VERNEW / 8*0. /
 121 C.
 122 C.    ------------------------------------------------------------------
 123 C.
 124       IQUEST(1)=0
 125       LDIV(1)  =IXCONS
 126       LDIV(2)  =IXDIV
 127       KVOL=JVOLUM
 128       IER=0
 129 *
 130       IOPTI=INDEX(CHOPT,'i')+INDEX(CHOPT,'I')
 131       IOPTT=INDEX(CHOPT,'t')+INDEX(CHOPT,'T')
 132       IOPTK=INDEX(CHOPT,'k')+INDEX(CHOPT,'K')
 133       IOPTS=INDEX(CHOPT,'s')+INDEX(CHOPT,'S')
 134       IOPTQ=INDEX(CHOPT,'q')+INDEX(CHOPT,'Q')
 135 *
 136 *     Save old JRUNG dates and versions
 137       IF(JRUNG.GT.0) THEN
 138          DO 10 J=1,8
 139             IDOLD(J) = IQ(JRUNG+10+J)
 140             VEROLD(J) = Q(JRUNG+20+J)
 141    10    CONTINUE
 142       ENDIF
 143 *
 144       NLINK=0
 145       DO 100 JKEY=1,NKEYS
 146          IF(IOPTS.EQ.0) THEN
 147          IF(CHOBJ(JKEY).EQ.'INIT') THEN
 148             DO 30 J=1, NLINIT
 149                DO 20  MLINK=1,NLINK
 150                   IF(LINK(MLINK).EQ.LINIT(J)) GO TO 30
 151    20          CONTINUE
 152                NLINK=NLINK+1
 153                LINK(NLINK)=LINIT(J)
 154    30       CONTINUE
 155             GO TO 100
 156          ELSEIF(CHOBJ(JKEY).EQ.'TRIG') THEN
 157             DO 50 J=1, NLTRIG
 158                DO 40  MLINK=1,NLINK
 159                   IF(LINK(MLINK).EQ.LTRIG(J)) GO TO 50
 160    40          CONTINUE
 161                NLINK=NLINK+1
 162                LINK(NLINK)=LTRIG(J)
 163    50       CONTINUE
 164             GO TO 100
 165          ELSEIF(CHOBJ(JKEY).EQ.'KINE') THEN
 166             DO 70 J=1, NLKINE
 167                DO 60  MLINK=1,NLINK
 168                   IF(LINK(MLINK).EQ.LKINE(J)) GO TO 70
 169    60          CONTINUE
 170                NLINK=NLINK+1
 171                LINK(NLINK)=LKINE(J)
 172    70       CONTINUE
 173             GO TO 100
 174          ENDIF
 175          ENDIF
 176             DO 90 J=1,NMKEY
 177                IF(CHOBJ(JKEY).EQ.KNAMES(J)) THEN
 178                   DO 80 MLINK=1,NLINK
 179                      IF(LINK(MLINK).EQ.J) GO TO 100
 180    80             CONTINUE
 181                   NLINK=NLINK+1
 182                   LINK(NLINK)=J
 183                   GO TO 100
 184                ENDIF
 185    90       CONTINUE
 186             WRITE(CHMAIL,10300) CHOBJ(JKEY)
 187             IF(IOPTQ.EQ.0) CALL GMAIL(0,0)
 188   100 CONTINUE
 189 *
 190       IF(IOPTI.GT.0) THEN
 191          DO 120 J=1, NLINK
 192             DO 110 K=1, NLINIT
 193                IF(LINK(J).EQ.LINIT(K)) GO TO 120
 194   110       CONTINUE
 195             WRITE(CHMAIL,10000) KNAMES(LINK(J))
 196             IF(IOPTQ.EQ.0) CALL GMAIL(0,0)
 197             LINK(J)=0
 198   120    CONTINUE
 199       ELSEIF(IOPTK.GT.0) THEN
 200          DO 140 J=1, NLINK
 201             DO 130 K=1, NLKINE
 202                IF(LINK(J).EQ.LKINE(K)) GO TO 140
 203   130       CONTINUE
 204             WRITE(CHMAIL,10100) KNAMES(LINK(J))
 205             IF(IOPTQ.EQ.0) CALL GMAIL(0,0)
 206             LINK(J)=0
 207   140    CONTINUE
 208       ELSEIF(IOPTT.GT.0) THEN
 209          DO 160 J=1, NLINK
 210             DO 150 K=1, NLTRIG
 211                IF(LINK(J).EQ.LTRIG(K)) GO TO 160
 212   150       CONTINUE
 213             WRITE(CHMAIL,10200) KNAMES(LINK(J))
 214             IF(IOPTQ.EQ.0) CALL GMAIL(0,0)
 215             LINK(J)=0
 216   160    CONTINUE
 217       ENDIF
 218       IOFF=0
 219       DO 170 J=1, NLINK
 220          IF(LINK(J).EQ.0) THEN
 221             IOFF=IOFF-1
 222          ELSE
 223             LINK(J+IOFF)=LINK(J)
 224          ENDIF
 225   170 CONTINUE
 226       NLINK=NLINK+IOFF
 227       NPOS=0
 228       DO 171 JL=1,NLINK
 229          IF(LINK(JL).EQ.9.OR.LINK(JL).EQ.3) THEN
 230             NPOS=JL
 231             GOTO 172
 232          ENDIF
 233   171 CONTINUE
 234   172 CONTINUE
 235 *
 236       IF(NLINK.LE.0) THEN
 237          WRITE(CHMAIL,10400)
 238          IF(IOPTQ.EQ.0) CALL GMAIL(0,0)
 239          IER=-1
 240          GOTO 999
 241       ENDIF
 242 *
 243       IF(IOPTI+IOPTK+IOPTT.EQ.0) THEN
 244 *
 245 *        We have to choose which event header to read, JRUNG or JHEAD
 246 *        If the banks list contains banks depending from both headers,
 247 *        the result is unpredictable. Error message to be inserted later.
 248          DO 168 J=1, NLINK
 249             DO 161 L=1, NLINIT
 250                IF(LINK(J).EQ.LINIT(L)) THEN
 251                   IOPTI=-1
 252                   GOTO 169
 253                ENDIF
 254   161       CONTINUE
 255             DO 162 L=1, NLKINE
 256                IF(LINK(J).EQ.LKINE(L)) THEN
 257                   IOPTK=-1
 258                   GOTO 169
 259                ENDIF
 260   162       CONTINUE
 261             DO 163 L=1, NLTRIG
 262                IF(LINK(J).EQ.LTRIG(L)) THEN
 263                   IOPTT=-1
 264                   GOTO 169
 265                ENDIF
 266   163       CONTINUE
 267   168    CONTINUE
 268   169    CONTINUE
 269       ENDIF
 270 *
 271       DO 180 J=1, NLINK
 272          IVERSI(J)=0
 273          IRESUL(J)=0
 274   180 CONTINUE
 275 *
 276 *               Go for next start of event data structure
 277   190 IF(IOPTI.NE.0) THEN
 278          IF(JRUNG.NE.0)CALL MZDROP(IXCONS,JRUNG,' ')
 279          NUH=2
 280          CALL FZIN(LUN,IXCONS,JRUNG,1,'E',NUH,IUHEAD)
 281          IF(IQUEST(1).GE.2) THEN
 282             IER = -IQUEST(1)
 283             GO TO 240
 284          ENDIF
 285          IF(NPOS.NE.0) THEN
 286             IVERSI(NPOS)=IUHEAD(1)
 287             IRESUL(NPOS)=1
 288          ENDIF
 289       ELSEIF(IOPTT+IOPTK.NE.0) THEN
 290          IF(JHEAD.NE.0)CALL MZDROP(IXDIV,JHEAD,' ')
 291          NUH=2
 292          CALL FZIN(LUN,IXDIV,JHEAD,1,'E',NUH,IUHEAD)
 293          IF(IQUEST(1).GE.2) THEN
 294             IER = -IQUEST(1)
 295             GO TO 240
 296          ENDIF
 297          IF(NPOS.NE.0) THEN
 298             IVERSI(NPOS)=IUHEAD(1)
 299             IRESUL(NPOS)=1
 300          ENDIF
 301       ENDIF
 302 *
 303       IVERIN = IUHEAD(1)
 304       IF(IDVERS.NE.0.AND.IDVERS.NE.IVERIN) THEN
 305          DO 200 I=1,NLINK
 306             LINK(I)=-ABS(LINK(I))
 307   200    CONTINUE
 308          GOTO 190
 309       ELSE
 310          IF (IDVERS .EQ. 0) IDVERS = IVERIN
 311          DO 210 I=1,NLINK
 312             LINK(I)= ABS(LINK(I))
 313   210    CONTINUE
 314       ENDIF
 315       NK   = IUHEAD(2)
 316       IF(NK.GT.10) THEN
 317          WRITE(CHMAIL,11100) NK
 318          IF(IOPTQ.EQ.0) CALL GMAIL(0,0)
 319          IER=-1
 320          GO TO 999
 321       ENDIF
 322       DO 230 IK=1,NK
 323 C
 324 C              Read next header
 325 C
 326          NUH=2
 327          CALL FZIN(LUN,0,0,0,'S',NUH,IUHEAD)
 328          IF(IQUEST(1).GT.2)GO TO 320
 329          IKEY=ITRAN(IUHEAD(1))
 330          DO 220 I=1,NLINK
 331             NKEY=LINK(I)
 332             IF(IKEY.EQ.NKEY)THEN
 333                IDIV=LDIV(IXD(NKEY))
 334                IF(NKEY.LE.20)THEN
 335                   IF(JNAMES(NKEY).NE.0)THEN
 336                      CALL MZDROP(IDIV,JNAMES(NKEY),'L')
 337                      JNAMES(NKEY)=0
 338                   ENDIF
 339                   CALL FZIN(LUN,IDIV,JNAMES(NKEY),1,'A',NUH,IUHEAD)
 340                ELSE
 341                   NKL=NKEY-20
 342                   IF(ISLINK(NKL).NE.0)THEN
 343                      CALL MZDROP(IDIV,ISLINK(NKL),'L')
 344                      ISLINK(NKL)=0
 345                   ENDIF
 346                   CALL FZIN(LUN,IDIV,ISLINK(NKL),1,'A',NUH,IUHEAD)
 347                ENDIF
 348                IF(IQUEST(1).LE.2.AND.IQUEST(1).GE.0) THEN
 349                   IVERSI(I)=IVERIN
 350                   IRESUL(I)=1
 351                   GOTO 230
 352                ELSE
 353                   GOTO 320
 354                ENDIF
 355             ENDIF
 356   220    CONTINUE
 357   230 CONTINUE
 358 *
 359   240 NIN=0
 360       DO 250 I=1,NLINK
 361          IF(IRESUL(I).EQ.1) THEN
 362             WRITE(CHMAIL,10500) KNAMES(LINK(I)), IVERSI(I)
 363             IF(IOPTQ.EQ.0) CALL GMAIL(0,0)
 364             NIN=NIN+1
 365          ELSEIF(LINK(I).GT.0) THEN
 366             WRITE(CHMAIL,10600) KNAMES(LINK(I))
 367             IF(IOPTQ.EQ.0) CALL GMAIL(0,0)
 368          ELSEIF(LINK(I).LT.0) THEN
 369             WRITE(CHMAIL,10700) KNAMES(-LINK(I)), IDVERS
 370             IF(IOPTQ.EQ.0) CALL GMAIL(0,0)
 371          ENDIF
 372   250 CONTINUE
 373 *
 374       IF(NIN.EQ.0) THEN
 375          WRITE(CHMAIL,10800)
 376          IF(IOPTQ.EQ.0) CALL GMAIL(0,0)
 377          IF(IER.GE.0) IER=-1
 378          GOTO 999
 379       ELSEIF(NIN.LT.NLINK) THEN
 380          IER=NIN
 381       ENDIF
 382 *
 383       IF(KVOL.NE.JVOLUM)THEN
 384          NVOLUM=IQ(JVOLUM-1)
 385          CALL MZGARB(IXCONS,0)
 386          CALL GGDVLP
 387          CALL GGNLEV
 388       ENDIF
 389 *
 390       IF(JVOLUM.GT.0) THEN
 391          NLEVEL=0
 392          NVOLUM=0
 393          DO 260 J=1, IQ(JVOLUM-2)
 394             IF(LQ(JVOLUM-J).EQ.0) GOTO 270
 395             NVOLUM=NVOLUM+1
 396   260    CONTINUE
 397   270    CONTINUE
 398       ENDIF
 399 *
 400       IF(JTMED.NE.0 )THEN
 401          CALL UCOPY(Q(JTMED+1),CUTGAM,10)
 402          NTMED=IQ(JTMED-2)
 403       ENDIF
 404 *
 405       IF(JPART.NE.0 ) NPART = IQ(JPART-2)
 406       IF(JVERTX.NE.0) NVERTX = IQ(JVERTX+1)
 407       IF(JKINE.NE.0) NTRACK = IQ(JKINE+1)
 408       IF(JMATE.NE.0 ) NMATE = IQ(JMATE-2)
 409       IF(JROTM.NE.0 ) NROTM = IQ(JROTM-2)
 410       IF(JDRAW.GT.0 ) THEN
 411          NKVIEW = IQ(JDRAW-2)
 412       ELSE
 413          NKVIEW = 0
 414 C
 415 C             Book JDRAW structure for view banks
 416 C
 417          CALL MZBOOK(IXCONS,JDRAW,JDRAW,1,'DRAW',0,0,0,3,0)
 418       ENDIF
 419
 420 C
 421       IF(JHEAD.GT.0)THEN
 422          IDRUN=IQ(JHEAD+1)
 423          IDEVT=IQ(JHEAD+2)
 424       ENDIF
 425       IF(JRUNG.GT.0) THEN
 426 *
 427 *             Here we deal with version numbers If JRUNG has been read in,
 428 *             then save the version numbers of the new JRUNG and restore
 429 *             the current version number for KINE, HITS and DIGI
 430          DO 300 J=1, NLINK
 431             IF(IVERSI(J).GT.0) THEN
 432                NKEY = ABS(LINK(J))
 433                IF(KNAMES(NKEY).EQ.'RUNG') THEN
 434                   DO 280 I=1,8
 435                      IDNEW(I) = IQ(JRUNG+10+I)
 436                      VERNEW(I) = Q(JRUNG+20+I)
 437   280             CONTINUE
 438 *
 439 *             And we put back the old version numbers because,
 440 *             in principle, KINE, HITS and DIGI have not be read in
 441                   DO 290 I=3,8
 442                      IQ(JRUNG+10+I) = IDOLD(I)
 443                      Q(JRUNG+20+I) = VEROLD(I)
 444   290             CONTINUE
 445                ENDIF
 446             ENDIF
 447   300    CONTINUE
 448 *
 449 *            And here we do it again for KINE, HITS and DIGI
 450          DO 310 J=1, NLINK
 451             IF(IVERSI(J).GT.0) THEN
 452                NKEY = ABS(LINK(J))
 453                IF(KNAMES(NKEY).EQ.'KINE') THEN
 454                   IF(IDNEW(3).GT.0) THEN
 455                      IQ(JRUNG+13) = IDNEW(3)
 456                      IQ(JRUNG+14) = IDNEW(4)
 457                      Q(JRUNG+23) = VERNEW(3)
 458                      Q(JRUNG+24) = VERNEW(4)
 459                   ENDIF
 460                ELSEIF(KNAMES(NKEY).EQ.'HITS') THEN
 461                   IF(IDNEW(5).GT.0) THEN
 462                      IQ(JRUNG+15) = IDNEW(5)
 463                      IQ(JRUNG+16) = IDNEW(6)
 464                      Q(JRUNG+25) = VERNEW(5)
 465                      Q(JRUNG+26) = VERNEW(6)
 466                   ENDIF
 467                ELSEIF(KNAMES(NKEY).EQ.'DIGI') THEN
 468                   IF(IDNEW(7).GT.0) THEN
 469                      IQ(JRUNG+17) = IDNEW(7)
 470                      IQ(JRUNG+18) = IDNEW(8)
 471                      Q(JRUNG+27) = VERNEW(7)
 472                      Q(JRUNG+28) = VERNEW(8)
 473                   ENDIF
 474                ELSEIF(KNAMES(NKEY).EQ.'MATE'.OR. KNAMES(NKEY) .EQ.'TMED'
 475      +         ) THEN
 476                   IF(VERNEW(1).NE.0) THEN
 477 *                We know which version number we are reading
 478                      IF(VERNEW(1).LT.GVERSN) THEN
 479                         WRITE(CHMAIL,10900) KNAMES(NKEY),VERNEW(1),
 480      +                  GVERSN
 481                         IF(IOPTQ.EQ.0) CALL GMAIL(0,0)
 482                         WRITE(CHMAIL,11000)
 483                         IF(IOPTQ.EQ.0) CALL GMAIL(0,0)
 484                      ENDIF
 485                   ENDIF
 486                ENDIF
 487             ENDIF
 488   310    CONTINUE
 489       ENDIF
 490   320 CONTINUE
 491 *
 492 10000 FORMAT(' *** GFIN *** Key ',A4,' ignored for initialization')
 493 10100 FORMAT(' *** GFIN *** Key ',A4,' ignored for kinematics')
 494 10200 FORMAT(' *** GFIN *** Key ',A4,' ignored for trigger')
 495 10300 FORMAT(' *** GFIN *** Unknown key ',A4)
 496 10400 FORMAT(' *** GFIN *** No valid key given')
 497 10500 FORMAT(' *** GFIN *** Data structure ',A4,' version ',I10,
 498      +       ' successfully read in ')
 499 10600 FORMAT(' *** GFIN *** Data structure ',A4,' was not found')
 500 10700 FORMAT(' *** GFIN *** Data structure ',A4,' version ',I10,
 501      +       ' was not found')
 502 10800 FORMAT(' *** GFIN *** Nothing found to read !')
 503 10900 FORMAT(' *** GFIN *** ',A4,' data structure ',
 504      +       'version ',F6.4,' current version is ',F6.4)
 505 11000 FORMAT('              Please call subroutine GPHYSI before ',
 506      +       'tracking')
 507 11100 FORMAT(' *** GFIN ***  Illegal number of links ',I10)
 508   999 END