FTN4,L
      SUBROUTINE C45OF(IUNIT,IOFSET,OFMHZ,OFHZ),
     +09580-16462 REV.2026 800130 
C 
C ------------------------------------------------------------
C THIS DEVICE SUBROUTINE SETS UP THE HP5355A
C AUTOMATIC FREQUENCY CONVERTER OFFSET FREQUENCY
C ENTRY FUNCTIONS.
C 
C A CALL TO THIS DEVICE SUBROUTINE MUST BE PRECEEDED BY A CALL
C TO C45SU, TO SET UP THE ASSOCIATED HP 5345A ELECTRONIC COUNTER
C AND A CALL TO C45HF TO SET UP ALL OTHER HP 5355A AUTOMATIC
C FREQUENCY CONVERTER FUNCTIONS.
C ------------------------------------------------------------
C 
C-------------------------------------------------------------
C 
C     RELOC. 09580-16462
C     SOURCE 09580-18462
C 
C     R.WRAY        800130
C 
C     TEST SYSTEM SOURCE SOFTWARE IS THE PROPRIETARY
C     MATERIAL OF THE HEWLETT PACKARD COMPANY.
C 
C     (C) COPYRIGHT HEWLETT PACKARD COMPANY 1980. 
C     ALL RIGHTS RESERVED.  NO PART OF THIS PROGRAM 
C     MAY BE PHOTOCOPIED, REPRODUCED, OR TRANSLATED TO
C     ANOTHER PROGRAM LANGUAGE WITHOUT THE PRIOR WRITTEN
C     CONSENT OF THE HEWLETT PACKARD COMPANY. 
C 
C-------------------------------------------------------------
C 
C     BRANCH AND MNEMONIC TABLES ENTRIES: 
C     ----------------------------------
C 
C       C45OF(I,I,R,R)    OV=XX,       ENT=C45OF,  FIL=%C45OF 
C 
C     CONFIGURATION TABLE DATA: 
C     ------------------------
C 
C     NO ENTRY REQUIRED 
C 
C---------------------------------------------------------------
C 
C ------------------------------------------------- 
C SET DIMENSIONS AND DATA FOR IERMS (ERROR MESSAGE) 
C ------------------------------------------------- 
C 
      DIMENSION IERMS(5)
      DATA IERMS/10,5,2HC4,2H5O,2HF / 
C 
C 
C ----------------------------------- 
C SET DEVICE TYPE NUMBER FOR HP 5355A 
C ----------------------------------- 
C 
      DATA IDTN/71/ 
C 
C 
C ----------
C ERROR CHECK 
C ----------- 
C 
      IERMS = 10
C 
C 
C ------------------
C GET STATION NUMBER
C ------------------
C 
      ISTN = ISN(DUMMY) 
C 
C 
C ------------------------
C GET LU NUMBER OF HP5355A
C ------------------------
C 
      LU1 = LUDV(ISTN,IDTN,IUNIT) 
C 
C 
C ----------------------------------------- 
C GET LU NUMBER OF HP-IB I/O INTERFACE CARD 
C ----------------------------------------- 
C 
      LU0 = IBLU0(LU1)
C 
C 
C ----------
C ERROR CHECK 
C ----------- 
C 
      IF(LU1.LE.0.OR.LU0.LE.0)GO TO 800 
C 
C 
C ----------------------------------- 
C CALL MAIN BODY OF DEVICE SUBROUTINE 
C ----------------------------------- 
C 
10    CALL X45OF(LU0,LU1,IERMS,IUNIT,IOFSET,OFMHZ,OFHZ) 
C 
C 
C ----------- 
C ERROR CHECK 
C ----------- 
C 
      IF(IERMS)800,20,800 
C 
20    RETURN
C 
C 
800   CALL ERROR(IERMS,IERMS(2))
      RETURN
      END 
C 
      SUBROUTINE X45OF(LU0,LU1,IERMS,IUNIT,IOFSET,OFMHZ,
     +OFHZ), 09580-16462 REV.2026 800130
