FTN4,L
      SUBROUTINE DCVSL(UNIT,VOLT,CURLIM),09580-16039 REV.2001 
     +791023
C-------------------------------------------------------------------
C 
C      RELOC.       09580-16039 
C      SOURCE       09580-18039 
C 
C      C. LEATH     03/15/77    REV. A
C      C. LEATH     05/20/77    REV. B
C      R. UNTALAN   07/15/77    REV. C
C      V.POVIO      780422      REV. D
C      BOB RICHARDS 791023
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-------------------------------------------------------------------
      INTEGER UNIT
      DIMENSION IERMS(5)
      DATA IDTN/22/ 
      DATA IERMS/10,5,2HDC,2HVS,2HL / 
C 
C INTERFACE MODULE FOR 61XX POWER SUPPLY DEVICE 
C SUBROUTINE. 
C 
C 
      ISTN = ISN(DUMMY) 
      IERMS= 10 
      IU = ((UNIT - 1)/8) + 1 
      LU = LUDV(ISTN,IDTN,IU) 
      IF(LU)800,800,10
10    IF(UNIT .GT. 8)UNIT=UNIT-8
      CALL XCVSL(LU,IERMS,UNIT,VOLT,CURLIM) 
      IF(IERMS)800,20,800 
20    RETURN
800   CALL ERROR(IERMS,IERMS(2))
      RETURN
      END 
      SUBROUTINE DCISL(UNIT,CURR,VOLLIM),09580-16039 REV.2001 
     +791023
      INTEGER UNIT
      DIMENSION IERMS(5)
      DATA IDTN/22/ 
      DATA IERMS/10,5,2HDC,2HIS,2HL / 
C 
C INTERFACE MODULE FOR 6140 LOW CURRENT DEVICE
C SUBROUTINE. 
C 
C 
      ISTN = ISN(DUMMY) 
      IERMS= 10 
      IU = ((UNIT - 1)/8) + 1 
      LU = LUDV(ISTN,IDTN,IU) 
      IF(LU)800,800,10
10    IF(UNIT .GT. 8)UNIT=UNIT-8
      CALL XCVSL(LU,IERMS,UNIT,CURR,VOLLIM) 
      IF(IERMS)800,20,800 
20    RETURN
800   CALL ERROR(IERMS,IERMS(2))
      RETURN
      END 
      SUBROUTINE XCVSL(LU,IERR ,UNIT,VI,VILIM), 
     +09580-16039 REV.2001 791023 
C*********************************************************************
C 
C        THIS SUBROUTINE SETS THE DVS/DCS TO THE LOW OUTPUT RANGE.
C        THE PARAMETERS IN THE CALLING SEQUENCE ARE DEFINED AS
C        FOLLOWS: 
C 
C 
C 
C     LU = LOGICAL UNIT NUMBER FOR INSTRUMENT 
C     IERR = 5 WORD ERROR ARRAY 
C     WHERE IERR(1) = ERROR CODE WITH:
C                  0 = NO ERROR 
C                  1 = PARAMETER ERROR
C                  2 = I/O DEVICE DOWN OR TIME OUT
C                  9 = I/O CALL REJECTED
C                 10 = DEVICE NOT ASSIGNED TO STATION OR NONEXISTENT
C           IERR(2) = CHARACTER COUNT 
C           IERR(3) - IERR(4) = DEVICE SUBROUTINE MNEMONICS 
C 
C                 IUNIT IS THE UNIT NUMBER
C                 VI IS THE DESIRED OUTPUT
C                     -16.3835 <= VI<= +16.3835 
C                 VILIM IS THE DESIRED CURRENT/VOLTAGE LIMIT
C 
C           OUTPUT LIMIT TABLE
C 
C-----------------------------------------------------------------
C POWER SUPPLIES      6128C     6129C   6130C   6131C   6140A 
C-----------------------------------------------------------------
C                      (MA)     (MA)     (MA)    (MA)    (V)
C                      250      100      20      20        2
C                      625      250      50      50        5
C                      875      350      70      70        7
C                     1250      500     100     100       10
C                     2500     1000     200     200       20
C                     6250     2500     500     500       50
C                     8750     3500     700      -        70
C                    12500     5000    1000      -       100
C-----------------------------------------------------------------
C 
C 
C*********************************************************************
      INTEGER UNIT, IBUF(2), CL, CLISZ
      INTEGER CONWD, IDBUF1(3), WORD2, WORD1
      INTEGER IERR(5) 
      INTEGER IDBUF2(3), ICBUF(3), IREG(2)
      REAL  CLMT(8) 
      EQUIVALENCE (REG,IREG,IA),(IREG(2),IB)
      DATA CLMT/20.,50.,70.,100.,200.,500.,700.,1000./
      DATA ICBL/3/, IDBL/3/, IDBUF1/13,0,0/ 
      DATA ICBUF/4,1,3/ 
