FTN4,L
      SUBROUTINE SFGEN(IUNIT,FKHZ,FHZ), 
     +09580-16310 1926 790502 
C 
C-------------------------------------
C 
C  HP 3325A SYNTHESIZER*FUNCTION GENERATOR
C      (SFGEN)
C 
C  RELOCATABLE 09580-16310  
C  SOURCE      09580-18310  
C 
C  R.UNTALAN 780917    REV. A 
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 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 HP3325A SYNTHESIZER*FUNCTION GENERATOR.
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    SFGEN(I,R,R), OV=XX,   ENT=SFGEN,   FIL=%SFGEN 
C    SFSWP(I,I,R,R,R,R,R,R,R),  OV=XX,   ENT=SFSWP,  FIL=%SFGEN 
C 
C 
C 
C  CONFIGURATION TABLE ENTRIES: 
C  ---------------------------- 
C 
C 
C    R  29,1,4
C    U1 
C        0    ENTER 0 FOR STANDARD UNIT  OR  1 FOR OPT.002
C        0    TEMPORARY STORAGE FOR WAVE FORM FUNCTION
C        0.0  TEMPORARY STORAGE FOR DC-OFFSET 
C 
C 
C 
C 
C 
C 
C------------------------------------ 
C 
C  SFGEN(IUNIT,FKHZ,FHZ)
C 
C    WHERE: 
C 
C       IUNIT = UNIT #
C 
C 
C       FKHZ = FREQUENCY IN KILOHERTZ  (NOTE: TOTAL FREQUENCY = FKHZ+FHZ) 
C 
C       ALL WAVEFORMS 1HZ RESOLUTION (.001KHZ)
C       DIGITS BEYOND THE ONE THOUSANDTH PLACE ARE NOT ACCEPTED.
C 
C             SINE FUNCTION 
C             ------------- 
C             0 KHZ  TO  20,999kHZ
C 
C 
C             SQUARE FUNCTION 
C             --------------- 
C             0 KHZ  TO  10,999kHZ
C 
C 
C             TRIANGLE/RAMPS FUNCTION 
C             ----------------------- 
C             0 KHZ  TO  10.999kHZ
C 
C 
C 
C      FHZ= FREQUENCY IN HERTZ
C 
C           SINE FUNCTION 
C           ------------- 
C           0 Hz  TO  999,999Hz 
C 
C 
C           SQUARE FUNCTION 
C           --------------- 
C           0 Hz  TO 999,999Hz
C 
C 
C           TRIANGLE/RAMPS FUNCTION 
C           0 H  TO  10,999Hz 
C 
C 
C 
C 
C  **NOTE: TOTAL FREQUENCY SETTING IS EQUAL TO FKHZ+FHZ 
C 
C 
C    FREQUECY RANGE ARE AS FOLLOWS: 
C    =============================
C 
C    Sine: 1uHz  TO  20.999 999 999 MHz 
C    Square: 1uHz  TO  10.999 999 999 MHz 
C    Triangle/Ramps: 1uHz  TO  10.999 999 999 kHz 
C 
C 
C 
C 
C 
C------------------------------------ 
      DIMENSION IERMS(5)
      DATA IDTN / 29 /
      DATA IERMS / 10,5,2HSF,2HGE,2HN  /
C 
      IERMS=10
C 
C  FIND STATION AND LU #'S
C   ISTN = STATION #
C   LU1 = HP 3325A 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 XFGEN(LU1,LUIB,IERMS,IUNIT,FKHZ,FHZ) 
      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 XFGEN(LU1,LUIB,IERR,IU,FKHZ,FHZ),
     +09580-16310 1926 790502 
C---------------------------------------------
C 
C 
      DIMENSION IERMS(5),IERR(5),IFREQ(20),ISTR(5),IREG(2)
      DIMENSION IBUF(4),IOBUF(10) 
      EQUIVALENCE (REG,IREG,IA),(IREG(2),IB),(IOBUF(1),IFREQ(1))
C 
C 
      IERR=0
C 
C 
C  ESTABLISH MIN. AND MAX. LIMITS 
C 
C 
      HZMAX=1000
      HZMIN=0 
C 
      FKMAX=21000 
      FKMIN=HZMIN 
C 
C 
C 
C 
C  RETRIEVE CURRENT WAVEFORM FUNCTION FROM CONFIGURATION TABLE
C 
      CALL TIM(29,IU,1,IBUF,4,IER)
      IF(IER .NE. 0) RETURN 
