FTN4,L SUBROUTINE ANAGN(IU,AMP,BIAV,IWA,FREQ), +09580-16465 REV.2026 800212 C C------------------------------------- C C SCHLUMBERGER 1172 FREQUENCY RESPONSE ANALYZER C C RELOCATABLE 09580-16465 C SOURCE 09580-18465 C C BOB RICHARDS 800212 C C------------------------------------ C C !=================================================! C ! ! C ! (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980 ! C ! ALL RIGHTS RESERVED ! C ! ! C ! NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, ! C ! REPRODUCED OR TRANSLATED INTO ANOTHER PROGRAM ! C ! LANGUAGE WITHOUT THE PRIOR WRITTEN CONSENT OF ! C ! THE HEWLETT-PACKARD COMPANY. ! C ! ! C !-------------------------------------------------! C ! ! C ! TEST SYSTEM SOURCE SOFTWARE IS THE PROPRIETARY ! C ! MATERIAL OF THE HEWLETT-PACKARD COMPANY. ! C ! ! C ! THIS SOURCE DATA SHALL BE USED SOLELY IN ! C ! CONJUNCTION WITH ELECTRONIC COMPUTER SYSTEMS ! C ! SUPPLIED TO THE USER BY HEWLETT-PACKARD. ! C ! ! C ! THIS PROPRIETARY DATA SHALL NOT BE COPIED OR ! C ! OTHERWISE REPRODUCED WITHOUT THE PRIOR WRITTEN ! C ! CONSENT OF HEWLETT-PACKARD, EXCEPT THAT ONE ! C ! COPY MAY BE MADE AND RETAINED BY THE USER FOR ! C ! ARCHIVE PURPOSES. ! C ! ! C ! THE USER SHALL NOT DISCLOSE THIS DATA TO ANY ! C ! THIRD PARTIES WITHOUT THE PRIOR WRITTEN CONSENT ! C ! OF HEWLETT-PACKARD. IN ADDITION, THE USER SHALL ! C ! USE AT LEAST THE SAME CARE AND SAFEGUARDS TO ! C ! PROTECT THIS DATA FROM UNAUTHORIZED USE OR ! C ! DISCLOSURE AS THE USER USES TO PROTECT ITS OWN ! C ! PROPRIETARY DATA. ! C ! ! C !=================================================! C C GENERAL: C -------- C C THE FOLLOWING DEVICE SUBROUTINES ARE USED C TO PROGRAM THE SCHLUMBERGER 1172 FREQUENCY RESPONSE ANALYZER. C C HARDWARE REQUIRED: C ------------------ C A. SCHLUMBERGER 1172 C B. HP59310 BUS INTERFACE KIT. C C JUMPER POSITION: C SW1-1 - 1 C SW1-2 TO SW1-8 - 0 C SW2-1 - 0 C SW2-2 - 0 C SW2-3 - 0 C SW2-4 - 0 C SW2-5 - 1 C SW2-6 - REN C SW2-7 - ICF C SW2-8 - CNX C C C. HP 21XX SERIES COMPUTER C C BRANCH AND MNEMONIC TABLE ENTRIES: C ---------------------------------- C C ANAGN(I,R,R,I,R), OV=XX, ENT=ANAGN, FIL=%ANAGN C C CONFIGURATION TABLE ENTRIES: C ---------------------------- C C NONE REQUIRED C C C C C------------------------------------ C C ANAGN(IU,AMP,BIAV,IWA,FREQ) C C WHERE: C C IU = UNIT # C C AMP = OPERATING AND DISPLAYED VOLTAGE C .01 TO 9.99 VOLTS - OPERATING C .010 TO 9.999 VOLTS - DISPLAYED C C BIAV = BIAS VOLTAGE C -9.99 TO 9.99 VOLTS C 10 MV RESOLUTION C C IWA = WAVEFORM OUTPUT C 0=TRIANGLE C 1=SINE C 2=SQUARE C C FREQ = OPERATING AND DISPLAYED FREQUENCIES C .0001HZ TO 9999.0HZ C C C C------------------------------------ C DIMENSION IERMS(5) DATA IDTN / 72 / DATA IERMS / 10,5,2HAN,2HAG,2HN / C IERMS=10 C C FIND STATION AND LU #'S C ISTN = STATION # C LU1 = SCHLUMBERGER 1172 LU C LUIB = HPIB LU C ISTN=ISN(DUMMY) LU1=LUDV(ISTN,IDTN,IU) LUIB=IBLU0(LU1) IF(LU1 .LE. 0 .OR. LUIB .LE. 0)GOTO 800 C C CALL X SUB C CALL XNAGN(LU1,LUIB,IERMS,IU,AMP,BIAV,IWA,FREQ) IF(IERMS)800,20,800 C C EXIT C 20 RETURN C C ERROR EXIT C 800 CALL ERROR(IERMS,IERMS(2)) RETURN END C C--------------------------------------------- C SUBROUTINE XNAGN(LU1,LUIB,IERMS,IU,AMP,BIAV,IWA,FREQ), +09580-16465 REV.2026 800212 DIMENSION IERMS(5),IOBUF(6),ITEM(3) C INTEGER T1,T2,ADC,ADG,AD3,AD4,AD6,AD7 C DATA T1 /52061B/ DATA T2 /52062B/ DATA ADC /41400B/ DATA ADG /43400B/ DATA AD3 /31400B/ DATA AD4 /32000B/ DATA AD6 /33000B/ DATA AD7 /33400B/ C C C--------------------------------------------- C C C THE PARAMETERS IN THE CALLING SEQUENCE HAVE THE FOLLOWING C MEANINGS. C C LUIB = LU # OF HPIB BUS. C LU1 = LU # OF SCHLUMBERGER 1172 C C IERMS IS A FIVE WORD ARRAY WITH IERR(1) CONTAINING C THE ERROR CODE. C C 0 = NO ERROR C 1 = PARAMETER ERROR C C ERROR MESSAGES THAT PERTAIN TO THE HPIB. C C 9 = I/O CALL REJECTED C 10 = LUIB OR LU1 = 0 C 12 = I/O DEVICE TIME OUT C 13 = IFC DETECTED DURING I/O REQUEST C 14 = SRQ ABORTED C 15 = NON-EXISTENT ALARM PROGRAM C 16 = ILLEGAL CONTROL REQUEST C 17 = EQT EXTENSION AREA FULL C C IERMS(2) = ERROR MNEMONIC CHARACTER COUNT C IERMS(3) TO IERMS(5) = ERROR MNEMONIC C C C--------------------------------------------- C C C C CHECK PARAMETERS C IERMS=1 C X = .01 Y = 9.99 Z = -9.99 IF(AMP.LT.X.OR.AMP.GT.Y) GO TO 8000 IF(BIAV.LT.Z.OR.BIAV.GT.Y) GOTO 8000 IF(IWA.LT.0.OR.IWA.GT.2) GOTO 8000 X = .0001 Y = 9999.0 IF(FREQ.LT.X.OR.FREQ.GT.Y) GOTO 8000 C C MEASUREMENT MODE TO 'STOP' C IOBUF(1) = T2 IOBUF(2) = 35460B C C REMOTE ENABLE C CALL EXEC(100003B,1600B+LUIB) GOTO 9000 30 CALL ABREG(IA,IB) IF(IB .LT. 0) GOTO 8500 C C SEND OUTPUT BUFFER C C FORMAT = "T2SEMICOLON0" C CALL EXEC(100002B,LU1,IOBUF,2,IDUMY,0) GOTO 9000 40 CALL ABREG(IA,IB) IF (IB .LT. 0) GOTO 8500 C C SET UP IOBUF FOR OUTPUT VOLTAGE DATA C C COMPUTE EXPONENT OF OUTPUT VOLTAGE DATA IF(AMP .LE. .09999) IE = 1 IF(AMP .GT. .09999 .AND. AMP .LE. .99999) IE = 2 IF(AMP .GT. .99999) IE = 3 C IF (IE .EQ. 1) TEMP = AMP*10000.0 IF (IE .EQ. 2) TEMP = AMP*1000.0 IF (IE .EQ. 3) TEMP = AMP*100.0 TEMP = TEMP+.5 C C CONVERT OUTPUT VOLTAGE MAGNITUDE TO ASCII CODE C IX = INT(TEMP) CALL CNUMD(IX,ITEM) C IOBUF(1) = T1 IOBUF(2) = 2HG0 IF ((IAND(ITEM(2),377B)).EQ.40B) ITEM(2) = ITEM(2) + 20B IOBUF(3) = ((IAND(ITEM(2),377B))*400B) + ((IAND(ITEM(3), +177400B))/400B) IOBUF(4) = ((IAND(ITEM(3),377B))*400B) + 60B IOBUF(5) = 2H00 IOBUF(6) = (60B + IE) * 400B C C SEND OUTPUT BUFFER C CALL EXEC (100002B,LU1,IOBUF,-11,IDUMY,0) GO TO 9000 50 CALL ABREG(IA,IB) IF (IB .LT. 0) GO TO 8500 C C CONVERT DISPLAY VOLTAGE TO ASCII CODE C IF (AMP .GE. 1.0) GOTO 60 TEMP = AMP * 10000.0 GOTO 70 60 TEMP = AMP * 100.0 70 TEMP = TEMP + .5 IX = INT(TEMP) CALL CNUMD(IX,ITEM) IOBUF(1) = T1 IF(AMP .GT. 1.0) GOTO 75 IOBUF(2) = 2H30 ITEMP = IAND(ITEM(2),177400B) IF (ITEMP .EQ. 20000B) ITEM(2) = ITEM(2) + 10000B IOBUF(3) = ITEM(2) IOBUF(4) = ITEM(3) GOTO 78 75 IOBUF(2) = (IAND(ITEM(2),377B)) + AD3 IOBUF(3) = ITEM(3) IOBUF(4) = 2H00 78 IOBUF(5) = 2H00 IOBUF(6) = 1H0 C C OUTPUT DISPLAY VOLTAGE C C FORMAT = "T13PXXQ0000" C C C OUTPUT DATA C CALL EXEC(100002B,LU1,IOBUF,-11,IDUMY,0) GOTO 9000 80 CALL ABREG(IA,IB) IF(IB.LT.0) GOTO 8500 C C CONVERT BIAS TO ASCII CODE C TEMP = (ABS(BIAV)) * 1000.0 TEMP = TEMP + 0.5 IX = INT(TEMP) CALL CNUMD(IX,ITEM) C C SET UP IOBUF C IOBUF(1) = T1 IOBUF(2) = 2HC0 IOBUF(3) = ITEM(2) IOBUF(4) = ITEM(3) IOBUF(5) = 2H0+ IF (BIAV .LT. 0.0) IOBUF(5) = 2H0- IOBUF(6) = 1H0 C C OUTPUT DATA C C FORMAT = "T1C0XXX00S0" C CALL EXEC(100002B,LU1,IOBUF,-11,IDUMY,0) GOTO 9000 90 CALL ABREG(IA,IB) IF(IB.LT.0) GOTO 8500 C C SELECT OUTPUT WAVEFORM C IOBUF(1) = T2 IOBUF(2) = 2H40 + IWA C C OUTPUT DATA C CALL EXEC(100002B,LU1,IOBUF,2,IDUMY,0) GOTO 9000 100 CALL ABREG(IA,IB) IF(IB.LT.0) GOTO 8500 C C SET UP OUTPUT BUFFER FOR OPERATING FREQUENCY DATA C DO 105 ICNT = 0,7 IF(FREQ .LT. (10.**(ICNT-3))) GOTO 108 105 CONTINUE 108 IE = ICNT TEMP = FREQ*(10.**(4-IE)) * 1000.0 TEMP = TEMP + 0.5 IX = INT(TEMP) CALL CNUMD(IX,ITEM) CALL SHFT(ITEM,IX) IOBUF(1) = T1 IOBUF(2) = IOR(AD7,ITEM(1)) IOBUF(3) = ITEM(2) IOBUF(4) = ITEM(3) IOBUF(5) = 2H00 IE = IE * 10 CALL CNUMD(IE,ITEM) IOBUF(6) = ITEM(3) IF (IE .EQ. 0) IOBUF(6) = 30000B C C OUTPUT DATA C C FORMAT = "T17MXXX000E" C CALL EXEC(100002B,LU1,IOBUF,-11,IDUMY,0) GOTO 9000 110 CALL ABREG(IA,IB) IF(IB.LT.0) GOTO 8500 C C SET UP DISPLAYED FREQUENCY C IOBUF(2) = (IAND(IOBUF(2),377B)) + AD6 C C THE REST OF IOBUF IS THE SAME AS FOR OPERATING FREQUENCY C C C OUTPUT DATA C C FORMAT = "T16MXXX000E" C CALL EXEC(100002B,LU1,IOBUF,-11,IDUMY,0) GOTO 9000 120 CALL ABREG(IA,IB) IF(IB.LT.0) GOTO 8500 C C C RETURN C 7000 IERMS = 0 RETURN C C ERROR EXIT C 8500 IERMS=IAND(IA,377B)+11 GOTO 8000 9000 IERMS=9 8000 IERMS(2)=5 IERMS(3)=2HAN IERMS(4)=2HAG IERMS(5)=2HN RETURN END C C SUBROUTINE SHFT(IBUF,IDIGT),09580-16465 REV.2026 800212 C C THIS SUBROUTINE SHIFTS THE OUTPUT FROM 'CNUMD' SO THAT THE MOST C SIGNIFICANT DIGIT IS ALWAYS IN THE LOWER EIGHT BITS OF IBUF(1). C DIMENSION IBUF(3) C IF (IDIGT.LT.0.OR.IDIGT.GT.9999) IBUF(1) = -1 IF (IDIGT.LT.0.OR.IDIGT.GT.9999) RETURN C C REPLACE IMBEDDED BLANKS WITH ZEROES C DO 50 L=1,3 IF ((IAND(IBUF(L),177400B)).EQ.20000B) IBUF(L) = IBUF(L) + 10000B IF ((IAND(IBUF(L),377B)).EQ.40B) IBUF(L) = IBUF(L) + 20B 50 CONTINUE C IF (IDIGT.GE.10) GOTO 75 IBUF(1) = IBUF(3) IBUF(2) = 2H00 IBUF(3) = 2H00 GOTO 1000 75 IF (IDIGT.GE.100) GOTO 80 IBUF(1) = (IAND(IBUF(3),177400B))/400B IBUF(2) = (IAND(IBUF(3),377B)*400B) + 60B IBUF(3) = 2H00 GOTO 1000 80 IF(IDIGT.GE.1000) GOTO 85 IBUF(1) = IBUF(2) IBUF(2) = IBUF(3) IBUF(3) = 2H00 GOTO 1000 85 IBUF(1) = (IAND(IBUF(2),177400B))/400B IBUF(2) = (IAND(IBUF(2),377B)*400B) + (IBUF(3)/400B) IBUF(3) = ((IAND(IBUF(3),377B))*400B) + 60B C 1000 RETURN END END$