C 
C 
C ------------------------------------------------------
C CALL X45OF(LU0,LU1,IERMS,IUNIT,IOFSET,OFMHZ,OFHZ) 
C ------------------------------------------------------
C       WHERE:
C                   LU0   = LU NUMBER OF HP-IB I/O INTERFACE CARD 
C                   LU1   = LU NUMBER OF HP5355A AUTO FREQ CONVERTER
C 
C                   IERMS = 5-ELEMENT INTEGER ARRAY, IN WHICH 
C                           IERMS(1) = ERROR CODE:
C                           0 = NO ERROR
C                           1 = PARAMETER ERROR 
C 
C                       ERROR MESSAGES THAT PERTAIN TO THE HP-IB: 
C 
C                           9 = I/O CALL REJECTED 
C                          10 = LU NO. NOT ASSIGNED TO HP-IB DEVICE 
C                               OR TO STATION 
C                          11 = DMA INPUT REQUEST PREMATURELY 
C                               TERMINATED
C                          12 = I/O DEVICE TIME OUT 
C                          13 = IFC (INTERFACE CLEAR) DETECTED
C                               DURING I/O REQUEST
C                          14 = SRQ SERVICE ABORTED 
C                          15 = NON-EXISTENT ALARM PROGRAM
C                          16 = ILLEGAL CONTROL REQUEST 
C                          17 = EQT EXTENSION AREA FULL,NO NEW
C                               DEVICE MAY BE ADDED ON LINE 
C 
C                   IERMS(2) = CHARACTER COUNT OF MNEMONIC NAME 
C                   IERMS(3-5) = PACKED ASCII OF MNEMONIC NAME IF 
C                                 IERMS(1) > 0
C                   IUNIT = UNIT NUMBER OF HP5355A (MUST BE SAME
C                           AS UNIT NUMBER OF ASSOCIATED HP 5345A)
C 
C                  IOFSET = OFFSET FREQUENCY ENTRY MODE 
C                           0 = NO OFFSET 
C                           1 = APPLY OFFSET FREQUENCY
C 
C                   OFMHZ = OFFSET FREQUENCY ENTRY - MEGAHERTZ
C                          -26500 TO 00000 TO +26500(REF NOTES
C                          1 AND 2 BELOW) 
C 
C                   OFHZ = OFFSET FREQUENCY ENTRY, +- HERTZ 
C                           000000 TO 999999
C 
C 
C  NOTES:    1. OFFSET FREQUENCY ENTERED MAY BE EITHER POSITIVE 
C               OR NEGATIVE.  THE FREQUENCY READ AND DISPLAYED
C               WILL BE THE ACTUAL MEASURED FREQUENCY PLUS OR 
C               MINUS THE OFFSET FREQUENCY ENTERED BY THIS DEVICE 
C               SUBROUTINE. 
C 
C            2. EACH OF THE OFFSET FREQUENCY PARAMETERS MUST BE 
C               PROGRAMMED BY ENTERING ASCII NUMBERS. FOR EXAMPLE,
C               TO PROGRAM AN OFFSET IN THE MEGAHERTZ RANGE, THE
C               'OFMHZ' PARAMETER WOULD BE ENTERED USING ANY
C               DESIRED FREQUENCY IN THE RANGE OF -26500 TO +26500. 
C               TRAILING ZEROS ARE REQUIRED, BUT LEADING ZEROS
C               ARE NOT REQUIRED. IF A NEGATIVE OFFSET IS REQUIRED, 
C               THE ENTERED NUMBER MUST BE PREFIXED BY A MINUS(-) 
C               SIGN. A PLUS (+) SIGN NEED NOT BE USED TO INDICATE
C               POSITIVE OFFSET. IF NO OFFSET IN THE MHZ RANGE IS 
C               REQUIRED, A ZERO (0) IS ENTERED FOR 'OFMHZ'.
C 
C               ANY OFFSET FROM -999999 TO +999999 HZ MAY BE PRO- 
C               GRAMMED BY ENTERING A NUMBER FOR THE OFMHZ
C               PARAMETER AND THEN THE DESIRED NUMBER FOR THE 
C               OFHZ PARAMETER.  NEITHER LEADING ZEROS NOR THE
C               PLUS SIGN (+) IS REQUIRED. AS IN THE OFMHZ PARA-
C               METER, A MINUS (-) PREFIX IS REQUIRED FOR A NEG-
C               ATIVE OFFSET (ONLY IF 'OFMHZ' = 0), AND TRAILING
C               ZEROS ARE REQUIRED. 
C ----------------
C PROGRAM CODE SET
C ----------------
C 
C                  PROGRAM
C        FUNCTION   CODE
C        --------  -------
C 
C       IOFSET =0   = OT0 
C              =1   = OT1 
C 
C        OFMHZ) 
C        OFHZ)     = OF [FLOATING POINT]
C 
C 
C ----------------
C DIMENSION ARRAYS
C ----------------
C 
      DIMENSION IERMS(5),IREG(2)
      DIMENSION  NMBR(6),IBUFR(21),IAR(6) 
      EQUIVALENCE(REG,IREG,IA),(IREG(2),IB) 