C 
C 
      IF(IBUF(2) .EQ. 1) FKMAX=11000
C 
      IF(IBUF(2) .GT. 1) FKMAX=11 
C 
      IF(IBUF(2) .GT. 1) HZMAX=11000
C 
C 
C 
C 
C 
C 
C 
C 
C  CHECK PARAMETERS 
C 
      FHZ=FHZ+.00000005 
      FKHZ=FKHZ+.000005 
C 
C 
C 
C 
      IF(FKHZ .LT. FKMIN .OR. FKHZ .GE. FKMAX) GOTO 8000
C 
      IF(FHZ .LT. HZMIN .OR. FHZ .GE. HZMAX) GOTO 8000
C 
C 
C 
C BLANK BUFFERS 
C 
      DO 10 I=1,17
10    IFREQ(1+I)=2H 
C 
      DO 22 I=1 ,5
22    ISTR(I)=2H
C 
C 
C 
C 
      CALL FR2A(FHZ,FKHZ,IFREQ) 
C 
C 
C   CHECK IF TOTAL FREQUENCY EXCEEDS MAXIMUM
C 
      IFR=1 
      ILST=6
C 
      IF(IBUF(2) .LT. 2) GOTO 900 
C 
      IFR=4 
C 
900   CALL A2F(IFREQ,IFR,ILST,VALU) 
C 
C 
C 
C 
      IF(VALU .GE. FKMAX) GOTO 8000 
C 
C 
C 
C 
      IOBUF(1)=2HFR 
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=10 
C 
3020  CALL REIO(100002B,LU1,IOBUF(1),ICNT,IDUMY,0)
      GOTO 9000 
3030  CALL ABREG(IA,IB) 
      IF(IB .LT. 0) GOTO 8500 
C 
C 
C 
C     RETURN
C 
C 
C CLEAR SRQ 
C 
C 
      CALL EXEC(100003B,600B+LU1) 
      GOTO 9000 
3100  CALL ABREG(IA,IB) 
      IF(IB .LT. 0) GOTO 8500 
      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)=2HSF
      IERR(4)=2HGE
      IERR(5)=2HN 
      RETURN
      END 
C 
C 
C 
      SUBROUTINE SFSWP(IU,ISWP,TSWP,STKZ,STHZ,SPKZ,SPHZ,SMKZ,SMHZ), 
     +09580-16310 1926 790502 
