FTN4,L
      SUBROUTINE ACPS1(IUNIT,FREQ,VOLTS),09580-16430 REV.2001 
     +791023
C 
C-------------------------------------
C 
C  ELGAR DAP-SERIES PROGRAMMABLE A-C POWER SUPPLY 
C 
C  RELOCATABLE 09580-16430
C  SOURCE      09580-18430
C 
C  ALAN SANDERSON  790502 
C  BOB RICHARDS    791023 
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 PROPRIETARY  !
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 PROPRIETARY 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 ELGAR DAP SERIES A-C POWER SUPPLY.
C 
C  HARDWARE REQUIRED: 
C  ------------------ 
C    A. ELGAR DAP SERIES WITH OPTION 333, CAPABLE OF
C       USING OPTIONS 7 AND 8.
C    B. HP59310  BUS 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    ACPS1(I,R,R),         OV=XX,   ENT=ACPS1,   FIL=%ACPS1 
C    ACPS3(I,R,R,R,R,I,I), OV=XX,   ENT=ACPS3,   FIL=%ACPS1 
C 
C  CONFIGURATION TABLE ENTRIES: 
C  ---------------------------- 
C 
C    R 64,1,6 
C    U1 
C 
C       NN     NUMBER OF PHASES (1 OR 3)
C       FFF.F  MAXIMUM OUTPUT VOLTAGE 
C       N      NUMBER OF FREQUENCY RANGES (1 OR 3)
C       FF.F   MINIMUM FREQUENCY (HZ).
C 
C 
C 
C------------------------------------ 
C    CALLING SEQUENCE:
C      CALL ACPS1(IUNIT,FREQ,VOLTS) 
C 
C    WHERE: 
C 
C       IUNIT = UNIT #
C 
C       FREQ  = FREQUENCY IN HZ.
C       VOLTS = PROGRAMMED OUTPUT VOLTAGE VALUE 
C 
C 
C 
C------------------------------------ 
      DIMENSION IERMS(5)
      DATA IDTN / 64 /
      DATA IERMS / 10,5,2HAC,2HPS,2H1  /
C 
      IERMS=10
C 
C  FIND STATION AND LU #'S
C   ISTN = STATION #
C   LU1 = HP 59501A LU
C   LUIB = HPIB LU
C 
      ISTN=ISN(DUMMY) 
      LU1=LUDV(ISTN,IDTN,IUNIT) 
      LUIB=IBLU0(LU1) 
      IF(LU1 .LE. 0 .OR. LUIB .LE. 0)GOTO 800 
C 
C  CALL X SUB 
C 
      CALL XACSU(LU1,LUIB,IERMS,IUNIT,FREQ,VOLTS,VOLTS,VOLTS,240.,120.) 
      IF(IERMS)800,20,800 
C 
C 
C  ERROR EXIT 
C 
800   CALL ERROR(IERMS,IERMS(2))
20    END 
      SUBROUTINE ACPS3(IUNIT,FREQ,VOLTA,VOLTB,VOLTC,IPHB,IPHC)
     1,09580-16430 REV.2001 791023
C 
C------------------------------------ 
C    CALLING SEQUENCE:
C     CALL ACPS3(IUNIT,FREQ,VOLTA,VOLTB,VOLTC,IPHB,IPHC)
C   WHERE:
C     IUNIT =  THE UNIT NUMBER OF THE DEVICE. 
C     FREQ  =  THE OUTPUT FREQUENCY OF THE DEVICE (HZ). 
C     VOLTA =  THE OUTPUT VOLTAGE (A-C RMS VOLTS) OF PHASE A. 
C     VOLTB =  THE OUTPUT VOLTAGE (A-C RMS VOLTS) OF PHASE B. 
C     VOLTC =  THE OUTPUT VOLTAGE (A-C RMS VOLTS) OF PHASE C. 
C     IPHB =  THE PHASE ANGLE OF PHASE B (DEGREES) RELATIVE TO
C     PHASE A.
C     IPHC IS THE PHASE ANGLE OF PHASE C (DEGREES) RELATIVE TO
C     PHASE A.
C 
C 
C------------------------------------ 
      DIMENSION IERMS(5)
      DATA IDTN / 64 /
      DATA IERMS / 10,5,2HAC,2HPS,2H3  /
C 
      IERMS=10