C 
C --------------------- 
C INITIALIZE ERROR CODE 
C --------------------- 
C 
      IERMS = 0 
C 
C 
C --------------- 
C SET DEVICE TYPE 
C --------------- 
C 
      DATA IDTN/71/ 
C 
C 
C ----------------
C CHECK PARAMETERS
C ----------------
C 
      IF(IOFSET.LT.0.OR.IOFSET.GT.1)GO TO 9100
C 
C 
C ----------------------------------
C SET HP 5355A OFFSET FREQUENCY MODE
C ----------------------------------
C 
      DO 50 ICNT = 1,21 
      IBUFR(ICNT) = 2H
50    CONTINUE
C 
C  OFFSET ON-OFF
C  -------------
C 
      IBUFR = 2HOT
      IBUFR(2) = 30000B 
      INX = 2 
      IF(IOFSET.EQ.0)GOTO 2000
C 
C  SET FREQ OFFSET
C  ---------------
C 
      IBUFR(2) = 2H1O 
      IBUFR(3) = 2HF
      INX = 4 
C 
C  SET OFFSET VALUE 
C  ---------------- 
C 
      VAL1 = OFMHZ
      IF(VAL1.LT.0.0)VAL1 = -OFMHZ
      IFLG = 0
C 
C FREQUENCY 
C --------- 
C 
      VAL2 = OFHZ 
      IF(VAL2.LT.0.0)VAL2 = -OFHZ 
      IF(VAL1.GT.99999.)GOTO 9100 
      IF(VAL2.GT.999999.)GOTO 9100
      ISIGN = 0 
      IF(OFMHZ.LT.0.0.OR.OFHZ.LT.0.0)ISIGN = 1
      INX = 4 
      IF(ISIGN.EQ.0)IBUFR(INX) = 20000B 
      IF(ISIGN.EQ.1)IBUFR(INX) = 26400B 
C 
C CONVERT 'OFMHZ' MHZ VALUE TO 5 ASCII DIGITS 
C ------------------------------------------- 
C 
      IF(VAL1.EQ.0.0)GOTO 500 
      CALL GENFP(VAL1,NMBR) 
      IF(NMBR.EQ.-1)GOTO 9100 
C 
C  FIND NUMBER OF DIGITS
C  ---------------------
C 
      NXM = 2 
      IF(NMBR.EQ.3.OR.NMBR.EQ.4)NXM = 3 
      IF(NMBR.LT.3)NXM = 4
      IF(ISIGN.EQ.0)GOTO 480
C 
      DO 475  I=NXM,4 
      IVAH = IAND(NMBR(I),177400B) / 256
      IVLO = IAND(NMBR(I),377B) * 256 
      IBUFR(INX) =  IOR(IBUFR(INX),IVAH)
      INX = INX + 1 
 475  IBUFR(INX) = IVLO 
C 
      GOTO 500
C 
 480  CONTINUE
      DO 490  J = NXM, 4
      IBUFR(INX) = NMBR(J)
 490  INX = INX + 1 