C 
C------------------------------------ 
C 
C  SFSWP(IU,ISWP,TSWP,STKZ,STHZ,SPKZ,SPHZ,SMKZ,SMHZ)
C 
C    WHERE: 
C 
C       IU = UNIT # 
C 
C      ISWP= SWEEP MODE 
C          0= LINEAR /RESET AND START  SINGLE SWEEP 
C          1= LINEAR /RESET AND START  CONTINUOS SWEEP
C          2= LOG /RESET AND START SINGLE SWEEP 
C          3= LOG /RESET AND START CONTINUOUS SWEEP 
C          4= RESET TO START FREQUENCY ONLY (STOPS SWEEP) 
C 
C     NOTE: IF UNIT IS CURRENTLY SWEEPING ,IT IS NECESSARY TO 
C           RESET THE UNIT FIRST (ISWP=4) BEFORE STARTING ANOTHER 
C           TYPE OF SWEEP. ANOTHER ALTERNATIVE IS TO REPEAT THE 
C           CALL TWICE. 
C 
C 
C      TSWP= SWEEP TIME 
C 
C           FOR LINEAR SWEEP
C           ----------------
C           .01 SEC. TO  99.99 SEC
C 
C           FOR LOG SWEEP 
C           ----------------
C           SINGLE : 2 SEC TO 99.99 SEC 
C           CONTINUOUS : .1 SEC TO 99.99 SEC
C 
C       STKZ= START FREQUENCY IN KILOHERTZ
C       SPKZ= STOP FREQUENCY IN KILOHERTZ 
C       SMKZ= MARKER FREQUENCY IN KILOHERTZ 
C 
C       RESOLUTION FOR THE KHZ PARAMETER IS 1 HZ (.001 KHZ) 
C       ANY DIGIT PASS THE  ONE THOUSANDTH PLACE IS NOT ACCEPTED. 
C 
C 
C              FREQUENCY IN KILOHERTZ  (NOTE: TOTAL FREQUENCY =  KHZ+ HZ) 
C              FOR LOG SWEEP MINIMUM FREQUECY IS 1 HZ.
C 
C             SINE FUNCTION 
C             ------------- 
C             0 kHZ  TO  20,999kHZ
C 
C 
C             SQUARE FUNCTION 
C             --------------- 
C             0 kHZ  TO  10,999kHZ
C 
C 
C             TRIANGLE/RAMPS FUNCTION 
C             ----------------------- 
C             0 kHZ  TO  10.999kHZ
C 
C 
C       STHZ=START FREQUENCY IN HERTZ 
C       SPHZ=STOP FREQUENCY IN HERTZ
C       SMHZ=MARKER FREQUENCY IN HERTZ
C 
C 
C      RESOLUTION IS 1 UHZ (.000001HZ) .
C 
C 
C           FREQUENCY IN HERTZ
C 
C           SINE FUNCTION 
C           ------------- 
C           0 HZ  TO  999 HZ
C 
C 
C           SQUARE FUNCTION 
C           --------------- 
C           0 Hz  TO 999 HZ 
C 
C 
C           TRIANGLE/RAMPS FUNCTION 
C           0 HZ TO  999 HZ 
C 
C 
C 
C 
C  **NOTE: TOTAL FREQUENCY SETTING IS EQUAL TO FKHZ+FHZ 
C          TOTAL FREQUENCY CANNOT NOT BE LESS THAN 1 UHZ. 
C          ********************************************** 
C 
C 
C    FREQUECY RANGE ARE AS FOLLOWS: 
C    =============================
C 
C    Sine: 1uHz  TO  20.999 999 999 MHz 
C    Square: 1uHz  TO  10.999 999 999 MHz 
C    Triangle/Ramps: 1uHz  TO  10.999 999 999 kHz 
C 
C 
C 
C 
C 
C------------------------------------ 
      DIMENSION IERMS(5)
      DATA IDTN / 29 /
      DATA IERMS / 10,5,2HSF,2HGE,2HN  /
C 
      IERMS=10
C 
C  FIND STATION AND LU #'S
C   ISTN = STATION #
C   L1 = HP 3325A LU
C   L2 = 59310 LU 
C 
      ISTN=ISN(DUMMY) 
      L1=LUDV(ISTN,IDTN,IU) 
      L2=IBLU0(L1)
      IF(L1 .LE. 0 .OR. L2 .LE. 0)GOTO 800
C 
C  CALL X SUB 
C 
      CALL XFSWP(L1,L2,IERMS,IU,ISWP,TSWP,STKZ,STHZ,SPKZ,SPHZ,SMKZ,SMHZ)
      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 XFSWP(L1,L2,IERR,IU,ISWP,TSWP,STKZ,STHZ,SPKZ,SPHZ, 
     +SMKZ,SMHZ),09580-16310 1926 790502
C---------------------------------------------
C 
C 
      DIMENSION IERR(5),IFREQ(10),IREG(2) 
      DIMENSION IBUF(4),IWBUF(10),IOBUF(10),IQBUF(10) 
      DIMENSION IPBUF(10),ITBUF(10),IMBUF(10) 
      EQUIVALENCE (REG,IREG,IA),(IREG(2),IB)
C 
C 
      IERR=0
C 
C 
C  ESTABLISH MIN. AND MAX. LIMITS 
C 
C 
      HZMAX=1000
      HZMIN=0 
      SZMIN=HZMIN 
      ZMIN=HZMIN
C 
      FKMAX=21000 
      FKMIN=.001
      SKMIN=FKMIN 
      RKMIN=FKMIN 
C 
C 
C 
C  RETRIEVE CURRENT WAVEFORM FUNCTION FROM CONFIGURATION TABLE
C 
      CALL TIM(29,IU,1,IBUF,4,IER)
      IF(IER .NE. 0) RETURN 
C 
C 
C 
      IF(IBUF(2) .GT. 1) FKMAX=11 
C 
      IF(IBUF(2) .GT. 1) HZMAX=11000
C 
C 
      IF(STHZ .GT. 0.0) FKMIN=0.0 
      IF(SPHZ .GT. 0.0) SKMIN=0.0 
      IF(SMHZ .GT. 0.0) RKMIN=0.0 
C 
C 
C 
      IF(STKZ .EQ. 0)HZMIN=.000001
      IF(SPKZ .EQ. 0)SZMIN=.000001
      IF(SMKZ .EQ. 0) ZMIN=.000001
