MINICERN/packlib/zebra/fq/fzmemo.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.1.1.1  1996/03/06 10:47:13  mclareni
   6 * Zebra
   7 *
   8 *
   9 #include "zebra/pilot.h"
  10 #if defined(CERNLIB_FZMEMORY)
  11       SUBROUTINE FZMEMO (LUNP,MBUF,NWBUF)
  12
  13 C-    Connect user buffer for M mode, User called
  14
  15 #include "zebra/zmach.inc"
  16 #include "zebra/zunit.inc"
  17 #include "zebra/mqsys.inc"
  18 #include "zebra/eqlqf.inc"
  19 #include "zebra/fzcf.inc"
  20 C--------------    End CDE                             --------------
  21       DIMENSION    LUNP(9), MBUF(99)
  22
  23 #if (defined(CERNLIB_QTRHOLL))&&(!defined(CERNLIB_A6M))
  24       DIMENSION    NAMESR(2)
  25       DATA  NAMESR / 4HFZME, 4HMO   /
  26 #endif
  27 #if (defined(CERNLIB_QTRHOLL))&&(defined(CERNLIB_A6M))
  28       DATA  NAMESR / 6HFZMEMO /
  29 #endif
  30 #if !defined(CERNLIB_QTRHOLL)
  31       CHARACTER    NAMESR*8
  32       PARAMETER   (NAMESR = 'FZMEMO  ')
  33 #endif
  34
  35 #include "zebra/q_locf.inc"
  36
  37 *     quick trace without test on capacity
  38 #include "zebra/qtraceq.inc"
  39
  40       LUN   = LUNP(1)
  41
  42       CALL FZLOC (LUN,0)
  43       IF (LUNF.EQ.0)    LOGLVF=1
  44       IF (IFIFOF.NE.3)  LOGLVF=1
  45
  46       IQUEST(2) = LOCF (MBUF(1))
  47       IQUEST(3) = IQUEST(2) - LQASTO
  48       IQUEST(7) = NWBUF
  49       IQUEST(8) = IQUEST(7)
  50 #if !defined(CERNLIB_B32)
  51       IF (IUPAKF.EQ.0)  THEN
  52 #endif
  53 #if !defined(CERNLIB_B32)
  54           IQUEST(8) = (IQBITW*IQUEST(8)) / 32
  55 #endif
  56 #if !defined(CERNLIB_B32)
  57         ENDIF
  58 #endif
  59 #if defined(CERNLIB_QPRINT)
  60       IF (LOGLVF.GE.1)   WRITE (IQLOG,9024) LUN
  61  9024 FORMAT (1X/' FZMEMO.  Connect user buffer for LUN=',I3)
  62
  63 #endif
  64 #if defined(CERNLIB_QDEVZE)
  65       IF (LOGLVF.GE.1)  THEN
  66           IQUEST(4) = LOCF (LQ(IQUEST(3)))
  67           WRITE (IQLOG,9824) IQUEST(2),IQUEST(3),IQUEST(4)
  68           WRITE (IQLOG,9825) IQUEST(7),IQUEST(8)
  69         ENDIF
  70  9824 FORMAT (1X/' DEVZE FZMEMO,  LOCF(BUF) / LBUF /'
  71      F,' LOCF(LQ(LBUF)) = ',3I9)
  72  9825 FORMAT (16X,'NW machine / 32-bit =',2I6)
  73
  74 #endif
  75       IF (LUNF.EQ.0)               GO TO 91
  76       IF (IFIFOF.NE.3)             GO TO 92
  77
  78       IQ(KQSP+LQFF+1) = IQUEST(3)
  79       IQ(KQSP+LQFF+8) = IQUEST(3)
  80       IQ(KQSP+LQFF+9) = IQUEST(8)
  81       GO TO 999
  82
  83 C-------------------------------------------------
  84 C-                 Error handling
  85 C-------------------------------------------------
  86
  87    91 IQUEST(1) = 1
  88       CALL ZFATAM ('FZMEMO - Stream not existing.')
  89
  90    92 IQUEST(1) = 2
  91       CALL ZFATAM ('FZMEMO - Stream not ready for Memory mode.')
  92
  93 #include "zebra/qtrace99.inc"
  94       RETURN
  95       END
  96 *      ==================================================
  97 #include "zebra/qcardl.inc"
  98 #endif