FTN4,L
      SUBROUTINE HFGSU(IUNIT,FKZ,FHZ,AMP,FAZE,IZ),
     +09580-16369  1926  790302 
C 
C-------------------------------------
C 
C  HP 3335A SYNTHESIZER GENERATOR 
C      (HFGSU)
C 
C  RELOCATABLE   09580-16369
C  SOURCE        09580-18369
C 
C  R.UNTALAN 780917 
C  R.UNTALAN 790302             
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 PROPRIETY 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 HP3335A SYNTHESIZERGENERATOR.
C 
C  HARDWARE REQUIRED: 
C  ------------------ 
C    A. HP3325A PROGRAMMABLE PULSE GENERATOR. 
C    B. HP59310  BUSS 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    HFGSU(I,R,R,R,R,I), OV=XX,   ENT=HFGSU,   FIL=%HFGSU 
C    HFWID(I,R,R,I),    OV=XX,   ENT=HFWID,  FIL=%HFGSU 
C 
C  CONFIGURATION TABLE ENTRIES: 
C  ---------------------------- 
C 
C 
C    R  53,1,10 
C    U1 
C        0    ENTER 0 FOR STANDARD UNIT  OR  ENTER OPTION NUMBER
C        0    TEMPORARY STORAGE FOR IMPEDANCE 
C        0  TEMPORARY STORAGE FOR FREQUENCY 
C        0  TEMPORARY STORAGE FOR FREQUENCY 
C        0  TEMPORARY STORAGE FOR FREQUENCY 
C        0  TEMPORARY STORAGE FOR FREQUENCY 
C        0  TEMPORARY STORAGE FOR FREQUENCY 
C        0  TEMPORARY STORAGE FOR FREQUENCY 
C        0  TEMPORARY STORAGE FOR FREQUENCY 
C        0  TEMPORARY STORAGE FOR FREQUENCY 
C 
C 
C 
C 
C------------------------------------ 
C 
C  HFGSU(IUNIT,FKZ,FHZ,AMP,FAZE,IZ) 
C 
C    WHERE: 
C 
C       IUNIT = UNIT #
C 
C 
C       FKZ = FREQUENCY IN KILOHERTZ  (NOTE: TOTAL FREQUENCY = FKZ+FHZ) 
C 
C              0 KHZ   TO   MAXIMUM 
C 
C 
C           WHERE : MAXIMUM  DEPENDS ON THE IMPEDANCE SELECTED. 
C                   SEE FREQUENCY RANGES BELOW. 
C 
C 
C 
C       FHZ=FREQUENCY IN HERTZ
C 
C             0 HZ  TO  999,999 HZ
C             RESOLUTION OF .001HZ
C 
C  **NOTE: TOTAL FREQUENCY SETTING IS EQUAL TO FKZ+FHZ
C 
C     MINIMUM VALUE IS DETERMINE ON THE OPTION AND THE IMPEDANCE
C     SELECTED. 
C 
C    FREQUECY RANGE ARE AS FOLLOWS: 
C    =============================
C 
C    50 OHM AND 75 OHM : 200HZ  TO  80.999 999 999 MHZ
C 
C    124 OHM : 10KHZ  TO  10 MHZ
C 
C    135 OHM AND 150 OHM : 10KHZ  TO  2 MHZ 
C 
C 
C     AMP = AMPLITUDE 
C          SEE TABLE BELOW FOR AMPLITUDE RANGES.
C 
C     AMPLITUDE RANGES ARE AS FOLLOWS 
C     =============================== 
C 
C     50 OHM : +13.01 DBM  TO  -86.98 DBM 
C 
C     75 OHM : +11.25 DBM  TO  -88.74 DBM 
C 
C     124 OHM : +11.25 DBM  TO  -88.74 DBM
C 
C     135 OHM : +11.25 DBM  TO  -88.74 DBM
C 
C     150 OHM : +11.25 DBM  TO  -88.84 DBM
C 
C 
C 
C 
C   FAZE= PHASE SEETING 
C 
C      0 TO 360 DEGREES   WITH  .001 DEGREE RESOLUTION
C 
C 
C     IZ =  IMPEDANCE 
C 
C        0 = 50 OHM 
C        1 = 75 OHM 
C        2 = 124 OHM
C        3 = 135 OHM
C        4 = 150 OHM
C 
C 
C   ALTHOUGH THE IMPEDANCE CANNOT BE REMOTELY PROGRAMED,
C   THE IMPEDANCE SELECT WILL PREVENT THE OPERATOR FROM 
C   PROGRAMMING AN AMPLITUDE OR FREQUENCY THAT IS OUTSIDE 
C   THE RANGE OF THE OUTPUT IMPEDANCE SELECTED. 
C 
C 
C   THE OPERATOR SHOULD MAKE SURE THAT THE SELECTED IMPEDANCE 
C   MATCHES THE INSTRUMENT SELECTED IMPEDANCE BY THE FRONT PANEL
C   SWITCH. 
C 
C 
C------------------------------------ 
      DIMENSION IERMS(5)
      DATA IDTN / 53 /
      DATA IERMS / 10,5,2HHF,2HGE,2HN  /