C 
C 
C 
C  ESTABLISH MINIMUM SWEEP WIDTH FOR EACH WAVEFORM
C  AND SWEEP TIME . LINEAR MODE 
C  RMIN= RESOLUTION IN MILIHERTZ
C 
      IF(IBUF(2) .EQ. 0) RMIN=.100
C 
      IF(IBUF(2) .EQ. 1) RMIN=.050
C 
      IF(IBUF(2) .EQ. 2) RMIN=.005
C 
      IF(IBUF(2) .GT. 2) RMIN= .010 
C 
C 
C  FMIN=MINIMU SWEEP WIDTH IN MILIHERTZ (LINEAR MODE ONLY)
C 
      FMIN=TSWP*100.0*RMIN
C 
C 
C 
C 
C  CHECK PARAMETERS 
C 
      STHZ=STHZ+.00000005 
      SPHZ=SPHZ+.00000005 
      STKZ=STKZ+.000005 
      SPKZ=SPKZ+.000005 
C 
C 
C 
C 
C 
      IF(SMKZ .EQ. 0.0 .AND. SMHZ .EQ. 0.0) GOTO 5
C 
      IF(SMKZ .LT. RKMIN .OR. SMKZ .GE. FKMAX) GOTO 8000
      IF(SMHZ .LT. ZMIN  .OR. SMHZ .GE. HZMAX) GOTO 8000
C 
C 
C 
5     IF(STKZ .LT. FKMIN .OR. STKZ .GE. FKMAX) GOTO 8000
      IF(SPKZ .LT. SKMIN .OR. SPKZ .GE. FKMAX) GOTO 8000
C 
      IF(STHZ .LT. HZMIN .OR. STHZ .GE. HZMAX) GOTO 8000
      IF(SPHZ .LT. SZMIN .OR. SPHZ .GE. HZMAX) GOTO 8000
C 
C 
C 
C 
C 
C CHECK SWEEP MODE AND SWEEP TIME 
C 
      IF(ISWP .LT. 0 .OR. ISWP .GT. 4) GOTO 8000
C 
C ESTABLISH MINIMUM SWEEP SWEEP TIME
C 
      IF(ISWP .LT. 2) TMIN=.01
C 
      IF(ISWP .EQ. 3) TMIN=.1 
C 
      IF(ISWP  .EQ.2) TMIN=2.0
C 
C 
      TMAX=99.99
C 
C 
      IF(TSWP .LT. TMIN .OR. TSWP .GT. TMAX) GOTO 8000
C 
C 
C 
C ----------------------------------------------- 
C 
C PROCESS START AND STOP FREQUENCIES
C 
C 
C BLANK BUFFERS 
C 
C 
      DO 11 I=1,10
      IPBUF(I)=2H 
      ITBUF(I)=2H 
      IWBUF(I)=2H 
11    IOBUF(I)=2H 
C 
C 
C 
      DO 1100 M=1,3 
C 
      IF(M - 2) 94,95,96
C 
94    FHZ=STHZ
      FKHZ=STKZ 
C 
      GOTO 15 
C 
95    FHZ=SPHZ
      FKHZ=SPKZ 
C 
      GOTO 15 
C 
C 
C IF MARKER NOT DESIRED SKIP PROCESSING.
96    IF(SMKZ .EQ. 0 .AND. SMHZ .EQ. 0) GOTO 1100 
      FHZ=SMHZ
      FKHZ=SMKZ 
C 
C 
15    DO 12 I=1,10
12    IFREQ(I)=2H 
C 
C 
C CONVERT TOTAL FREQUENCY TO ASCII
C 
      CALL FR2A(FHZ,FKHZ,IFREQ) 
C 
C 
C  CHECK IF FREQUENCY EXCEEDS MAXIMUM 
C 
      IFR=1 
      ILST=6
C 
      IF(IBUF(2) .LT. 2) GOTO 1180
C 
C 
      IFR=4 
C 
1180  CALL A2F(IFREQ,IFR,ILST,VALU) 
C 
C 
C 
C 
C 
      IF(VALU .GE. FKMAX) GOTO 8000 
C 
C 
C 
C 
C 
C 
C 
      IF(M - 2) 1190,1200,1210
