FTN4,L SUBROUTINE DCAV(NUNIT,VGAIN),09580-16441 REV.2001 791023 C------------------------------------------------------ C C RELOC. 09580-16441 C SOURCE 09580-18441 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 DCAV(I,R), OV=XX, ENT=DCAV, FIL=%DCAV 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 (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 AMPLIFIER FUNCTION AND REQUIRES THAT THE UNITS C BE PROGRAMMED USING THE HP-6940 CONTAINING A 69325A FOR GAIN C AND A 69326A OR A 69327A CARD FOR CURRENT LIMIT. SEE PAGES 28 C AND 29 OF FOR MORE DETAILS CONCERNING CONTROL CARD C 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/ C DATA IERMS/10,5,2HDC,2HAV,2H / ISTN = ISN(DUMMY) LU = LUDV(ISTN,IDTN) IF(LU)800,800,30 30 CALL XCAV(LU,IERMS,NUNIT,VGAIN) IF(IERMS)800,40,800 40 CONTINUE RETURN C 800 CALL ERROR(IERMS,IERMS(2)) RETURN END C SUBROUTINE XCAV(LU,IERR,NUNIT,VGAIN),09580-16441 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 VGAIN = PROGRAMMED GAIN (MULTIPLY ALL NUMBERS BELOW BY C ABOUT .999 FOR ACTUAL MAX GAIN) C 6825 - (8.0,MAX,HIGH RANGE 2.0,MAX,LOW RANGE) C 6826 - (20.0,MAX,HIGH RANGE 2.0,MAX,LOW RANGE) C 6827 - (40.0,MAX,HIGH RANGE 4.0,MAX,LOW RANGE) C C ********** WARNING ************* C * * C * THIS DEVICE SUBROUTINE SETS THE* C * CURRENT LIMIT TO MAXIMUM. USE * C * "DCVOT" TO SET AN APPROPRIATE * C * CURRENT LIMIT BEFORE SWITCHING * C * THE 68XX TO THE POWER SUPPLY * C * MODE. * C * * C ********************************** C C*********************************************************************** C DIMENSION IWORD(4),JWORD(4),IERR(5),IREG(2),IBUF(5) C EQUIVALENCE (REG,IREG,IA),(IREG(2),IB) EQUIVALENCE (IBUF(1),MODEL) EQUIVALENCE (IBUF(3),IGAIN) EQUIVALENCE (IBUF(4),IASLT) EQUIVALENCE (IBUF(5),IISLT) C DATA ICNWD/170160B/,IDTN/66/,IOTWD/170040B/,LBUF/5/ C IERR = 0 C C DIVISION FACTOR C FC = .97652 C C GAIN MULTIPLICATION FACTOR C FG = .999 C CALL TIM(IDTN,NUNIT,1,IBUF,LBUF,IER) IF(IER .NE. 0) GOTO 8000 IF (IGAIN .LT. 0 .OR. IGAIN .GT. 1) GOTO 7600 IF (VGAIN .LT. 0.0) GOTO 8000 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 (IGAIN .EQ. 0 .AND. VGAIN .GT. (2.0 * FG)) GOTO 8000 IF (VGAIN .GT. (8.0 * FG)) GOTO 8000 GOTO 200 C C 6826A C 135 IF (IGAIN .EQ. 0 .AND. VGAIN .GT. (2.0 * FG)) GOTO 8000 IF (VGAIN .GT. (20.0 * FG)) GOTO 8000 GOTO 235 C C 6827A C 170 IF (IGAIN .EQ. 0 .AND. VGAIN .GT. (4.0 * FG)) GOTO 8000 IF (VGAIN .GT. (40.0 * FG)) GOTO 8000 GOTO 270 C C CALCULATE 6825A GAIN WORD C 200 VGMX2 = 4.0 IF(IGAIN .EQ. 0) VGMX2 = 1.0 VGAIN = VGAIN - VGMX2 IF(IGAIN.EQ.1.AND.VGAIN.LT.0.0) IG=4096-IFIX(ABS(VGAIN)/(.002*FC)) IF(IGAIN .EQ. 1 .AND. VGAIN .GE. 0.0) IG = IFIX(VGAIN/(.002*FC)) IF(IGAIN.EQ.0.AND.VGAIN.LT.0.0) IG=4096-IFIX(ABS(VGAIN)/ +(.0005*FC)) IF(IGAIN.EQ.0.AND.VGAIN.GE.0.0) IG = IFIX(VGAIN/(.0005*FC)) GOTO 300 C C CALCULATE 6826A GAIN WORD C 235 VGMX2 = 10.0 IF(IGAIN .EQ. 0) VGMX2 = 1.0 VGAIN = VGAIN - VGMX2 IF(IGAIN.EQ.1.AND.VGAIN.LT.0.0) IG=4096-IFIX(ABS(VGAIN)/(.005*FC)) IF(IGAIN.EQ.1.AND.VGAIN.GT.0.0) IG = IFIX(VGAIN/(.005*FC)) IF(IGAIN.EQ.0.AND.VGAIN.LT.0.0) IG=4096-IFIX(ABS(VGAIN)/ +(.0005*FC)) IF(IGAIN.EQ.0.AND.VGAIN.GE.0.0) IG = IFIX(VGAIN/(.0005*FC)) GOTO 300 C C CALCULATE 6827A GAIN WORD C 270 VGMX2 = 20. IF(IGAIN .EQ. 0) VGMX2 = 2.0 VGAIN = VGAIN - VGMX2 IF(IGAIN.EQ.1.AND.VGAIN.LT.0.0) IG=4096-IFIX(ABS(VGAIN)/(.01*FC)) IF(IGAIN .EQ. 1 .AND. VGAIN .GE. 0.0) IG = IFIX(VGAIN/(.01*FC)) IF(IGAIN.EQ.0.AND.VGAIN.LT.0.0) IG=4096-IFIX(ABS(VGAIN)/(.001*FC)) IF(IGAIN.EQ.0.AND.VGAIN.GE.0.0) IG = IFIX(VGAIN/(.001*FC)) C C CALCULATE 6940/6941 CURRENT BOARD SLOT C 300 IUNIT = 0 ITRY = IISLT IF (ITRY .GT. 1514) GOTO 7600 310 CONTINUE IF (ITRY .LT. 0) GOTO 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,7676B) IWORD(4) = IOTWD C C OUTPUT CURRENT LIMIT WORD TO MULTI-PROGRAMMER C CALL REIO(100002B,100B+LU,IWORD(2),IWORD,IDUMY,0) GO TO 7000 330 CALL ABREG(IA,IB) IF(IAND(IREG,377B).NE.0)GO TO 7500 C C CALCULATE 6940/6941 GAIN BOARD SLOT C 400 JUNIT = 0 JTRY = IASLT IF (JTRY .GT. 1514) GOTO 7600 410 CONTINUE IF (JTRY .LT. 0) GOTO 7600 IF(JTRY.GE.0.AND.JTRY.LE.14)GO TO 420 JUNIT = JUNIT+1 IF (JUNIT .GT. 15) GOTO 7600 JTRY = JTRY-100 GO TO 410 C C GAIN BOARD ADDRESS FOUND C 420 JWORD = 3 JWORD(2) = ICNWD + JUNIT JWORD(3) = IOR(JTRY*10000B,IG) JWORD(4) = IOTWD C C OUTPUT GAIN 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) = 2HAV IERR(5) = 2H RETURN END END$