FTN4,L SUBROUTINE VARPG(IU,IC,IFU,FREQ,AMP,FSET,PHASE), +09580-16308 1926 790502 C C------------------------------------- C C WAVETEK 152 VARIPHASE GENERATOR C (VARPG) C C RELOCATABLE 09580-16308 C SOURCE 09580-18308 C C V.POVIO 780510 REV. A C C BOB RICHARDS 790502 C C------------------------------------ C C !=================================================! C ! ! C ! (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979 ! 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 PROPRIETY ! C ! MATERIAL OF THE HEWLETT-PACKARD COMPANY. ! C ! ! C ! THIS SOURCE DATA SHALL BE USED SOLELY IN ! C ! CONJUCTION WITH ELECTRONIC COMPUTER SYSTEMS ! C ! SUPPLIED TO THE USER BY HEWLETT-PACKARD. ! C ! ! C ! THIS PROPRIETY 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 WAVETEK 152 VARIPHASE GENERATOR. C C HARDWARE REQUIRED: C ------------------ C A. WAVETEK 152 VARIPHASE GENERATOR. C B. HP59310 BUSS 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 VARPG(I,I,I,R,R,R,R), OV=XX, ENT=VARPG, VARPG C C C------------------------------------ C C VARPG(IU,IC,IFU,FREQ,AMP,FSET,PHASE) C C WHERE: C C IU = UNIT # C C IC = CHANNEL # (1-9) C C IFU = FUNCTION C 0 = SINE C 1 = COSINE C 2 = TRIANGLE C 3 = VARIPHASE SINE C 4 = DC C 5 = SQUARE C 6 = VARIPHASE SQUARE C C FREQ = FREQUENCY C 1.00 HZ TO 100 KHZ (3 DIGIT RESOLUTION) C C AMP = AMPLITUDE PEAK VOLTAGE C DC = -9.99 VDC TO +9.99 VDC (3 DIGIT RESOLUTION) C ALL OTHERS = .010 VOLTS TO 9.99 VOLTS C * IF "-" INDICATES INVERTED SIGNAL. C * TRIANGLE AND VARIPHASE SIN CANNOT BE INVERTED. C C FSET = OFFSET C -9.99 TO +9.99 C * SIGNAL LEVEL PLUS OFFSET VOLTAGE MUST NOT C EXCEED +/- 9.99 VOLTS PEAK. C C PHASE = PHASE ANGLE C 000.0 TO 359.9 DEGREES (.1 DEGREE RESOLUTION) C C------------------------------------ DIMENSION IERMS(5) DATA IDTN / 50 / DATA IERMS / 10,5,2HVA,2HRP,2HG / C IERMS=10 C C FIND STATION AND LU #'S C ISTN = STATION # C LU1 = WTK 152 LU C LUIB = 59310 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 XARPG(LU1,LUIB,IERMS,IU,IC,IFU,FREQ,AMP,FSET,PHASE) 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 XARPG(LU1,LUIB,IERMS,IU,IC,IFU,FREQ,AMP,FSET,PHA), +09580-16308 1926 790502 DIMENSION IERMS(5),IOBUF(30),IFS(6),IAS(6),IOS(6),IPS(6) DIMENSION IMUL(6) DATA IMUL /2,1,0,-1,-2,-3/ C C--------------------------------------------- C C C THE PARAMETERS IN THE CALLING SEGUENCE HAVE THE FOLLOWING C MEANINGS. C C LUIB = LU # OF HPIB BUSS. C LU1 = LU # OF WAVETEK 152 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 CHECK PARAMETERS C IERMS=1 IF(IC .LT. 1 .OR. IC .GT. 9) GOTO 8000 IF(IFU .LT. 0 .OR. IFU .GT. 6) GOTO 8000 IF(FREQ .LT. 1.0 .OR. FREQ .GT. 99900.0) GOTO 8000 IF(AMP .LT. -9.99 .OR. AMP .GT. 9.99) GOTO 8000 IF(FSET .LT. -9.99 .OR. FSET .GT. 9.99) GOTO 8000 IF(PHA .LT. 0.0 .OR. PHA .GT. 359.9) GOTO 8000 C C CLEAR BUFFERS C DO 850 J=1,6 IFS(J)=20040B IAS(J)=20040B IOS(J)=20040B IPS(J)=20040B 850 CONTINUE C C SET UP OUTPUT BUFFER C IOBUF(1)=2HB0+IC IOBUF(2)=2HC0+IFU C C FREQUENCY C I1=0 IF(FREQ .GT. 9.99) I1=1 IF(FREQ .GT. 99.9) I1=2 IF(FREQ .GT. 999.0) I1=3 IF(FREQ .GT. 9990.0) I1=4 FREQ1=(FREQ*10.0**(IMUL(I1+1))) IFREQ=(FREQ1+.001) FREQ=IFREQ CALL F2A(FREQ,IFS(1)) IOBUF(3)=2H F IOBUF(4)=IFS(2) IOBUF(5)=(IAND(IFS(3),177400B))+105B IOBUF(6)=(30000B+(I1*2**8))+101B C C AMPLITUDE C I2=0 IF(AMP .LT. 1.0)I2=1 IF(AMP .LT. 0.1)I2=2 AMP=AMP*10.0**(I2) IAMP=INT(AMP*100) AMP=IAMP CALL F2A(AMP,IAS) IOBUF(7)=IAS(2) IOBUF(8)=(IAND(IAS(3),177400B))+105B IOBUF(9)=(30000B+(I2*2**8))+104B C C OFFSET C I3=0 IF(FSET .LT. 0.0) I3=1 IF(FSET .LT. 0.0) FSET=-FSET IFSET=INT(FSET*100.0) FSET=IFSET CALL F2A(FSET,IOS) IOBUF(10)=IOS(2) I4=40B IF(I3 .GT. 0.0)I4=55B IOBUF(11)=(IAND(IOS(3),177400B))+I4 C C PHASE C IPHA=INT(PHA*10.0) PHA=IPHA CALL F2A(PHA,IPS) IOBUF(12)=2H H IOBUF(13)=IPS(2) IOBUF(14)=IPS(3) IOBUF(15)=2HI INUM=15 C C REMOTE ENABLE C 2000 CALL EXEC(100003B,1600B+LUIB) GOTO 9000 70 CALL ABREG(IA,IB) IF(IB .LT. 0) GOTO 8500 C C SEND OUTPUT BUFFER C CALL REIO(100002B,LU1,IOBUF(1),INUM,IDUMY,0) GOTO 9000 71 CALL ABREG(IA,IB) IF(IB .LT. 0) GOTO 8500 C C C RETURN C 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)=2HVA IERMS(4)=2HRP IERMS(5)=2HG RETURN END END$