C 
C 
C START FREQUENCY BUFFER
C 
1190  ITBUF(1)=2HST 
      ITBUF(2)=IFREQ(2) 
      ITBUF(3)=IFREQ(3) 
      ITBUF(4)=IFREQ(4) 
      ITBUF(5)=IFREQ(5) 
      ITBUF(6)=IFREQ(6) 
      ITBUF(7)=IFREQ(7) 
      ITBUF(8)=IFREQ(8) 
      ITBUF(9)=IFREQ(9) 
      ITBUF(10)=IFREQ(10) 
C 
      GOTO 1100 
C 
C 
C  STOP FREQUENCY BUFFER
C 
1200  IPBUF(1)=2HSP 
      IPBUF(2)=IFREQ(2) 
      IPBUF(3)=IFREQ(3) 
      IPBUF(4)=IFREQ(4) 
      IPBUF(5)=IFREQ(5) 
      IPBUF(6)=IFREQ(6) 
      IPBUF(7)=IFREQ(7) 
      IPBUF(8)=IFREQ(8) 
      IPBUF(9)=IFREQ(9) 
      IPBUF(10)=IFREQ(10) 
C 
      GOTO 1100 
C 
C 
C MARKER FREQUENCY BUFFER 
C 
1210  IMBUF(1)=2HMF 
      IMBUF(2)=IFREQ(2) 
      IMBUF(3)=IFREQ(3) 
      IMBUF(4)=IFREQ(4) 
      IMBUF(5)=IFREQ(5) 
      IMBUF(6)=IFREQ(6) 
      IMBUF(7)=IFREQ(7) 
      IMBUF(8)=IFREQ(8) 
      IMBUF(9)=IFREQ(9) 
      IMBUF(10)=IFREQ(10) 
C 
1100  CONTINUE
C 
C 
C 
C 
C  PROCESS  SWEEP MODE AND SWEEP TIME 
C 
C 
      IOBUF(1)=2HSM 
      IOBUF(2)=2H1
      IF(ISWP .GT. 1 )IOBUF(2)=2H2
C 
C 
C 
C PROCESS SWEEP TIME
C 
      ITS=INT(TSWP) 
      IZ1=ITS/10
      IZ2=ITS-(IZ1*10)
      IZ3=INT(TSWP*10.0)-(IZ1*100)-(IZ2*10) 
      IZ4=INT((TSWP*100.0)+.5)-(IZ1*1000)-(IZ2*100)-(IZ3*10)
C 
C 
      IDT1=(IZ1*2**8)+30000B
      IDT2=IZ2+60B
C 
      IDT3=IZ3+60B
      IDT4=(IZ4*2**8)+30000B
C 
      IDOT=27000B 
C 
C 
      IOBUF(3)=2HTI 
      IOBUF(4)=IOR(IDT1,IDT2) 
      IOBUF(5)=IOR(IDOT,IDT3) 
      IOBUF(6)=IDT4 
C 
C 
      IOBUF(7)=2HSE 
C 
C 
C 
      IOBUF(8)=2HSS 
      IF(ISWP .EQ. 1 .OR. ISWP .EQ. 3) IOBUF(9)=2HSC
C 
      IF(ISWP .EQ. 0 .OR. ISWP .EQ. 2) IOBUF(9)=2HSS
C 
      IF(ISWP .EQ. 4) IOBUF(9)=2H 
C 
C 
C 
C 
C 
C 
C 
C=============================================
C 
C  CHECK IF MINIMUM SWEEP WIDTH IS IN SPEC
C 
C  EXAMINE FIRST 6 DIGITS OF START AND STOP BUFFER
C 
C 
      PVAL2=0 
      TVAL2=0 
C 
      CALL A2F(IPBUF,2,7,PVAL)
      CALL A2F(ITBUF,2,7,TVAL)
C 
C 
C 
C 
C 
      IF(PVAL-TVAL)790,789,790
C 
789   CALL A2F(IPBUF,8,9,PVAL2) 
      CALL A2F(ITBUF,8,9,TVAL2) 
C 
C 
C 
      IF(PVAL2-TVAL2) 790,791,790 
C 
C 
C IN LINEAR SWEEP, IF ANY OF THE FIRST 8 DIGITS IS DIFFERENT THEN 
C MINIMUM SWEEP WIDTH IS MET.(PASS CONDITION) 
C 
C 
790   IF(ISWP .LT. 2) GOTO 3000 
C 
C 
C 
C  IN LOG SWEEP, THE STOP FREQUENCY CANNOT BE GREATER THAN THE
C  START FREQUENCY. 
C 
C 
791   IF((PVAL .LT. TVAL) .OR. (PVAL2 .LT. TVAL2)) GOTO 8000
C 
C 
      IF(ISWP .GT. 1) GOTO 800
