FTN4,L
      SUBROUTINE DCVOT(IUNIT,VOUT,CURLMP,CURLMN), 
     +09580-16440 REV.2001 791023 
C------------------------------------------------------ 
C 
C     RELOC.                      09580-16440 
C     SOURCE                      09580-18440 
C 
C     BOB RICHARDS  790807
C     BOB RICHARDS  791023
C 
C     TEST SYSTEM SOURCE SOFTWARE IS THE PROPRIETARY
C     MATERIAL OF THE HEWLETT-PACKARD COMPANY.
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     BRANCH AND MNEMONIC TABLE ENTRIES:
C     --------------------------------- 
C 
C     DCVOT(I,R,R,R),      OV=XX,         ENT=DCVOT,  FIL=%DCVOT
C 
C-------------------------------------------------------- 
C 
C     CONFIGURATION TABLE ENTRIES:
C     ----------------------------
C 
C     R 66,1,5
C     U1
C     * 
C         6825          POWER SUPPLY MODEL NUMBER (6825,6826,6827)
C            1          VOLTAGE RANGE (0=LOW, 1=HIGH) 
C            1          FULL SCALE GAIN RANGE (0=LOW, 1=HIGH) 
C           13          VOLTAGE/GAIN BOARD I/O SLOT 
C          302          CURRENT LIMIT BOARD I/O SLOT
C     * 
C     *   SLOTS ARE AS FOLLOWS: 
C     *   0 - 14     (6940)  THIS IS FOR UNIT #0, SLOTS 1 THRU 14 
C     *   100 - 114  (6941 UNIT # 1)
C     *   200 - 214  (6941 UNIT # 2)
C     *    "     "     "    "   " " 
C     *    "     "     "    "   " " 
C     *   1500 - 1514(6941 UNIT # 15)  MAX
C 
C-----------------------------------------------------------
C 
C     THIS SUBROUTINE PROGRAMS THE HP 6825/26/27 POWER SUPPLY/
C     AMPLIFIER POWER SUPPLY FUNCTIONS (VOLTAGE OUT, CURRENT
C     LIMIT).  THIS SUBROUTINE REQUIRES THAT THE POWER SUPPLIES 
C     BE PROGRAMMED USING THE HP-6940 CONTAINING 69325A, 69326A,
C     69327A, AND/OR 69328A CARDS.  SEE PAGES 28 AND 29 OF
C     FOR MORE DETAILS CONCERNING CONTROL CARD SELECTION AND USE. 
C 
      DIMENSION IERMS(5)
C 
C  USE TYPE "23" TO GET LU OF 6940.  THE 68XX HAS NO LU.
C 
      DATA IDTN/23/ 
      DATA IERMS/10,5,2HDC,2HVO,2HT / 
      ISTN = ISN(DUMMY) 
      LU = LUDV(ISTN,IDTN)
      IF(LU)800,800,30
30    CALL XCVOT(LU,IERMS,IUNIT,VOUT,CURLMP,CURLMN) 
      IF(IERMS)800,40,800 
40    CONTINUE
      RETURN
C 
800   CALL ERROR(IERMS,IERMS(2))
      RETURN
      END 
C 
      SUBROUTINE XCVOT(LU,IERR,NUNIT,VOUT,CURLMP,CURLMN), 
     +09580-16440 REV.2001 791023 
C 
C*****************************************************************
C               LU    = LOGICAL UNIT NUMBER OF 6940 
C               IERR  = 5-WORD ERROR ARRAY
C                      WHERE: IERR(1) = ERROR CODE
C                                       0 = NO ERRORS 
C                                      -1 = PARAMETER ERROR 
C                                      -2 = TIME OUT ERROR
C                                      -3 = CONFIGURATION TABLE 
C                                           ENTRY ERROR 
C                                      -9 = I/O CALL REJECTED 
C                                     -10 = ILLEGAL LU
C                             IERR(2) = CHARACTER COUNT 
C                             IERR(3) - IERR(5) = DEVICE MNEMONIC 
C               NUNIT = UNIT NUMBER OF POWER SUPPLY/AMPLIFIER.
C               VOUT  = PROGRAMMED OUTPUT VOLTAGE (VOLTS) 
C                       (MULTIPLY ALL VOUT VALUES BY ABOUT .999 
C                       TO GET TRUE LIMITS) 
C                       6825 - (+- 20V HIGH, +-5V LOW)
C                       6826 - (+- 50V HIGH, +-5V LOW)
C                       6827 - (+- 100V HIGH, +-10V LOW)
C               CURLMP= POSITIVE CURRENT LIMIT (MA) 
C                       6825 - (+2000MA)
C                       6826 - (+1000MA)
C                       6827 - (+500MA) 
C               CURLMN= NEGATIVE CURRENT LIMIT (MA) 
C                       6825 - (-2000MA)
C                       6826 - (-1000MA)
C                       6827 - (-500MA) 
C 
C*****************************************************************
C 
      DIMENSION IWORD(4),IERR(5),IREG(2),IBUF(5),JWORD(4) 
C 
      EQUIVALENCE (REG,IREG,IA),(IREG(2),IB)
      EQUIVALENCE (IBUF(1),MODEL) 
      EQUIVALENCE (IBUF(2),IVRNG) 
      EQUIVALENCE (IBUF(3),IGAIN) 
      EQUIVALENCE (IBUF(4),IVSLT) 
      EQUIVALENCE (IBUF(5),IISLT) 
C 
      DATA ICNWD/170160B/,IDTN/66/,IOTWD/170040B/ 
      DATA LBUF/5/
C 
      IERR = 0
C 
C     MULTIPLICATION FACTOR 
C 
      FC = .976563
C 
C     VOUT MULTIPLICATION FACTOR
C 
      FV = .999 
C 
      CALL TIM(IDTN,NUNIT,1,IBUF,LBUF,IER)
      IF(IER .NE. 0) GOTO 8000
      IF (IVRNG .LT. 0 .OR. IVRNG .GT. 1) GOTO 7600 
C 
C  CHECK INPUT PARAMETERS AGAINST MODEL NUMBER AND RANGES 
C 
      IF (MODEL .LT. 6825) GOTO 7600
      GOTO (100,135,170,7600), (MODEL - 6824) 
C 
C  6825A
C 
100   IF (IVRNG .EQ. 0 .AND. ABS(VOUT) .GT. (5.0 * FV)) GOTO 8000 
      IF (ABS(VOUT) .GT. (20.0 * FV)) GOTO 8000 
      IF (CURLMP .LT. 0.0 .OR. CURLMP .GT. 2000.0) GOTO 8000
      IF (CURLMN .GT. 0.0 .OR. CURLMN .LT. -2000.0) GOTO 8000 
      GOTO 200
C 
C  6826A
C 
135   IF (IVRNG .EQ. 0 .AND. ABS(VOUT) .GT. (5.0 * FV)) 
     + GOTO 8000
      IF (ABS(VOUT) .GT. (50.0 * FV)) GOTO 8000 
      IF (CURLMP .LT. 0.0 .OR. CURLMP .GT. 1000.0) GOTO 8000
      IF (CURLMN .GT. 0.0 .OR. CURLMN .LT. -1000.0) GOTO 8000 
      GOTO 235
C 
C  6827A
C 
170   IF (IVRNG .EQ. 0 .AND. ABS(VOUT) .GT. (10.0 * FV))
     + GOTO 8000
      IF (ABS(VOUT) .GT. (100.0 * FV)) GOTO 8000
      IF (CURLMP .LT. 0.0 .OR. CURLMP .GT. 500.0) GOTO 8000 
      IF (CURLMN .GT. 0.0 .OR. CURLMN .LT. -500.0) GOTO 8000
      GOTO 270
C 
C  CALCULATE 6825A VOLTAGE WORD 
C 
200   IF(IVRNG .EQ. 1 .AND. VOUT .LT. 0.0) JD=4096-IFIX(ABS(VOUT)/
     +(.01*FC)) 
      IF(IVRNG .EQ. 1 .AND. VOUT .GE. 0.0) JD = IFIX(VOUT/(.01*FC)) 
      IF(IVRNG .EQ. 0 .AND. VOUT .LT. 0.0) JD=4096-IFIX(ABS(VOUT)/
     +(.0025*FC)) 
      IF(IVRNG .EQ. 0 .AND. VOUT .GE. 0.0) JD = IFIX(VOUT/(.0025*FC)) 
C 
C  CALCULATE 6825A CURRENT LIMIT WORD 
C 
      IDP = IFIX(CURLMP/32.0) 
      IDN = IFIX(ABS(CURLMN/32.0))
      GOTO 300
C 
C  CALCULATE 6826A VOLTAGE WORD 
C 
235   IF(IVRNG .EQ. 1 .AND. VOUT .LT. 0.0) JD=4096-IFIX(ABS(VOUT)/
     +(.025*FC))
      IF(IVRNG .EQ. 1 .AND. VOUT .GE. 0.0) JD = IFIX(VOUT/(.025*FC))
      IF(IVRNG .EQ. 0 .AND. VOUT .LT. 0.0) JD=4096-IFIX(ABS(VOUT)/
     +(.0025*FC)) 
      IF(IVRNG .EQ. 0 .AND. VOUT .GE. 0.0) JD = IFIX(VOUT/(.0025*FC)) 
C 
C  CALCULATE 6826A CURRENT LIMIT WORD 
C 
      IDP = IFIX(CURLMP/16.0) 
      IDN = IFIX(ABS(CURLMN/16.0))
      GOTO 300
C 
C  CALCULATE 6827A VOLTAGE WORD 
C 
270   IF(IVRNG .EQ. 1 .AND. VOUT .LT. 0.0) JD=4096-IFIX(ABS(VOUT)/
     +(.05*FC)) 
      IF(IVRNG .EQ. 1 .AND. VOUT .GE. 0.0) JD = IFIX(VOUT/(.05*FC)) 
      IF(IVRNG .EQ. 0 .AND. VOUT .LT. 0.0) JD=4096-IFIX(ABS(VOUT)/
     +(.005*FC))
      IF(IVRNG .EQ. 0 .AND. VOUT .GE. 0.0) JD = IFIX(VOUT/(.005*FC))
C 
C  CALCULATE 6827A CURRENT LIMIT WORD 
C 
      IDP = IFIX(CURLMP/8.0)
      IDN = IFIX(ABS(CURLMN/8.0)) 
C 
C  SET UP CURRENT LIMIT 
C 
300   IDP = 100B * IDP
      ID = IOR(IDP,IDN) 
C 
      IUNIT = 0 
      ITRY = IISLT
      IF (ITRY .GT. 1514) GOTO 7600 
310   CONTINUE
      IF (ITRY.LT.0)GO TO 7600
      IF(ITRY.GE.0.AND.ITRY.LE.14)GO TO 320 
      IUNIT = IUNIT+1 
      IF (IUNIT .GT. 15) GOTO 7600
      ITRY = ITRY-100 
      GO TO 310 
C 
C  CURRENT LIMIT BOARD ADDRESS FOUND
C 
320   IWORD = 3 
      IWORD(2) = ICNWD + IUNIT
      IWORD(3) = IOR(ITRY*10000B,ID)
      IWORD(4) = IOTWD
C 
C  OUTPUT CURRENT LIMIT WORD TO MULTI-PROGRAMMER
C 
      CALL REIO(100002B,100B+LU,IWORD(2),IWORD,IDUMY,0) 
      GOTO 7000 
330   CALL ABREG(IA,IB) 
      IF(IAND(IREG,377B).NE.0)GO TO 7500
C 
C  SET UP VOLTAGE OUTPUT WORDS
C 
400   JUNIT = 0 
      JTRY = IVSLT
      IF (JTRY .GT. 1514) GOTO 7600 
410   CONTINUE
      IF (JTRY .LT. 0) GOTO 7600
      IF (JTRY .GE. 0 .AND. JTRY .LE. 14) GOTO 420
      JUNIT = JUNIT + 1 
      JTRY = JTRY - 100 
      GOTO 410
C 
C  VOLTAGE OUTPUT CARD ADDRESS FOUND
C 
420   JWORD = 3 
      JWORD(2) = ICNWD + JUNIT
      JWORD(3) = IOR(JTRY*10000B,JD)
      JWORD(4) = IOTWD
C 
C  OUTPUT VOLTAGE OUTPUT WORD TO MULTI-PROGRAMMER 
C 
      CALL REIO(100002B,100B+LU,JWORD(2),JWORD,IDUMY,0) 
      GO TO 7000
430   CALL ABREG(IA,IB) 
      IF(IAND(IREG,377B).NE.0)GO TO 7500
C 
C  RETURN 
C 
      RETURN
C 
C       ERROR CONDITIONS
C 
7000  IERR = 9
      GO TO 8100
7500  IERR = 2
      GO TO 8100
7600  IERR = 3
      GO TO 8100
8000  IERR = 1
8100  IERR(3) = 2HDC
      IERR(4) = 2HVO
      IERR(5) = 2HT 
      RETURN
      END 
      END$
                                                                                                                                                                                                