MINICERN/packlib/zebra/rz/rzvin.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.2  1996/04/24 17:27:20  mclareni
   6 * Extend the include file cleanup to dzebra, rz and tq, and also add
   7 * dependencies in some cases.
   8 *
   9 * Revision 1.1.1.1  1996/03/06 10:47:27  mclareni
  10 * Zebra
  11 *
  12 *
  13 #include "zebra/pilot.h"
  14       SUBROUTINE RZVIN(V,NDIM,N,KEYU,ICYCLE,CHOPT)
  15 *
  16 ************************************************************************
  17 *
  18 *           Read Fortran array V from a RZ file
  19 * Input:
  20 *   NDIM*   Declared dimension of array V
  21 *  *N*      With option O: N contains offset of first word to be read
  22 *   KEYU    Keyword vector of the information to be read
  23 *   ICYCLE  Cycle number of the key to be read
  24 *           ICYCLE > highest cycle number means read the highest cycle
  25 *           ICYCLE = 0 means read the lowest cycle
  26 *   CHOPT   Character variable specifying the options selected.
  27 *           data structure
  28 *             default
  29 *                   Same as 'D' below
  30 *             'A'   Read continuation of the previously read data structure
  31 *                   with identifier KEYU,ICYCLE
  32 *                   Given that option implies that the record was written with
  33 *                   the same option by a call to RZOUT.
  34 *             'C'   Provide   information   about   the   cycle   numbers
  35 *                   associated with KEY.
  36 *                   The  total number  of  cycles  and the  cycle  number
  37 *                   identifiers of the 19 highest  cycles are returned in
  38 *                   IQUEST(50) and IQUEST(51..89) respectively
  39 *             'D'   Read the  Data structure  with the  (key,cycle)  pair
  40 *                   specified.
  41 *             'N'   Read the neighbouring. keys (i.e. those preceding and
  42 *                   following KEY).
  43 *                   The  key-vectors of  the previous  and  next key  are
  44 *                   available   respectively   as   IQUEST(31..35)    and
  45 *                   IQUEST(41..45), see below.
  46 *             'O'   Argument N contains offset of first word of vector
  47 *                   to be read
  48 * Output:
  49 *   V       Array containing the contents of the record
  50 *   N       Actual length of array V
  51 *           If the current length is greater than the declared dimension,then
  52 *           only NDIM are returned in V.
  53 *           In that case,IQUEST(11) contains the number of words in the record
  54 *
  55 *  IQUEST(13)=IFORM
  56 *
  57 *  Integer value CHOPT for RZVOUT Meaning
  58 *  ------------- ---------------- -------
  59 *  3                              Array V contains only floating points
  60 *  2          'I'                 Array V contains integers
  61 *  1          'B'                 Array V contains bit-patterns
  62 *  5          'H'                 Array V contains Holleriths
  63 *
  64 * Called by <USER>
  65 *
  66 *  Author  : R.Brun DD/US/PD
  67 *  Written : 03.04.86
  68 *  Last mod: 22.06.92 JDS - return IFORM in IQUEST(13)
  69 *          : 04.11.94 JDS - option O - N contains offset of first
  70 *                           word of vector to be read
  71 *
  72 ************************************************************************
  73 #include "zebra/rzcl.inc"
  74       CHARACTER*(*) CHOPT
  75       DIMENSION KEYU(*),V(*)
  76       EQUIVALENCE (IOPTA,IQUEST(91)), (IOPTC,IQUEST(92))
  77      +,           (IOPTD,IQUEST(93)), (IOPTN,IQUEST(94))
  78      +,           (IOPTO,IQUEST(95))
  79 *
  80 *-----------------------------------------------------------------------
  81 *
  82
  83 #include "zebra/q_jbyt.inc"
  84
  85 *           Find KEY,CYCLE
  86 *
  87       CALL RZINK(KEYU,ICYCLE,CHOPT)
  88       IF(IQUEST(1).NE.0)GO TO 99
  89 *
  90 *!! options set by call to UOPTC in RZINK !!
  91 *
  92       IF(IOPTC.NE.0.AND.IOPTD.EQ.0)GO TO 99
  93       IF(IOPTN.NE.0.AND.IOPTD.EQ.0)GO TO 99
  94       ISTART = 1
  95       CALL UOPTC(CHOPT,'O',IOPTO)
  96       IF(IOPTO.NE.0) ISTART = N
  97 *
  98       NW = IQUEST(12)
  99       N  = NW
 100       IF(NW.GT.NDIM)THEN
 101          IQUEST(11)=NW
 102          NW=NDIM
 103       ENDIF
 104 *
 105       IFORM=JBYT(IQUEST(14),1,3)
 106       IF(IFORM.LE.0)THEN
 107          IQUEST(1)=2
 108          GO TO 99
 109       ENDIF
 110 *
 111 *           Read record into array V
 112 *
 113       CALL RZREAD(V,NW,ISTART,IFORM)
 114 *
 115 *     Store I/O descriptor in IQUEST(13)
 116 *
 117       IQUEST(13) = IFORM
 118 *
 119   99  RETURN
 120       END