C 
C*************************************************************
C  IF SWEEP MODE IS LINEAR AND THE FIRST 8 DIGITS OF
C  START AND STOP BUFFER WERE EQUAL , THEN CHECK LAST 6 DIGITS
C 
C 
C 
C 
      CALL A2F(IPBUF,11,16,PNUM)
      CALL A2F(ITBUF,11,16,TNUM)
C 
C  CALCULATE SWEEP WIDTH FOR LINEAR MODE
C 
C 
C 
C  RESCALE TO MILIHERTZ 
      FDIF=(PNUM-TNUM)/1000.
C 
C 
C 
      IF(ABS(FDIF) .LT. FMIN) GOTO 8000 
C 
C 
      GOTO 3000 
C*************************************************************
C 
C 
C CHECK IF START AND STOP FREQ. ARE  ON THE SAME RANGE
C IF THEY ARE,THEN MINIMUM LOG SWEEP IS NOT MET (FAILED MIN. SPEC)
C 
C IN LOG SWEEP, STOP FREQ. MUST BE AT LEAST 10 TIMES GREATER THAN 
C THE START FREQ.(ONLY SWEEP UPWARD IS ALLOWED) 
C 
C 
C CHECK MINIMUM START FREQUENCY IF IT IS AT LEAST 1 HZ
C 
C 
C 
800   IF(STKZ .EQ. 0  .AND.  STHZ .LT. 1) GOTO 8000 
C 
C 
C 
      CALL A2F(ITBUF,1,9,XVAL)
      CALL A2F(IPBUF,1,9,YVAL)
C 
C 
      ZLIM=10000000.0 
      DO 810 I=1,7
      IF(YVAL .GE. ZLIM) GOTO 820 
      ZLIM=ZLIM/10.0
810   CONTINUE
C 
C 
C 
C 
820   IF(XVAL .GE. ZLIM) GOTO 8000
C 
C 
C 
      IF(YVAL/10.0 .LT. XVAL) GOTO 8000 
C 
C 
C 
C 
C 
C 
C===================================
C 
C 
C 
C 
C  REMOTE ENABLE
C 
3000  CALL EXEC(100003B,1600B+L2) 
      GOTO 9000 
3010  CALL ABREG(IA,IB) 
      IF(IB .LT. 0) GOTO 8500 
C 
      ICNT=10 
C 
C 
C 
C OUPUT START FREQUENCY 
C 
C 
3040  CALL REIO(100002B,L1,ITBUF(1),ICNT,IDUMY,0) 
      GOTO 9000 
3050  CALL ABREG(IA,IB) 
      IF(IB .LT. 0) GOTO 8500 
C 
C 
C OUTPUT STOP FREQUENCY 
C 
3060  CALL REIO(100002B,L1,IPBUF(1),ICNT,IDUMY,0) 
      GOTO 9000 
3070  CALL ABREG(IA,IB) 
      IF(IB .LT. 0) GOTO 8500 
C 
C 
C OUTPUT MARKER FREQUENCY 
C 
3080  IF(SMKZ .EQ. 0.0 .AND. SMHZ .EQ. 0.0) GOTO 3090 
      CALL REIO(100002B,L1,IMBUF(1),ICNT,IDUMY,0) 
3085  CALL ABREG(IA,IB) 
      IF(IB .LT. 0) GOTO 8500 
C 
C 
C OUTPUT SWEEP MODE 
C 
3090  CALLREIO(100002B,L1,IOBUF(1),ICNT,IDUMMY,0) 
      GOTO 9000 
3092  CALL ABREG(IA,IB) 
      IF(IB .LT. 0) GOTO 8500 
C 
C 
C 
C CLEAR SRQ 
C 
C 
3095  CALL EXEC(100003B,600B+L1)
      GOTO 9000 
3100  CALL ABREG(IA,IB) 
      IF(IB .LT. 0) GOTO 8500 
      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)=2HSF
      IERR(4)=2HSW
      IERR(5)=2HP 
      RETURN
      END 
      SUBROUTINE FR2A(FHZ,FKHZ,IFREQ),09580-16310 1926 790502 
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-16310 1926 790502 
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$