FTN4,L
      SUBROUTINE GFMRD(IUNIT,IMODE,IREF,ITRIG,FREQ,RETL,RETR),
     +09580-16012 REV.2001 791023 
C 
C**************************************** 
C 
C  RELOCATABLE  09580-16012 
C  SOURCE       09580-18012 
C 
C  V.POVIO       10-4-76
C  BOB RICHARDS  4-27-79
C  BOB RICHARDS  791023 
C 
C*********************************************************************
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 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 
C 
C**************************************** 
C 
C   HP 3575 GAIN PHASE METER
C   ------------------------
C 
C   GENERAL:
C   ------- 
C 
C    THE FOLLOWING DEVICE SUBROUTINE PROGRAMS 
C    ANY FUNCTION OF THE HP 3575 GAIN PHASE METER 
C    (OPT 002) AND RETURNS THE MEASUREMENT DATA,
C    APPEARING ON THE LEFT AND RIGHT FRONT PANEL
C    DISPLAYS, TO THE CALLING PROGRAM AS A FLOATING 
C    POINT VALUE. 
C 
C   HARDWARE ENVIRONMENT: 
C   --------------------
C 
C    HP 21MX SERIES COMPUTER
C 
C    HP 3575 GAIN PHASE METER WITH OPT 002
C 
C    2 HP 12566-60024 MICROCIRCUIT CARDS
C      WITH JUMPERS SET AS FOLLOWS
C 
C      W1 - A 
C      W2 - A 
C      W3 - B 
C      W4 - B 
C      W5 THRU W8 - REMOVED 
C      W9 - A 
C 
C    HP 09500-60281 INTERFACE CABLE 
C 
C  INPUT AND OUTPUT WORD FORMAT:
C  ---------------------------- 
C 
C   PROGRAM WORD FROM MICROCIRCUIT CARD #1
C 
C       15 14 13 12 11 10  9  8  7  6  5  4  3  2  1  0 
C      -------------------------------------------------
C      !RL!TM!PR!CF!  !  !F1!F2!  !  !AF!BF!  !  !BA!AA!
C      -------------------------------------------------
C 
C   REMOTE/LOCAL
C    RL=1 REMOTE
C      =0 LOCAL 
C 
C   TRIGGER MODE
C    TM=1 NON DELAYED 
C      =0 DELAYED 
C 
C   PHASE REFERENCE 
C    PR=1 -A
C      =0 A 
C 
C   RIGHT DISPLAY 
C    CF=1 PHASE 
C      =0 B 
C 
C   FREQUENCY RANGE 
C    F1&F2 00=1-1K
C          01=10-10K
C          10=100-1M
C          11=1K-13M
C 
C   AMPLITUDE FUNCTION
C    AF&BF 00=B/A 
C          01=A 
C          10=B 
C 
C   VOLTAGE RANGE 
C    BA OR AA 0=HIGH RANGE
C             1=LOW RANGE 
C 
C 
C  LEFT DISPLAY DATA TO MICROCIRCUIT CARD #1
C 
C       15 14 13 12 11 10  9  8  7  6  5  4  3  2  1  0 
C      -------------------------------------------------
C      !BO!AO!S !H !  TENS     !  UNITS    !  TENTHS   !
C      -------------------------------------------------
C 
C    OVERLOAD 
C     BO=1 OVERLOAD  B
C     AO=1 OVERLOAD A 
C 
C   SIGN
C    1=+
C    0=-
C 
C   H=HUNDEEDS
C 
C   BITS 0-11 ARE IN BCD
C 
C 
C  RIGHT DISPLAY DATA TO MICROCIRCUIT CARD #2 
C 
C   SAME AS ABOVE EXCEPT BIT 15 =1 OVERLOAD ON
C   A OR B AND BIT 14 IS NOT USED 
C 
C  BRANCH AND MNEMONIC TABLE ENTRIES
C  ---------------------------------
C 
C    GFMRD(I,I,I,I,R,RV,RV),  OV=X, ENT=GFMRD, FIL=%GFMRD 
C 
C**************************************** 
C 
C    NOTE:
C 
C         THE WELCOM FILE REQUIRES TWO ENTRIES FOR EACH HP3575 BECAUSE
C         TWO I/O SLOTS (I.E. LU'S) ARE REQUIRED TO INTERFACE THE HP3575. 
C         THEREFORE, THE UNIT 1 'UNIT' ENTRIES WOULD BE 1 AND 2, THE UNIT 
C         2 ENTRIES WOULD BE 3 AND 4, ETC.  BASIC CALLS WOULD BE TO UNITS 
C         1, 3, ETC.
C 
C 
C 
C    ERRORS:
C 
C          1 = PARAMETER INPUT ERROR
C 
C          2 = HP-3575 OVERLOAD/TIMEOUT ERROR 
C 
C          9 = EXEC CALL ERROR
C 
C 
C 
      DIMENSION IERMS(5)
      DATA IERMS/10,5,2HGF,2HMR,2HD / 
      DATA IDTN/40/ 
C 
C  FIND STATION # AND LU #
C 
      IERMS=10
      ISTN=ISN(DUMMY) 
      ILU1=LUDV(ISTN,IDTN,IUNIT)
      ILU2=LUDV(ISTN,IDTN,IUNIT+1)
      IF(ILU1 .EQ. 0 .OR. ILU2 .EQ. 0)GOTO 800
C 
C  JUMP TO DEVICE SUBROUTINE
C 
      CALL XFMRD(ILU1,ILU2,IERMS,IMODE,IREF,ITRIG,FREQ,RETL,RETR) 
      IF(IERMS)800,20,800 
20    RETURN
C 
C  ERROR EXIT 
C 
800   CALL ERROR(IERMS,IERMS(2))
      RETURN
      END 
C 
C**************************************** 
C 
C  GFMRD(IUNIT,IMODE,IREF,ITRIG,FREQ,RETL,RETR) 
C 
C    WHERE
C 
C    IUNIT=UNIT NUMBER (1,3,5, ETC.)
C 
C    IMODE=MODE 
C 
C          1=RETURN B/A DB INTO RETL
C          2=RETURN A DBV INTO RETL 
C          3=RETURN B DBV INTO RETL 
C 
C    IREF=PHASE REFERENCE OR RIGHT HAND DISPLAY SELECTION 
C 
C          0=RIGHT HAND DISPLAY IS B SIGNAL LEVEL IN DBV
C          1=RIGHT HAND DISPLAY IS PHASE ANGLE USING 'A'
C            SIGNAL AS THE REFERENCE. 
C         -1=RIGHT HAND DISPLAY IS PHASE ANGLE USING '-A' 
C            SIGNAL AS THE REFERENCE. 
C 
C    ITRIG=TRIGGER MODE 
C 
C          0=NON DELAYED
C          1=DELAYED
C 
C    FREQ=FREQUENCY 
C 
C         -1=1HZ TO 1KHZ RANGE
C         -2=10HZ TO 100KHZ RANGE 
C         -3=100HZ TO 1MHZ RANGE
C         -4=1KHZ TO 13MHZ RANGE
C           OR
C          FREQUENCY OF INPUT SIGNAL IN KHZ (.001 TO 13000) 
C 
C    RETL=RETURNED LEFT PANEL READING.
C 
C    RETR=RETURNED RIGHT PANEL READING
C 
C  *THIS CALL INITIATES AND COMPLETES A MEASUREMENT.
C   THE MOST ACCURATE MEASUREMENTS ARE MADE IF ITRIG=1
C 
C   WITH THE FREQUENCY MODE SET TO THE LOWEST RANGE ("-1") IN-
C   STRUMENT TIMEOUT IS SET TO 60 SECONDS AS OPPOSED TO 10
C   SECONDS FOR OTHER MODES.
C 
C*****************************************
C 
      SUBROUTINE XFMRD(ILU1,ILU2,IERMS,IMODE,IREF,ITRIG,FREQ,RETL,RETR),
     +09580-16012 REV.2001 791023 
      DIMENSION IBUF(2),IDATA(5),IREG(2),ITIME(4),IERMS(5)
      EQUIVALENCE (REG,IREG,IA),(IREG(2),IB)
C 
C  INITILIZE
C 
      ICNT=0
      IERMS=1 
      ITIME(1)=1000 
      IF(FREQ .EQ. -1.0) ITIME(1) = 6000
C 
C  CHECK PARAMETERS 
C 
      IF((IMODE .LT. 1) .OR. (IMODE .GT. 3))GOTO 8001 
      IF((IREF .LT. -1) .OR. (IREF .GT. 1))GOTO 8001
      IF((ITRIG .LT. 0) .OR. (ITRIG .GT. 1))GOTO 8001 
      IF((FREQ .LT. -4.0) .OR. (FREQ .GT. 13000.0))GOTO 8001
      IERMS=2 
C 
C  SET IREF AND ITRIG 
C 
      ITRIA = 0 
      IF(IREF .EQ. 1)IREF=10000B
      IF(IREF .EQ. -1)IREF=30000B 
      IF(ITRIG .EQ. 0)ITRIA=40000B
C 
C  SET AMP WORD 
C 
      IF(IMODE .EQ. 1)IMODE=0 
      IF(IMODE .EQ. 2)IMODE=20B 
      IF(IMODE .EQ. 3)IMODE=40B 
C 
C  SET FREQUENCY
C 
      IF(FREQ .LT. 0.0)GOTO 300 
      IF(IREF .NE. 0)GOTO 200 
C 
C  AMPLITUDE MEASUREMENT SET HIGHEST RANGE
C 
      IRNGE=0 
      IF(FREQ .GT. 0.01)IRNGE=400B
      IF(FREQ .GT. 0.1)IRNGE=1000B
      IF(FREQ .GT.1.0)IRNGE=1400B 
      GOTO 400
C 
C  PHASE MEASUREMENT SET LOWEST RANGE 
C 
200   IRNGE=1400B 
      IF(FREQ  .LT. 1.0)IRNGE=1000B 
      IF(FREQ .LT. 0.1)IRNGE=400B 
      IF(FREQ .LT. 0.01)IRNGE=0 
      GOTO 400
C 
C  SET RANGE
C 
300   IF(FREQ .EQ. -1.0)IRNGE=0 
      IF(FREQ .EQ. -2.0)IRNGE=400B
      IF(FREQ .EQ. -3.0)IRNGE=1000B 
      IF(FREQ .EQ. -4.0)IRNGE=1400B 
400   IBUF(1)=IMODE+IREF+ITRIA+IRNGE+100003B
C 
C  IF OVERLOAD RETRY UP TO 10 TIMES 
C 
110   IF(ICNT .GT. 10)GOTO 8001 
C 
C  TRY ATTENUATOR SETTING 
C 
      IDATA(1)=IOR(IBUF(1),40000B)
      ICNWD=300B+ILU1 
      CALL EXEC(100002B,ICNWD,IDATA(1),1,IDUMY,0) 
      GOTO 8002 
8900  CALL ABREG(IA,IB) 
      IF(IAND(IREG(1),177B) .NE. 0)GOTO 8001
C 
C  WAIT TO SETTLE 
C 
      CALL EXEC(12+100000B,0,1,0,-1)
      GOTO 8002 
450   IF(ICNT .LE. 0) GOTO 8901 
      CALL EXEC(12+100000B,0,1,0,-300)
      GOTO 8002 
C 
C  CHECK FOR OVERLOADS
C 
8901  ICNWD=300B+ILU1 
      CALL EXEC(100001B,ICNWD,IDATA(1),1,IDUMY,0) 
      GOTO 8002 
8910  CALL ABREG(IA,IB) 
      IF(IAND(IREG(1),177B) .NE. 0)GOTO 8001
      IF((IAND(IDATA(1),140000B)) .EQ. 0)GOTO 700 
C 
C  OVERLOADED , WHICH CHANNEL 
C 
      ITEMP=1 
      ITEMQ=2 
      IF(IAND(IDATA(1),40000B) .NE. 0)ITEMP=0 
      IF(IAND(IDATA(1),100000B) .NE. 0)ITEMQ=0
      IBUF(1)=(IAND(IBUF(1),177774B))+ITEMP+ITEMQ 
      ICNT=ICNT+1 
      GOTO 110
C 
C  PROGRAM 3575 
C 
700   IDATA(1)=IBUF(1)
      ICNWD=300B+ILU1 
      CALL EXEC(100002B,ICNWD,IDATA(1),1,IDUMY,0) 
      GOTO 8002 
8902  CALL ABREG(IA,IB) 
      IF(IAND(IREG(1),177B) .NE. 0)GOTO 8001
C 
C  WAIT TO SETTLE 
C 
      CALL EXEC(12+100000B,0,1,0,-15) 
      GOTO 8002 
C 
C  ENCODE 3575
C 
500   IDATA(1)=12 
      IDATA(2)=3
      IDATA(3)=11 
      IDATA(4)=4
      IDATA(5)=5
C 
      ICNWD=11100B+ILU2 
      CALL EXEC(100003B,ICNWD,IDATA(3),1,IDATA(4),2)
      GOTO 8002 
8903  CALL ABREG(IA,IB) 
      IF(IAND(IREG(1),177B) .NE. 0)GOTO 8001
C 
C  SET TIME OUT VALUE 
C 
      CALL EXEC(100003B,100B+ILU1,ITIME(1)) 
      GOTO 8002 
8904  CALL ABREG(IA,IB) 
      IF(IAND(IREG(1),177B) .NE. 0)GOTO 8001
C 
      ICNWD=13100B+ILU1 
      CALL EXEC(100002B,ICNWD,IDATA(1),1,IDATA(2),1)
      GOTO 8002 
8905  CALL ABREG(IA,IB) 
      IF(IAND(IREG(1),177B) .NE. 0)GOTO 8001
C 
C  EVERYTHING OK NOW TAKE READING 
C 
210   CALL EXEC(12+100000B,0,1,0,-3)
      GOTO 8002 
C 
212   ICNWD=300B+ILU1 
      CALL EXEC(100001B,ICNWD,IDATA(1),1,IDUMY,0) 
      GOTO 8002 
8906  CALL ABREG(IA,IB) 
      IF(IAND(IREG(1),177B) .NE. 0)GOTO 8001
C 
      ICNWD=300B+ILU2 
      CALL EXEC(100001B,ICNWD,IDATA(2),1,IDUMY,0) 
      GOTO 8002 
8907  CALL ABREG(IA,IB) 
      IF(IAND(IREG(1),177B) .NE. 0)GOTO 8001
230   CONTINUE
C 
C  CONVERT DATA 
C 
      RETL=(IAND(IDATA(1),17B))*.1
      RETL=RETL+((IAND(IDATA(1),360B))/2**4)
      RETL=RETL+(((IAND(IDATA(1),7400B))/2**8)*10.0)
      RETL=RETL+(((IAND(IDATA(1),10000B))/2**12)*100.0) 
      IF((IAND(IDATA(1),20000B)) .EQ. 0)RETL=RETL*(-1.0)
C 
330   RETR=(IAND(IDATA(2),17B))*.1
      RETR=RETR+((IAND(IDATA(2),360B))/2**4)
      RETR=RETR+(((IAND(IDATA(2),7400B))/2**8)*10.0)
      RETR=RETR+(((IAND(IDATA(2),10000B))/2**12)*100.0) 
      IF((IAND(IDATA(2),20000B)) .EQ. 0)RETR=RETR*(-1.0)
C 
C  EXIT 
C 
340   IERMS=0 
      RETURN
C 
C  ERROR EXIT 
C 
8002  IERMS=9 
8001  IERMS(2) = 5
      IERMS(3)=2HGF 
      IERMS(4)=2HMR 
      IERMS(5)=2HD
      RETURN
      END 
      END$