FTN4,L SUBROUTINE DCVSH(UNIT,VOLT,CURLIM),09580-16038 REV.2001 +791023 C------------------------------------------------------------------- C C RELOC. 09580-16038 C SOURCE 09580-18038 C C C. LEATH 03/15/77 REV. A C R. UNTALAN 05/15/77 REV. B C V.POVIO 780422 REV. C 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,2HH / C C INTERFACE MODULE 61XX HIGH OUTPUT DEVICE SUBROUTINE C C IERMS= 10 ISTN = ISN(DUMMY) IU = ((UNIT - 1)/8) + 1 LU = LUDV(ISTN,IDTN,IU) IF(LU)800,800,10 10 IF(UNIT .GT. 8)UNIT=UNIT-8 CALL XCVSH(LU,IERMS,UNIT,VOLT,CURLIM) IF(IERMS)800,20,800 20 RETURN 800 CALL ERROR(IERMS,IERMS(2)) RETURN END SUBROUTINE DCISH(UNIT,CURR,VOLLIM),09580-16038 REV.2001 +791023 C------------------------------------------------------------------- C INTEGER UNIT DIMENSION IERMS(5) DATA IDTN/22/ DATA IERMS/10,5,2HDC,2HIS,2HH / C C INTERFACE MODULE 6140A HIGH CURRENT DEVICE SUBROUTINE C C IERMS= 10 ISTN = ISN(DUMMY) IU = ((UNIT - 1)/8) + 1 LU = LUDV(ISTN,IDTN,IU) IF(LU)800,800,10 10 IF(UNIT .GT. 8)UNIT=UNIT-8 CALL XCVSH(LU,IERMS,UNIT,CURR,VOLLIM) IF(IERMS)800,20,800 20 RETURN 800 CALL ERROR(IERMS,IERMS(2)) RETURN END SUBROUTINE XCVSH(LU,IERR ,UNIT,VI,VILIM), +09580-16038 REV.2001 791023 C********************************************************************* C C THIS SUBROUTINE SETS THE DVS/DCS TO THE HIGH V/I RANGE. C THE PARAMETERS IN THE CALLING SEQUENCE ARE DEFINED C AS FOLLOWS: 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(V OR I) C -50.00<= VI <= 50.00 FOR 6129 AND 6130 (VOLTS) C -100.00<=VI <= 100.00 FOR 6131 (VOLTS) C -163.84<= VI <= 163.835 FOR 6140A (MA) C N/A FOR 6128 OR 6933 SINCE THEY HAVE NO HIGH C VOLTAGE RANGE. C C VILIM IS THE DESIRED VOLTAGE/CURRENT LIMIT C C C VOLTAGE/CURRENT LIMIT TABLE 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********************************************************************* INTEGER UNIT, IBUF(2), CL, CLISZ INTEGER CONWD, IDBUF1(3), WORD1, WORD2 INTEGER IDBUF2(3), ICBUF(3), IREG(2) INTEGER IERR(5) REAL LIMIT, 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 THE CONFIGURATION TABLE CONTAINS TWO ENTRIES FOR THE C POWER SUPPLIES: C C IBUF(1)= TYPE OF PWR SUPPLY (6128,6129, ETC.) C IBUF(2)= OUTPUT WORD2 WITHOUT THE CURRENT/VOLTAGE LIMIT C THE FOLLOWING IS AN EXAMPLE OF THE CONFIGURATION TABLE DATA FOR THE C 61XX POWER SUPPLIES. C C R 22,6,2 DEVICE TYPE #,6UNITS,2ENTRIES EACH C U1 C 6130 C 0 C U2 C 6140 C 0 C U3 C 6131 C 0 C U4 C 6129 C 0 C U5 C 6129 C 0 C U6 C 6131 C 0 C********************************************************************* C C BRANCH AND MNEMONIC TABLE ENTRIES C C DCVSH(I,R,R), OV=N, ENT=DCVSH, FIL=%DCVSH C DCISH(I,R,R), OV=N, ENT=DCISH, FIL=%DCVSH C DCVSL(I,R,R), OV=N, ENT=DCVSL, FIL=%DCVSL C DCISL(I,R,R), OV=N, ENT=DCISL, FIL=%DCVSL C DCV(I,R,R), OV=N, ENT=DCV, FIL=%DCV C DCI(I,R,R), OV=N, ENT=DCI, FIL=%DCV C DCOPL(IVA), OV=N, ENT=DCOPL, FIL=%DCOPL C C C****************************************************************** C C IERR = 0 CALL TIM(22,UNIT,1,IBUF,2,N) IF(N.NE.0)RETURN IERR = 1 C********************************************************************* C CHECK IF TYPE IS 6128 OR 6933 WHICH HAVE NO HIGH RANGE C********************************************************************* IF(IBUF .EQ.6128.OR.IBUF .EQ.6933) GO TO 99 C********************************************************************* C SET APPROPRIATE LIMIT C LIMIT= 50.00001 IF(IBUF .EQ.6131) LIMIT= 100.00001 IF(IBUF .EQ.6140) LIMIT= 163.83501 C C SET # OF ENTRIES IN I-LIMIT TABLE C CLISZ= 8 IF(IBUF .EQ.6131) CLISZ= 6 C C DETERMINE APPLICABLE OUTPUT LIMIT TABLE C DIVFA= 1.0 IF(IBUF .EQ. 6140) DIVFA = 0.100 IF(IBUF .EQ.6129) DIVFA= 5.0 IF(IBUF .EQ.6128.OR.IBUF .EQ.6933) DIVFA= 15.0 C********************************************************************* C CHECK IF LIMIT IS EXCEEDED C********************************************************************* IF(ABS(VI)-LIMIT.GT.0.) GO TO 99 C********************************************************************* C SET UP OUTPUT WORD1 C********************************************************************* WORD1= IFIX(VI*200.) C********************************************************************* C PROCESS CURRENT 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 LIMIT EXCEED THE MAXIMUM? C********************************************************************* IF(CL+1.GT.CLISZ) GO TO 99 GO TO 45 C********************************************************************* C SET UP OUTPUT WORD2, AND OTHER PARAMETERS NEEDED FOR OUTPUT C********************************************************************* 60 WORD2= (CL*10B) + (UNIT-1) CONWD= 11300B + LU IDBUF1(3)= WORD2 IDBUF2 = 13 IDBUF2(2)= WORD1 IDBUF2(3)= WORD2 C********************************************************************* C IS NEW RANGE THE SAME AS PREVIOUS RANGE? C********************************************************************* IERR = 2 C C DISARM ANY PREVIOUS ALARM PROGRAM. 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 SEND UPDATED BUFFER TO TABLE C ESTABLISH ALARM MODE, SET RANGE, SET OUTPUT TO ZERO C********************************************************************* 70 CALL EXEC(100002B,CONWD,IDBUF1,IDBL,ICBUF,ICBL) GO TO 88 73 CALL ABREG(IA,IB) 77 IF(IAND(IREG,377B ).NE.0)GO TO 99 C C ESTABLISH ALARM MODE AND SET NEW OUTPUT CALL EXEC(100003B,500B+LU) GO TO 88 C 75 CALL EXEC(100002B ,CONWD,IDBUF2,IDBL,ICBUF,ICBL) GO TO 88 80 IBUF(2) = WORD2 CALL TIM(22,UNIT,2,IBUF,2,N) C 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) = 2HH RETURN END END$