FTN4,L SUBROUTINE DCVOT(IUNIT,VOUT,CURLMP,CURLMN), +09580-16440 REV.2001 791023 C------------------------------------------------------ C C RELOC. 09580-16440 C SOURCE 09580-18440 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 DCVOT(I,R,R,R), OV=XX, ENT=DCVOT, FIL=%DCVOT 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 RANGE (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 POWER SUPPLY FUNCTIONS (VOLTAGE OUT, CURRENT C LIMIT). THIS SUBROUTINE REQUIRES THAT THE POWER SUPPLIES C BE PROGRAMMED USING THE HP-6940 CONTAINING 69325A, 69326A, C 69327A, AND/OR 69328A CARDS. SEE PAGES 28 AND 29 OF C FOR MORE DETAILS CONCERNING CONTROL CARD 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/ DATA IERMS/10,5,2HDC,2HVO,2HT / ISTN = ISN(DUMMY) LU = LUDV(ISTN,IDTN) IF(LU)800,800,30 30 CALL XCVOT(LU,IERMS,IUNIT,VOUT,CURLMP,CURLMN) IF(IERMS)800,40,800 40 CONTINUE RETURN C 800 CALL ERROR(IERMS,IERMS(2)) RETURN END C SUBROUTINE XCVOT(LU,IERR,NUNIT,VOUT,CURLMP,CURLMN), +09580-16440 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 VOUT = PROGRAMMED OUTPUT VOLTAGE (VOLTS) C (MULTIPLY ALL VOUT VALUES BY ABOUT .999 C TO GET TRUE LIMITS) C 6825 - (+- 20V HIGH, +-5V LOW) C 6826 - (+- 50V HIGH, +-5V LOW) C 6827 - (+- 100V HIGH, +-10V LOW) C CURLMP= POSITIVE CURRENT LIMIT (MA) C 6825 - (+2000MA) C 6826 - (+1000MA) C 6827 - (+500MA) C CURLMN= NEGATIVE CURRENT LIMIT (MA) C 6825 - (-2000MA) C 6826 - (-1000MA) C 6827 - (-500MA) C C***************************************************************** C DIMENSION IWORD(4),IERR(5),IREG(2),IBUF(5),JWORD(4) C EQUIVALENCE (REG,IREG,IA),(IREG(2),IB) EQUIVALENCE (IBUF(1),MODEL) EQUIVALENCE (IBUF(2),IVRNG) EQUIVALENCE (IBUF(3),IGAIN) EQUIVALENCE (IBUF(4),IVSLT) EQUIVALENCE (IBUF(5),IISLT) C DATA ICNWD/170160B/,IDTN/66/,IOTWD/170040B/ DATA LBUF/5/ C IERR = 0 C C MULTIPLICATION FACTOR C FC = .976563 C C VOUT MULTIPLICATION FACTOR C FV = .999 C CALL TIM(IDTN,NUNIT,1,IBUF,LBUF,IER) IF(IER .NE. 0) GOTO 8000 IF (IVRNG .LT. 0 .OR. IVRNG .GT. 1) GOTO 7600 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 (IVRNG .EQ. 0 .AND. ABS(VOUT) .GT. (5.0 * FV)) GOTO 8000 IF (ABS(VOUT) .GT. (20.0 * FV)) GOTO 8000 IF (CURLMP .LT. 0.0 .OR. CURLMP .GT. 2000.0) GOTO 8000 IF (CURLMN .GT. 0.0 .OR. CURLMN .LT. -2000.0) GOTO 8000 GOTO 200 C C 6826A C 135 IF (IVRNG .EQ. 0 .AND. ABS(VOUT) .GT. (5.0 * FV)) + GOTO 8000 IF (ABS(VOUT) .GT. (50.0 * FV)) GOTO 8000 IF (CURLMP .LT. 0.0 .OR. CURLMP .GT. 1000.0) GOTO 8000 IF (CURLMN .GT. 0.0 .OR. CURLMN .LT. -1000.0) GOTO 8000 GOTO 235 C C 6827A C 170 IF (IVRNG .EQ. 0 .AND. ABS(VOUT) .GT. (10.0 * FV)) + GOTO 8000 IF (ABS(VOUT) .GT. (100.0 * FV)) GOTO 8000 IF (CURLMP .LT. 0.0 .OR. CURLMP .GT. 500.0) GOTO 8000 IF (CURLMN .GT. 0.0 .OR. CURLMN .LT. -500.0) GOTO 8000 GOTO 270 C C CALCULATE 6825A VOLTAGE WORD C 200 IF(IVRNG .EQ. 1 .AND. VOUT .LT. 0.0) JD=4096-IFIX(ABS(VOUT)/ +(.01*FC)) IF(IVRNG .EQ. 1 .AND. VOUT .GE. 0.0) JD = IFIX(VOUT/(.01*FC)) IF(IVRNG .EQ. 0 .AND. VOUT .LT. 0.0) JD=4096-IFIX(ABS(VOUT)/ +(.0025*FC)) IF(IVRNG .EQ. 0 .AND. VOUT .GE. 0.0) JD = IFIX(VOUT/(.0025*FC)) C C CALCULATE 6825A CURRENT LIMIT WORD C IDP = IFIX(CURLMP/32.0) IDN = IFIX(ABS(CURLMN/32.0)) GOTO 300 C C CALCULATE 6826A VOLTAGE WORD C 235 IF(IVRNG .EQ. 1 .AND. VOUT .LT. 0.0) JD=4096-IFIX(ABS(VOUT)/ +(.025*FC)) IF(IVRNG .EQ. 1 .AND. VOUT .GE. 0.0) JD = IFIX(VOUT/(.025*FC)) IF(IVRNG .EQ. 0 .AND. VOUT .LT. 0.0) JD=4096-IFIX(ABS(VOUT)/ +(.0025*FC)) IF(IVRNG .EQ. 0 .AND. VOUT .GE. 0.0) JD = IFIX(VOUT/(.0025*FC)) C C CALCULATE 6826A CURRENT LIMIT WORD C IDP = IFIX(CURLMP/16.0) IDN = IFIX(ABS(CURLMN/16.0)) GOTO 300 C C CALCULATE 6827A VOLTAGE WORD C 270 IF(IVRNG .EQ. 1 .AND. VOUT .LT. 0.0) JD=4096-IFIX(ABS(VOUT)/ +(.05*FC)) IF(IVRNG .EQ. 1 .AND. VOUT .GE. 0.0) JD = IFIX(VOUT/(.05*FC)) IF(IVRNG .EQ. 0 .AND. VOUT .LT. 0.0) JD=4096-IFIX(ABS(VOUT)/ +(.005*FC)) IF(IVRNG .EQ. 0 .AND. VOUT .GE. 0.0) JD = IFIX(VOUT/(.005*FC)) C C CALCULATE 6827A CURRENT LIMIT WORD C IDP = IFIX(CURLMP/8.0) IDN = IFIX(ABS(CURLMN/8.0)) C C SET UP CURRENT LIMIT C 300 IDP = 100B * IDP ID = IOR(IDP,IDN) C IUNIT = 0 ITRY = IISLT IF (ITRY .GT. 1514) GOTO 7600 310 CONTINUE IF (ITRY.LT.0)GO TO 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,ID) IWORD(4) = IOTWD C C OUTPUT CURRENT LIMIT WORD TO MULTI-PROGRAMMER C CALL REIO(100002B,100B+LU,IWORD(2),IWORD,IDUMY,0) GOTO 7000 330 CALL ABREG(IA,IB) IF(IAND(IREG,377B).NE.0)GO TO 7500 C C SET UP VOLTAGE OUTPUT WORDS C 400 JUNIT = 0 JTRY = IVSLT IF (JTRY .GT. 1514) GOTO 7600 410 CONTINUE IF (JTRY .LT. 0) GOTO 7600 IF (JTRY .GE. 0 .AND. JTRY .LE. 14) GOTO 420 JUNIT = JUNIT + 1 JTRY = JTRY - 100 GOTO 410 C C VOLTAGE OUTPUT CARD ADDRESS FOUND C 420 JWORD = 3 JWORD(2) = ICNWD + JUNIT JWORD(3) = IOR(JTRY*10000B,JD) JWORD(4) = IOTWD C C OUTPUT VOLTAGE OUTPUT 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) = 2HVO IERR(5) = 2HT RETURN END END$