FTN4,L
      SUBROUTINE DCAV(NUNIT,VGAIN),09580-16441 REV.2001 791023
C------------------------------------------------------ 
C 
C     RELOC.                      09580-16441 
C     SOURCE                      09580-18441 
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     DCAV(I,R),         OV=XX,         ENT=DCAV,   FIL=%DCAV 
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 (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 AMPLIFIER FUNCTION AND REQUIRES THAT THE UNITS
C     BE PROGRAMMED USING THE HP-6940 CONTAINING A 69325A FOR GAIN
C     AND A 69326A OR A 69327A CARD FOR CURRENT LIMIT. SEE PAGES 28 
C     AND 29 OF         FOR MORE DETAILS CONCERNING CONTROL CARD
C     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/ 
C 
      DATA IERMS/10,5,2HDC,2HAV,2H  / 
      ISTN = ISN(DUMMY) 
      LU = LUDV(ISTN,IDTN)
      IF(LU)800,800,30
30    CALL XCAV(LU,IERMS,NUNIT,VGAIN) 
      IF(IERMS)800,40,800 
40    CONTINUE
      RETURN
C 
800   CALL ERROR(IERMS,IERMS(2))
      RETURN
      END 
C 
      SUBROUTINE XCAV(LU,IERR,NUNIT,VGAIN),09580-16441 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               VGAIN = PROGRAMMED GAIN (MULTIPLY ALL NUMBERS BELOW BY
C                       ABOUT .999 FOR ACTUAL MAX GAIN) 
C                       6825 - (8.0,MAX,HIGH RANGE  2.0,MAX,LOW RANGE)
C                       6826 - (20.0,MAX,HIGH RANGE  2.0,MAX,LOW RANGE) 
C                       6827 - (40.0,MAX,HIGH RANGE  4.0,MAX,LOW RANGE) 
C 
C            **********  WARNING  ************* 
C            *                                * 
C            * THIS DEVICE SUBROUTINE SETS THE* 
C            * CURRENT LIMIT TO MAXIMUM.  USE * 
C            * "DCVOT" TO SET AN APPROPRIATE  * 
C            * CURRENT LIMIT BEFORE SWITCHING * 
C            * THE 68XX TO THE POWER SUPPLY   * 
C            * MODE.                          * 
C            *                                * 
C            ********************************** 
C 
C***********************************************************************
C 
      DIMENSION IWORD(4),JWORD(4),IERR(5),IREG(2),IBUF(5) 
C 
      EQUIVALENCE (REG,IREG,IA),(IREG(2),IB)
      EQUIVALENCE (IBUF(1),MODEL) 
      EQUIVALENCE (IBUF(3),IGAIN) 
      EQUIVALENCE (IBUF(4),IASLT) 
      EQUIVALENCE (IBUF(5),IISLT) 
C 
      DATA ICNWD/170160B/,IDTN/66/,IOTWD/170040B/,LBUF/5/ 
C 
      IERR = 0
C 
C     DIVISION FACTOR 
C 
      FC = .97652 
C 
C     GAIN MULTIPLICATION FACTOR
C 
      FG = .999 
C 
      CALL TIM(IDTN,NUNIT,1,IBUF,LBUF,IER)
      IF(IER .NE. 0) GOTO 8000
      IF (IGAIN .LT. 0 .OR. IGAIN .GT. 1) GOTO 7600 
      IF (VGAIN .LT. 0.0) GOTO 8000 
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 (IGAIN .EQ. 0 .AND. VGAIN .GT. (2.0 * FG)) GOTO 8000 
      IF (VGAIN .GT. (8.0 * FG)) GOTO 8000
      GOTO 200
C 
C  6826A
C 
135   IF (IGAIN .EQ. 0 .AND. VGAIN .GT. (2.0 * FG)) GOTO 8000 
      IF (VGAIN .GT. (20.0 * FG)) GOTO 8000 
      GOTO 235
C 
C  6827A
C 
170   IF (IGAIN .EQ. 0 .AND. VGAIN .GT. (4.0 * FG)) GOTO 8000 
      IF (VGAIN .GT. (40.0 * FG)) GOTO 8000 
      GOTO 270
C 
C  CALCULATE 6825A GAIN WORD
C 
200   VGMX2 = 4.0 
      IF(IGAIN .EQ. 0) VGMX2 = 1.0
      VGAIN = VGAIN - VGMX2 
      IF(IGAIN.EQ.1.AND.VGAIN.LT.0.0) IG=4096-IFIX(ABS(VGAIN)/(.002*FC))
      IF(IGAIN .EQ. 1 .AND. VGAIN .GE. 0.0) IG = IFIX(VGAIN/(.002*FC))
      IF(IGAIN.EQ.0.AND.VGAIN.LT.0.0) IG=4096-IFIX(ABS(VGAIN)/
     +(.0005*FC)) 
      IF(IGAIN.EQ.0.AND.VGAIN.GE.0.0) IG = IFIX(VGAIN/(.0005*FC)) 
      GOTO 300
C 
C  CALCULATE 6826A GAIN WORD
C 
235   VGMX2 = 10.0
      IF(IGAIN .EQ. 0) VGMX2 = 1.0
      VGAIN = VGAIN - VGMX2 
      IF(IGAIN.EQ.1.AND.VGAIN.LT.0.0) IG=4096-IFIX(ABS(VGAIN)/(.005*FC))
      IF(IGAIN.EQ.1.AND.VGAIN.GT.0.0) IG = IFIX(VGAIN/(.005*FC))
      IF(IGAIN.EQ.0.AND.VGAIN.LT.0.0) IG=4096-IFIX(ABS(VGAIN)/
     +(.0005*FC)) 
      IF(IGAIN.EQ.0.AND.VGAIN.GE.0.0) IG = IFIX(VGAIN/(.0005*FC)) 
      GOTO 300
C 
C  CALCULATE 6827A GAIN WORD
C 
270   VGMX2 = 20. 
      IF(IGAIN .EQ. 0) VGMX2 = 2.0
      VGAIN = VGAIN - VGMX2 
      IF(IGAIN.EQ.1.AND.VGAIN.LT.0.0) IG=4096-IFIX(ABS(VGAIN)/(.01*FC)) 
      IF(IGAIN .EQ. 1 .AND. VGAIN .GE. 0.0) IG = IFIX(VGAIN/(.01*FC)) 
      IF(IGAIN.EQ.0.AND.VGAIN.LT.0.0) IG=4096-IFIX(ABS(VGAIN)/(.001*FC))
      IF(IGAIN.EQ.0.AND.VGAIN.GE.0.0) IG = IFIX(VGAIN/(.001*FC))
C 
C  CALCULATE 6940/6941 CURRENT BOARD SLOT 
C 
300   IUNIT = 0 
      ITRY = IISLT
      IF (ITRY .GT. 1514) GOTO 7600 
310   CONTINUE
      IF (ITRY .LT. 0) GOTO 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,7676B) 
      IWORD(4) = IOTWD
C 
C  OUTPUT CURRENT LIMIT WORD TO MULTI-PROGRAMMER
C 
      CALL REIO(100002B,100B+LU,IWORD(2),IWORD,IDUMY,0) 
      GO TO 7000
330   CALL ABREG(IA,IB) 
      IF(IAND(IREG,377B).NE.0)GO TO 7500
C 
C  CALCULATE 6940/6941 GAIN BOARD SLOT
C 
400   JUNIT = 0 
      JTRY = IASLT
      IF (JTRY .GT. 1514) GOTO 7600 
410   CONTINUE
      IF (JTRY .LT. 0) GOTO 7600
      IF(JTRY.GE.0.AND.JTRY.LE.14)GO TO 420 
      JUNIT = JUNIT+1 
      IF (JUNIT .GT. 15) GOTO 7600
      JTRY = JTRY-100 
      GO TO 410 
C 
C  GAIN BOARD ADDRESS FOUND 
C 
420   JWORD = 3 
      JWORD(2) = ICNWD + JUNIT
      JWORD(3) = IOR(JTRY*10000B,IG)
      JWORD(4) = IOTWD
C 
C  OUTPUT GAIN 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) = 2HAV
      IERR(5) = 2H
      RETURN
      END 
      END$
                                    