MINICERN/packlib/zebra/fq/fzophr.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.2  1996/04/18 16:10:48  mclareni
   6 * Incorporate changes from J.Zoll for version 3.77
   7 *
   8 * Revision 1.1.1.1  1996/03/06 10:47:11  mclareni
   9 * Zebra
  10 *
  11 *
  12 #include "zebra/pilot.h"
  13       SUBROUTINE FZOPHR
  14
  15 C-    Write one physical record
  16 C-    service routine to FZOUT
  17
  18 #include "zebra/zunit.inc"
  19 #include "zebra/mqsys.inc"
  20 #include "zebra/eqlqf.inc"
  21 #include "zebra/mzcn.inc"
  22 #include "zebra/mzioc.inc"
  23 #include "zebra/fzcx.inc"
  24 C--------------    End CDE                             --------------
  25
  26 #include "fzstamp.inc"
  27
  28 *      Declaratives, DIMENSION etc.
  29 #include "fzophrd1.inc"
  30 * Ignoring t=pass
  31
  32 #if (defined(CERNLIB_QTRHOLL))&&(!defined(CERNLIB_A6M))
  33       DIMENSION    NAMESR(2)
  34       DATA  NAMESR / 4HFZOP, 4HHR   /
  35 #endif
  36 #if (defined(CERNLIB_QTRHOLL))&&(defined(CERNLIB_A6M))
  37       DATA  NAMESR / 6HFZOPHR /
  38 #endif
  39 #if !defined(CERNLIB_QTRHOLL)
  40       CHARACTER    NAMESR*8
  41       PARAMETER   (NAMESR = 'FZOPHR  ')
  42 #endif
  43
  44 *      Declaratives, DATA
  45 #include "fzophrd2.inc"
  46
  47
  48 #include "zebra/qtrace.inc"
  49
  50 C------            Book-keeping
  51
  52       JOP = IDX(2)
  53       IF (JOP.LT.-1)               GO TO 81
  54       IQ(KQSP+LQFX+22) = IQ(KQSP+LQFX+22) + 1
  55       IQ(KQSP+LQFX+33) = IQ(KQSP+LQFX+33) + 1
  56
  57       JFAST  = IQ(KQSP+LBPARX-6)
  58       NFASTX = IQ(KQSP+LBPARX-5)
  59       IF (JFAST.NE.0)              GO TO 17
  60
  61 C--                Steering record
  62
  63       LQ(L4STAX)   = MCCW1
  64       LQ(L4STAX+1) = MCCW2
  65       LQ(L4STAX+2) = MCCW3
  66       LQ(L4STAX+3) = MCCW4
  67       LQ(L4STAX+7) = NFASTX
  68       IQ(KQSP+LQFX+23)= IQ(KQSP+LQFX+23) + 1
  69 #if defined(CERNLIB_QDEVZE)
  70       J = LQ(L4STAX+5)
  71       IF (LOGLVX.GE.3)  WRITE (IQLOG,9716) J,NFASTX
  72  9716 FORMAT (' FZOPHR-  write steering record #',I5,' NFASTX=',2I4)
  73 #endif
  74       GO TO 19
  75
  76 C--                Fast record
  77
  78    17 NFASTX = NFASTX - 1
  79       IQ(KQSP+LBPARX-5) = NFASTX
  80 #if defined(CERNLIB_QDEVZE)
  81       IF (LOGLVX.GE.3)  WRITE (IQLOG,9717)
  82  9717 FORMAT (' FZOPHR-  write     fast record')
  83 #endif
  84    19 IQ(KQSP+LBPARX-6) = NFASTX
  85
  86 C-----------       Output of the record       ----------------------
  87
  88       LWR  = L4STAX
  89       NWR  = IQ(KQSP+LBPARX+1)
  90       NWU  = NWR - NWFILX
  91
  92 #if defined(CERNLIB_FZALFA)
  93       IF (IFIFOX.EQ.4)             GO TO 78
  94 #endif
  95 #if defined(CERNLIB_FQNEEDCV)
  96
  97 C--                Pack the record, if needed
  98
  99       IF (IUPAKX.NE.0)             GO TO 24
 100       NWPK = MAXREX - NWFILX
 101
 102 #endif
 103 #if defined(CERNLIB_FQNEEDCV)
 104 #include "fzophr22.inc"
 105 #endif
 106 #if defined(CERNLIB_FQNEEDCV)
 107    24 CONTINUE
 108
 109 #endif
 110 #if defined(CERNLIB_FZDACC)
 111       IF (IFIFOX.EQ.2)             GO TO 51
 112 #endif
 113 #if defined(CERNLIB_FZMEMORY)
 114       IF (IFIFOX.EQ.3)             GO TO 71
 115 #endif
 116
 117 C-----------------------------------------------------------
 118 C----              Output Sequential
 119 C-----------------------------------------------------------
 120
 121       IQ(KQSP+LQFX+20) = IQ(KQSP+LQFX+20) + NWR
 122
 123 #if defined(CERNLIB_FZCHANNEL)
 124 C--       Output sequential channel
 125
 126       IF (IACMOX.EQ.3)  THEN
 127           CALL JUMPST (IADOPX)
 128           ICODE     = 1
 129           IQUEST(1) = LUNX
 130           IQUEST(2) = NWR
 131           IQUEST(3) = ISTENX
 132           IQUEST(4) = 0
 133           IQUEST(5) = MEDIUX - 4
 134           CALL JUMPX2 (LQ(LWR),ICODE)
 135           GO TO 999
 136         ENDIF
 137
 138 #endif
 139 #if defined(CERNLIB_FZLIBC)
 140 C--       Output sequential with calls to the C library
 141
 142       IF (IACMOX.EQ.2)  THEN
 143           CALL CFPUT (IADOPX, MEDIUX, NWR, LQ(LWR), ISW)
 144           IF (ISW.NE.0)  THEN
 145               IQUEST(1) = 19
 146               IQUEST(2) = 21
 147               IQUEST(3) = ISW
 148               IQUEST(4) = LUNX
 149               IQUEST(5) = IADOPX
 150               CALL ZTELL (19,0)
 151             ENDIF
 152           GO TO 999
 153         ENDIF
 154
 155 #endif
 156 #if defined(CERNLIB_FZFORTRAN)
 157 C--       Output sequential with Fortran calls
 158
 159 #include "fzophr44.inc"
 160 * Ignoring t=pass
 161 #endif
 162 #if defined(CERNLIB_FZFORTRAN)
 163 #include "fzophr45.inc"
 164
 165 #endif
 166 #if defined(CERNLIB_FZDACC)
 167 C-----------------------------------------------------------
 168 C----              Output Direct Access
 169 C-----------------------------------------------------------
 170
 171    51 JREC = IQ(KQSP+LQFX+33)
 172       IQ(KQSP+LQFX+20) = IQ(KQSP+LQFX+20) + NWR
 173
 174 #endif
 175 #if defined(CERNLIB_FZDACCH)
 176 C--       Output random channel
 177
 178       IF (IACMOX.EQ.3)  THEN
 179           CALL JUMPST (IADOPX)
 180           ICODE     = 1
 181           IQUEST(1) = LUNX
 182           IQUEST(2) = NWR
 183           IQUEST(3) = ISTENX
 184           IQUEST(4) = JREC
 185           IQUEST(5) = MEDIUX - 4
 186           CALL JUMPX2 (LQ(LWR),ICODE)
 187           GO TO 999
 188         ENDIF
 189
 190 #endif
 191 #if defined(CERNLIB_FZDACCL)
 192 C--       Output random with calls to the C library
 193
 194       IF (IACMOX.EQ.2)  THEN
 195           CALL CFPUT (IADOPX, MEDIUX, NWR, LQ(LWR), ISW)
 196           IF (ISW.NE.0)  THEN
 197               IQUEST(1) = 19
 198               IQUEST(2) = 22
 199               IQUEST(3) = ISW
 200               IQUEST(4) = LUNX
 201               IQUEST(5) = IADOPX
 202               CALL ZTELL (19,0)
 203             ENDIF
 204           GO TO 999
 205         ENDIF
 206
 207 #endif
 208 #if defined(CERNLIB_FZDACCF)
 209 #include "fzophr55.inc"
 210
 211 #endif
 212 #if defined(CERNLIB_FZMEMORY)
 213 C-----------------------------------------------------------
 214 C----              Output in memory mode
 215 C-----------------------------------------------------------
 216
 217    71 LBUF = IQ(KQSP+LQFX+1)
 218       CALL UCOPY (LQ(LWR),LQ(LBUF),NWU)
 219       IQ(KQSP+LQFX+1)  = IQ(KQSP+LQFX+1)  + NWU
 220       IQ(KQSP+LQFX+20) = IQ(KQSP+LQFX+20) + NWU
 221       GO TO 999
 222
 223 #endif
 224 #if defined(CERNLIB_FZALFA)
 225 C-----------------------------------------------------------
 226 C----              Output ALFA format
 227 C-----------------------------------------------------------
 228
 229    78 CALL FZOASC (LUNX,L4STAX,L4ENDX,JFAST,L4STOX,0)
 230       IQ(KQSP+LQFX+20) = IQ(KQSP+LQFX+20) + MAXREX
 231       GO TO 999
 232
 233 #endif
 234 C-----------------------------------------------------------
 235 C--                ENDFILE
 236 C-----------------------------------------------------------
 237
 238 C-       NEOFM = 1  EoF 1 only       IDX(1) = -2  EoF
 239 C-               2  EOF 2 only                -3  EoD
 240 C-               3  EOF 1 + 2
 241
 242    81 IF (IFIFOX.GE.2)             GO TO 999
 243       IF (IACMOX.GE.3)             GO TO 999
 244       NEOFU = IQUEST(11)
 245       NEOFM = IQUEST(12)
 246 #if defined(CERNLIB_FZLIBC)
 247       IF (IACMOX.EQ.2)  THEN
 248           CALL CFWEOF (IADOPX, MEDIUX, IQUEST(11))
 249           GO TO 89
 250         ENDIF
 251 #endif
 252
 253 #include "fzophre1.inc"
 254 * Ignoring t=pass
 255
 256    87 DO 88 J=1,NEOFU
 257       ENDFILE LUNX
 258    88 CONTINUE
 259    89 CONTINUE
 260 #if defined(CERNLIB_QPRINT)
 261       IF (LOGLVX.GE.0)   WRITE (IQLOG,9089) LUNX,IQUEST(11)
 262  9089 FORMAT (' FZOPHR.  LUN=',I4,' Write',I2,' System EOF')
 263 #endif
 264
 265 #include "zebra/qtrace99.inc"
 266       RETURN
 267       END
 268 *      ==================================================
 269 #include "zebra/qcardl.inc"