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$