FTN4,L
      SUBROUTINE TIMRD(IUNIT,RMNTH,DAY,HOUR,RMINT,SEC), 
     +09580-16322 1926 790502 
C 
C-------------------------------------
C 
C  HP 59309A
C 
C  RELOCATABLE 09580-16322
C  SOURCE      09580-18322
C 
C  BOB RICHARDS  790109   
C  BOB RICHARDS  790502   
C 
C------------------------------------ 
C 
C  !=================================================!
C  !                                                 !
C  ! (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979      !
C  !                ALL RIGHTS RESERVED              !
C  !                                                 !
C  ! NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED,     !
C  ! REPRODUCED OR TRANSLATED INTO ANOTHER PROGRAM   !
C  ! LANGUAGE WITHOUT THE PRIOR WRITTEN CONSENT OF   !
C  ! THE HEWLETT-PACKARD COMPANY.                    !
C  !                                                 !
C  !-------------------------------------------------!
C  !                                                 !
C  ! TEST SYSTEM SOURCE SOFTWARE IS THE PROPRIETY    !
C  ! MATERIAL OF THE HEWLETT-PACKARD COMPANY.        !
C  !                                                 !
C  ! THIS SOURCE DATA SHALL BE USED SOLELY IN        !
C  ! CONJUCTION WITH ELECTRONIC COMPUTER SYSTEMS     !
C  ! SUPPLIED TO THE USER BY HEWLETT-PACKARD.        !
C  !                                                 !
C  ! THIS PROPRIETARY DATA SHALL NOT BE COPIED OR    !
C  ! OTHERWISE REPRODUCED WITHOUT THE PRIOR WRITTEN  !
C  ! CONSENT OF HEWLETT-PACKARD, EXCEPT THAT ONE     !
C  ! COPY MAY BE MADE AND RETAINED BY THE USER FOR   !
C  ! ARCHIVE PURPOSES.                               !
C  !                                                 !
C  ! THE USER SHALL NOT DISCLOSE THIS DATA TO ANY    !
C  ! THIRD PARTIES WITHOUT THE PRIOR WRITTEN CONSENT !
C  ! OF HEWLETT-PACKARD. IN ADDITION, THE USER SHALL !
C  ! USE AT LEAST THE SAME CARE AND SAFEGUARDS TO    !
C  ! PROTECT THIS DATA FROM UNAUTHORIZED USE OR      !
C  ! DISCLOSURE AS THE USER USES TO PROTECT ITS OWN  !
C  ! PROPRIETARY DATA.                               !
C  !                                                 !
C  !=================================================!
C 
C  GENERAL: 
C  -------- 
C 
C    THE FOLLOWING DEVICES ARE USED 
C    TO PROGRAM THE HP 59309A DIGITAL CLOCK.
C 
C  HARDWARE REQUIRED: 
C  ------------------ 
C    A. HP 59309A 
C    B. HP59310  BUS INTERFACE KIT. 
C 
C         JUMPER POSITION:
C          SW1-1 - 1
C          SW1-2 TO SW1-8 - 0 
C          SW2-1 - 0
C          SW2-2 - 0
C          SW2-3 - 0
C          SW2-4 - 0
C          SW2-5 - 1
C          SW2-6 - REN
C          SW2-7 - ICF
C          SW2-8 - CNX
C 
C    C. HP 21XX SERIES COMPUTER 
C 
C  BRANCH AND MNEMONIC TABLE ENTRIES: 
C  ---------------------------------- 
C 
C    TIMRD(I,RV,RV,RV,RV,RV)   OV=XX,   ENT=TIMRD,   FIL=%TIMRD 
C 
C 
C 
C 
C------------------------------------ 
C 
C  TIMRD(IUNIT,RMNTH,DAY,HOUR,RMINT,SEC)
C 
C    WHERE: 
C 
C       IUNIT = UNIT #
C 
C       RMNTH = RETURNED VALUE OF MONTH.
C 
C       DAY   = RETURNED VALUE OF DAY.
C 
C       HOUR  = RETURNED VALUE OF HOUR. 
C 
C       MINIT = RETURNED VALUE OF MINUTE. 
C 
C       SEC   = RETURNED VALUE OF SECOND. 
C 
C 
C     NOTES:  THIS DEVICE SUBROUTINE ASSUMES THAT ALL FORMAT
C             SWITCHES (A5S1-A5S4) ARE IN THE "OFF" POSITION. 
C 
C             A RETURNED VALUE OF "-1.0" INDICATES A READ OR
C             CONVERSION ERROR. 
C 
C------------------------------------ 
      DIMENSION IERMS(5)
      DATA IDTN / 59 /
      DATA IERMS / 10,5,2HTI,2HMR,2HD  /
C 
      IERMS=10
C 
C  FIND STATION AND LU #'S
C   ISTN = STATION #
C   LU1 = HP 59309A LU
C   LUIB = HPIB LU
C 
      ISTN=ISN(DUMMY) 
      LU1=LUDV(ISTN,IDTN,IUNIT) 
      LUIB=IBLU0(LU1) 
      IF(LU1 .LE. 0 .OR. LUIB .LE. 0)GOTO 800 
C 
C  CALL X SUB 
C 
      CALL XIMRD(LU1,LUIB,IERMS,IUNIT,RMNTH,DAY,HOUR,RMINT,SEC) 
      IF(IERMS)800,20,800 
C 
C  EXIT 
C 
20    RETURN
C 
C  ERROR EXIT 
C 
800   CALL ERROR(IERMS,IERMS(2))
      RETURN
      END 
C 
C---------------------------------------------
C 
      SUBROUTINE XIMRD(LU1,LB,IERMS,IUT,RMO,DA,HR,RMI,SE),
     +09580-16322 1926 790502 
      DIMENSION IERMS(5)
      DIMENSION IREG(2),IOBUF(6)
      EQUIVALENCE (REG,IREG,IA),(IREG(2),IB)
C 
      INUM = 6
C---------------------------------------------
C 
C 
C  THE PARAMETERS IN THE CALLING SEQUENCE HAVE THE FOLLOWING
C  MEANINGS.
C 
C     LU1  = LU # OF HP59309A 
C     LB   = LU # OF HPIB CARD
C 
C    IERMS IS A FIVE WORD ARRAY WITH IERR(1) CONTAINING 
C      THE ERROR CODE.
C 
C        0 = NO ERROR 
C 
C    ERROR MESSAGES THAT PERTAIN TO THE HPIB. 
C 
C        9 = I/O CALL REJECTED
C       10 = LUIB OR LU1 = 0
C       12 = I/O DEVICE TIME OUT
C       13 = IFC DETECTED DURING I/O REQUEST
C       14 = SRQ ABORTED
C       15 = NON-EXISTENT ALARM PROGRAM 
C       16 = ILLEGAL CONTROL REQUEST
C       17 = EQT EXTENSION AREA FULL
C 
C    IERMS(2) = ERROR MNEMONIC CHARACTER COUNT
C    IERMS(3) TO IERMS(5) = ERROR MNEMONIC
C 
C 
C---------------------------------------------
C 
C  CLEAR INPUT BUFFER 
C 
      DO 100 I=1,INUM 
      IOBUF(I) = 20040B 
100   CONTINUE
C 
C  REMOTE ENABLE
C 
2000  CALL EXEC(100003B,1600B+LB) 
      GOTO 9000 
2050  CALL ABREG(IA,IB) 
      IF (IB .LT. 0) GOTO 8500
C 
C  READ DATA FROM 59309A
C 
      CALL REIO(100001B,LU1,IOBUF,INUM,IDUMY,0) 
      GOTO 9000 
C 
C 
150   CALL ABREG(IA,IB) 
      IF(IB .LT. 0) GOTO 8500 
C 
C 
C 
C  UNPACK BUFFER.  CONVERT TO FLOATING POINT. 
C 
      CALL ASTFP(IOBUF(6),SE) 
C 
      CALL ASTFP(IOBUF(5),RMI)
C 
      CALL ASTFP(IOBUF(4),HR) 
C 
      CALL ASTFP(IOBUF(3),DA) 
C 
      CALL ASTFP(IOBUF(2),RMO)
C 
C  RETURN 
C 
      IERMS=0 
      RETURN
C 
C  ERROR EXIT 
C 
8500  IERMS=IAND(IA,377B)+11
      GOTO 8000 
9000  IERMS=9 
8000  IERMS(2)=5
      IERMS(3)=2HTI 
      IERMS(4)=2HMR 
      IERMS(5)=2HD
      RETURN
      END 
      SUBROUTINE ASTFP(INTIN,FPOUT),09580-16322 1926 790502 
C 
C 
C     THIS SUBROUTINE IS USED TO CONVERT A 2 DIGIT (16 BIT) 
C     ASCII NUMBER TO FLOATING POINT FORMAT.
C 
C     CALL ASTFP(INTIN,FPOUT) 
C 
C         WHERE:
C 
C                INTIN = 2 DIGIT ASCII INPUT (00-99 ONLY, NO BLANKS 
C                        OR OTHER CHARACTERS).
C 
C                FPOUT = RETURNED FLOATING POINT NUMBER.
C 
C 
C 
      ILOW = (IAND(INTIN,377B)) - 60B 
      IF (ILOW .LT. 0 .OR. ILOW .GT. 9) GOTO 100
      IHIGH = INTIN/256 
      IHIGH = (IAND(IHIGH,377B)) - 60B
      IF (IHIGH .LT. 0 .OR. IHIGH .GT. 9) GOTO 100
      FPOUT = FLOAT((IHIGH * 10) + ILOW)
      RETURN
C 
C  ERROR RETURN 
C 
100   FPOUT = -1.0
      RETURN
      END 
      END$
  