C 
      IERMS=10
C 
C  FIND STATION AND LU #'S
C   ISTN = STATION #
C   LU1 = HP 3335A LU 
C   LUIB = 59310 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 XFGSU(LU1,LUIB,IERMS,IUNIT,FKZ,FHZ,AMP,FAZE,IZ)
      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 XFGSU(LU1,LUIB,IERR,IU,FKZ,FHZ,AMP,FAZE,IZ), 
     +09580-16369  1926  790302 
C---------------------------------------------
C 
C 
      DIMENSION IERMS(5),IERR(5),IFREQ(20),IREG(2)
      DIMENSION IOBUF(5),IBUF(10),IFBUF(5)
      EQUIVALENCE (REG,IREG,IA),(IREG(2),IB)
      EQUIVALENCE (IFREQ(9),IOBUF(1)),(IFREQ(16),IFBUF(1))
C 
C 
      IERR=0
C 
C 
C  ESTABLISH MIN. AND MAX. LIMITS 
C 
C 
      FKMAX=80999.0005
      HZMAX=999999.1
C 
      FKMIN=0 
      HZMIN=0 
C 
C 
C 
C 
C  RETRIEVE DATA  FROM CONFIGURATION TABLE
C 
      CALL TIM(53,IU,1,IBUF,10,IER) 
      IF(IER .NE. 0) RETURN 
C 
C 
C 
C 
C  CHECK IF IMPEDANCE SELECTED IS VALID ACCORDING TO THE OPTION 
C  ON UNIT. 
C 
      IF(IBUF .EQ. 0 .AND. IZ .GT. 1) GOTO 8000 
C 
      IF((IBUF .EQ. 2 .OR. IBUF .EQ. 4) .AND. (IZ .LT. 1
     +.OR. IZ .GT. 3)) GOTO 8000
C 
      IF(IBUF .EQ. 3 .AND. IZ .NE. 1 .AND. IZ .NE. 4) GOTO 8000 
C 
C 
C   SET MIN. AND MAX. LIMITS ACCORDING TO IMPEDANCE 
C 
      IF(FKZ .EQ. 0) HZMIN=200.0
      IF(FHZ .EQ. 0) FKMIN=.200 
C 
C 
C 
      IF(IZ .NE. 2) GOTO 300
C 
      FKMAX=10000.
      FKMIN=10. 
      HZMIN=10000.
C 
      IF(FKZ .GE. 10.0) HZMIN=0 
      IF(FHZ .GE. 10000.0) FKMIN=0
C 
C 
300   IF(IZ .LT. 3) GOTO 310
C 
      FKMAX=2000.0
      FKMIN=10.0
      HZMIN=10000.0 
