FTN4,L
      SUBROUTINE  RFSU(IUNIT,AMHZ,AKHZ,ALEVL),
     +09580-16277 1926 790316 
C-------------------------------------------------------------------
C 
C      RELOC.       09580-16277 
C      SOURCE       09580-18277 
C 
C      R.UNTALAN    MARCH 16,1979 
C 
C 
C      HP 92425A TEST SYSTEM SOFTWARE IS THE PROPRIETARY
C      MATERIAL OF THE HEWLETT-PACKARD COMPANY.  USE AND
C      DISCLOSURE THEREOF ARE RESTRICTED BY WRITTEN AGREEMENT.
C 
C      (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979.
C      ALL RIGHTS RESERVED.  NO PART OF THIS PROGRAM
C      MAY BE PHOTOCOPIED, REPRODUCED OR TRANSLATED 
C      TO ANOTHER PROGRAM LANGUAGE WITHOUT THE PRIOR
C      WRITTEN CONSENT OF THE HEWLETT-PACKARD COMPANY.
C 
C-------------------------------------------------------------------
      DIMENSION IERMS(5)
      DATA IERMS/10,4,2HRF,2HSU / 
      IERMS = 10
      ISTN = ISN(DUM) 
      LU = LUDV(ISTN,19,IUNIT)
      LUIB=IBLU0(LU)
      IF(LU.LE.0.OR.LUIB.LE.0) GOTO 800 
10    CALL  XFSU(LUIB,LU,IERMS,IUNIT,AMHZ,AKHZ,ALEVL) 
      IF(IERMS.NE.0) GOTO 800 
20    RETURN
C 
C 
800   CALL ERROR(IERMS,IERMS(2))
      RETURN
      END 
      SUBROUTINE  XFSU(LUIB,LRFU,IERR,IUNIT,AMHZ,AKHZ,ALEVL), 
     +09580-16277 1926 790316 
C 
C 
C 
C 
C       THIS DEVICE SUBROUTINE PROGRAMS THE 8672A 
C     SYNTHESIZED SIGNAL GENERATOR TO A DESIRED FREQUENCY 
C     AND OUTPUT LEVEL.. HOWEVER, IT IS NECESSARY TO MAKE 
C     ANOTHER CALL (RFMOD) TO ESTABLISH RF(ON/OFF),NORMAL OR
C     OVERANGE,AND LEVELING CONTROL.
C 
C 
C     ENTER  RFSU(I,R,R,R) IN BASIC TABLES
C 
C 
C 
C     CALL  XFSU(LRFU,IERR,MHZ,KHZ,LEVL)
C        WHERE: 
C              LRFU  = LU 0F HP8672A SYNTH. SIG. GEN
C 
C              MHZ   = FREQUENCY  IN MEGAHERTZ
C                      2000 MHZ TO 18600 MHZ
C 
C              KHZ   = FREQUENCY LOHERTZ
C                      -999,999 KHZ TO +999,999 KHZ 
C 
C              LEVL  = OUTPUT LEVEL IN DBM
C                      +3DBM TO -120 DBM
C 
C 
C  NOTE: TOTAL FREQUECY SETTING IS EQUAL TO THE ALGEBRAIC SUM 
C        OF MHZ AND KHZ. EXAMPLE : MHZ=2010  AND KHZ=-9,998 
C        THEN TOTAL FREQUENCY SETTING EQUAL 2,000,002 KHZ.
C 
C 
C  NOTE: TO PROGRAM UNIT TO LOCAL SET MHZ AND KHZ TO ZERO.
C  EXAMPLE: CALL RFSU(U,0,0,L)
C 
C 
C              IERR  = 5 ELEMENT ERROR ARRAY
C                      IERR(1) = ERROR CODE 
C                            0 = NO ERROR 
C                            1 = PARAMETER ERROR
C 
C     ERROR MESSAGES WHICH PERTAIN TO THE HPIB
C 
C     9 = I/O CALL REJECTED 
C     10 = LU NOT ASSIGNED TO HPIB DEVICE OR TO STATION.
C     11 - DMA INPUT REQUEST PREMATURELY TERMINATED 
C     12 - I/O DEVICE TIME OUT
C     13 - IFC (INTERFACE CLEAR) DETECTED 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 DEVICE MAY BE ADDED ON LINE
C 
C                      IERR(2) - IERR(4) = DEVICE SUBROUTINE NAME 
C 
C 
C 
      DIMENSION IERMS(5),ILBUF(3),MSTR(10),KSTR(10),IFREQ(10) 
      DIMENSION IERR(5),ISTR(4),IREG(2),ICBFR(3),IALRM(5) 
      EQUIVALENCE(REG,IREG,IA),(IREG(2),IB) 
      DATA IALRM/5,2HDV,2HIN,2HT /
C 
C 
C 
C  DISABLE (SRQ) ALARM SERVICE
C 
      CALL SRQ(LRFU,17) 
C 
C  **INITIALIZE ERROR CODE
      IERR=0
C 
C 
C  CHECK IF LOCAL SELECTED
C 
      IF(AMHZ+AKHZ.NE.0.) GOTO 111
C 
C 
C SET UNIT TO LOCAL CONTROL 
C 
C OUTPUT CODE   UNL,UNT,LISTEN ADDRESS AND GTL
C 
C 
      JCNT=0
C 
C   DO A DUMMY CALL TO 8672 
C   TO UPDATE EQT WORD 4
C 
      CALL EXEC(100002B,10000B+LRFU,IFREQ,JCNT,IDUMY,0) 
      GOTO 8800 
C 
C 
C   PICK UP SUBCHANNEL # FROM EQT WORD 4
C   AND DETERMINE ASCII LISTEN ADDRESS
C 
222   ICODE=13
      CALL EXEC(ICODE,LRFU,ISTA1,ISTA2,ISTA3) 
C 
      ISUB=IAND(3700B,ISTA2)*4B 
      ISUB=ISUB+20000B
C 
      ICBFR(1)=2H-? 
      ICBFR(2)=ISUB+1 
C 
C 
      CALL EXEC(100002B,10000B+LUIB,IFREQ,JCNT,ICBFR,2) 
      GOTO 8800 
1000  CALL ABREG(IA,IB) 
      IF(IB.LT.0) GOTO 8900 
C 
C 
      GOTO 800
C 
C 
C 
C 
C  CHECK PARAMETERS 
111   IF(AMHZ.LT.2000.0.OR.AMHZ.GT.18599.0) GOTO 8000 
      IF(ABS(AKHZ).GT.999.999E3) GOTO 8000
      IF(ALEVL.LT.-120.0 .OR. ALEVL .GT. 3.0) GOTO 8000 
C 
C 
C 
C 
C 
C 
C  BLANK OUTPUT BUFFER
C 
5     DO 10 I=1,10
      IFREQ(I)=2H 
      MSTR(I)=2H
10    KSTR(I)=2H
      ISBFR=0 
C 
      Q1000=1000
      MHZ1=INT(AMHZ)
      BKHZ1=FLOAT(MHZ1) 
      FKHZ1=(Q1000*AMHZ)-(Q1000*BKHZ1)
      MHZ2=INT(AKHZ/Q1000)
      CMHZ2=FLOAT(MHZ2) 
      FKHZ2=AKHZ-(CMHZ2*Q1000)
C 
C 
C  SET PREFIX "Q" FOR 1GHZ RANGE
      IFREQ(1)=2H Q 
C 
C 
      CALL PSUM(MHZ1,FKHZ1,MHZ2,FKHZ2,MHZS,FKHZS) 
C 
C 
C  CHECK IF 18,600,000 KHZ< TOTAL FREQ.<= 2000 KHZ
C 
      IF(MHZS.GE.18600) GOTO 8000 
      IF (MHZS.LT.2000) GOTO 8000 
C 
C 
C CHECK IF FREQUENCY > 10GHZ ,IF SO THEN CHANGE PREFIX TO "P" 
C 
      IF(MHZS.GE.10**4)IFREQ(1)=2H P
C 
C 
C  CONVERT MHZS AND FKHZS TO ASCII AND STORE IT IN OUTPUT BUFFER
C 
      IKHZS=INT(FKHZS)
C 
C 
      CALL ASCII(MSTR,MHZS) 
      CALL F2A(FKHZS,KSTR)
C 
C 
C  SET INDEX COUNTER
      M=4 
      IF(MHZS.LT.10**4)M=3
C 
C 
      DO 50 I=2,M 
      IFREQ(I)=MSTR(I)
50    IFREQ(I-1+M)=KSTR(I)
C 
C 
C  INSERT ASCII "U" (100KHZ RANGE) IF NECESSARY 
C 
      IF(M.EQ.4) IFREQ(4)=IFREQ(4)+125B 
C 
C 
      KFREQ=IFREQ(2+M)
C 
C 
      IF(FKHZS.GE.100.)GOTO 70
C 
C 
C  INSERT LEADING ZERO IN HUNDREDS PLACE AND TENS PLACE 
C 
C 
      IFREQ(2+M)=(KFREQ/2**8)+30000B
      IFREQ(3+M)=KFREQ*2**8 
      IF(FKHZS.GE.10.) GOTO 70
      IFREQ(2+M)=30060B 
      IFREQ(3+M)=IAND(KFREQ,177400B)
C 
C 
C  CONVERT DBM SETTING TO EQUIVALENT ATTENUATION
C 
70    L=ABS(ALEVL-3.) 
C 
C 
C 
C 
C 
C 
C  DETERMINE PROPER 10DB AND 1DB STEP ATTENUATOR
C 
C        OUTPUT          PROGRAMMED       PROGRAMMED
C         LEVEL          10DB ATTEN.      1DB ATTEN.
C  ------------------  ---------------   ------------ 
C    3DBM TO -10DBM         0            0,1,2,3...9,:,;,<,=
C  -11DBM TO -20DBM         1            4,5,6...9,:,;,<,=
C  -21DBM TO -30DBM         2            4,5,6...9,:,;,<,=
C          .                .               . 
C          .                .               . 
C          .                .               . 
C          .                .               . 
C  -91DBM TO -100DBM        9            4,5,6...9,:,;,<,=
C  -101DBM TO -110DBM       : (10)       4,5,6...9,:,;,<,=
C  -111DBM TO -120DBM       ; (11)       4,5,6...9,:,;,<,=
C 
C  -------------------------------------------------------
C 
      DO 100 I=1,12 
      MAX=(I*10)+3
      IF(L.LE.MAX) GOTO 200 
100   CONTINUE
200   IFACT=I-1 
      ITENS=IFACT+60B 
      ILBUF(1)=45400B+ITENS 
      IUNITS=L-(IFACT*10) 
      ILBUF(2)=46060B+IUNITS
C 
C 
C 
C  **TRANSFER LEVEL SETTING INTO OUTPUT BUFFER
C 
      IFREQ(4+M)=ILBUF(1) 
      IFREQ(5+M)=ILBUF(2) 
      IFREQ(3+M)=2HZ1 
C 
C PROGRAM REMOTE ENABLE 
C 
300   CALL EXEC(100003B,1600B+LUIB) 
      GOTO 8800 
600   CALL ABREG(IA,IB) 
      IF(IB.LT.0) GOTO 8900 
C 
C 
C OUPUT FREQUENCY AND LEVEL SETTING 
C 
      CALL REIO(100002B,2000B+LRFU,IFREQ(1),10,IDUMY,0) 
      GOTO 8800 
700   CALL ABREG(IA,IB) 
      IF(IB.LT.0) GOTO 8900 
C 
C 
C  ARM SERVICE REQUEST(SRQ) 
C 
      CALL SRQ(LRFU,16,IALRM) 
C 
C 
C  NORMAL EXIT
C 
800   RETURN
C 
C 
C 
C ERROR EXIT
C 
C 
8000  IERR=1
      GOTO 9000 
C 
8800  IERR=9
      GOTO 9000 
8900  IERR=IAND(IREG,377B)+11 
9000  IERR(2)=4 
      IERR(3)=2HRF
      IERR(4)=2HSU
      IERR(5)=2H
      RETURN
      END 
C 
C 
C 
C 
      SUBROUTINE PSUM(MHZ1,FKHZ1,MHZ2,FKHZ2,MHZS,FKHZS),
     +09580-16277 1926 790316 
C PSUM:  (DOUBLE) PRECISION SUM (OR DIFFERENCE) 
C 
C*************************************************
C*
C*
C*  SUBROUTINE PSUM CALCULATES THE DOUBLE-PRECISION SUM 
C*  (MHZS,FKHZS) OF TWO DOUBLE-PRECISION FREQUENCIES, 
C*  (MHZ1,FKHZ1) AND (MHZ2,FKHZ2).  ONE FREQUENCY MAY BE
C*  NEGATIVE (E.G.  BOTH PARTS NEGATED) TO ALLOW SUM TO 
C*  ALSO PERFORM SUBTRACTION. THE SUM MUST BE POSITIVE, 
C*  HOWEVER.
C*
C*
C*********************************************************
C 
C 
C 
C 
C ****  DEFINE DECIMAL CONSTANT.
C 
      D1000=1000
C 
C ****  CALCULATE SUM 
C 
      MHZS=MHZ1+MHZ2
      FKHZS=FKHZ1+FKHZ2 
C 
C 
C  ****  TEST IF CARRY NEEDED 
C 
      IF (FKHZS-D1000)600,500 
C 
C 
C  ****  GENERATE CARRY 
C 
500   MHZS=MHZS+1 
      FKHZS=FKHZS-D1000 
      RETURN
C 
C 
C  ****  IS FKHZS NEGATIVE? 
C 
600   IF (FKHZS)700,9000
C 
C 
C  ****  GENERATE CARRY 
C 
700   MHZS=MHZS-1 
      FKHZS=D1000+FKHZS 
C 
C 
9000  RETURN
      END 
      END$