C 
      IBUFR(INX) =27000B
      IF(VAL2.EQ.0.0)GOTO 2000
      IFLG = 1
      GOTO 510
C 
C 
C CONVERT 'OFHZ' HZ VALUE TO 6 ASCII DIGITS 
C ----------------------------------------- 
C 
 500  IF(VAL2.EQ.0.0)GOTO 2000
C 
C INSERT DECIMAL POINT
C --------------------
C 
      IBUFR(INX) = IOR(IBUFR(INX),56B)
      INX = INX + 1 
      IFLG = 0
 510  CALL GENFP(VAL2,NMBR) 
      IF(NMBR.EQ.-1)GOTO 9100 
C 
C 
      IF(IFLG.EQ.0)GOTO 560 
C 
      DO 550  J = 2 , 4 
      IVAH = IAND(NMBR(J),177400B) / 256
      IVLO = IAND(NMBR(J),377B) * 256 
      IBUFR(INX) = IOR(IBUFR(INX),IVAH) 
      INX = INX + 1 
 550  IBUFR(INX) = IVLO 
      GOTO 2000 
C 
 560  CONTINUE
      DO 570  J = 2, 4
      IBUFR(INX) = NMBR(J)
 570  INX = INX + 1 
C 
      INX = INX - 1 
      GOTO 2000 
C 
 600  IF(VAL1.GT.99.9)GOTO 9100 
      ISIGN = 0 
      IF(OFMHZ.LT.0.0)ISIGN = 1 
      IF(ISIGN.EQ.0)IBUFR(INX) = 25400B 
      IF(ISIGN.EQ.1)IBUFR(INX) = 26400B 
C 
C 
 620  INX = INX + 1 
      IBUFR(INX) = (NVAL+60B)*256 
C 
C  -------------
C  REMOTE ENABLE
C  -------------
C 
2000  CALL EXEC(100003B,1600B+LUIB) 
      GOTO 8000 
70    CALL ABREG(IA,IB) 
      IF(IB .LT. 0) GOTO 990
C 
C  SEND OUTPUT BUFFER 
C  ------------------ 
C 
      IVAL = IAND(IBUFR(INX),377B)
      IF(IVAL.EQ.0) IBUFR(INX) = IOR(IBUFR(INX),105B) 
      IF(IVAL.EQ.0) IBUFR(INX+1) = 33000B 
      INX = INX+1 
      IF(IVAL.NE.0)IBUFR(INX) = 42466B
      NUM = INX 
      IF(IVAL.EQ.0)NUM = -(2 * INX - 1) 
C 
      CALL REIO(100002B,LU1,IBUFR(1),NUM,IDUMY,0) 
      GOTO 8000 
71    CALL ABREG(IA,IB) 
      IF(IB .LT. 0) GOTO 990
C 
C  RETURN 
C  ------ 
C 
C 
      IERMS=0 
      RETURN
C 
C  ERROR EXIT 
C  ---------- 
C 
990   IERMS=IAND(IA,377B)+11
      GOTO 9900 
8000  IERMS=9 
      GOTO 9900 
9100  IERMS = 1 
9900  IERMS(2)=5
      IERMS(3)=2HC4 
      IERMS(4)=2H5O 
      IERMS(5)=2HF
      RETURN
      END 
C 
C 
C 
C     ------------------------------------------------------
      SUBROUTINE GENFP(FNUM,IFS),09580-16462 REV.2026 800130
C     ------------------------------------------------------
C 
C 
C     ------------------------------------------------------
C     ON ENTRY, FNUM CONTAINS A FLOATING POINT NUMBER IN THE
C     THE RANGE 0.0 - 999999.0 (ANY F.P. FORMAT ACCEPTABLE TO 
C     SUBROUTINE "F2A").  THE NUMBER MUST BE POSITIVE.
C 
C     ON RETURN, IFS(2-4) CONTAINS PACKED ASCII WITH LEADING
C     ZEROES, NO DECIMAL POINT, NO "E".  IFS(5-6) CONTAINS
C     ASCII BLANKS (20040B).
C     ------------------------------------------------------
C 
C     IFS(1) = -1 (INTEGER FORMAT) FOR ERROR RETURN.
C 
C 
C 
      DIMENSION IFS(6),JFS(10)
