FTN4,L
      SUBROUTINE TSYOM(IUNIT,AMPL,OFFST,ILOCL,ICYCL,IDSEN), 
     +09580-16456 REV.2026 800131 
C 
C-------------------------------------
C 
C  HP 5953A TIME SYNTHESIZER
C 
C  RELOCATABLE   09580-16456
C  SOURCE        09580-18456
C 
C  BOB RICHARDS  790821 
C  BOB RICHARDS  800131  CORRECT COMMENT  
C 
C------------------------------------ 
C 
C  !=================================================!
C  !                                                 !
C  ! (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980      !
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 PROPRIETARY  !
C  ! MATERIAL OF THE HEWLETT-PACKARD COMPANY.        !
C  !                                                 !
C  ! THIS SOURCE DATA SHALL BE USED SOLELY IN        !
C  ! CONJUNCTION 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 5359A TIME SYNTHESIZER.  
C 
C  HARDWARE REQUIRED: 
C  ------------------ 
C    A. HP 5953A
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    TSYOM(I,R,R,I,I,I)   OV=XX,   ENT=TSYOM,   FIL=%TSYOM
C 
C  CONFIGURATION TABLE ENTRIES: 
C  ---------------------------- 
C 
C    R 51,1,42
C    U1 
C    *
C         0        * 42 "0" ENTRIES 
C         0 
C         0 
C         0 
C         . 
C         . 
C 
C 
C         0 
C 
C 
C 
C 
C------------------------------------ 
C 
C  TSYOM(IUNIT,AMPL,OFFST,ILOCL,ICYCL,IDSEN)
C 
C    WHERE: 
C 
C       IUNIT = UNIT #
C 
C       AMPL  = OUTPUT AMPLITUDE
C             = +/- 0.5 TO +/- 5.0 (VOLTS)
C               " - " INDICATES A COMPLEMENTED OUTPUT.
C 
C       OFFST = OUTPUT OFFSET 
C             = -1.0 TO +1.0 (VOLTS)
C 
C       ILOCL = LOCAL CONTROL OF AMPLITUDE AND OFFSET 
C               0=LOCAL CONTROL 
C               1=PROGRAM CONTROL 
C 
C       ICYCL = NORMAL/SINGL CYCLE
C               0=SINGLE CYCLE/REARM
C               1=NORMAL
C 
C       IDSEN = OUTPUT DISABLE/ENABLE 
C               0=OUTPUT DISABLE
C               1=OUTPUT ENABLE 
C 
C 
C 
C 
C 
C------------------------------------ 
      DIMENSION IERMS(5)
      DATA IDTN / 51 /
      DATA IERMS / 10,5,2HTS,2HYO,2HM  /
C 
      IERMS=10
C 
C  FIND STATION AND LU #'S
C   ISTN = STATION #
C   LU1 = HP-5359A 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 XSYOM(LU1,LUIB,IERMS,IUNIT,AMPL,OFFST,ILOCL,ICYCL,IDSEN) 
      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 XSYOM(LU1,LUIB,IERMS,IUNIT,AMPL,OFST,LOCL,ICYL,IDEN),
     +09580-16456 REV.2026 800131 
      DIMENSION IERMS(5),IOBUF(17),IFS(6) 
C 
C---------------------------------------------
C 
C 
C  THE PARAMETERS IN THE CALLING SEQUENCE HAVE THE FOLLOWING
C  MEANINGS.
C 
C     LUIB = LU # OF HPIB.
C     LU1  = LU # OF HP-5359A 
C 
C    IERMS IS A FIVE WORD ARRAY WITH IERR(1) 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    IERMS(2) = ERROR MNEMONIC CHARACTER COUNT
C    IERMS(3) TO IERMS(5) = ERROR MNEMONIC
C 
C 
C---------------------------------------------
C 
C 
C 
C  CHECK PARAMETERS 
C 
      IERMS=1 
      DO 200 I=1,17 
      IOBUF(I) = 20040B 
200   CONTINUE
C 
C 
C 
      IF (IDEN .EQ. 0) GO TO 400
      IF (LOCL .EQ. 0) GO TO 210
      IF (AMPL .EQ. 0.0) GO TO 400
      IF(ABS(AMPL) .LT. 0.5 .OR.ABS(AMPL) .GT.5.0) GO TO 8000 
      IF(OFST .LT. -1.0 .OR. OFST .GT. 1.0) GO TO 8000
      IF(LOCL .LT. 0 .OR. LOCL .GT. 1) GO TO 8000 
210   IF(ICYL .LT. 0 .OR. ICYL .GT. 1) GO TO 8000 
      IF(IDEN .LT. 0 .OR. IDEN .GT. 1) GO TO 8000 
C 
C 
C 
C  SET UP OUTPUT BUFFER 
C 
C 
      IOBUF(1) = 2HOD 
      IF(IDEN .EQ. 1) IOBUF(1) = 2HOE 
      IF (LOCL .EQ. 0) GO TO 295
      IOBUF(2) = 2HON 
      IF(AMPL .LT. 0.0) IOBUF(2) = 2HOC 
      AMPL = ABS(AMPL)
      DO 250  I=1,6 
      IFS(I) = 20040B 
250   CONTINUE
      IOBUF(3) = 2HOA 
      CALL F2A(AMPL,IFS(1)) 
      DO 270  I=2,6 
      IOBUF(I+2) = IFS(I) 
270   CONTINUE
      IOBUF(9) = 2H , 
      DO 280  I=1,6 
      IFS(I) = 20040B 
280   CONTINUE
      IOBUF(10) = 2HOO
      CALL F2A(OFST,IFS(1)) 
      DO 290  I=2,6 
      IOBUF(I+9) = IFS(I) 
290   CONTINUE
      IOBUF(16) = 2H ,
295   IOBUF(18) = 2HNC
      IOBUF(19) = 2H
      IF(ICYL .EQ. 1) GO TO 300 
      IOBUF(18) = 2HSC
      IOBUF(19) = 2HRA
300   IOBUF(17) = 2H
      IF(LOCL .EQ. 0) IOBUF(17) = 2HOL
      INUM = 19 
      GO TO 2000
C 
C 
400   IOBUF(1) = 2HOD 
C 
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 
      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)=2HTS 
      IERMS(4)=2HYO 
      IERMS(5)=2HM
      RETURN
      END 
      END$
                                                                                        