FTN4,L
      SUBROUTINE TSASU(IUN,INPZ,IREF,IRANG,IBNDW,OFSET,IDSM),09580-16323
     + REV.2013 800131
C 
C 
C  THIS DEVICE SUBROUTINE IS USED TO PROGRAM THE HP-3571A.
C 
C 
C-------------------------------------------------------------------
C 
C      RELOC.       09580-16323 
C      SOURCE       09580-18323 
C 
C      TOSH KONDO                  REV. A 
C      BOB RICHARDS   2-20-79      REV. B 
C      BOB RICHARDS   790502
C      BOB RICHARDS   800109
C      BOB RICHARDS   800128
C      BOB RICHARDS   800131
C 
C      HP 92425B 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 1980.
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 
C 
C 
      DIMENSION IERMS(5)
      DATA IERMS/10,5,2HTS,2HAS,2HU / 
      DATA IDTN /60/
C 
      ISTN=ISN(DUMMY) 
C 
C 
C    GET LU OF HP3571A
C 
      LU1 = LUDV(ISTN,IDTN,IUN) 
      LU0 = IBLU0(LU1)
      IF(LU1 .LE. 0 .OR. LU0 .LE. 0) GOTO 800 
      CALL XSASU(LU0,LU1,IERMS,INPZ,IREF,IRANG,IBNDW,OFSET,IDSM)
      IF(IERMS .NE. 0) GOTO 800 
20    RETURN
C 
800   CALL ERROR(IERMS,IERMS(2))
      RETURN
      END 
C 
C   BRANCH AND MNEMONIC TABLE ENTRIES:
C 
C       TSASU(I,I,I,I,I,R,I)   OV=XX,   ENT=TSASU,  FIL=%TSASU
C       TSAMU(I,I,RV)          OV=XX,   ENT=TSAMU,  FIL=%TSASU
C 
      SUBROUTINE XSASU(LU0,LU1,IERR,INPZ,IREF,IRANG,IBNDW,OFSET,IDSM),09
     +580-16323 REV.2013 800131 
C 
C-------------------------------------------------------------------- 
C      THIS DEVICE SUBROUTINE SETS UP THE HP3571A TRACKING SPECTRUM 
C      ANALYZER.
C 
C    CALL TSASU(IUNIT,INPZ,IREF,IRANG,IBNDW,OFSET,IDSM) 
C 
C    WHERE: 
C           IUNIT = UNIT NUMBER 
C           INPZ  = INPUT IMPEDANCE 
C                   1 = 50 OHMS 
C                   2 = 75 OHMS 
C                   3 = 1 MEGOHM ,30 PF 
C 
C           IREF = DISPLAY REFERENCE
C                   1 = DBM 
C                   2 = DBV 
C                   3 = DB SET RELATIVE (00.00DB) 
C                   4 = DB RELATIVE 
C 
C           IRANG = INPUT RANGE 
C                  -60 = -60 DBV
C                  -50 = -50 DBV
C                  -40 = -40 DBV
C                  -30 = -30 DBV
C                  -20 = -20 DBV
C                  -10 = -10 DBV
C                    0 = 0   DBV
C                   10 =+10  DBV
C 
C           IBNDW = BANDWIDTH 
C                  3 = 3 HZ 
C                 10 = 10 HZ
C                 30 = 30 HZ
C                100 =100 HZ
C                300 =300 HZ
C               1000 =1000 HZ 
C               3000 =3000 HZ 
C              10000 =10000 HZ
C 
C         OFSET = NUMERIC OFFSET
C                (-199.99DB TO +199.99DB) 
C 
C         IDSM = DISPLAY SMOOTHING
C               0= OFF
C               1= ON 
C 
C           ERROR PARAMETER:
C                  0 = NO ERROR 
C                  1 = PARAMETER ERROR
C                  3 = OVERLOAD ERROR  (TSAMU)
C                  4 = BAD DATA FROM 3571A (TSAMU)
C 
C           ERROR MESSAGE WHICH PERTAIN TO HPIB 
C                  9 = I/O CALL REJECTED
C                 10 = LU NOT ASSIGNED TO HPIB DEVICE OR
C                      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
C                       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
C                      ADDED ON LINE
C 
C-----------------------------------------------------------------------
C 
C 
      DIMENSION IRFLD(8),IBWFD(8),IOFSC(5),IDIGT(5) 
      DIMENSION IOBUF(14),IREG(2),IERR(5) 
      EQUIVALENCE (REG,IREG,IA),(IREG(2),IB)
