MINICERN/packlib/zebra/rz/rzprnk.F

   1 *
   2 * $Id$
   3 *
   4 * $Log$
   5 * Revision 1.2  1996/04/24 17:27:05  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:26  mclareni
  10 * Zebra
  11 *
  12 *
  13 #include "zebra/pilot.h"
  14       SUBROUTINE RZPRNK(CHPATH,IKEY,ICYC,CHOPT)
  15 *
  16 ************************************************************************
  17 *
  18 *     Generic printing routine for RZ keys
  19 *
  20 * Input:
  21 *    CHPATH Character variable  specifying the pathname
  22 *    IKEY   Key number
  23 *    ICYC   Cycle number
  24 *    CHOPT  Character option
  25 *
  26 * Called by RZVER1
  27 *
  28 *  Author  :
  29 *  Written :
  30 *  Last mod: 04.03.94 S.Banerjee (Change in cycle structure)
  31 *
  32 ************************************************************************
  33       CHARACTER*(*) CHPATH,CHOPT
  34 #include "zebra/zunit.inc"
  35 #include "zebra/rzcl.inc"
  36 #include "zebra/rzk.inc"
  37 #include "zebra/rzclun.inc"
  38 #include "zebra/rzcycle.inc"
  39       CHARACTER*80  CHLINE
  40       DIMENSION     IHTAG(2)
  41       DIMENSION     KEYS(KNMAX)
  42 #include "zebra/q_jbyt.inc"
  43 *
  44 *-----------------------------------------------------------------------
  45 *
  46       IF(LQRS.EQ.0)  GOTO 99
  47       IF(LCDIR.EQ.0) GOTO 99
  48
  49       LK = IQ(KQSP+LCDIR+KLK)
  50       NK = IQ(KQSP+LCDIR+KNKEYS)
  51       NWK= IQ(KQSP+LCDIR+KNWKEY)
  52       KTAGS=KKDES+(NWK-1)/10+1
  53       LKC=LK+(NWK+1)*(IKEY-1)
  54       LCYC=IQ(KQSP+LCDIR+LKC)
  55       CALL RZDATE( IQ(KQSP+LCDIR+LCYC+KFLCYC),IDATE,ITIME,1)
  56
  57       WRITE(IQPRNT,*)
  58       WRITE(IQPRNT,9001) CHPATH(1:LENOCC(CHPATH)),IKEY,ICYC,IDATE,ITIME
  59 9001  FORMAT(' Directory: ',A,/' Object  : ',I10,1X,
  60      +       ' Cycle   : ',I10,1X,' Created : ',I6,1X,I4)
  61 *
  62 *     Get keys vector and tag definitions
  63 *
  64       CHLINE = ' '
  65       ISTART = 1
  66
  67       K=LK+(NWK+1)*(IKEY-1)
  68       DO 10 J=1,NWK
  69          IKDES=(J-1)/10
  70          IKBIT1=3*J-30*IKDES-2
  71          CALL ZITOH(IQ(KQSP+LCDIR+KTAGS+2*J-2),IHTAG,2)
  72          CALL UHTOC(IHTAG,4,CHLINE(ISTART:),8)
  73          CHLINE(ISTART+8:) = ': '
  74          ISTART=ISTART + 10
  75          IFORM=JBYT(IQ(KQSP+LCDIR+KKDES+IKDES),IKBIT1,3)
  76          IF(IFORM.LT.3)THEN
  77             WRITE(CHLINE(ISTART:ISTART+9),'(I10)') IQ(KQSP+LCDIR+K+J)
  78          ELSE
  79             CALL ZITOH(IQ(KQSP+LCDIR+K+J),KEYS,1)
  80             CALL UHTOC(KEYS,4,CHLINE(ISTART+6:),4)
  81          ENDIF
  82
  83          ISTART = ISTART + 12
  84          IF(ISTART+20.GT.LEN(CHLINE).OR.J.EQ.NWK) THEN
  85             WRITE(IQPRNT,*) CHLINE(1:LENOCC(CHLINE))
  86             CHLINE = ' '
  87             ISTART = 1
  88          ENDIF
  89
  90    10 CONTINUE
  91 *
  92    99 RETURN
  93       END