MINICERN/packlib/zebra/fq/fzocv.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.2  1996/04/18 16:10:46  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 #if !defined(CERNLIB_FQXISN)
  14       SUBROUTINE FZOCV (MS,MT)
  15
  16 C-    Convert for output with copy
  17 C-    from source in native to target in exchange data format
  18
  19 #include "zebra/quest.inc"
  20 #include "zebra/mzioc.inc"
  21 C--------------    End CDE                             --------------
  22       DIMENSION    MS(99), MT(99)
  23
  24       DOUBLE PRECISION   THDB
  25       DIMENSION    THIS(2)
  26       EQUIVALENCE  (THDB,THIS)
  27       EQUIVALENCE  (ITHA,THA,THIS(1)), (ITHB,THB,THIS(2))
  28
  29 C----            Conversion Control in /MZIOC/ :
  30
  31 C-    for a given call translation source MS -> target MT is done
  32 C-        either  for a complete batch of NWFOTT words
  33 C-                      if NWFODN.EQ.0  and  NWFOAV.GE.NWFOTT
  34
  35 C-            or  for the first instalment of a batch of NWFOTT words
  36 C-                      if NWFODN.EQ.0  and  NWFOAV.LT.NWFOTT
  37
  38 C-            or  for a new instalment of N=MIN(NWFOAV,NWFOTT-NWFODN)
  39 C-                      words, if  NWFODN.NE.0
  40
  41 C-    *  marks words to be initialized by the caller
  42 C-       only for the call at the beginning of a new batch
  43 C-
  44 C-         NWFOAV  number of words available in the buffer to receive
  45 C-                                                         the result
  46 C-                    set by the caller whenever a new lot of data
  47 C-                    becomes available for conversion (new buffer)
  48 C-                    counted down by FZOCV
  49 C-       * NWFOTT  total number of words in the batch to be done,
  50 C-                    maybe in several instalments
  51 C-       * NWFODN  number of words in the batch already done
  52 C-                    set to zero by the caller at start of batch
  53 C-                    (in fact MZIOCR sets it to zero)
  54 C-         NWFORE  n.w. remaining to be done for the pending batch
  55 C-                    set by FZOCV, zero if end of batch
  56 C-
  57 C-         IFOCON  remembers the last conversion problem
  58 C-            (1)  error code if -ve, expected type if +ve
  59 C-            (2)  location of the word
  60 C-            (3)  content  of the word
  61
  62 C-         MFOSAV
  63 C-          (1+2)  saves type and word-count for re-entry
  64
  65 C-       * JFOEND  position of last sector plus 1
  66 C-       * JFOREP  position of repeat sector descr.
  67 C-         JFOCUR  position of current sector description
  68
  69 C-   * MFO(JFO+1)  t= sector type as in format
  70 C-   *        +2)  c= word count  as in format
  71 C-                    c > 0 :  no. of words
  72 C-                    c = 0 :  dynamic sector
  73 C-                    c < 0 :  indefinite sector, rest of the bank
  74
  75 C-            JMT  # of words done so far for the current call
  76 C-            JMS  # of words done so far for the current batch
  77
  78 #include "fzocvd1.inc"
  79 #include "fzocvd2.inc"
  80
  81
  82       JMT = 0
  83       IF (NWFODN.NE.0)             GO TO 30
  84
  85       NWFORE = NWFOTT
  86       JMTEX  = MIN (NWFORE,NWFOAV)
  87
  88       JMS    = 0
  89       JFOCUR = 0
  90       IFOCON(1) = 0
  91
  92 C------            Start next sector
  93
  94    21 ITYPE  = MFO(JFOCUR+1)
  95       IF (ITYPE.EQ.7)              GO TO 24
  96       NWSEC = MFO(JFOCUR+2)
  97       IF   (NWSEC)           22, 23, 31
  98
  99 C--                Rest of the bank
 100
 101    22 NWSEC = NWFORE
 102       GO TO 31
 103
 104 C--                Dynamic sector
 105
 106    23 IWORD = MS(JMS+1)
 107       NWSEC = IWORD
 108       GO TO 25
 109
 110 C--                Self-describing sector
 111
 112    24 IWORD = MS(JMS+1)
 113       ITYPE = MOD (IWORD,16)
 114       NWSEC = IWORD/16
 115
 116    25 MT(JMT+1) = IWORD
 117       JMT = JMT + 1
 118       JMS = JMS + 1
 119       NWFORE = NWFORE - 1
 120
 121       IF (ITYPE.GE.8)              GO TO 27
 122       IF (NWSEC.EQ.0)              GO TO 29
 123       IF (NWSEC.GT.0)              GO TO 31
 124
 125 C--                Faulty sector control word
 126
 127    27 IFOCON(1) = -1
 128       IFOCON(2) = JMS
 129       IFOCON(3) = IWORD
 130
 131 C--                Rest of the bank is unused
 132
 133    29 ITYPE = 0
 134       NWSEC = NWFORE
 135       GO TO 31
 136
 137 C--                RE-ENTRY TO CONTINUE
 138
 139    30 JMTEX  = MIN (NWFORE,NWFOAV)
 140       JMS    = NWFODN
 141       ITYPE  = MFOSAV(1)
 142       NWSEC  = MFOSAV(2)
 143
 144 C------            CONVERSION LOOPS
 145
 146    31 NWDO   = MIN (NWSEC,JMTEX-JMT)
 147       IF (NWDO.EQ.0)               GO TO 801
 148       IF (ITYPE.LE.0)              GO TO 91
 149       GO TO (101,201,301,401,501,101,101), ITYPE
 150
 151 C--                Rest of the bank unused
 152
 153    91 CALL VZERO (MT(JMT+1),NWDO)
 154       JMS = JMS + NWDO
 155       JMT = JMT + NWDO
 156       GO TO 801
 157
 158 C--                B - bit strings
 159
 160 C--                I - integers
 161
 162 #include "fzocvfi.inc"
 163 * Ignoring t=pass
 164
 165 C--                F - floating
 166
 167 #include "fzocvff.inc"
 168 * Ignoring t=pass
 169
 170 C--                D - double precision
 171
 172   401 NDPN   = (NWDO+1) / 2
 173       NWDODB =  NDPN * 2
 174 #include "fzocvfd.inc"
 175       IF (NWDODB.EQ.NWDO)          GO TO 801
 176       IF (NWDODB.GT.NWSEC)         GO TO 471
 177       IF (NWDODB.GT.NWFORE)        GO TO 471
 178       NWDO = NWDODB
 179       GO TO 801
 180
 181 C--                Error : odd number of double-precision words
 182
 183   471 JMS = JMS - 1
 184       JMT = JMT - 1
 185       IFOCON(1) = -2
 186       IFOCON(2) = JMS
 187       IFOCON(3) = NWDO
 188       GO TO 801
 189
 190 C--                H - hollerith
 191
 192   501 CONTINUE
 193 #include "fzocvfh.inc"
 194 * Ignoring t=pass
 195
 196 C----              COPY AS IS
 197
 198 #include "fzocvjf.inc"
 199   201 CONTINUE
 200   101 CONTINUE
 201 #include "fzocvfai.inc"
 202
 203 C------            END OF SECTOR
 204
 205   801 NWFORE = NWFOTT - JMS
 206       IF (JMT.GE.JMTEX)            GO TO 804
 207       JFOCUR = JFOCUR + 2
 208       IF (JFOCUR.LT.JFOEND)        GO TO 21
 209       JFOCUR = JFOREP
 210       GO TO 21
 211
 212 C--                Data or buffer exhausted
 213
 214   804 IQUEST(1) = JMT
 215       NWFOAV = NWFOAV - JMT
 216       IF (NWFORE.EQ.0)             RETURN
 217
 218 C--                Ready for re-entry
 219
 220       NWFODN    = JMS
 221       MFOSAV(1) = ITYPE
 222       MFOSAV(2) = NWSEC - NWDO
 223       RETURN
 224       END
 225 *      ==================================================
 226 #include "zebra/qcardl.inc"
 227 #endif