C 
C 
      DATA IRFLD/-60,-50,-40,-30,-20,-10,0,10/
      DATA IBWFD/3,10,30,100,300,1000,3000,10000/ 
      DATA IOFSC/10000,1000,100,10,1/ 
C 
C 
C      HPIB PROGRAMMING CODES:
C 
C     DISPLAY REF:               INPUT IMPEDANCE: 
C      RELATIVE    R2              1 MEG,30PF      Z2 
C      DBV         R1              75 OHMS         Z1 
C      DBM         R0              50 OHMS         Z0 
C 
C     BANDWIDTH:                 INPUT RANGE: 
C      10 KHZ      B7              + 10 DBV        V7 
C       3 KHZ      B6                 0 DBV        V6 
C       1 KHZ      B5               -10 DBV        V5 
C     300  HZ      B4               -20 DBV        V4 
C     100  HZ      B3               -30 DBV        V3 
C      30  HZ      B2               -40 DBV        V2 
C      10  HZ      B1               -50 DBV        V1 
C       3  HZ      B0               -60 DBV        V0 
C 
C    ENTER OFFSET:   P
C    OFFSET PREFACE: O
C    DISPLAY SMOOTHING: 
C               ON   S1 
C               OFF  S0 
C 
C---------------------------------------------------------
C 
C 
      DATA IREL,IVRG,IBWD,INPR/2HR ,2HV ,2HB ,2HZ / 
      DATA OFMAX/199.99/
C 
      IERR=1
C 
C    INPUT IMPEDANCE
C 
      IF(INPZ .LT. 1 .OR. INPZ.GT. 3) GOTO 9900 
      IOBUF(1) = INPR +20B +(INPZ-1)
C 
C   DISPLAY REFERENCE 
C 
      IF(IREF .LT. 1 .OR. IREF .GT. 4) GOTO 9900
      JREF =IREF - 1
      IF(JREF .GT. 2 ) JREF = 2 
      IOBUF(2) = IREL +20B +JREF
C 
C   INPUT RANGE 
C 
      IRCOD = 0 
      DO 10, I=1,8
      IF(IRANG .EQ. IRFLD(I)) GOTO 20 
10    IRCOD = IRCOD + 1 
      IF(IRCOD .GT. 7) GOTO 9900
20    IOBUF(3) = IVRG + 20B +IRCOD
C 
C     BANDWIDTH 
C 
      IBCOD=0 
      DO 30, I=1,8
      IF (IBNDW .EQ. IBWFD(I)) GOTO 40
30    IBCOD = IBCOD + 1 
      IF(IBCOD .GT. 7) GOTO 9900
40    IOBUF(4) = IBWD + 20B +IBCOD
C 
      IF(IREF .EQ. 3 .AND. OFSET .NE. 0.0) GOTO 9900
      IF(IDSM .LT. 0 .OR. IDSM .GT. 1) GOTO 9900
      INX = 5 
      IF(IREF .LT. 3) GOTO 100
C 
C    SET CURRENT DBV READING TO RELATIVE READING (00.00 DB) 
C 
      IF(IREF .EQ. 3) GOTO 110
