awips2/nativeLib/rary.ohd.pproc.gribit/TEXT/upage2.f

C$PRAGMA C (DATIM2)
C MODULE UPAGE2
C-----------------------------------------------------------------------
C
C  ROUTINE TO PRINT HEADER LINE AT TOP OF PAGE.
C
      SUBROUTINE UPAGE2 (NUNIT)
C
      CHARACTER*2   MONTH,DAY
      CHARACTER*4   YEAR,TIME
      CHARACTER*20  XSTR/' '/
      CHARACTER*12  SYSTM
      CHARACTER*28  DATE2
C
      INCLUDE 'uiox'
      INCLUDE 'ucmdbx'
      INCLUDE 'upagex'
      INCLUDE 'upvrsx'
C
C    ================================= RCS keyword statements ==========
      CHARACTER*68     RCSKW1,RCSKW2
      DATA             RCSKW1,RCSKW2 /                                 '
     .$Source: /fs/hseb/ob72/wfo_rfc/precip_proc/source/gribit/src/RCS/upage2.f,v $
     . $',                                                             '
     .$Id: upage2.f,v 1.1 2006/05/03 13:44:00 gsood Exp $
     . $' /
C    ===================================================================
C
C
      IUNIT=IABS(NUNIT)
C
      IF (ICMTRC.GT.0) THEN
         NPSNLN(ICMPRU)=NPSNLN(ICMPRU)+1
         WRITE (ICMPRU,60) NUNIT,IPSPAG(IUNIT),PUSRID
         ENDIF
C
C  CHECK IF PAGE HEADER TO BE PRINTED
      IF (IPSPAG(IUNIT).EQ.-1) GO TO 50
C
C  CHECK IF UNIT NUMBER IS SAME AS PUNCH UNIT
      IF (IUNIT.EQ.ICDPUN) THEN
C     CHECK IF PUNCH UNIT IS SAME AS PRINT UNIT
         IF (ICDPUN.NE.LP) GO TO 50
         ENDIF
C
      IPRERR=1
C
      DO 10 I=1,LEN(SYSTM)
         SYSTM(I:I)='?'
10       CONTINUE
C
C  CHECK SYSTEM
      IF (PGMSYS.EQ.'CALB') GO TO 20
      IF (PGMSYS.EQ.'FCST'.OR.PGMSYS.EQ.'RFS5') GO TO 20
      IF (PGMSYS.EQ.'????') GO TO 30
      IF (PGMSYS.EQ.'UTIL') THEN
CCC         XSTR=' O/H UTILITY'
         GO TO 30
         ENDIF
      IF (PGMSYS.EQ.'HADS') THEN
         XSTR(2:5)=PGMSYS(1:4)
         GO TO 30
         ENDIF
C
C- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
C
C  HEADER FOR NWSRFS
C
20    IF (PGMSYS.EQ.'CALB') SYSTM='CALIBRATION'
      IF (PGMSYS.EQ.'FCST'.OR.PGMSYS.EQ.'RFS5') SYSTM='FORECAST'
      CALL ULENTH (SYSTM,LEN(SYSTM),LSYSTM)
C
C  GET CURRENT DATE AND TIME
      CALL DATIM2 (DATE2)
C
      IF (IPSPAG(IUNIT).EQ.1) NPSPAG(IUNIT)=NPSPAG(IUNIT)+1
      IF (IPSPAG(IUNIT).EQ.0) NPSPAG(IUNIT)=-1
C
C  PRINT PAGE HEADER
      IF (PUSRID.NE.' '.AND.IPSPAG(IUNIT).EQ.1)
     *   WRITE (IUNIT,70) SYSTM(1:LSYSTM),PGMNAM,PGMVRN,PGMVRD,
     *      PUSRID,
     *      DATE2(2:24),
     *      NPSPAG(IUNIT)
      IF (PUSRID.NE.' '.AND.IPSPAG(IUNIT).EQ.0)
     *   WRITE (IUNIT,80) SYSTM(1:LSYSTM),PGMNAM,PGMVRN,PGMVRD,
     *      PUSRID,
     *      DATE2(2:24)
      IF (PUSRID.EQ.' '.AND.IPSPAG(IUNIT).EQ.1)
     *   WRITE (IUNIT,90) SYSTM(1:LSYSTM),PGMNAM,PGMVRN,PGMVRD,
     *      DATE2(2:24),
     *      NPSPAG(IUNIT)
      IF (PUSRID.EQ.' '.AND.IPSPAG(IUNIT).EQ.0)
     *   WRITE (IUNIT,100) SYSTM(1:LSYSTM),PGMNAM,PGMVRN,PGMVRD,
     *       DATE2(2:24)
      WRITE (IUNIT,150)
C
C  UPDATE LINE COUNTERS
      NPSNLN(IUNIT)=3
      NPSNLT(IUNIT)=NPSNLT(IUNIT)+3
      GO TO 40