C 
      IF(FKZ .GE. 10.0) HZMIN=0 
      IF(FKZ .GE. 10000.0) FKMIN=0
C 
C 
C  SET MIN. AND MAX. LIMITS FOR AMPLITUDE 
C 
C 
310   PMAX=13.01
      PMIN=-86.98 
C 
      IF(IZ .EQ. 0) GOTO 320
C 
      PMAX=11.25
      PMIN=-88.74 
C 
C 
C  CHECK PARAMETERS 
C 
C 
C 
320   IF(FKZ .GT. FKMAX .OR. FKZ .LT. FKMIN) GOTO 8000
C 
      IF(FHZ .GT. HZMAX .OR. FHZ .LT. HZMIN) GOTO 8000
C 
      IF(AMP .GT. PMAX .OR. AMP .LT. PMIN) GOTO 8000
C 
      IF(FAZE .GT. 360.0 .OR. FAZE .LT. 0.) GOTO 8000 
C 
C 
C 
C 
C 
C 
C BLANK BUFFERS 
C 
      DO 10 I=1,20
10    IFREQ(I)=2H 
C 
C 
C 
C   CALCULATE TOTAL FREQUENCY 
C 
      CALL FR2A(FHZ,FKZ,IFREQ)
C 
C 
C   CHECK IF TOTAL FREQUENCY EXCEEDS MAXIMUM
C 
C 
      CALL A2F(IFREQ,1,6,VAL1)
C 
      CALL A2F(IFREQ,7,13,VAL2) 
C 
C 
      IF(VAL1 .GT. FKMAX) GOTO 8000 
C 
C 
      IF(IZ .LE. 1) GOTO 330
C 
      IF(VAL1 .EQ. FKMAX .AND. VAL2 .NE. 0) GOTO 8000 
C 
C 
C  CHANGE IFREQ(8) TO XH  X= DIGIT 0 TO 9 
C 
330   INUM= IAND(177400B,IFREQ(8))
      IFREQ(8)=IOR(INUM,110B) 
C 
C 
C  PROCESS AMPLITUDE
C 
      CALL F4DA(AMP,IOBUF(1)) 
C 
      IOBUF(1)=2H A 
      ICHR=113B 
      IF(AMP .LT. 0) ICHR=115B
      IOBUF(4)=IOR(IOBUF(4),ICHR) 
C 
C 
C 
C  PROCESS FAZE SETTING 
C 
      IFAZE=INT(FAZE*10.0)
      FAZE=FLOAT(IFAZE)/10.0
C 
      CALL F2A(FAZE,IFBUF)
C 
C 
      IFREQ(15)=2HP 
      IFREQ(20)=2HH 
C 
C 
C 
C 
C  STORE IMPEDANCE AND FREQUENCY IN CONFIGURATION TABLE 
C 
      IBUF(2)=IZ
      IBUF(3)=IFREQ(2)
      IBUF(4)=IFREQ(3)
      IBUF(5)=IFREQ(4)
      IBUF(6)=IFREQ(5)
      IBUF(7)=IFREQ(6)
      IBUF(8)=IFREQ(7)
      IBUF(9)=IFREQ(8)
      IBUF(10)=IFREQ(9) 
C 
      CALL TIM(53,IU,2,IBUF,10,IER) 
      IF(IER .NE. 0) RETURN 
C 
C 
      IFREQ(1)=2H F 
C 
C 
C===================================
C 
C 
C 
C 
C  REMOTE ENABLE
C 
3000  CALL EXEC(100003B,1600B+LUIB) 
      GOTO 9000 
3010  CALL ABREG(IA,IB) 
      IF(IB .LT. 0) GOTO 8500 
C 
      ICNT=20 
C 
3020  CALL REIO(100002B,LU1,IFREQ(1),ICNT,IDUMY,0)
      GOTO 9000 
3030  CALL ABREG(IA,IB) 
      IF(IB .LT. 0) GOTO 8500 
