FTN4,L
C 
C------------------------------------------ 
C 
C  RELOCATABLE   09580-16270
C  SOURCE        09580-18270
C 
C  V.POVIO    REV.A    6-21-77
C  R.RICHARDS REV.B    1-3-79 
C 
C  TEST SYSTEM SOURCE SOFTWARE IS THE PROPRIETRY
C  MATERIAL OF THE HEWLETT-PACKARD COMPANY. 
C 
C  (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977 
C  ALL RIGHTS RESERVED. NO PART OF THIS PROGRAM 
C  MAY BE PHOTOCOPIED, REPODUCED OR TRANSLATED
C  TO ANOTHER PROGRAM LANGUAGE WITHOUT THE ORIOR
C  WRITTEN CONSENT OF THE HEWLETT-PACKARD COMPANY.
C 
C------------------------------------------ 
C 
C   HP 3570A NETWORK ANALYZER 
C   ------------------------- 
C 
C   GENERAL 
C   ------- 
C 
C     THE FOLLOWING DEVICE SUBROUTINE ARE USED
C     TO PROGRAM THE HP 3570A NETWOK ANALYZER.
C 
C       NOTE: THIS DEVICE SUBROUTINE IS FOR A 
C              STANDARD INSTRUMENT AND DOES 
C              NOT COVER AN OPTION 2,3
C 
C 
C   BRANCH AND MNEMONIC TABLE ENTRIES.
C   ----------------------------------
C 
C      NASU(I,I,I,I,I),      OV=XX,   ENT=NASU,   FIL=%NASU 
C      NAMU(I,RV,RV),        OV=XX,   ENT=NAMU,   FIL=%NASU 
C 
C------------------------------------------ 
C 
      SUBROUTINE NASU(IUNIT,IV,IBW,IAF,IPR),
     +09580-16270 1926 790103 
      DIMENSION IERMS(5)
      DATA IERMS /10,5,2HNA,2HSU,2H  /
C 
C------------------------------------------ 
C 
C  NASU(IUNIT,IV,IBW,IAF,IPR) 
C 
C    WHERE: 
C 
C      IUNIT = UNIT # 
C 
C      IV    = MAX/REF INPUT VOLTAGE
C              1 = 0DBM 
C              2 = .1 V 
C              3 = 1V 
C 
C      IBW   = BANDWITH 
C              1 = 10 HZ
C              2 = 100 HZ 
C              3 = 3 KHZ
C 
C      IAF   = AMPLITUDE FUNCTION 
C              1 = A
C              2 = B
C              3 = B-A
C 
C      IPR   = PHASE REF
C              1 = A
C              2 = -A 
C 
C-----------------------------------------
C 
C 
C  FIN LU # 
C 
      ISTN = ISN(DUMMY) 
      IERMS = 10
      LU1 = LUDV(ISTN,12,IUNIT) 
      LU0 = IBLU0(LU1)
      IF(LU0 .LE. 0 .OR. LU1 .LE. 0)GOTO 800
C 
C  CALL SUBROUTINE XASU 
C 
      CALL XASU(LU0,LU1,IERMS,IUNIT,IV,IBW,IAF,IPR) 
      IF(IERMS)800,20,800 
20    RETURN
C 
800   CALL ERROR(IERMS,IERMS(2))
      RETURN
      END 
C 
C-----------------------------------------------
C 
      SUBROUTINE XASU(LU0,LU1,IERMS,IUNIT,IV,IBW,IAF,IPR),
     +09580-16270 1926 790103 
      DIMENSION IERMS(5),IREG(2),IBWA(3),IOBUF(4) 
      EQUIVALENCE (REG,IREG,IA),(IREG(2),IB)
      DATA IBWA /112B,111B,113B/
C 
C-----------------------------------------------
C 
C  THE PARAMETERS IN THE CALLING SEGUENCE HAVE THE FOLLOWING
C  MEANINGS.
C 
C     LU0 = LU # OF HPIB BUSS.
C     LU1 = LU # OF HP3570. 
C 
C    IERMS IS A FIVE WORD ARRAY WITH IERR(1) CONTAINING 
C      THE ERROR CODE.
C 
C        0 = NO ERROR 
C        1 = PARAMETER ERROR
C        3 = INCORRECT DATA FROM NAMU CALL
C 
C    ERROR MESSAGES THAT PERTAIN TO THE HPIB. 
C 
C        9 = I/O CALL REJECTED
C       10 = LU0 OR LU1 = 0 
C       12 = I/O DEVICE TIME OUT
C       13 = IFC DETECTED DURING I/O REQUEST
C       14 = SRQ ABORTED
C       15 = NON-EXISTENT ALARM PROGRAM 
C       16 = ILLEGAL CONTROL REQUEST
C       17 = EQT EXTENSION AREA FULL
C 
C    IERMS(2) = ERROR MNEMONIC CHARACTER COUNT
C    IERMS(3) TO IERMS(5) = ERROR MNEMONIC
C 
C-------------------------------------------------
C 
C  CHECK PARAMETERS 
C 
      IERMS = 1 
      IF(IV .LT. 1 .OR. IV .GT. 3)GOTO 9900 
      IF(IBW .LT. 0 .OR. IBW .GT. 3)GOTO 9900 
      IF(IAF .LT. 1 .OR. IAF .GT. 3)GOTO 9900 
      IF(IPR .LT. 1 .OR. IPR .GT. 2)GOTO 9900 
C 
C  SET UP OUTPUT BUFFER 
C 
      IOBUF(1)=IV+104B
      IOBUF(2)=IBWA(IBW)
      IOBUF(3)=IAF+100B 
      IOBUF(4)=116B-IPR 
C 
C  REMOTE ENABLE
C 
      CALL EXEC(100003B,1600B+LU0)
      GOTO 9000 
131   CALL ABREG(IA,IB) 
      IF(IB .LT. 0)GOTO 8500
C 
C  OUTPUT BUFFER
C 
      CALL REIO(100002B,LU1,IOBUF,4,IDUMY,0)
      GOTO 9000 
181   CALL ABREG(IA,IB) 
      IF(IB .LT. 0)GOTO 8500
C 
C  RETURN 
C 
      IERMS=0 
      RETURN
C 
C  ERROR EXIT 
C 
8500  IERMS=IAND(IA,377B)+11
      GOTO 9900 
9000  IERMS=9 
9900  IERMS(2)=5
      IERMS(3)=2HNA 
      IERMS(4)=2HSU 
      IERMS(5)=2H 
      RETURN
      END 
C 
C-------------------------------------------- 
C 
      SUBROUTINE NAMU(IUNIT,AMP,RPHASE),
     +09580-16270 1926 790103 
      DIMENSION IERMS(5)
      DATA IERMS/10,5,2HNA,2HMU,2H  / 
C 
C-------------------------------------------- 
C 
C  NAMU(IUNIT,AMP,RPHASE) 
C 
C    WHERE: 
C 
C      IUNIT  = UNIT #
C 
C      AMP    = AMPLITUDE READING RIGHT HAND DISPLAY
C 
C      RPHASE = PHASE/DELAY READING LEFT HAND DISPLAY 
C 
C---------------------------------------------
C  FIND LU #
C 
      IERMS=10
      ISTN=ISN(DUMMY) 
      LU1=LUDV(ISTN,12,IUNIT) 
      LU0=IBLU0(LU1)
      IF(LU0 .LE. 0 .OR. LU1 .LE. 0) GOTO 800 
C 
C  CALL SUBROUTINE
C 
      CALL XAMU(LU0,LU1,IERMS,IUNIT,AMP,RPHASE) 
      IF(IERMS)800,20,800 
20    RETURN
C 
800   CALL ERROR(IERMS,IERMS(2))
      RETURN
      END 
C 
C---------------------------------------- 
C 
      SUBROUTINE XAMU(LU0,LU1,IERMS,IUNIT,AMP,RPHASE),
     +09580-16270 1926 790103 
      DIMENSION IERMS(5),IREG(2),IREAD(9) 
      DIMENSION IOBUF(2)
      EQUIVALENCE (REG,IREG,IA),(IREG(2),IB)
C 
      IERMS=1 
C 
C SET UP OUTPUT BUFFER
C 
      IOBUF(1)=117B 
      IOBUF(2)=54B
C 
C  OUTPUT ASCII STRING TO INSTRUMENT
C 
7000  CALL REIO(100002B,LU1,IOBUF,2,IDUMY,0)
      GOTO 9000 
97    CALL ABREG(IA,IB) 
      IF(IB .LT. 0)GOTO 8500
C 
C  READ DATA
C 
      CALL REIO(100001B,LU1,IREAD(2),8,IDUMY,0) 
      GOTO 9000 
98    CALL ABREG(IA,IB) 
      IF(IB .LT. 0)GOTO 8500
C 
C  CHANGE ASCII TO FLOATING POINT 
C 
      IREAD(1)=16 
C 
      IERMS=3 
      IREG=A2F(IREAD,2,7,AMP) 
      IF(IREG .LT. 0)GOTO 8000
      IF((IAND(IREAD(2),2000B)) .EQ. 2000B) AMP=AMP*(-1.0)
C 
      IREG=A2F(IREAD,11,15,RPHASE)
      IF(IREG .LT. 0) GOTO 8000 
      IF((IAND(IREAD(6),2000B)) .EQ. 2000B)RPHASE=RPHASE*(-1.0) 
C 
C  RETURN 
C 
      IERMS=0 
      RETURN
C 
C  ERROR EXIT 
C 
8500  IERMS=IAND(IA,377B)+11
      GOTO 8000 
9000  IERMS=9 
8000  IERMS(2)=5
      IERMS(3)=2HNA 
      IERMS(4)=2HMU 
      IERMS(5)=2H 
      RETURN
      END 
      END$
                                                                                                                                                                                  