C*********************************************************************
C        RETRIEVE IBUF,FROM THE CONFIGURATION TABLE, WHICH
C        CONTAINS:
C              IBUF(1)= TYPE OF PWR SUPPLY (6128,6129, ETC.)
C              IBUF(2)= OUTPUT WORD2 WITHOUT THE CURRENT LIMIT
C 
C       SEE &DCVSH LISTING FOR CONFIGURATION TABLE EXAMPLE
C 
      IERR = 0
      CALL TIM(22,UNIT,1,IBUF,2,N)
      IF(N.NE.0) RETURN 
      IERR = 1
C*********************************************************************
C*********************************************************************
C        SET # OF ENTRIES IN I-LIMIT TABLE
C*********************************************************************
      CLISZ= 8
      IF(IBUF   .EQ.6131) CLISZ= 6
C*********************************************************************
C        DETERMINE APPLICABLE CURRENT/VOLTAGE LIMIT TABLE 
C 
      DIVFA= 1.0
      IF(IBUF   .EQ.6129) DIVFA= 5.0
      IF(IBUF   .EQ.6128.OR.IBUF   .EQ.6933) DIVFA= 15.0
      IF(IBUF .EQ. 6140) DIVFA = 0.100
C*********************************************************************
C        CHECK IF OUTPUT EXCEEDS LIMIT
C 
      IF(ABS(VI)-16.383502.GT.0.)GO TO 99 
C*********************************************************************
C        SET UP OUTPUT WORD1
C 
      WORD1= IFIX(VI*2000.002)
C*********************************************************************
C        PROCESS CURRENT/VOLTAGE LIMIT
C*********************************************************************
      SAVEA= -VILIM/DIVFA 
      IF(SAVEA.GT.0.)GO TO 99 
      CL= 0 
 45   IF(CLMT(CL+1) + SAVEA) 50,60
 50   CL= CL+1
C*********************************************************************
C        DOES CURRENT/VOLTAGE LIMIT EXCEED THE MAXIMUM? 
C 
      IF(CL+1.GT.CLISZ) GO TO 99
      GO TO 45
C*********************************************************************
C        SET UP OUTPUT WORD2, AND OTHER OUTPUT PARAMETERS 
C 
 60   WORD2= (CL*10B) + (UNIT-1) + 100B 
      CONWD= 11300B + LU
      IDBUF1(3)= WORD2
      IDBUF2   = 13 
      IDBUF2(2)= WORD1
      IDBUF2(3)= WORD2
C*********************************************************************
C        IS THE NEW OUTPUT RANGE THE SAME AS PREVIOUS OUTPUT RANGE? 
C 
      IERR = 2
C 
C     DISARM ANY PREVIOUS ALARM PROGRAMS
C 
      CALL EXEC(100003B,400B+LU)
      GO TO 88
69    CALL ABREG(IA,IB) 
      IF(IAND(IREG,377B).NE.0)GO TO 99
      ITST1 = IAND(IBUF(2),177707B) 
      ITEST= IAND(WORD2,177707B)
      IF(ITST1  .NE.ITEST) GO TO 70 
      ITST1 = IAND(IBUF(2),70B) 
      ITEST = IAND(WORD2,70B) 
      IF(ITEST.LE.ITST1)GO TO 75
C*********************************************************************
C        ESTABLISH ALARM MODE, SET OUTPUT RANGE, SET OUTPUT TO ZERO 
C 
70    CALL EXEC(100002B,CONWD,IDBUF1,IDBL,ICBUF,ICBL) 
      GO TO 88
77    IF(IAND(IREG,377B).NE.0)GO TO 99
C*********************************************************************
C        ESTABLISH ALARM MODE AND SET NEW VOLTAGE 
C 
C     REARM INTERRUPT PROGRAM 
C 
      CALL EXEC(100003B,500B+LU)
      GO TO 88
75    CALL EXEC(100002B ,CONWD,IDBUF2,IDBL,ICBUF,ICBL)
      GO TO 88
79    CALL ABREG(IA,IB) 
      IF(IAND(IREG,377B).NE.0)GO TO 99
      IBUF(2) = WORD2 
C 
C 
      CALL TIM(22,UNIT,2,IBUF,2,N)
C 
      IERR = 0
      RETURN
 88   IERR = 9
 99   IERR(2) = 5 
      IERR(3) = 2HDC
      IERR(4) = 2HVS
      IF(IBUF .EQ. 6140) IERR(4) = 2HIS 
      IERR(5) = 2HL 
      RETURN
      END 
      END$
                                                        