FTN4,L
      SUBROUTINE VARPG(IU,IC,IFU,FREQ,AMP,FSET,PHASE),
     +09580-16308 1926 790502 
C 
C-------------------------------------
C 
C  WAVETEK 152 VARIPHASE GENERATOR
C      (VARPG)
C 
C  RELOCATABLE 09580-16308
C  SOURCE      09580-18308
C 
C  V.POVIO   780510    REV. A 
C 
C  BOB RICHARDS 790502
C 
C------------------------------------ 
C 
C  !=================================================!
C  !                                                 !
C  ! (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979      !
C  !                ALL RIGHTS RESERVED              !
C  !                                                 !
C  ! NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED,     !
C  ! REPRODUCED OR TRANSLATED INTO ANOTHER PROGRAM   !
C  ! LANGUAGE WITHOUT THE PRIOR WRITTEN CONSENT OF   !
C  ! THE HEWLETT-PACKARD COMPANY.                    !
C  !                                                 !
C  !-------------------------------------------------!
C  !                                                 !
C  ! TEST SYSTEM SOURCE SOFTWARE IS THE PROPRIETY    !
C  ! MATERIAL OF THE HEWLETT-PACKARD COMPANY.        !
C  !                                                 !
C  ! THIS SOURCE DATA SHALL BE USED SOLELY IN        !
C  ! CONJUCTION WITH ELECTRONIC COMPUTER SYSTEMS     !
C  ! SUPPLIED TO THE USER BY HEWLETT-PACKARD.        !
C  !                                                 !
C  ! THIS PROPRIETY DATA SHALL NOT BE COPIED OR      !
C  ! OTHERWISE REPRODUCED WITHOUT THE PRIOR WRITTEN  !
C  ! CONSENT OF HEWLETT-PACKARD, EXCEPT THAT ONE     !
C  ! COPY MAY BE MADE AND RETAINED BY THE USER FOR   !
C  ! ARCHIVE PURPOSES.                               !
C  !                                                 !
C  ! THE USER SHALL NOT DISCLOSE THIS DATA TO ANY    !
C  ! THIRD PARTIES WITHOUT THE PRIOR WRITTEN CONSENT !
C  ! OF HEWLETT-PACKARD. IN ADDITION, THE USER SHALL !
C  ! USE AT LEAST THE SAME CARE AND SAFEGUARDS TO    !
C  ! PROTECT THIS DATA FROM UNAUTHORIZED USE OR      !
C  ! DISCLOSURE AS THE USER USES TO PROTECT ITS OWN  !
C  ! PROPRIETARY DATA.                               !
C  !                                                 !
C  !=================================================!
C 
C  GENERAL: 
C  -------- 
C 
C    THE FOLLOWING DEVICE SUBROUTINES ARE USED
C   TO PROGRAM THE WAVETEK 152 VARIPHASE GENERATOR. 
C 
C  HARDWARE REQUIRED: 
C  ------------------ 
C    A. WAVETEK 152 VARIPHASE GENERATOR.
C    B. HP59310  BUSS INTERFACE KIT.
C 
C         JUMPER POSITION:
C          SW1-1 - 1
C          SW1-2 TO SW1-8 - 0 
C          SW2-1 - 0
C          SW2-2 - 0
C          SW2-3 - 0
C          SW2-4 - 0
C          SW2-5 - 1
C          SW2-6 - REN
C          SW2-7 - ICF
C          SW2-8 - CNX
C 
C    C. HP 21XX SERIES COMPUTER 
C 
C  BRANCH AND MNEMONIC TABLE ENTRIES: 
C  ---------------------------------- 
C 
C    VARPG(I,I,I,R,R,R,R),  OV=XX,   ENT=VARPG,        VARPG
C 
C 
C------------------------------------ 
C 
C  VARPG(IU,IC,IFU,FREQ,AMP,FSET,PHASE) 
C 
C    WHERE: 
C 
C       IU    = UNIT #
C 
C       IC    = CHANNEL # (1-9) 
C 
C       IFU   = FUNCTION
C               0 = SINE
C               1 = COSINE
C               2 = TRIANGLE
C               3 = VARIPHASE SINE
C               4 = DC
C               5 = SQUARE
C               6 = VARIPHASE SQUARE
C 
C       FREQ  = FREQUENCY 
C               1.00 HZ TO 100 KHZ  (3 DIGIT RESOLUTION)
C 
C       AMP   = AMPLITUDE PEAK VOLTAGE
C                DC = -9.99 VDC TO +9.99 VDC (3 DIGIT RESOLUTION) 
C                ALL OTHERS = .010 VOLTS TO 9.99 VOLTS
C                * IF "-" INDICATES INVERTED SIGNAL.
C                * TRIANGLE AND VARIPHASE SIN CANNOT BE INVERTED. 
C 
C       FSET = OFFSET 
C               -9.99 TO +9.99
C                 * SIGNAL LEVEL PLUS OFFSET VOLTAGE MUST NOT 
C                   EXCEED +/- 9.99 VOLTS PEAK. 
C 
C       PHASE = PHASE ANGLE 
C               000.0 TO 359.9 DEGREES (.1 DEGREE RESOLUTION) 
C 
C------------------------------------ 
      DIMENSION IERMS(5)
      DATA IDTN / 50 /
      DATA IERMS / 10,5,2HVA,2HRP,2HG  /
C 
      IERMS=10
C 
C  FIND STATION AND LU #'S
C   ISTN = STATION #
C   LU1 = WTK 152  LU 
C   LUIB = 59310 LU 
C 
      ISTN=ISN(DUMMY) 
      LU1=LUDV(ISTN,IDTN,IU)
      LUIB=IBLU0(LU1) 
      IF(LU1 .LE. 0 .OR. LUIB .LE. 0)GOTO 800 
C 
C  CALL X SUB 
C 
      CALL XARPG(LU1,LUIB,IERMS,IU,IC,IFU,FREQ,AMP,FSET,PHASE)
      IF(IERMS)800,20,800 
C 
C  EXIT 
C 
20    RETURN
C 
C  ERROR EXIT 
C 
800   CALL ERROR(IERMS,IERMS(2))
      RETURN
      END 
C 
C---------------------------------------------
C 
      SUBROUTINE XARPG(LU1,LUIB,IERMS,IU,IC,IFU,FREQ,AMP,FSET,PHA), 
     +09580-16308 1926 790502 
      DIMENSION IERMS(5),IOBUF(30),IFS(6),IAS(6),IOS(6),IPS(6)
      DIMENSION IMUL(6) 
      DATA IMUL /2,1,0,-1,-2,-3/
C 
C---------------------------------------------
C 
C 
C  THE PARAMETERS IN THE CALLING SEGUENCE HAVE THE FOLLOWING
C  MEANINGS.
C 
C     LUIB = LU # OF HPIB BUSS. 
C     LU1  = LU # OF WAVETEK 152
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 
C    ERROR MESSAGES THAT PERTAIN TO THE HPIB. 
C 
C        9 = I/O CALL REJECTED
C       10 = LUIB 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 
C  CHECK PARAMETERS 
C 
      IERMS=1 
      IF(IC .LT. 1 .OR. IC .GT. 9) GOTO 8000
      IF(IFU .LT. 0 .OR. IFU .GT. 6) GOTO 8000
      IF(FREQ .LT. 1.0 .OR. FREQ .GT. 99900.0) GOTO 8000
      IF(AMP .LT. -9.99 .OR. AMP .GT. 9.99) GOTO 8000 
      IF(FSET .LT. -9.99 .OR. FSET .GT. 9.99) GOTO 8000 
      IF(PHA .LT. 0.0 .OR. PHA .GT. 359.9) GOTO 8000
C 
C  CLEAR BUFFERS
C 
      DO 850 J=1,6
      IFS(J)=20040B 
      IAS(J)=20040B 
      IOS(J)=20040B 
      IPS(J)=20040B 
850   CONTINUE
C 
C  SET UP OUTPUT BUFFER 
C 
      IOBUF(1)=2HB0+IC
      IOBUF(2)=2HC0+IFU 
C 
C  FREQUENCY
C 
      I1=0
      IF(FREQ .GT. 9.99) I1=1 
      IF(FREQ .GT. 99.9) I1=2 
      IF(FREQ .GT. 999.0) I1=3
      IF(FREQ .GT. 9990.0) I1=4 
      FREQ1=(FREQ*10.0**(IMUL(I1+1))) 
      IFREQ=(FREQ1+.001)
      FREQ=IFREQ
      CALL F2A(FREQ,IFS(1)) 
      IOBUF(3)=2H F 
      IOBUF(4)=IFS(2) 
      IOBUF(5)=(IAND(IFS(3),177400B))+105B
      IOBUF(6)=(30000B+(I1*2**8))+101B
C 
C  AMPLITUDE
C 
      I2=0
      IF(AMP .LT. 1.0)I2=1
      IF(AMP .LT. 0.1)I2=2
      AMP=AMP*10.0**(I2)
      IAMP=INT(AMP*100) 
      AMP=IAMP
      CALL F2A(AMP,IAS) 
      IOBUF(7)=IAS(2) 
      IOBUF(8)=(IAND(IAS(3),177400B))+105B
      IOBUF(9)=(30000B+(I2*2**8))+104B
C 
C  OFFSET 
C 
      I3=0
      IF(FSET .LT. 0.0) I3=1
      IF(FSET .LT. 0.0) FSET=-FSET
      IFSET=INT(FSET*100.0) 
      FSET=IFSET
      CALL F2A(FSET,IOS)
      IOBUF(10)=IOS(2)
      I4=40B
      IF(I3 .GT. 0.0)I4=55B 
      IOBUF(11)=(IAND(IOS(3),177400B))+I4 
C 
C  PHASE
C 
      IPHA=INT(PHA*10.0)
      PHA=IPHA
      CALL F2A(PHA,IPS) 
      IOBUF(12)=2H H
      IOBUF(13)=IPS(2)
      IOBUF(14)=IPS(3)
      IOBUF(15)=2HI 
      INUM=15 
C 
C  REMOTE ENABLE
C 
2000  CALL EXEC(100003B,1600B+LUIB) 
      GOTO 9000 
70    CALL ABREG(IA,IB) 
      IF(IB .LT. 0) GOTO 8500 
C 
C  SEND OUTPUT BUFFER 
C 
      CALL REIO(100002B,LU1,IOBUF(1),INUM,IDUMY,0)
      GOTO 9000 
71    CALL ABREG(IA,IB) 
      IF(IB .LT. 0) GOTO 8500 
C 
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)=2HVA 
      IERMS(4)=2HRP 
      IERMS(5)=2HG
      RETURN
      END 
      END$
                                      