C 
C 
C 
C     RETURN
C 
C 
      IERMS=0 
      RETURN
C 
C 
C 
C-----------------------------
C 
C ERROR EXIT
C 
8000  IERR=1
      GOTO 8800 
C 
C 
9000  IERR=9
      GOTO 8800 
8500  IERR=IAND(IREG,377B)+11 
8800  IERR(2)=5 
      IERR(3)=2HHF
      IERR(4)=2HSU
      IERR(5)=2H
      RETURN
      END 
C 
C 
C ============================================= 
C 
      SUBROUTINE HFWID(IUNIT,WKZ,WHZ,MODE), 
     +09580-16369  1926  790302 
C 
C============================================== 
C 
C  HFWID(IUNIT,WKZ,WHZ,MODE)
C 
C    WHERE: 
C 
C       IUNIT = UNIT #
C 
C 
C       WKZ = WID IN KILOHERTZ
C 
C              0 KHZ   TO   MAXIMUM FREQUENCY RANGE 
C 
C              1 KHZ RESOLUTION ON WKZ . FRACTIONAL PART WILL BE IGNORED. 
C 
C 
C 
C 
C 
C 
C       WHZ=WID IN HERTZ
C 
C             0 HZ  TO  999. HZ 
C 
C  **NOTE: TOTAL WIDTH SETTING IS EQUAL TO WKZ+WHZ
C 
C 
C    FREQUECY WIDTH  RANGE ARE AS FOLLOWS:
C    ==================================== 
C 
C    50 OHM AND 75 OHM : 200HZ  TO  80.999 999  MHZ 
C 
C    124 OHM : 200HZ  TO  10 MHZ
C 
C    135 OHM AND 150 OHM : 200 HZ  TO  2 MHZ
C 
C 
C 
C **NOTE: HALF OF THE SWEEP WIDTH WILL BE BELOW THE CENTER FREQUENCY
C         ESTABLISHING THE START FREQUENCY. 
C 
C    MODE = SWEEP MODE
C 
C        0= START SINGLE 10 SEC 
C        1= START SINGLE 50 SEC 
C        2= START AUTO
C        3= GO TO START 
C        4= STOP
C 
C 
C   NOTE: IF AUTO START IS SELECTED, THE UNIT WILL NOT
C         PROGRAM TO ANOTHER MODE UNLESS IT IS FIRST STOP.
C 
C 
C 
C 
C------------------------------------ 
      DIMENSION IERMS(5)
      DATA IDTN / 53 /
      DATA IERMS / 10,5,2HHF,2HWI,2HD  /
C 
      IERMS=10
C 
C  FIND STATION AND LU #'S
C   ISTN = STATION #
C   LU1 = HP 3335A LU 
C   LUIB = 59310 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 XFWID(LU1,LUIB,IERMS,IUNIT,WKZ,WHZ,MODE) 
      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 XFWID(LU1,LUIB,IERR,IU,WKZ,WHZ,MODE),
     +09580-16369  1926  790302 
C------------------------------------------------------ 
C 
C 
      DIMENSION IERMS(5),IERR(5),IREG(2)
      DIMENSION IWID(11),IBUF(10),IFBUF(10),IMODE(5)
      EQUIVALENCE (IBUF(2),IFBUF(1))
      DATA IMODE/ 2HX ,2HY ,2HZ ,2HG ,2HQ / 
C 
C 
      IERR=0
C 
C 
C  RETRIEVE DATA FROM CONFRIGURATION TABLE
C  CHECK CURRENT CENTER FREQ. AND IMPEDANCE SETTING 
C 
      CALL TIM(53,IU,1,IBUF,10,IER) 
      IF(IER .NE. 0) RETURN 
C 
C 
C 
C   SET MIN. AND MAX. LIMITS
C 
      WKMAX=80999.0 
      WHMAX=999.999 
      WKMIN=0 
      WHMIN=0 