C 
C    SET UP FOR NUMERIC OFFSET ENTRY (-199.99DB TO 199.99 DB) 
C 
      IF(ABS(OFSET) .GT. OFMAX) GOTO 9900 
      IOFF = IFIX(OFSET*100.) 
      ITRY = IOFF 
C 
C   IF OFFSET IS NEGATIVE ................. 
C 
      IF(IOFF .LT. 0) ITRY = -ITRY
C 
C   CONVERT NUMERIC VALUE TO DIGITS...............
C 
      DO 60, I=1,5
      KNX = 0 
      IDIGT(I) = 0
50    CONTINUE
      IF((ITRY-IOFSC(I)) .LT. 0) GOTO 60
      KNX = KNX + 1 
      ITRY = ITRY - IOFSC(I)
      GOTO 50 
C 
60    IDIGT(I) = KNX
C 
C   FIND MOST SIGNIFICANT DIGIT.................... 
C 
      JNX =1
70    IF(IDIGT(JNX) .NE. 0) GOTO 80 
      JNX = JNX + 1 
      IF(JNX .LE. 5) GOTO 70
80    CONTINUE
C 
C    IF OFFSET VALUE IS NEGATIVE, INSERT POLARITY SIGN........... 
C 
      IF(IOFF .LT. 0) IOBUF(JNX)=47455B 
      IF(IOFF .LT. 0) GOTO 90 
C 
C   INSERT OFFSET DIGITS TO OUTPUT BUFFER...................... 
C 
      IOBUF(INX) = 47460B + IDIGT(JNX)
90    INX= INX + 1
      JNX = JNX + 1 
      IF(JNX .GT. 5) GOTO 100 
C 
C   ODD DIGITS
C 
      IOBUF(INX) = (IDIGT(JNX) +60B) *256 
      JNX =JNX + 1
      IF(JNX .GT. 5) GOTO 120 
C 
C  EVEN DIGITS
C 
      IOBUF(INX) = IOBUF(INX) + 60B + IDIGT(JNX)
      GOTO 90 
C 
C  DISPLAY SMOOTHING
C 
100   IOBUF(INX) = 51460B 
      IF(IDSM .EQ. 1) IOBUF(INX) = 51461B 
      GOTO 200
C 
C  ENTER OFFSET (00.00DB) ASCII 'P' 
C 
110   IOBUF(INX) = 50000B 
120   IOBUF(INX) =IOBUF(INX) + 123B 
      IOBUF(INX+1) = (60B + IDSM) *256
      INX = -(INX*2+1)
C 
C  REMOTE ENABLED.................... 
C 
200   CONTINUE
      CALL EXEC(100003B,1600B+LU0)
      GOTO 9100 
210   CALL ABREG(IA,IB) 
      IF(IB .LT. 0) GOTO 8500 
C 
C  OUTPUT BUFFER................... 
C 
      CALL REIO(100002B,LU1,IOBUF,INX,IDUMY,0)
      GOTO 9100 
220   CALL ABREG(IA,IB) 
      IF(IB .LT. 0) GOTO 8500 
C 
C     RETURN................. 
C 
      IERR = 0
      RETURN
C 
C   ERROR EXIT
C 
8500  IERR = IAND(IA,377B) +11
      GOTO 9900 
9100  IERR = 9
9900  IERR(2) = 5 
      IERR(3) = 2HTS
      IERR(4) = 2HAS
      IERR(5) = 2HU 
      RETURN
      END 
C 
C     HP3571 TRACKING SPECTRUM ANALYZER MEASURE SUBROUTINE
C 
      SUBROUTINE TSAMU(IUN,MODE,AMPL),09580-16323 REV.2013 800131 
C 
      DIMENSION IERMS(5)
      DATA IERMS /10,5,2HTS,2HAM,2HU /
      DATA IDTN /60/
