FTN4,L SUBROUTINE ANASU(IU,IRG,MMDE,MOD,INT,IBI), +09580-16464 REV.2026 800212 C C------------------------------------- C C SCHLUMBERGER 1172 FREQUENCY RESPONSE ANALYZER C C RELOCATABLE 09580-16464 C SOURCE 09580-18464 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 ANASU(I,I,I,I,I,I), OV=XX, ENT=ANASU, FIL=%ANASU C C CONFIGURATION TABLE ENTRIES: C ---------------------------- C C NONE REQUIRED C C C C C------------------------------------ C C ANASU(IU,IRG,MMDE,MOD,INT,IBI) C C WHERE: C C IU = UNIT # C C IRG = INPUT RANGE C 1=AUTO C 2=10MV C 3=100MV C 4=1V C 5=10V C 6=100V C C MMDE = INPUT MODE C 1=X C 2=Y C 3=Y/X C C MOD = CARRIER MODE C 0=BOTH OFF C 1=MOD. OUTPUT C 2=DEMOD OUTPUT C 3=BOTH ON C C INT = INTEGRATION TIME C 0=MIN C 1=X10 C 2=X100 C 3=X1000 C C IBI = BIAS MODE C 0=BOTH OFF C 1=OUTPUT ADD C 2=INPUT REJECT C 3=BOTH ON C C C------------------------------------ C DIMENSION IERMS(5) DATA IDTN / 72 / DATA IERMS / 10,5,2HAN,2HAS,2HU / 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 XNASU(LU1,LUIB,IERMS,IU,IRG,MMDE,MOD,INT,IBI) 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 XNASU(LU1,LUIB,IERMS,IU,IRG,MMDE,MOD,INT,IBI), +09580-16464 REV.2026 800212 C DIMENSION IERMS(5),IOBUF(12) C INTEGER LST,ARNG,AMMDE,AMOD,AINT,AIBI C DATA LST /52062B/ DATA ARNG /34400B/ DATA AMMDE /36000B/ DATA AMOD /31400B/ DATA AIBI /31000B/ DATA AINT /37400B/ 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 IF(IRG.LT.1.OR.IRG.GT.6) GO TO 8000 IF(MMDE.LT.1.OR.MMDE.GT.3) GOTO 8000 IF(MOD.LT.0.OR.MOD.GT.3) GOTO 8000 IF(INT.LT.0.OR.INT.GT.3) GOTO 8000 IF(IBI.LT.0.OR.IBI.GT.3) GOTO 8000 C C SET UP INPUT-OUTPUT BUFFER FOR WRITE TO LATCH STORE CHARACTERS C IOBUF(1) = LST IOBUF(3) = LST IOBUF(5) = LST IOBUF(7) = LST IOBUF(9) = LST IOBUF(11) = LST C C MEASUREMENT MODE TO STOP C IOBUF(2) = 35460B C C RANGE DATA C IF (IRG.EQ.1) GOTO 30 IOBUF(4) = IOR(IOR(IRG,60B),ARNG) GOTO 40 30 IOBUF(4) = IOR(ARNG,70B) C C INPUT MODE DATA C 40 IOBUF(6) = IOR(IOR(MMDE,60B),AMMDE) C C CARRIER MODE DATA C IOBUF(8) = IOR(IOR(MOD,60B),AMOD) C C INTEGRATION TIME DATA C IOBUF(10) = IOR(IOR(INT,60B),AINT) C C BIAS MODE DATA C IOBUF(12) = IOR(IOR(INT,60B),AIBI) C C REMOTE ENABLE C CALL EXEC(100003B,1600B+LUIB) GO TO 9000 90 CALL ABREG(IA,IB) IF (IB .LT. 0) GO TO 8500 C C SEND OUTPUT BUFFER C CALL EXEC (100002B,LU1,IOBUF,12,IDUMY,0) GO TO 9000 91 CALL ABREG(IA,IB) IF (IB .LT. 0) GO TO 8500 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)=2HAS IERMS(5)=2HU RETURN END END$