GEANT321/gxint/gxfz.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.1.1.1  1995/10/24 10:21:50  cernlib
   6 * Geant
   7 *
   8 *
   9 #include "geant321/pilot.h"
  10 *CMZ :  3.21/02 29/03/94  15.41.33  by  S.Giani
  11 *-- Author :
  12       SUBROUTINE GXFZ
  13 C.
  14 C.    ******************************************************************
  15 C.    *                                                                *
  16 C.    *      FZEBRA control commands                                   *
  17 C.    *                                                                *
  18 C.    *       Authors:   F.Carminati **********                        *
  19 C.    *                                                                *
  20 C.    ******************************************************************
  21 C.
  22 #include "geant321/gcbank.inc"
  23 #include "geant321/gcunit.inc"
  24 #include "geant321/gcxlun.inc"
  25 #include "geant321/gcflag.inc"
  26       COMMON/QUEST/IQUEST(100)
  27       CHARACTER*4  CHOPT
  28       CHARACTER*80 CHPATH
  29       CHARACTER*32 CHPATL
  30       CHARACTER*4  KEYSU
  31 C.
  32 C.    ------------------------------------------------------------------
  33 C.
  34       CALL KUPATL(CHPATL,NPAR)
  35 *
  36       IF (CHPATL.EQ.'FZOPEN') THEN
  37          CALL KUGETI(LUN)
  38          CALL GXLUNF(LUN,1,IFREE)
  39          IF(IFREE.NE.0) GOTO 99
  40          CALL KUGETC(CHPATH,NCHPAT)
  41          CALL KUGETC(CHOPT,NCH)
  42          CALL KUGETI(LRECL)
  43          CALL CUTOL(CHPATH)
  44          IF(INDEX(CHOPT,'A').NE.0) THEN
  45             OPEN(UNIT=LUN,FILE=CHPATH(1:NCHPAT),FORM='FORMATTED',
  46      +      STATUS='UNKNOWN')
  47          ELSE
  48             OPEN(UNIT=LUN,FILE=CHPATH(1:NCHPAT),FORM='UNFORMATTED',
  49      +      STATUS='UNKNOWN')
  50          ENDIF
  51          CALL GOPEN(LUN, CHOPT, LRECL, IER)
  52          IF(INDEX(CHOPT,'I').NE.0) THEN
  53             LUNIT(LUN)=1
  54          ELSE
  55             LUNIT(LUN)=2
  56          ENDIF
  57          IF(NPAR.GT.4) THEN
  58             CALL KUGETC(CHOPT,NCH)
  59             IF(INDEX(CHOPT,'I').NE.0)THEN
  60                LUNIT(LUN)=0
  61                IDENT = 0
  62                CALL GFIN(LUN, 'INIT', 1, IDENT, ' ',IER)
  63                IF(IER.LT.0) THEN
  64                   WRITE(CHMAIL,12300) IER
  65 12300 FORMAT(' *** GXFZ : Error in GFIN, IER = ',I4)
  66                   CALL GMAIL(0,0)
  67                ENDIF
  68                CALL GCLOSE(LUN,IER)
  69                LUNIT(LUN)=0
  70             ELSEIF(INDEX(CHOPT,'O').NE.0)THEN
  71                LUNIT(LUN)=0
  72                IDENT=1
  73                CALL GFOUT(LUN, 'INIT', 1, IDENT, ' ',IER)
  74                IF(IER.LT.0) THEN
  75                   WRITE(CHMAIL,12301) IER
  76 12301 FORMAT(' *** GXFZ : Error in GFOUT, IER = ',I4)
  77                   CALL GMAIL(0,0)
  78                ENDIF
  79                CALL GCLOSE(LUN,IER)
  80                LUNIT(LUN)=0
  81             ENDIF
  82          ENDIF
  83 *
  84       ELSEIF (CHPATL.EQ.'FZIN') THEN
  85          CALL KUGETI(LUN)
  86          CALL KUGETC(KEYSU,NCH)
  87          CALL KUGETI(IDENT)
  88          CALL GFIN(LUN, KEYSU, 1, IDENT, ' ',IER)
  89          IF(IER.LT.0) THEN
  90             WRITE(CHMAIL,12300) IER
  91             CALL GMAIL(0,0)
  92          ENDIF
  93 *
  94       ELSEIF (CHPATL.EQ.'FZOUT') THEN
  95          CALL KUGETI(LUN)
  96          CALL KUGETC(KEYSU,NCH)
  97          CALL KUGETI(IDENT)
  98          CALL GFOUT(LUN, KEYSU, 1, IDENT, ' ',IER)
  99          IF(IER.LT.0) THEN
 100             WRITE(CHMAIL,12301) IER
 101             CALL GMAIL(0,0)
 102          ENDIF
 103 *
 104       ELSEIF (CHPATL.EQ.'FZCLOSE') THEN
 105          CALL KUGETI(LUN)
 106          CALL GCLOSE(LUN, IER)
 107          LUNIT(LUN)=0
 108 *
 109       ENDIF
 110 *
 111    99 END