C 
C    SET SWEEP MIN. AND MAX. ACCORDING TO CURRENT 
C    IMPEDANCE VALUE. 
C 
      IF(IBUF(2) .GT. 1) WKMIN=10.0 
C 
      IF(IBUF(2) .EQ. 2) WKMAX=10000.0
C 
      IF(IBUF(2) .GT. 2) WKMAX=2000.0 
C 
C 
C 
C 
      IF(WKZ .GT. WKMAX .OR. WKZ .LT. WKMIN) GOTO 8000
      IF(WHZ .GT. WHMAX .OR. WHZ .LT. WHMIN) GOTO 8000
      IF(WKZ .EQ. 0 .AND. WHZ .EQ. 0) GOTO 8000 
C 
C 
C 
      IF(MOD .GT. 3 .OR. MOD .LT. 0) GOTO 8000
C 
C 
C  ELIMINATE FRACTIONAL PART OF WKZ 
C 
      TEMP=WKZ
      ITEN=0
      IF(WKZ .LT. 32766.0) GOTO 88
C 
      ITEN=INT(WKZ/10000.)
      TEMP=WKZ-(FLOAT(ITEN)*10000.) 
C 
C 
88    WKZ=FLOAT(INT(TEMP))+FLOAT(ITEN)*10000. 
C 
C 
C 
C 
C 
C  FIND THE MIDPOINT OF FREQUENCY RANGE 
C  THE FHMID CAN ONLY BE A VALUE OF EITHER A 999.999 OR 0.0 
C  THE FKMID CAN TAKE THE FOLLOWING VALUES: 40499 OR 5000 OR 1000 
C 
C 
      FKMID=WKMAX/2.0 
      FHMID=WHMAX 
C 
      IF(FKMID .GT. 40497.) FKMID= FKMID+.50
      IF(WKMAX .LT. 80900.) FHMID=0 
C 
C 
C  FIND OUT IF CENTER FREQUENCY IS ABOVE OR BELOW THE 
C  MIDPOINT OF FRQUENCY RANGE. IF C.F. IS AT OR ABOVE 
C  THE MIDPOINT THEN  MAX.WID = (WKMAX+WHMAX- C.F.) * 2.0 
C 
C  IF C.F. IS BELOW THE MIDPOINT ,  MAX.WID=(C.F.-200HZ)*2.0
C 
C 
C  CONVERT C.F. TO FLOATING POINT 
C 
C 
C 
C 
C 
C 
      CALL A2F(IFBUF,1,6,CFKZ)
      CALL A2F(IFBUF,7,13,CFHZ) 
C 
C 
C  CHECK IF CENTER FREQ. IS ABOVE MIDDLE OF FREQ. RANGE 
C 
      IF(CFKZ .GE. FKMID) GOTO 200
C 
C 
C    CENTER FREQ. IS BELOW THE MIDDLE OF FREQ. RANGE
C 
      IF(CFHZ .GE. 200.0) GOTO 150
C 
      CFKZ=CFKZ-1.0 
      CFHZ=CFHZ+1000.0
C 
C 
150   WKDF=CFKZ 
      WHDF=CFHZ-200.0 
C 
      GOTO 250
C 
C   CENTER FREQ. IS ABOVE THE MIDDLE OF FREQ. RANGE 
C   FIND THE DIFFERENCE BETWEEN CENTER FREQ. AND MAXIMUM FREQ.RANGE 
C 
200   WKDF=WKMAX-CFKZ 
      WHDF=WHMAX-CFHZ 
C 
C 
C    ESTABLISH MAXIMUM LIMITS FOR SWEEP WIDTH.
C 
250   SWHZ=WHDF*2.0 
      SWKZ=WKDF*2.0 
C 
C     IF(SWHZ .LT. 1000) GOTO 300 
C 
      SWHZ=SWHZ-1000.0
      SWKZ=SWKZ+1.0 
