MINICERN/packlib/zebra/fq/fzitrn.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.1.1.1  1996/03/06 10:47:15  mclareni
   6 * Zebra
   7 *
   8 *
   9 #include "zebra/pilot.h"
  10       SUBROUTINE FZITRN (MBAT,NWBAT)
  11
  12 C-    Transmit one batch of data from the input buffer,
  13 C-    exchange file format, native data format
  14 C-    service routine to FZIN
  15 C-    careful : must not be called with  N4SKII=0 .AND. NWBAT=0
  16
  17 #include "zebra/zunit.inc"
  18 #include "zebra/zebq.inc"
  19 #include "zebra/mzca.inc"
  20 #include "zebra/fzci.inc"
  21 C--------------    End CDE                             --------------
  22       DIMENSION    MBAT(99), NWBAT(9)
  23 #if (defined(CERNLIB_QTRHOLL))&&(!defined(CERNLIB_A6M))
  24       DIMENSION    NAMESR(2)
  25       DATA  NAMESR / 4HFZIT, 4HRN   /
  26 #endif
  27 #if (defined(CERNLIB_QTRHOLL))&&(defined(CERNLIB_A6M))
  28       DATA  NAMESR / 6HFZITRN /
  29 #endif
  30 #if !defined(CERNLIB_QTRHOLL)
  31       CHARACTER    NAMESR*8
  32       PARAMETER   (NAMESR = 'FZITRN  ')
  33 #endif
  34
  35
  36 *     quick trace without test on capacity
  37 #include "zebra/qtraceq.inc"
  38
  39       NWDO  = NWBAT(1)
  40       NDONE = 0
  41
  42    24 NWAV = L4ENDI - L4CURI
  43       IF (NWAV.EQ.0)               GO TO 41
  44       IF (N4SKII.NE.0)             GO TO 31
  45
  46       NW  = MIN (NWDO-NDONE, NWAV)
  47       CALL UCOPY (LQ(L4CURI), MBAT(NDONE+1), NW)
  48       NDONE  = NDONE  + NW
  49       L4CURI = L4CURI + NW
  50       IF (NDONE.LT.NWDO)           GO TO 41
  51 #include "zebra/qtrace99.inc"
  52       RETURN
  53
  54 C--                Skip over N4SKII leading data words
  55
  56    31 NSK    = MIN (N4SKII,NWAV)
  57       L4CURI = L4CURI + NSK
  58       N4SKII = N4SKII - NSK
  59       IF (N4SKII.EQ.0)             GO TO 46
  60
  61 C----              Read next PhR / LR for batch continued
  62
  63    41 IFLAGI = -1
  64       CALL FZIREC
  65       IF (IFLAGI.NE.0)             GO TO 999
  66    46 IF (NWDO+N4SKII.NE.0)        GO TO 24
  67       GO TO 999
  68       END
  69 *      ==================================================
  70 #include "zebra/qcardl.inc"