C 
C  FIND STATION AND LU #'S
C   ISTN = STATION #
C   LU1 = HP 59501A LU
C   LUIB = HPIB LU
C 
      ISTN=ISN(DUMMY) 
      LU1=LUDV(ISTN,IDTN,IUNIT) 
      LUIB=IBLU0(LU1) 
      IF(LU1 .LE. 0 .OR. LUIB .LE. 0)GOTO 800 
C 
C  CALL X SUB 
C 
      CALL XACSU(LU1,LUIB,IERMS,IUNIT,FREQ,VOLTA,VOLTB,VOLTC,IPHB,IPHC) 
      IF(IERMS)800,20,800 
C 
C 
C  ERROR EXIT 
C 
800   CALL ERROR(IERMS,IERMS(2))
20    END 
C 
C---------------------------------------------
C 
      SUBROUTINE XACSU(LU1,LUIB,IERMS,IUNIT,FREQ,VOLTA,VOLTB,VOLTC,IPHB,
     +IPHC),09580-16430 REV.2001 791023 
      DIMENSION IERMS(5),IBUF(6),IOBUF(19),IREG(2)
      EQUIVALENCE (REG,IREG,IA),(IREG(2),IB)
C 
C  EQUIVALENCES FOR TIM CONFIGURATION BUFFER
C 
      EQUIVALENCE (IBUF(5),FRQMIN)
      EQUIVALENCE (IBUF(4),NFREQ) 
      EQUIVALENCE (IBUF(2),VMAX)
      EQUIVALENCE (IBUF(1),NPHASE)
      DATA IDTN/64/ 
      DATA LETRA/2HA,/,LETRB/2HB,/,LETRC/2HC,/,LETRD/2HD,/,LETRE/2HE,/
      DATA LETRF/2HF,/,LETRG/2HG,/,IZERO/2H00/
C 
C---------------------------------------------
C 
C 
C  THE PARAMETERS IN THE CALLING SEQUENCE HAVE THE FOLLOWING
C  MEANINGS:
C 
C     LUIB = LU # OF HPIB BUSS. 
C     LU1  = LU # OF THE ELGAR DAP SERIES PROGRAMMER. 
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     FREQ  = THE DESIRED OUTPUT FREQUENCY (HZ).
C     VOLTA = PHASE A OUTPUT VOLTAGE. 
C     VOLTB = PHASE B OUTPUT VOLTAGE. 
C     VOLTC = PHASE C OUTPUT VOLTAGE. 
C     IPHB  = PHASE B ANGLE WITH RESPECT TO PHASE A (DEGREES - 0 TO 360). 
C     IPHC  = PHASE C ANGLE WITH RESPECT TO PHASE A (DEGREES - 0 TO 360). 
C 
C---------------------------------------------
C 
C 
C  RETRIEVE CONFIGURATION DATA
C 
      CALL TIM(IDTN,IUNIT,1,IBUF,6,IER) 
      IF(IER .NE. 0)RETURN
      IERMS = 1 
C 
C  CHECK THE INPUT PARAMETERS 
C 
C  CHECK THE FREQUENCY
C 
      IF(FREQ.LT.FRQMIN.OR.FREQ.GT.9990.)GO TO 8000 
      IF(NFREQ.EQ.1.AND.FREQ.GT.999.)GO TO 8000 
C 
C  CHECK ALL THREE PHASES IF REQUIRED 
C 
      IF(VOLTA.GT.VMAX.OR.VOLTA.LT.0.0)GO TO 8000 
      IF(NPHASE.EQ.1)GO TO 100
      IF(VOLTB.GT.VMAX.OR.VOLTB.LT.0.0)GO TO 8000 
      IF(VOLTC.GT.VMAX.OR.VOLTC.LT.0.0)GO TO 8000 
C 
C  CHECK THE PHASE ANGLES 
C 
      IF(IPHB.LT.0.OR.IPHB.GT.360)GO TO 8000
      IF(IPHC.LT.0.OR.IPHC.GT.360)GO TO 8000
C 
C FORMAT FREQUENCY ACCORDING TO TYPE OF PROGRAMMER
C 
100   IF(NFREQ.EQ.1)GO TO 120 
      IF(FREQ.GT.99.9)GO TO 110 
C 
C  IF LOW FREQUENCY, HIGH RESOLUTION, MULTIPLY BY 100 
C  AND PUT IN DIV. BY 10 EXPONENT IN LOW DIGIT
C  99.6 CONVERTS TO INTEGER 9962 .
C 
      IFREQ=10.*FREQ
      IFREQ = 10 * IFREQ + 2
      GO TO 200 