C 
C 
C  CHECK IF SWEEP WIDTH IS WITHIN BOUNDS. 
C 
C 
300   IF(WKZ .GT. SWKZ) GOTO 8000 
      IF(WKZ .EQ. SWKZ .AND. WHZ .GT. SWHZ) GOTO 8000 
C 
C 
C 
C CONVERT SWEEP WIDTH TO ASCII
C 
      CALL FR2A(WHZ,WKZ,IWID) 
C 
      IWID(1)=2H W
      IWID(10)=IAND(177400B,IWID(10)) 
C 
C 
C    SET SWEEP MODE 
C 
      IWID(11)=IMODE(MODE+1)
C 
C 
C===================================
C 
C 
C 
C 
C  REMOTE ENABLE
C 
3000  CALL EXEC(100003B,1600B+LUIB) 
      GOTO 9000 
3010  CALL ABREG(IA,IB) 
      IF(IB .LT. 0) GOTO 8500 
C 
      ICNT=11 
C 
3020  CALL REIO(100002B,LU1,IWID(1),ICNT,IDUMY,0) 
      GOTO 9000 
3030  CALL ABREG(IA,IB) 
      IF(IB .LT. 0) GOTO 8500 
C 
C 
C 
C     RETURN
C 
C 
      IERMS=0 
      RETURN
C 
C 
C 
C-----------------------------
C 
C ERROR EXIT
C 
8000  IERR=1
      GOTO 8800 
C 
C 
9000  IERR=9
      GOTO 8800 
8500  IERR=IAND(IREG,377B)+11 
8800  IERR(2)=5 
      IERR(3)=2HHF
      IERR(4)=2HWI
      IERR(5)=2HD 
      RETURN
      END 
C 
C 
C 
C-------------------------------------------------
      SUBROUTINE F4DA(XNUM,ISTR),09580-16369 1926 790302
C 
C---------------------------------------------------- 
C 
C 
C 
C 
C    THIS SUBROUTINE WILL CONVERT A FOUR DIGIT NUMBER 
C    IN THE FORM XX.XX TO AN ASCII STRING . 
C 
C 
C   XNUM= A NUMBER RANGING FROM -99.99 TO 99.99 
C   ISTR= RETURNED ASCII STRING 
C 
C   IF ABSOLUTE VALUE OF XNUM IS GREATER THAN 99.99 
C   BLANKS WILL BE RETURNED IN THE STRING.
C 
C---------------------------------------------------- 
C 
C 
C 
      DIMENSION ISTR(4) 
C 
C 
C  BLANK BUFFR
C 
      DO 100 I=1,4
100   ISTR(I)=2H
C 
C 
C PROCESS NUMBER
C 
      ANUM=ABS(XNUM)
C 
      IF(ANUM .GT. 99.99) GOTO 1000 
      INUM=INT(ANUM)
      IZ1=INUM/10 
      IZ2=INUM-(IZ1*10) 
      IZ3=INT(ANUM*10.0)-(IZ1*100)-(IZ2*10) 
      IZ4=INT((ANUM*100.0)+.5)-(IZ1*1000)-(IZ2*100)-(IZ3*10)
C 
C 
      ID1=(IZ1*2**8)+30000B 
      ID2=IZ2+60B 
C 
      ID3=IZ3+60B 
      ID4=(IZ4*2**8)+30000B 
C 
      IDOT=27000B 
C 
C 
C 
      ISTR(1)=2H +
      IF(XNUM .LT. 0) ISTR(1)=2H -
C 
C 
      ISTR(2)= IOR(ID1,ID2) 
      ISTR(3)= IOR(IDOT,ID3)
      ISTR(4)= ID4
C 
C 
C 
1000  RETURN
      END 
C 
C 
C 
C=====================================================
      SUBROUTINE FR2A(FHZ,FKHZ,IFREQ),09580-16369  1926  790302 
