FTN4,L SUBROUTINE TIMRS(IUNIT,IDAY,IHR,MIN,ISEC), +09580-16321 1926 790502 C C------------------------------------- C C HP 59309A C C RELOCATABLE 09580-16321 C SOURCE 09580-18321 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 DEVICE SUBROUTINES ARE USED C TO PROGRAM THE HP 59309A PROGRAMMABLE 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 TIMRS(I,I,I,I,I), OV=XX, ENT=TIMRS, FIL=%TIMRS C C CONFIGURATION TABLE ENTRIES: C ---------------------------- C C R 59,1,1 C U1 C 36N WHERE N = 5 FOR COMMON YEAR C N = 6 FOR LEAP YEAR C C C C------------------------------------ C C TIMRS(IUNIT,IDAY,IHR,MIN,ISEC) C C WHERE: C C IUNIT = UNIT # C C IDAY = DAY OF YEAR, 1-365 (366 FOR LEAP YEAR) C C IHR = HOUR OF DAY, 0-23 C C MIN = MINUTE OF HOUR, 0-59 C C ISEC = SECOND OF MINUTE, 0-59 C C C C------------------------------------ DIMENSION IERMS(5) DATA IDTN / 59 / DATA IERMS / 10,5,2HTI,2HMR,2HS / 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 XIMRS(LU1,LUIB,IERMS,IUNIT,IDAY,IHR,MIN,ISEC) 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 XIMRS(LU1,LUIB,IR,IU,IDA,IHR,MIN,ISE), +09580-16321 1926 790502 DIMENSION IR(5),IOBUF(255),IBUF(1),IREG(2) EQUIVALENCE (IBUF(1),NODAY),(REG,IREG,IA),(IREG(2),IB) C C--------------------------------------------- C C C THE PARAMETERS IN THE CALLING SEQUENCE HAVE THE FOLLOWING C MEANINGS. C C LUIB = LU # OF HPIB BUS. C LU1 = LU # OF HP-59309A C C IR IS A FIVE WORD ARRAY WITH IER CONTAINING C THE ERROR CODE. C C 0 = NO ERROR C 1 = PARAMETER 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 IR(2) = ERROR MNEMONIC CHARACTER COUNT C IR(3) TO IR(5) = ERROR MNEMONIC C C C--------------------------------------------- C C C RETRIEVE CONFIGURATION DATA C CALL TIM(59,IU,1,IBUF,1,IER) IF(IER .NE. 0)RETURN C C CHECK PARAMETERS C IR=1 IF(IDA .LT. 1 .OR. IDA .GT. NODAY) GOTO 8000 IF(IHR .LT. 0 .OR. IHR .GT. 23) GOTO 8000 IF(MIN .LT. 0 .OR. MIN .GT. 59) GOTO 8000 IF(ISE .LT. 0 .OR. ISE .GT. 59) GOTO 8000 C C SET UP OUTPUT BUFFER C INUM = 2 IODEV = 1 IOBUF(1) = 2HPR C C SECOND UPDATE C IF (ISE .EQ. 0) GOTO 200 DO 190 I=1,ISE IF (IODEV .EQ. 1) GOTO 175 IOBUF(INUM) = IOBUF(INUM) + 123B IODEV = 1 INUM = INUM + 1 GOTO 190 175 IOBUF(INUM) = 51400B IODEV = 0 190 CONTINUE C C MINUTE UPDATE C 200 IF (MIN .EQ. 0) GOTO 300 DO 290 I=1,MIN IF (IODEV .EQ. 1) GOTO 275 IOBUF(INUM) = IOBUF(INUM) + 115B IODEV = 1 INUM = INUM + 1 GOTO 290 275 IOBUF(INUM) = 46400B IODEV = 0 290 CONTINUE C C HOUR UPDATE C 300 IF (IHR .EQ. 0) GOTO 400 DO 390 I=1,IHR IF (IODEV .EQ. 1) GOTO 375 IOBUF(INUM) = IOBUF(INUM) + 110B IODEV = 1 INUM = INUM + 1 GOTO 390 375 IOBUF(INUM) = 44000B IODEV = 0 390 CONTINUE C C DAY UPDATE C 400 IDA = IDA - 1 IF (IDA .EQ. 0) GOTO 500 DO 490 I=1,IDA IF (IODEV .EQ. 1) GOTO 475 IOBUF(INUM) = IOBUF(INUM) + 104B IODEV = 1 INUM = INUM + 1 GOTO 490 475 IOBUF(INUM) = 42000B IODEV = 0 490 CONTINUE C C C 500 IF (IODEV .EQ. 1) GOTO 550 IOBUF(INUM) = IOBUF(INUM) + 124B GOTO 2000 550 IOBUF(INUM) = 2HT C C REMOTE ENABLE C 2000 CALL EXEC(100003B,1600B+LUIB) GOTO 9000 70 CALL ABREG(IA,IB) IF(IB .LT. 0) GOTO 8500 C C SEND OUTPUT BUFFER C CALL REIO(100002B,LU1,IOBUF(1),INUM,IDUMY,0) GOTO 9000 71 CALL ABREG(IA,IB) IF(IB .LT. 0) GOTO 8500 C C C RETURN C IR=0 RETURN C C ERROR EXIT C 8500 IR=IAND(IA,377B)+11 GOTO 8000 9000 IR=9 8000 IR(2)=5 IR(3)=2HTI IR(4)=2HMR IR(5)=2HS RETURN END END$