MINICERN/packlib/zebra/fq/fzloc.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.2  1996/04/18 16:10:44  mclareni
   6 * Incorporate changes from J.Zoll for version 3.77
   7 *
   8 * Revision 1.1.1.1  1996/03/06 10:47:15  mclareni
   9 * Zebra
  10 *
  11 *
  12 #include "zebra/pilot.h"
  13       SUBROUTINE FZLOC (LUNP,MODEP)
  14
  15 C-    Locate FZ control-bank for unit LUN
  16 C-    Unpack control information
  17
  18 C-    MODE =  -2 or +2 : connect as output unit
  19 C-            -1 or +1 : connect as input  unit
  20 C-                   0 : no connection (for FZFILE, FZHOOK, FZLIMI, etc)
  21 C-         if > 0 : unit is required for the given I/O mode
  22 C-         if < 0 : wanting to 'end' the unit (for FZENDx)
  23 C-                  if IQUEST(1) < 0 : connect only if active
  24 C-                                     (loop for all units)
  25 C-                               = 0 : connect if possible
  26 C-                                     (for the particular unit)
  27
  28 #include "zebra/zstate.inc"
  29 #include "zebra/mqsys.inc"
  30 #include "zebra/eqlqf.inc"
  31 #include "zebra/fzcf.inc"
  32 #include "zebra/fzci.inc"
  33 #include "zebra/fzcx.inc"
  34 C--------------    End CDE                             --------------
  35       DIMENSION    LUNP(9), MODEP(9)
  36       DIMENSION    PILX(4)
  37       EQUIVALENCE (PILX(1),IPILX(1))
  38 #if defined(CERNLIB_QMVDS)
  39       SAVE         CHDATA
  40 #endif
  41 #if (defined(CERNLIB_QTRHOLL))&&(!defined(CERNLIB_A6M))
  42       DIMENSION    NAMESR(2)
  43       DATA  NAMESR / 4HFZLO, 4HC    /
  44 #endif
  45 #if (defined(CERNLIB_QTRHOLL))&&(defined(CERNLIB_A6M))
  46       DATA  NAMESR / 6HFZLOC /
  47 #endif
  48 #if !defined(CERNLIB_QTRHOLL)
  49       CHARACTER    NAMESR*8
  50       PARAMETER   (NAMESR = 'FZLOC   ')
  51 #endif
  52       DATA  CHDATA / 12345.0 /
  53
  54 #include "zebra/q_jbit.inc"
  55 #include "zebra/q_jbyt.inc"
  56
  57       LUN  = LUNP(1)
  58       MODE = MODEP(1)
  59       MODA = IABS(MODE)
  60       MODS = IQUEST(1)
  61
  62       LQFF = LQFS
  63    14 IF (LQFF.NE.0)  THEN
  64           IF (IQ(KQSP+LQFF-5).EQ.LUN)  GO TO 21
  65           LQFF = LQ(KQSP+LQFF)
  66           GO TO 14
  67         ELSE
  68           LUNF  = 0
  69           IACTVF= 0
  70           IF (MODE.GT.0)           GO TO 94
  71           RETURN
  72         ENDIF
  73
  74 C--                Bank for LUN found
  75
  76    21 MSTATF = IQ(KQSP+LQFF)
  77       MEDIUF = JBYT (MSTATF,1,3)
  78       IFIFOF = JBYT (MSTATF,4,3)
  79       IDAFOF = JBIT (MSTATF,7)
  80       IACMOF = JBYT (MSTATF,8,3)
  81       IUPAKF = JBIT (MSTATF,16)
  82       IADOPF = IQ(KQSP+LQFF+1)
  83       IACTVF = IQ(KQSP+LQFF+2)
  84       INCBPF = IQ(KQSP+LQFF+3)
  85       LOGLVF = IQ(KQSP+LQFF+4)
  86       MAXREF = IQ(KQSP+LQFF+5)
  87       LUNF   = LUN
  88       IF   (MODA-1)          79, 31, 51
  89
  90 C--                Connect as input unit
  91
  92    31 IF (IACTVF.LT.1)             GO TO 34
  93       IF (IACTVF.GE.8)             GO TO 34
  94    32 MSTATI = MSTATF
  95       MEDIUI = MEDIUF
  96       IFIFOI = IFIFOF
  97       IDAFOI = IDAFOF
  98       IACMOI = IACMOF
  99       IUPAKI = IUPAKF
 100       IADOPI = IADOPF
 101       IACTVI = IACTVF
 102       INCBPI = INCBPF
 103       LOGLVI = LOGLVF
 104       MAXREI = MAXREF
 105       LUNI   = LUNF
 106       LQFI   = LQFF
 107       GO TO 79
 108
 109 C--   connection required
 110    34 IF (MODE.LT.0)               GO TO 36
 111       IF (JBIT(MSTATF,11).EQ.0)    GO TO 93
 112       IF (IACTVF.EQ.0)             GO TO 37
 113       IF (IACTVF.EQ.8)             GO TO 37
 114       IF (IACTVF.NE.18)            GO TO 92
 115       IACTVF = 0
 116       GO TO 37
 117
 118 C--   connect if possible
 119    36 IF (MODS.LT.0)               GO TO 79
 120       IF (JBIT(MSTATF,11).EQ.0)    GO TO 79
 121       IF (IACTVF.EQ.0)             GO TO 37
 122       IF (IACTVF.EQ.8)             GO TO 37
 123       IF (IACTVF.NE.18)            GO TO 79
 124
 125 C--   clear buffer parameters
 126    37 IF (IFIFOF.EQ.0)             GO TO 32
 127       CALL VZERO (IQ(KQSP+LQFF+40),INCBPF-40)
 128       GO TO 32
 129
 130
 131 C--                Connect as output unit
 132
 133    51 IF (IACTVF.LT.11)            GO TO 54
 134       IF (IACTVF.EQ.18)            GO TO 54
 135    52 MSTATX = MSTATF
 136       MEDIUX = MEDIUF
 137       IFIFOX = IFIFOF
 138       IDAFOX = IDAFOF
 139       IACMOX = IACMOF
 140       IUPAKX = IUPAKF
 141       IADOPX = IADOPF
 142       IACTVX = IACTVF
 143       INCBPX = INCBPF
 144       LOGLVX = LOGLVF
 145       MAXREX = MAXREF
 146       LUNX   = LUNF
 147       LQFX   = LQFF
 148       GO TO 79
 149
 150 C--   connection required
 151    54 IF (MODE.LT.0)               GO TO 56
 152       IF (JBIT(MSTATF,12).EQ.0)    GO TO 93
 153       IF (IACTVF.EQ.10)            GO TO 57
 154       IF (IACTVF.NE.0)             GO TO 91
 155       GO TO 57
 156
 157 C--   connect if possible
 158    56 IF (MODS.LT.0)               GO TO 79
 159       IF (JBIT(MSTATF,12).EQ.0)    GO TO 79
 160       IF (IACTVF.EQ.10)            GO TO 57
 161       IF (IACTVF.NE.0)             GO TO 79
 162
 163 C--   clear buffer parameters
 164    57 IF (IFIFOF.NE.0)  CALL VZERO (IQ(KQSP+LQFF+40),INCBPF-40)
 165        PILX(1) = CHDATA
 166       IPILX(2) = 10000.0 * QVERSN + .2
 167       IPILX(3) = 0
 168       IPILX(4) = 0
 169       GO TO 52
 170
 171    79 RETURN
 172
 173 C-------------------------------------------------
 174 C-                 trouble
 175 C-------------------------------------------------
 176
 177 C--                Write after read without FZEND
 178
 179    91 NQCASE = -1
 180
 181 C--                Read after write without REWIND
 182
 183    92 NQCASE = NQCASE + 2
 184       NQFATA = 3
 185       IQUEST(13) = IACTVF
 186       GO TO 90
 187
 188 C--                Permission fault
 189
 190    93 NQCASE = 3
 191       NQFATA = 3
 192       IQUEST(13) = JBYT (MSTATF,11,2)
 193       GO TO 90
 194
 195 C--                File not opened
 196
 197    94 NQCASE = 4
 198       NQFATA = 2
 199    90 IQUEST(11) = LUN
 200       IQUEST(12) = MODE
 201 #include "zebra/qtrace.inc"
 202 #include "zebra/qtofatal.inc"
 203       END
 204 *      ==================================================
 205 #include "zebra/qcardl.inc"