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$