FTN4,L
      SUBROUTINE DCV(UNIT,VOLT,CURLIM),09580-16040 REV.2001 
     +791023
C-------------------------------------------------------------------
C 
C      RELOC.       09580-16040 
C      SOURCE       09580-18040 
C 
C      C. LEATH     03/15/77    REV. A
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-------------------------------------------------------------------
C*********************************************************************
C 
C        THIS SUBROUTINE SETS THE DVS TO THE HIGH OR LOW VOLTAGE
C        RANGE DEPENDING ON THE DESIRED VOLTAGE.  THE LOW RANGE 
C        IS SELECTED IF ABS(VOLT) <= 16.3835 VDC AND THE HIGH 
C        RANGE IS SELECTED IF ABS(VOLT) > 16.3835 VDC.
C 
C         THE CALL IS MADE AS FOLLOWS:
C 
C                      CALL DCV(IUNIT,VOLT,CURLIM)
C 
C                 IUNIT IS THE UNIT NUMBER (MUST BE BETWEEN 1 AND 8)
C                 VOLT IS DESIRED VOLTAGE 
C                 CURLIM IS THE CURRENT LIMIT 
C 
C         IERR = 0 = NO ERRORS
C         IERR = 2 = CALLED UNIT IS NOT A DVS.
C 
C 
C*********************************************************************
      INTEGER UNIT, IBUF(2) 
      DIMENSION IERMS(5)
      DATA IERMS/10,5,2HDC,2HV ,2H  / 
C*********************************************************************
C        RETRIEVE IBUF, FROM THE CONFIGURATION TABLE, WHICH 
C        CONTAINS:
C                    IBUF(1)= TYPE OF PWR SUPPLY (6128,6129,ETC.) 
C                    IBUF(2)= PRESENT CURRENT LIMIT 
C*********************************************************************
      CALL TIM(22,UNIT,1,IBUF,2,N)
C*********************************************************************
C        USE LOW RANGE FOR 6128 AND 6933
C******************************************************************** 
      IF(IBUF(1).EQ.6128.OR.IBUF(1).EQ.6933) GO TO 50 
C******************************************************************** 
C     SEE IF CALLED UNIT IS REALLY A DVS. 
C******************************************************************** 
      IF(IBUF(1) .EQ. 6140) GOTO 9000 
C******************************************************************** 
C        DETERMINE APPROPRIATE RANGE DEPENDING ON WHETHER 
C        VOLT IS > OR <= TO 16.383502, THEN CALL EITHER 
C        DCVSH FOR THE HIGH RANGE OR DCVSL FOR THE LOW RANGE. 
C*********************************************************************
      IF(ABS(VOLT).LE.16.383502) GO TO 50 
      CALL DCVSH(UNIT,VOLT,CURLIM)
      RETURN
 50   CALL DCVSL(UNIT,VOLT,CURLIM)
      RETURN
C 
C     ERROR - CALLED UNIT IS NOT A DVS. 
C 
9000  CALL ERROR(IERMS,IERMS(2))
      RETURN
      END 
      SUBROUTINE DCI(UNIT,CURR,VOLLIM),09580-16040 REV.2001 
     +791023
C*********************************************************************
C 
C        THIS SUBROUTINE SETS THE DCS TO THE HIGH OR LOW CURRENT
C        RANGE DEPENDING ON THE DESIRED CURRENT.  THE LOW RANGE 
C        IS SELECTED IF ABS(CURR) <= 16.3835 MA AND THE HIGH
C        RANGE IS SELECTED IF ABS(CURR) > 16.3835 MA. 
C 
C         THE CALL IS MADE AS FOLLOWS:
C 
C                      CALL DCI(IUNIT,CURR,VOLLIM)
C 
C                 IUNIT IS THE UNIT NUMBER (MUST BE BETWEEN 1 AND 8)
C                 CURR IS DESIRED CURRENT 
C                 VOLLIM IS THE VOLTAGE LIMIT 
C 
C*********************************************************************
      INTEGER UNIT, IBUF(2) 
      DIMENSION IERMS(5)
      DATA IERMS/10,5,2HDC,2HI ,2H  / 
C*********************************************************************
C        RETRIEVE IBUF, FROM THE CONFIGURATION TABLE, WHICH 
C        CONTAINS:
C                    IBUF(1)= TYPE OF PWR SUPPLY (6140) 
C                    IBUF(2)= PRESENT VOLTAGE LIMIT 
C 
C      IERR = 0 = NO ERRORS 
C      IERR = 2 = CALLED UNIT IS NOT A 6140 DCS 
C 
C*********************************************************************
      CALL TIM(22,UNIT,1,IBUF,2,N)
C*********************************************************************
C     SEE IF CALLED UNIT IS A 6140 DCS
C******************************************************************** 
      IF(IBUF(1) .NE. 6140) GOTO 9000 
C******************************************************************** 
C        DETERMINE APPROPRIATE RANGE DEPENDING ON WHETHER 
C        CURR IS > OR <= TO 16.383502, THEN CALL EITHER 
C        DCISH FOR THE HIGH RANGE OR DCISL FOR THE LOW RANGE. 
C*********************************************************************
      IF(ABS(CURR).LE.16.383502) GO TO 50 
      CALL DCISH(UNIT,CURR,VOLLIM)
      RETURN
 50   CALL DCISL(UNIT,CURR,VOLLIM)
      RETURN
C 
C     ERROR - CALLED UNIT IS NOT A DCS
C 
9000  CALL ERROR(IERMS,IERMS(2))
      RETURN
      END 
      END$
                                                                                                                                              