C====================================================== 
C 
C 
C 
C 
C   R. UNTALAN   9/26/78
C 
C   THIS SUBROUTINE WILL CONVERT THE TOTAL FREQUENCY
C   INTO AN ASCII STRING . A TOTAL OF 15 DIGITS, DECIMAL
C   POINT,AND TWO ASCII CHARACTERS (HZ) ATTACH AT THE END.
C   THE BUFFER (IFREQ) SHOULD BE DIMENSION 10 WORDS BY THE
C   CALLING PROGRAM. THE STRING FORMAT IS AS FOLLOWS: 
C 
C   LEADING AND TRAILING ZEROES WILL BE PLACED IN THE STRING. 
C   EXAMPLE: IF TOTAL = 12345.987 
C            STRING =   BB000012345.987000HZ
C 
C   BBXXXXXXXXX.XXXXXXHZ
C 
C   WHERE X IS A DIGIT 0 TO 9 
C   AND BB ARE BLANKS 
C=======================================================
C 
C 
      DIMENSION IFREQ(10),ID(20)
C 
C 
C PRESET DIGITS TO ZERO 
C 
      DO 10 I=1,16
10    ID(I)=0 
C 
C   CHECK HOW MANY SIGNIFICANT DIGITS PAST THE DECIMAL
C 
C 
      DO 20 I=2,-1,-1 
      EXP=FLOAT(I)
      IF(FHZ .GE. 10.**EXP) GOTO 30 
20    CONTINUE
C 
C 
C 
30    IF(EXP .EQ. 2.0)FHZ=FHZ+.0005 
      IF(EXP .EQ. 1.0) FHZ=FHZ+.00005 
      IF(EXP .EQ. 0.0) FHZ=FHZ+.000005
      IF(EXP .LT. 0.0) FHZ=FHZ+.0000005 
C 
C 
C 
      IADD=0
      ITEN=0
      D1000=1000
C 
C 
C 
C 
C 
      IF(FKHZ .GE. 10000.0) GOTO 130
      TEMP=FKHZ 
      ITEN=0
      GOTO 125
C 
C 
C TEMPORARILY TRUNCATE THE TEN THOUSANDS DIGIT
C 
130   ITEN=INT(FKHZ/10000.) 
      TENT=FLOAT(ITEN)*10000.0
      TEMP=(FKHZ-TENT)
C 
C 
125   KHZ1=INT(TEMP)
C 
C 
      FKZ1=FLOAT(KHZ1)
C 
C 
C ISOLATE HZ COMPONENT OF FKHZ
C 
      AHZ1=(TEMP*1000.0)-(FKZ1*1000.0)
      FHZ1=FLOAT(INT(AHZ1+.5))
      IF(FKHZ .GE. 10000.)FHZ1=INT(FHZ1/100.)*100 
C 
C 
321   KHZ2=INT(FHZ/D1000) 
      CKHZ2=FLOAT(KHZ2) 
C 
C 
C  IF HZ<10 THEN DROP LAST 3 DIGITS AND PICK THEM UP LATER
C 
      THZ=FHZ 
      IF(FHZ .GT. 10.0) GOTO 677
C 
      LHZ=INT(FHZ*D1000)
      THZ=FLOAT(LHZ)/D1000
C 
C 
C 
C 
C 
C 
677   FHZ2=THZ-(CKHZ2*D1000)
C 
C 
C 
      CALL XSUM(KHZ1,FHZ1,KHZ2,FHZ2,KHZS,FHZS)
C 
C 
C 
C 
C 
C ***CONVERT KHZ AND HZ TO ASCII
C 
      IF(KHZS .LT. 10000) GOTO 109
C 
      KHZS=KHZS-10000 
      ITEN=ITEN+1 
C 
C 
109   ID(1)=ITEN/10 
      ID(2)=ITEN-ID(1)*10 
C 
C 
      ID(3)=KHZS/1000 
      ID(4)=(KHZS-ID(3)*1000)/100 
C 
C 
      ID(5)=(KHZS-(ID(3)*1000)-(ID(4)*100))/10
      ID(6)=KHZS-(ID(3)*1000)-(ID(4)*100)-(ID(5)*10)
