FTN4,L
      PROGRAM START 
C 
C-------------------------------------------------------------
C 
C     RELOC.       09580-16064
C     SOURCE       09580-18064
C 
C     M. KAESSNER       770504  REV.A 
C 
C     HP 92425A TEST SYSTEM SOFTWARE IS THE PROPRIETARY 
C     MATERIAL OF THE HEWLETT-PACKARD COMPANY.  USE AND 
C     DISCLOSURE THEREOF ARE RESTRICTED BY WRITTEN AGREEMENT. 
C 
C     (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. 
C     ALL RIGHTS RESERVED.  NO PART OF THIS PROGRAM 
C     MAY BE PHOTOCOPIED, REPRODUCED OR TRANSLATED
C     TO ANOTHER PROGRAM LANGUAGE WITHOUT THE PRIOR 
C     WRITTEN CONSENT OF THE HEWLETT-PACKARD COMPANY. 
C 
C-------------------------------------------------------------
C 
C     USES THE FOLLOWING SUBROUTINES: 
C          DATE     SCAN      CLOSE 
C          TIMEX    RMPAR     EXEC
C          TABS     MESSS 
C          ATACH    OPEN
C          ASCII    READF 
C          INTV     JDRTP 
C 
C 
C 
C     THIS ROUTINE PROMPTS THE OPERATOR FOR THE DATE AND TIME TO
C INITIALIZE THE RTE CLOCK.  IT THEN OPENS THE WELCOM FILE AND LOOKS
C FOR RECORDS BEGINNING WITH ':* #' . THE FOUR NUMBERS FOLLOWING
C REPRESENT: (1) THE STATION NUMBER; (2) THE LU OF THE DEVICE; (3)
C THE UNIT NUMBER; AND (4) THE DEVICE TYPE.  THESE ARE THEN STORED
C IN THE DRTXX WHICH IS IN THE MEMORY RESIDENT LIBRARY IN THE 
C FOLLOWING WAY:
C      POSITION WITHIN THE TABLE REPRESENTS THE LU
C      BITS  0-2   STATION NUMBER 
C      BITS  3-6   UNIT#
C      BITS  7-15  DEVICE TYPE
C 
C     ALTHOUGH THE STATION NUMBER IS THE LOGICAL UNIT NUMBER OF 
C THE CRT, THE STATION NUMBER WITHIN THIS TABLE IS A RELATIVE NUMBER. 
C THE FIRST STATION ENCOUNTERED IS STATION 1, THE SECOND IS #2
C IRREGARDLESS OF ACTUAL LU.  USE ROUINTES
C      ISN    TO RETURN REAL STATION CRT LU 
C      LUDV   TO GET THE LU OF A PARTICULAR DEVICE
C      LU2ST  IF YOU HAVE AN LU AND WANT IT'S STATION (CRT LU)
C 
C 
C 
C 
C 
      DIMENSION  IDCB(150)
      DIMENSION NAME3(3), IPARM(5), NAME5(3)
      DIMENSION NAME4(3), IBUF(50), IDSEG(30), LU6SW(4) 
      DIMENSION ITOKN(30), ISTR1(9), NAME6(3) 
      DIMENSION NAME7(3), ICOMA(2), IHR(5), MIN(5), IYR(5)
      DIMENSION IDAYR(5), MON(5), MONDA(12), ISTAT(128) 
      DIMENSION ISTNS(20) 
C 
      DATA NAME4 / 2HWE, 2HLC, 2HOM / 
      DATA ICOMA / 1, 2H,   / 
      DATA MONDA / 0, 31, 59 ,90, 120, 151, 181, 212, 
     X             243, 273, 304, 334 / 
      DATA ISTNS/0,0,-1,1,-1,2,-1,3,-1,4,-1,5,-1,6,-1,7/
C 
      CALL RMPAR(IPARM) 
      LUOP = IPARM(1) 
      IF (LUOP .EQ. 0) LUOP = 1 
C 
C     GET TIME SET UP 
C 
      WRITE (LUOP, 1003)
1003  FORMAT ("BY ENTERING DATE AS MO/DA/YR #_")
      READ (LUOP, 1002) (IBUF(J), J = 2,10) 
      IBUF(1) = 8 
      NTOKN = 0 
      CALL SCAN (IBUF, MON, NTOKN, IQT) 
      CALL SCAN (IBUF, ITOKN, NTOKN, IQT) 
      CALL SCAN (IBUF, IDAYR, NTOKN, IQT) 
      CALL SCAN (IBUF, ITOKN, NTOKN, IQT) 
      CALL SCAN (IBUF, IYR,   NTOKN, IQT) 
      WRITE (LUOP, 1001)
1001  FORMAT ("AND ENTERING TIME AS HR:MM (24-HOUR CLOCK) #_")
      READ (LUOP, 1002) (IBUF(I), I=2,10) 
1002  FORMAT (10A2) 
      IBUF(1) = 5 
      NTOKN = 0 
      CALL SCAN (IBUF, IHR, NTOKN, IQT) 
      CALL SCAN (IBUF, ITOKN, NTOKN, IQT) 
      CALL SCAN (IBUF, MIN, NTOKN, IQT) 
      IDCB(1) = 5 
      IDCB(2) = 2HTM
      IDCB(3) = 2H,1
      IDCB(4) = 2H9 
      M = INTV(MON, IERR) 
      IDAY = INTV (IDAYR) 
      IXX = MONDA(M) + IDAY 
      JYR = INTV (IYR, IERR)
      ILPYR = JYR - 4 * (JYR / 4) 
      IF ((ILPYR .EQ. 0) .AND. (M .GT. 2)) IXX = IXX + 1
      CALL ASCII (IDAYR, IXX) 
      CALL ATACH (IDCB, IYR)
      CALL ATACH (IDCB, ICOMA)
      CALL ATACH (IDCB, IDAYR)
      CALL ATACH (IDCB, ICOMA)
      CALL ATACH (IDCB, IHR)
      CALL ATACH (IDCB, ICOMA)
      CALL ATACH (IDCB, MIN)
      I = MESSS (IDCB(2), IDCB(1))
      IBUF(1) = 0 
      CALL DATE (IBUF)
      CALL TIMEX(ITOKN) 
      CALL TABS (IBUF, 20)
      CALL ATACH (IBUF, ITOKN)
      WRITE (LUOP, 1004) (IBUF(J), J=2,18)
1004  FORMAT ("SYSTEM DATE AND TIME ARE ",20A2) 
C 
C 
C     CLEAR DRTXX BEFORE STORING INTO IT
C 
C 
100   DO 150 J=1,63 
      CALL JDRTP(J,0) 
150   CONTINUE
C 
C 
C     PROCESS WELCOM FILE 
C 
200   CALL OPEN (IDCB, IERR, NAME4, 1)
      IF (IERR .LT. 0) GO TO 900
4001  CALL READF (IDCB, IERR, IBUF(2), 50, LEN) 
      IF (LEN .LT. 0) GO TO 4099
      IBUF(1) = 2 * LEN 
      IF (IBUF(2) .NE. 2H:*) GO TO 4001 
      IF (LEN .LT. 2) GO TO 4001
      IF (IBUF(3) .EQ. 2H #) GO TO 250
      GO TO 4001
C 
C     SCAN FOR <STATION>  <LUN>  <DEV#>  <DEV TYPE> 
C 
250   NTOKN = 5 
      CALL SCAN (IBUF, ITOKN, NTOKN, IQT) 
      ISTN = INTV(ITOKN, IERR)
      IF (IERR .NE. 0) GO TO 800
      DO 300 I=1,15,2 
      IF (ISTN.EQ.ISTNS(I)) GOTO 350
      IF (ISTNS(I))  325,300
300   CONTINUE
      GOTO 800
C 
325   ISTNS(I) = ISTN 
350   ISTN = ISTNS(I+1) 
C 
      CALL SCAN (IBUF, ITOKN, NTOKN, IQT) 
      ILUN = INTV (ITOKN, IERR) 
      IF (IERR .NE. 0) GO TO 800
      CALL SCAN (IBUF, ITOKN, NTOKN, IQT) 
      IDVNM = INTV (ITOKN, IERR)
      IF (IERR .NE. 0) GO TO 800
      CALL SCAN (IBUF, ITOKN, NTOKN, IQT) 
      IDVTP = INTV (ITOKN, IERR)
      IF (IERR .NE. 0) GO TO 800
C 
C     MAKE ENTRY IN LU-TO-STATION TABLE 
C 
      JJ = IDVTP * 128 + IDVNM * 8 + ISTN 
      CALL JDRTP (ILUN, JJ) 
      GO TO 4001
C 
4099  CALL CLOSE(IDCB)
      GO TO 900 
C 
C     ERROR 
C 
800   WRITE (LUOP, 8001)
8001  FORMAT ("*** CONVERSION ERROR IN SETTING DRTXX TABLE")
      WRITE (LUOP, 8002) (IBUF(J), J = 2, LEN+1)
8002  FORMAT (40A2) 
      GO TO 4001
C 
C     DONE
C 
900   CALL EXEC(6)
      END 
END$
                                                                                                    