C 
C 
C 
      IF (FNUM .GE. 0.0 .OR. FNUM .LT. 1E6) GO TO 10
      IFS(1) = -1 
      RETURN
C 
C 
C 
10    DO 100 I=1,6
      IFS(I) = 20040B 
100   CONTINUE
C 
C     CONVERT TO ASCII
C     ----------------
C 
C 
      CALL F2A(FNUM,IFS(1)) 
      IF(IAND(IFS(2),177400B) .NE. 37400B) GO TO 110
      IFS(1) = -1 
      RETURN
C 
C     FIND "E" IF PRESENT 
C     ------------------- 
C 
110   IEFLG = 0 
      DO 150 I=2,6
      IF (IAND(IFS(I),177400B) .EQ. 42400B) GO TO 130 
      IF (IAND(IFS(I),377B) .EQ. 105B) GO TO 120
      GO TO 150 
120   IENUM = (IAND(IFS(I+1),177400B))/256
      GO TO 140 
130   IF (I .EQ. 2) IEFLG = 1 
      IENUM = IAND(IFS(I),377B) 
140   IENUM = IENUM - 60B 
      GO TO 160 
150   CONTINUE
      IENUM = 0 
C 
C     ------------------------------------------
C     IENUM CONTAINS INTEGER VALUE OF "E" (0-6).
C     NOW UNPACK CHARACTERS.
C     ------------------------------------------
C 
160   DO 200 I=1,5
      N=(I*2)-1 
      JFS(N) = (IAND(IFS(I+1),177400B))/256 
      JFS(N) = IAND(JFS(N),377B)
      JFS(N+1) = IAND(IFS(I+1),377B)
200   CONTINUE
      IF (IEFLG .NE. 1) GO TO 210 
      JFS(1) = 61B
      JFS(2) = 40B
      IENUM = IENUM - 1 
C 
C     LOCATE THE DECIMAL POINT
C     ------------------------
C 
210   DO 220 ID=1,10
      IF (JFS(ID) .EQ. 56B .OR. JFS(ID) .EQ. 40B) GO TO 230 
      IF (JFS(ID) .EQ. 105B) GO TO 225
220   CONTINUE
      IFS(1) = -1 
      RETURN
C 
C     VALID NUMBER BUT NO DECIMAL POINT 
C     --------------------------------- 
C 
225   JFS(ID+1) = 60B 
C 
C     DELETE DECIMAL POINT, ADJUST E VALUE
C     ------------------------------------
C 
230   DO 250 I=ID,9 
      JFS(I) = JFS(I+1) 
      IF (JFS(I) .EQ. 105B .OR. JFS(I) .EQ.40B) GO TO 240 
      GO TO 250 
240   DO 245 J=I,10 
      JFS(J) = 60B
245   CONTINUE
      GO TO 260 
250   CONTINUE
C 
C     SHIFT CHARACTERS AS NECESSARY 
C     ----------------------------- 
C 
260   ISHFT = 7 - (ID+IENUM)
      IF (ISHFT .EQ. 0) GO TO 300 
      DO 280 I=10,ISHFT+1,-1
      JFS(I) = JFS(I-ISHFT) 
280   CONTINUE
C 
C     ADD LEADING ZEROES
C     ------------------
C 
      DO 290 I=1,ISHFT
      JFS(I) = 60B
290   CONTINUE
C 
C     PACK CHARACTERS 
C     --------------- 
C 
300   DO 310 I=1,3
      J = (I*2)-1 
      JFS(J) = JFS(J)*256 
      JFS(J) = IAND(JFS(J),177400B) 
      JFS(J+1) = IAND(JFS(J+1),377B)
      IFS(I+1) = JFS(J)+JFS(J+1)
310   CONTINUE
C 
C     LOAD TRAILING BLANKS
C     --------------------
C 
      DO 320 I=5,6
      IFS(I) = 20040B 
320   CONTINUE
C 
C 
C 
      RETURN
      END 
      END$
                                                                                                                                                            