C
C- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
C
C  GET CURRENT DATE AND TIME
30    CALL UDATC1 (MONTH,DAY,YEAR,TIME)
C
C  GET LENGTH OF STRING
      CALL ULENTH (XSTR,LEN(XSTR),LXSTR)
      IF (LXSTR.EQ.0) THEN
         LXSTR=1
         ELSE
            LXSTR=LXSTR+1
         ENDIF
C
C  PRINT PAGE HEADER AND UPDATE LINE COUNTERS
C
      IF (IPSPAG(IUNIT).EQ.0) THEN
         NPSPAG(IUNIT)=-1
         IF (PUSRID.EQ.' ')
     *      WRITE (IUNIT,110) XSTR(1:LXSTR),
     *          PGMNAM,PGMVRN,PGMVRD,MONTH,DAY,YEAR,TIME
         IF (PUSRID.NE.' ')
     *      WRITE (IUNIT,120) XSTR(1:LXSTR),
     *          PGMNAM,PGMVRN,PGMVRD,MONTH,DAY,YEAR,TIME,
     *          PUSRID
         NPSNLN(IUNIT)=1
         NPSNLT(IUNIT)=NPSNLT(IUNIT)+1
         ENDIF
C
      IF (IPSPAG(IUNIT).EQ.1) THEN
         NPSPAG(IUNIT)=NPSPAG(IUNIT)+1
         IF (PUSRID.EQ.' ')
     *      WRITE (IUNIT,130) XSTR(1:LXSTR),
     *         PGMNAM,PGMVRN,PGMVRD,MONTH,DAY,YEAR,TIME,
     *         NPSPAG(IUNIT)
         IF (PUSRID.NE.' ')
     *      WRITE (IUNIT,140) XSTR(1:LXSTR),
     *         PGMNAM,PGMVRN,PGMVRD,MONTH,DAY,YEAR,TIME,
     *         PUSRID,
     *         NPSPAG(IUNIT)
         NPSNLN(IUNIT)=1
         NPSNLT(IUNIT)=NPSNLT(IUNIT)+1
         WRITE (IUNIT,150)
         NPSNLN(IUNIT)=NPSNLN(IUNIT)+2
         NPSNLT(IUNIT)=NPSNLT(IUNIT)+2
         ENDIF
C
C- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
C
C  SET TOP OF PAGE INDICATOR
40    IPSNWP(NUNIT)=1
C
50    IF (ICMTRC.GT.0) THEN
         NPSNLN(ICMPRU)=NPSNLN(ICMPRU)+1
         WRITE (ICMPRU,160) IUNIT,NPSPAG(IUNIT),NPSNLN(IUNIT)
         ENDIF
C
      RETURN
C
C- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
C
60    FORMAT (' ENTER UPAGE2 - ',
     *   'NUNIT=',I2,3X,
     *   'IPSPAG(IUNIT)=',I2,3X,
     *   'PUSRID=',A)
70    FORMAT ('1NWSRFS ',A,' SYSTEM - PROGRAM ',A,1X,
     *   '(VERSION: ',A,' - ',A,')',
     *   T79,'USER=',A,
     *   T94,'DATE=',A,
     *   T125,'PAGE=',I4)
80    FORMAT ('1NWSRFS ',A,' SYSTEM - PROGRAM ',A,1X,
     *   '(VERSION: ',A,' - ',A,')',
     *   T79,'USER=',A,
     *   T94,'DATE=',A)
90    FORMAT ('1NWSRFS ',A,' SYSTEM - PROGRAM ',A,1X,
     *   '(VERSION: ',A,' - ',A,')',
     *   T93,'DATE=',A,
     *   T125,'PAGE=',I4)
100   FORMAT ('1NWSRFS ',A,' SYSTEM - PROGRAM ',A,1X,
     *   '(VERSION: ',A,' - ',A,')',
     *   T93,'DATE=',A)
110   FORMAT ('1*',A,'PROGRAM ',A,' (VERSION: ',A,' - ',A,') *',
     *     10X,'DATE=',A,'/',A,'/',A,'.',A)
120   FORMAT ('1*',A,'PROGRAM ',A,' (VERSION: ',A,' - ',A,') *',
     *     10X,'DATE=',A,'/',A,'/',A,'.',A,
     *     10X,'USER=',A)
130   FORMAT ('1*',A,'PROGRAM ',A,' (VERSION: ',A,' - ',A,') *',
     *     10X,'DATE=',A,'/',A,'/',A,'.',A,
     *     T125,'PAGE=',I4)
140   FORMAT ('1*',A,'PROGRAM ',A,' (VERSION: ',A,' - ',A,') *',
     *     10X,'DATE=',A,'/',A,'/',A,'.',A,
     *     10X,'USER=',A,
     *     T125,'PAGE=',I4)
150   FORMAT ('0')
160   FORMAT (' EXIT UPAGE2 - ',
     *   'IUNIT=',I2,3X,
     *   'NPSPAG(IUNIT)=',I4,3X,
     *   'NPSNLN(IUNIT)=',I4)
C
      END