C 
C 
      RD6=(FHZS/100.) 
C 
      ID(7)=INT(RD6)
C 
      RD7=(FHZS-FLOAT(ID(7)*100))/10. 
C 
      ID(8)=INT(RD7)
      RD8=FHZS-FLOAT(ID(7)*100)-FLOAT(ID(8)*10) 
C 
      ID(9)=INT(RD8)
C 
C 
      ID(10)=56B
C 
C 
C ISOLATE FRACTIONAL PART OF HZ 
C 
      FRAC=FHZS-FLOAT(ID(7)*100)-FLOAT(ID(8)*10)-FLOAT(ID(9)) 
C 
C 
      FRAC=FRAC+.00005
C 
C 
      ID(11)=INT(FRAC*10.)
C 
      ID(12)=INT(FRAC*100.)-(ID(11)*10) 
C 
      ID(13)=INT(FRAC*1000.)-(ID(11)*100)-(ID(12)*10) 
      IF(EXP .EQ. 2.0) GOTO 110 
C 
C 
C PROCESS LAST THREE DIGITS OF ORIGINAL HZ
C 
C 
      FRAC=FHZ*1000.
      IFHZ=INT(FRAC)
      WFHZ=FLOAT(IFHZ)
C 
C 
      FRAC=FRAC-WFHZ
C 
      ID(14)=INT(FRAC*10) 
      IF(ID(14) .LT. 0 .OR. ID(14) .GT. 9) ID(14)=0 
      IF(EXP .EQ. 1.) GOTO 110
C 
C 
C 
      ID(15)=INT(FRAC*100)-(ID(14)*10)
      IF(ID(15) .LT.0 .OR. ID(15) .GT. 9) ID(15)=0
      IF(EXP .EQ. 0.) GOTO 110
C 
C 
      ID(16)=INT(FRAC*1000)-(ID(14)*100)-(ID(15)*10)
      IF(ID(16) .LT. 0 .OR. ID(16) .GT. 9) ID(16)=0 
C 
C 
C STORE DIGITS IN OUTPUT BUFFER 
C 
110   IFREQ(1)=2H 
C 
C  STORE DIGITS IN OUTPUT BUFFER
C 
      J=1 
      DO 200 I=1,8
      IFREQ(I+1)=IASC(ID(J),ID(J+1))
200   J=J+2 
C 
      IFREQ(10)=2HHZ
C 
      RETURN
C 
C 
      END 
C 
C 
C==================================================== 
C 
      INTEGER FUNCTION IASC(IV1,IV2)
      IVA=(IOR(IV1,60B))*400B 
      IVB=IOR(IV2,60B)
      IF(IV2 .GT. 9)IVB=IV2 
      IF(IV1 .GT. 9)IVA=IV1 
      IASC=IOR(IVA,IVB) 
      RETURN
      END 
C 
C 
C=====================================================
C 
C 
C 
C************************************************** 
C 
      SUBROUTINE XSUM(KHZ1,FHZ1,KHZ2,FHZ2,KHZS,FHZS), 
     +09580-16369  1926  790302 
C 
C************************************************** 
C 
C 
C 
C 
C  *** DEFINE DECIMAL CONSTANT
C 
      D1000=1000
C 
C **** CALCULATE SUM
C 
      KHZS=KHZ1+KHZ2
      FHZS=FHZ1+FHZ2
C 
C 
C **** TEST IF CARRY NEEDED 
C 
      IF(FHZS-D1000) 600,500
C 
C 
C **** GENERATE CARRY 
C 
500   KHZS=KHZS+1 
      FHZS=FHZS-D1000 
      RETURN
C 
C 
C **** IS FHZS NEGATIVE?
C 
600   IF(FHZS)700,9000
C 
C 
C 
C **** GENERATE CARRY 
C 
700   KHZS=KHZS-1 
      FHZS=D1000+FHZS 
C 
C 
9000  RETURN
      END 
      END$