FTN4,L SUBROUTINE SWFRQ(IUN,IBND,FREQ), +09580-16426 1926 790420 C **************************************************** C C SOURCE 09580-18426 C RELOCATABLE 09580-16426 C C T. KONDO 12/11/78 REV. A C C TEST SYSTEM SOURCE SOFTWARE IS THE PROPRIETRY C MATERIAL OF THE HEWLETT-PACKARD COMPANY. 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 C THIS DEVICE SUBROUTINE IS FOR HP8620C SWEEP OSCILLATOR. C C SET-UP CALL: C SWFRQ(IUN,IBND,FREQ) C WHERE: C IUN = UNIT NUMBER C IBND = BAND SELECT C (FOR 86290A RF PLUG-IN) C 1 = BAND 1 (RANGE 2.0 TO 6.2 GHZ) C 2 = BAND 2 (RANGE 6.0 TO 12.4 GHZ) C 3 = BAND 3 (RANGE 12.0 TO 18.0 GHZ) C 4 = BAND 4 (RANGE 2.0 TO 18.0 GHZ) C NOTE: FOR OTHER PLUG-IN UNIT, C REFER TO THE OPERATING & C SERVICING MANUAL. C C FREQ = FREQUENCY C (FOR 86290A RF PLUG-IN) C BAND 1 420 KHZ C BAND 2 840 KHZ C BAND 3 800 KHZ C BAND 4 1.6 MHZ C NOTE: REFER TO OPERATING & SERVICING C MANUAL OF THE PLUG-IN UNIT. THERE C ARE 10,000 STEPS PER BAND SO THE C FREQUENCY PROGRAMMED IS TO THE C NEAREST STEP. C C SWEEP OSCILLATOR CALLS: C SWMAN(IUN,MODE,IBND,MKR,VOLTS) C C WHERE: C IUN = UNIT NUMBER C MODE = MODE SELECT C 1 = DELTA-F SWEEP * C 2 = CW * (SAME AS 7) C 3 = MARKER SWEEP * C 4 = LOCAL FULL SWEEP * C 5 = LOCAL DELTA-F * C 6 = CW * (SAME AS 2) C 7 = LOCAL MARKER SWEEP * C * FOR THESE SELECTIONS OF ACTUAL FREQUENCY GENERATED C BY THE HP8620C WILL DEPEND ON THE SETTING OF FRONT C PANEL CONTROLS. REFER TO THE OPTION 11 8620C MANUAL C NO. 08620-90060. C C IBND = SELECTED BAND C 0 = LOCAL CONTROL C 1 = BAND 1 C 2 = BAND 2 C 3 = BAND 3 C 4 = BAND 4 C C MKR = MARKER SELECT C 0 = LOCAL CONTROL C 1 = REMOTE MARKER C C VOLTS = VOLTAGE SELECT C THE VOLTAGE RANGE: C (0 - 10.0 VOLTS) C EXAMPLE: C FREQ VOLTS REQ VOLTS C 0% 0 0 C 0.1% 0.010 0.01 C 55% 5.500 5.5 C 100% 10.000 10.0 C C = * = * = * = * = * = * = * = * = * = * = C C HP8620C CONFIGURATION: C C BRANCH & MNEMONIC TABLES: C SWFRQ(I,I,R), OV=XX, ENT=SWFRQ, FIL=%SWFRQ C SWMAN(I,I,I,I,R), OV=XX, ENT=SWMAN, FIL=%SWFRQ C C = * = * = * = * = * = * = * = * = * = * = C C ********************************************* C C CONFIGURATION TABLE ENTRIES C C R 55,1,1 C U1 C 0 TEMPORARY STORAGE C C ********************************************** C C DIMENSION IERMS(5) DATA IERMS /10,5,2HSW,2HFR,2HQ / DATA IDTN /55/ C C FIND LU # C IERMS = 10 ISTN =ISN(DUMMY) LU1 = LUDV(ISTN,IDTN,IUN) LU0 = IBLU0(LU1) IF(LU1.LE.0.OR.LU0.LE.0)GOTO 800 CALL XWFRQ(LU0,LU1,IERMS,IUN,IBND,FREQ) IF(IERMS.NE.0)GOTO 800 20 RETURN C C 800 CALL ERROR(IERMS,IERMS(2)) RETURN END C ------------------------------------- SUBROUTINE SWMAN(IUN,MODE,IBND,MKR,VOLTS), +09580-16426 1926 790420 DIMENSION IERMS(5) DATA IERMS /10,5,2HSW,2HMA,2HN / DATA IDTN /55/ C C FIND LU # C IERMS = 10 ISTN = ISN(DUMY) LU1 = LUDV(ISTN,IDTN,IUN) LU0 = IBLU0(LU1) IF (LU1.LE.0.OR.LU0.LE.0)GOTO 800 CALL XWMAN(LU0,LU1,IERMS,IUN,MODE,IBND,MKR,VOLTS) IF(IERMS.NE.0)GOTO 800 20 RETURN C 800 CALL ERROR(IERMS,IERMS(2)) RETURN END C -------------------------------------------------- SUBROUTINE XWFRQ(LU0,LU1,IERR,IUN,IBND,FREQ), +09580-16426 1926 790420 DIMENSION BUFR(4),IBUFR(16),IBDP(4),IOBUF(6),IRGE(3) DIMENSION IDGT(3),IERR(5),IREG(2) C EQUIVALENCE (REG,IREG,IA),(IREG(2),IB),(BUFR,IBUFR) C DATA IBDP /2HB1,2HB2,2HB3,2HB4/ DATA IRGE /1000,100,10/ DATA IDTN / 55 / C C READ OUTPUT BUFFER C LEN = 16 CALL TIM(IDTN,IUN,1,IBUFR,LEN,IERFG) IF (IERFG.LT.0)GOTO 9900 C C CHECK PARAMETERS C IERR = 0 IF(IBND.LT.1.OR.IBND.GT.4)GOTO 9900 INX = IBND*2-1 C FLOWR = BUFR(INX) FUPPR = BUFR(INX+1) C IF(FREQ.LT.FLOWR.OR.FREQ.GT.FUPPR)GOTO 9900 C IOBUF = 5 IOBUF(2) = 2HM1 IOBUF(3) = IBDP(IBND) C C CALCULATE PROGRAMMING VOLTAGE C VOLTS =((FREQ-FLOWR)/(FUPPR-FLOWR))*10.0 IF(VOLTS.GE.9.9995)GOTO 200 C C CONVERT VOLTS TO ASCII C IVOLT = VOLTS * 1000.0 C DO 150 I = 1, 3 NUM = 0 120 IF(IVOLT.LT.IRGE(I))GOTO 150 IVOLT = IVOLT - IRGE(I) NUM = NUM + 1 GOTO 120 C 150 IDGT(I) = NUM + 60B C IOBUF(4) = IOR(53000B,IDGT(1)) IOBUF(5) = IOR(IDGT(2)*256,IDGT(3)) IOBUF(6) = IOR((IVOLT+60B)*256,105B) GOTO 300 C C 200 IOBUF(4) = 2HV: IOBUF(5) = 2H00 IOBUF(6) = 2H0E C C ENABLE REMOTE C 300 CONTINUE CALL EXEC(100003B,1600B+LU0) GOTO 9000 7710 CALL ABREG(IA,IB) IF(IB.LT.0)GOTO 9100 C C OUTPUT ASCII TO 8620C C CALL REIO(100002B,LU1,IOBUF(2),IOBUF,IDUMY,0) GOTO 9000 7730 CALL ABREG(IA,IB) IF(IB.LT.0)GOTO 9100 RETURN C C ERROR ROUTINE C 9000 IERR = 9 GOTO 9910 9100 IERR = IAND(IREG,377B) + 11 GO TO 9910 9900 IERR = 1 9910 IERR(2) = 5 IERR(3) = 2HSW IERR(4) = 2HFR IERR(5) = 2HQ RETURN END C C --------------------------------------------------------- SUBROUTINE XWMAN(LU0,LU1,IERR,IUN,MODE,IBND,MKR,VOLTS), +09580-16426 1926 790420 DIMENSION IOBUF(7),IERR(5),IREG(2),IRGE(3) C EQUIVALENCE (REG,IREG,IA),(IREG(2),IB) C DATA IRGE /1000,100,10/ IERR = 0 IF(MODE.LT.1.OR.MODE.GT.7)GOTO 9900 IF(IBND.LT.0.OR.IBND.GT.4)GOTO 9900 IF(MKR.LT.0.OR.MKR.GT.1)GOTO 9900 IF(VOLTS.LT.0.0.OR.VOLTS.GT.10.0)GOTO 9900 C IMOD = MODE + 61B IOBUF(2) = IOR(46400B,IMOD) IOBUF(3) = IOR(41000B,IBND+60B) C IF(VOLTS.LT.9.9995)GOTO 100 IOBUF(4) = 53072B IOBUF(5) = 30060B IOBUF(6) = 30105B GOTO 200 100 IVOLT = VOLTS * 1000.0 IDX = 4 IOBUF(4) = 53000B C ******** DO 140 I=1, 3 NUM = 0 110 IF(IVOLT.LT.IRGE(I))GOTO 120 NUM = NUM + 1 IVOLT = IVOLT - IRGE(I) GOTO 110 120 IF(I.NE.2)GOTO 130 IOBUF(IDX) = (NUM+60B)*256 GOTO 140 130 IOBUF(IDX) = IOR(IOBUF(IDX),NUM+60B) IDX = IDX + 1 140 CONTINUE C ********* IOBUF(6) = (IVOLT+60B)*256 + 105B 200 CONTINUE IF(MKR.EQ.0)IOBUF(7) = 46000B IF(MKR.NE.0)IOBUF(7) = 51000B C CALL EXEC(100003B,1600B+LU0) GO TO 9000 300 CALL ABREG(IA,IB) IF(IB.LT.0)GOTO 9100 C C OUTPUT FIELD CODES C IOBUF = -11 CALL REIO(100002B,LU1,IOBUF(2),IOBUF,IDUMY,0) GO TO 9000 350 CALL ABREG(IA,IB) IF(IB.LT.0)GOTO 9100 RETURN C C ERROR EXIT C 9000 IERR = 9 GO TO 9910 9100 IERR = IAND(IREG,377B) + 11 GO TO 9910 9200 IERR = 4 GO TO 9910 9300 IERR = 3 GO TO 9910 9900 IERR = 1 9910 IERR(2) = 5 IERR(3) = 2HSW IERR(4) = 2HMA IERR(5) = 2HN RETURN END END$