C 
C  PROCESS FREQUENCIES IN THE HIGH RANGE
C  SINCE RESOLUTION IS TO 10 HZ. IN THIS
C  RANGE, VALUES ARE TRUNCATED.  WITH THE 
C  EXPONENT (LOW ORDER DIGIT), A VALUE
C  OF 8815. HZ. CONVERTS TO AN INTEGER 8810 . 
C 
110   IF(FREQ.LT.1000.)GO TO 120
      IFREQ = FREQ
      IFREQ = 10*(IFREQ/10) 
      GO TO 200 
C 
C  FOR THE SINGLE FREQUENCY RANGE UNIT, THE LOW ORDER DIGIT 
C  IS IGNORED.  IN THE 3 RANGE UNIT, IT IS A 1.  A FREQUENCY
C  OF 156.0 HZ TRANSLATES TO AN INTEGER 1561 .
C 
120   IFREQ = FREQ
      IFREQ = 10 * IFREQ + 1
C 
C  NEXT, SEE IF SINGLE PHASE
C  IF SO, NO NEED FOR PHASE ANGLE SETTINGS. 
C 
200   IF(NPHASE.EQ.1)GO TO 300
      IANGB = IPHB * 10 
      IANGC = IPHC * 10 
C 
C SET UP THE VOLTAGES 
C  RESOLUTION IS TO .1 V, SO 104.7 VOLTS CONVERTS TO
C  AN INTEGER 1047 .
C  IF HIGH VOLTAGE (>130) HIGH VOLTAGE BIT IS SET 
C  BY ADDING 4000 TO THE NUMBER.
C 
      IVOLTB = 10. * VOLTB
      IF(IVOLTB.GT.1300)IVOLTB=IVOLTB+4000
      IVOLTC = 10. * VOLTC
      IF(IVOLTC.GT.1300)IVOLTC=IVOLTC+4000
300   IVOLTA = 10. * VOLTA
      IF(IVOLTA.GT.1300)IVOLTA=IVOLTA+4000
C 
C  PERFORM FORMATTING ACCORDING TO SINGLE OR
C  THREE PHASE SUBSYSTEM. 
C 
C 
C  FOR SINGLE PHASE OPERATION, THE FOLLOWING BUFFER IS SENT:
C 
C    IIIIF,JJJJE, 
C 
C   WHERE I AND J ARE THE FREQUENCY AND VOLTAGE VALUES. 
C 
      CALL CNUMD(IFREQ,IOBUF) 
      CALL CNUMD(IVOLTA,IOBUF(4)) 
      IF(NPHASE.NE.1)GO TO 1500 
C 
C  PUT IN LEADING ZEROS 
C 
      DO 1100 I=2,6 
1100  IOBUF(I)=IOR(IZERO,IOBUF(I))
      IOBUF(4)=LETRF
      IOBUF(7)=LETRE
      NUM = 6 
      GO TO 2000
C 
C  FOR THREE PHASE OPERATION, THE FOLLOWING BUFFER IS SENT: 
C 
C  IIIIF,JJJJA,KKKKB,LLLLC,MMMMD,NNNNG, 
C 
C  WHERE: 
C   IIII = FREQUENCY SETTING
C   JJJJ = PHASE A AMPLITUDE SETTING
C   KKKK = PHASE B AMPLITUDE SETTING
C   LLLL = PHASE C AMPLITUDE SETTING
C   MMMM = PHASE B ANGLE SETTING
C   NNNN = PHASE C ANGLE SETTING
C 
1500  CALL CNUMD(IVOLTB,IOBUF(7)) 
      CALL CNUMD(IVOLTC,IOBUF(10))
      CALL CNUMD(IANGB,IOBUF(13)) 
      CALL CNUMD(IANGC,IOBUF(16)) 
C 
C  PUT IN LEADING ZEROS 
C 
      DO 1600 I=2,18
1600  IOBUF(I)=IOR(IZERO,IOBUF(I))
      IOBUF(4)=LETRF
      IOBUF(7)=LETRA
      IOBUF(10)=LETRB 
      IOBUF(13)=LETRC 
      IOBUF(16)=LETRD 
      IOBUF(19)=LETRG 
      NUM=18
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(2),NUM) 
      GOTO 9000 
71    CALL ABREG(IA,IB) 
      IF(IB .LT. 0) GOTO 8500 
C 
C 
      IERMS=0 
      GO TO 8000
C 
C  ERROR EXIT 
C 
8500  IERMS=IAND(IA,377B)+11
      GOTO 8000 
9000  IERMS=9 
8000  RETURN
      END 
      END$