C-------------------------------------------- 
C 
C      TSAMU(IUN,MODE,AMPL) 
C         WHERE:
C               IUN = UNIT #
C               MODE = MODE OF OPERATION
C                    1 = HP3330 IS SET TO SWEEP 
C                    2 = HP3330 IS NOT SWEEPING OR IS NOT USED
C                    3 = EXTERNAL TRIGGER COMMAND 
C               AMPL = RETURNED AMPLITUDE 
C 
C-----------------------------------------------
C 
C 
      ISTN = ISN(DUMMY) 
      LU1 = LUDV(ISTN,IDTN,IUN) 
      LU0 = IBLU0(LU1)
      IF(LU1 .LE. 0 .OR. LU0 .LE. 0) GOTO 800 
C 
      CALL XSAMU(LU0,LU1,IERMS,MODE,AMPL) 
      IF(IERMS)800,20,800 
20    RETURN
C 
C 
800   CALL ERROR(IERMS,IERMS(2))
      RETURN
      END 
C 
C 
      SUBROUTINE XSAMU(LU0,LU1,IERR,MODE,AMPL),09580-16323 REV.2013 8001
     +31
C 
C 
      DIMENSION IERR(5),IREG(2),IOBUF(2),IREAD(6) 
      EQUIVALENCE (REG,IREG,IA),(IREG(2),IB)
C 
C    HPIB PROGRAMMING CODES:
C 
C          MEASUREMENT CONTROL MODE:
C              AUTO         M0
C              EXTERNAL     M1
C     EXTERNAL TRIGGER:     T 
C 
C     DATA OUTPUT FORMAT: 
C        N/O  SGN  OR D4  D3  D2  D1  CR  LF
C 
C 
      DATA IEXMD /2HM1/ 
      DATA ITRIG /2HT / 
C 
      IERR = 1
      IF(MODE .LT. 1 .OR. MODE .GT. 3) GOTO 9900
      IF(MODE .NE. 2) GOTO 100
      IOBUF(1) = IEXMD
      IOBUF(2) = ITRIG
      NUM = -3
      IF(MODE .EQ. 1 ) NUM = 1
      GOTO 200
C 
C   PROCESS EXTERNAL TRIGGER COMMAND
C 
100   IOBUF(1) = ITRIG
      NUM = -1
C 
C  REMOTE ENABLED 
C 
200   CONTINUE
C 
      CALL EXEC(100003B,1600B+LU0)
      GOTO 9100 
300   CALL ABREG(IA,IB) 
      IF(IB .LT. 0) GOTO 8500 
C 
C   OUTPUT EXTERNAL MODE / EXTERNAL TRIGGER 
C 
      CALL REIO(100002B,LU1,IOBUF,NUM,IDUMY,0)
      GOTO 9100 
310   CALL ABREG(IA,IB) 
      IF(IB .LT. 0) GOTO 8500 
C 
C  READ DATA
C 
      NUMX = 4
      CALL REIO(100001B,LU1,IREAD(2),NUMX,IDUMY,0)
      GOTO 9100 
320   CALL ABREG(IA,IB) 
      IF(IB .LT. 0) GOTO 8500 
C 
C  CHECK FOR OVERLOAD 
C 
      IOVLD = IAND(IREAD,177400B) 
      IF(IOVLD .EQ. 47400B) GOTO 400
C 
C  CONVERT TO ASCII 
C 
      AMPL = 0.0
      IREG = A2F(IREAD,2,8,AMPL)
      IF(IREG .LT. 0) GOTO 9400 
      IERR = 0
      RETURN
C 
C   OVER-LOAD RETURN
C 
400   AMPL = 1E38 
      GOTO 9300 
C 
C  ERROR RETURN 
C 
8500  IERR = IAND(IA,377B)+11 
      GOTO 9900 
9100  IERR = 9
      GOTO 9900 
9300  IERR =3 
      GOTO 9900 
9400  IERR = 4
9900  IERR(2) =5
      IERR(3) = 2HTS
      IERR(4) = 2HAM
      IERR(5) = 2HU 
      RETURN
      END 
      END$