FTN4,L
      SUBROUTINE SFAMP(IUNIT,AMP,AOFST,ISCL,IOUT),
     +09580-16311 REV.2001 791023 
C 
C-------------------------------------
C 
C  HP 3325A SYNTHESIZER*FUNCTION GENERATOR
C      (SFAMP)
C 
C  RELOCATABLE   09580-16311
C  SOURCE        09580-18311
C 
C  R.UNTALAN 780917    REV. A 
C  R.UNTALAN 790606 
C  BOB RICHARDS 790607
C  R.UNTALAN 790625 
C  BOB RICHARDS  791023 
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 PROPRIETARY  !
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 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 HP3325A SYNTHESIZER*FUNCTION GENERATOR.
C 
C  HARDWARE REQUIRED: 
C  ------------------ 
C    A. HP3325A PROGRAMMABLE PULSE GENERATOR. 
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    SFAMP(I,R,R,I,I), OV=XX,   ENT=SFAMP,   FIL=%SFAMP 
C 
C  CONFIGURATION TABLE ENTRIES: 
C  ---------------------------- 
C 
C 
C    R  29,1,4
C    U1 
C        0    ENTER 0 FOR STANDARD UNIT  OR  1 FOR OPT.002
C        0    FUNCTI0N WAVEFORM TEMPORARY STORAGE 
C        0.0  TEMPORARY STORAGE FOR DC-OFFSET 
C 
C 
C 
C 
C 
C------------------------------------ 
C 
C  SFAMP(IUNIT,AMP,AOFST,ISCL,IOUT) 
C 
C    WHERE: 
C 
C       IUNIT = UNIT #
C 
C       AMP   = AMPLITUDE 
C               STANDARD UNIT 
C               ------------- 
C 
C               ALL WAVEFORM FUNCTIONS
C               ----------------------
C               peak-peak = 1.000mV TO 10.00 VOLTS
C 
C               SINE FUNCTION 
C               ------------- 
C               rms= 0.354mV TO 3.536 VOLTS 
C               dBm(50 OHM) = -56.02  TO  +23.98
C 
C 
C               SQUARE FUNCTION 
C               --------------- 
C               rms= 0.500mV  TO  5.000 VOLTS 
C               dBm(50 OHM) = -53.01 TO +26.99
C 
C 
C               TRIANGLE/RAMPS FUNTIONS 
C               ----------------------- 
C               rms= 0.289mV  TO  2.887 VOLTS 
C               dBm(50 OHM) = -57.78  TO +22.22 
C 
C 
C               DC ONLY FUNCTION
C               ----------------
C               AMPLITUDE MUST BE SET TO ZERO.
C 
C 
C       AOFST = OFFSET
C              DC only(no ac signal): 0 TO +-5.0V 50 OHM
C              IF UNIT HAS OPTION .002 : .01MV TO 20V 500OHM
C              DC+AC: Maximum dc offset +-4.5 V on highest range
C                     decreasing to +-4.5mV on lowest range.
C                     IF UNIT HAS OPT.002 ,MULTIPLY MINIMUM AND 
C                     MAXIMUM BY 4. 
C 
C 
C 
C       ISCL = UNITS SCALE
C              0= peak-peak 
C              1= rms 
C              2= dBm 
C 
C 
C      IOUT = OUTPUT SELECT 
C 
C           IN STANDARD INSTRUMENTS IOUT CONTROLS THE OUTPUT
C            SIGNAL ROUTING.
C 
C            0 = REAR 
C            1 = FRONT
C 
C          IF UNIT IS AN OPT.002 (HIGH VOLTAGE) IOUT CONTROLS THE 
C          HIGH OUTPUT VOLTAGE. 
C 
C            0 = HIGH VOLTAGE OFF 
C            1 = HIGH VOLTAGE ON
C 
C 
C 
C------------------------------------ 
      DIMENSION IERMS(5)
      DATA IDTN / 29 /
      DATA IERMS / 10,5,2HSF,2HAM,2HP  /
C 
      IERMS=10
C 
C  FIND STATION AND LU #'S
C   ISTN = STATION #
C   LU1 = HP 3325A LU 
C   LUIB = 59310 LU 
C 
      ISTN=ISN(DUMMY) 
      LU1=LUDV(ISTN,IDTN,IUNIT) 
      LUIB=IBLU0(LU1) 
      IF(LU1 .LE. 0 .OR. LUIB .LE. 0)GOTO 800 
C 
C  CALL X SUB 
C 
      CALL XFAMP(LU1,LUIB,IERMS,IUNIT,AMP,AOFST,ISCL,IOUT)
      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 XFAMP(LU1,LUIB,IERR,IU,AMP,AOFST,ISCL,IOUT), 
     +09580-16311 REV.2001 791023 
C---------------------------------------------
C 
C 
      DIMENSION IOBUF(20),IERR(5),IVAL(10),IREG(2),IALRM(5) 
      DIMENSION IOFF(10),IBUF(4),COFF(2)
      EQUIVALENCE (REG,IREG,IA),(IREG(2),IB),(IBUF(1),COFF(1))
C 
C 
C 
C 
C 
C  READ FROM ALLFL TO DETERMINE IF STD. OR OPT.002
C IF OPT.002 MAX. IS 40 VOLTS AND MIN. IS 4 MV. 
C 
C  IBUF(1)= 0  STD. UNIT
C           1  OPT. 002 
C 
C  IBUF(2)= WAVEFORM FUNCTION 
C         =0   SINE WAVE
C         =1   SQUARE WAVE
C         =2   TRIANGLE WAVE
C         =3   POS. RAMP
C         =4   NEG. RAMP
C         =5   DC ONLY
C 
C 
      CALL TIM(29,IU,1,IBUF,4,IER)
      IF(IER .NE. 0) RETURN 
C 
C 
      IERR=0
C 
      FMAX=1.0
      IF(IBUF .EQ. 1 .AND. IOUT .EQ. 1) FMAX=4.0
C 
C 
C 
C SET P-P LIMITS FOR ALL WAVEFORMS
C 
      AMIN=.001*FMAX
      AMAX=10.00*FMAX 
      IF(IBUF(2) .EQ. 5) AMIN=0.0 
C 
C 
C  DETERMINE RANGE OF AMPLITUDE AND THEN DETERMINE
C  THE MAXIMUM OFFSET LIMITS BASED ON 
C  THE AMPLITUDE RANGE. 
C 
C 
C 
C 
      PPV=AMP 
C 
C 
      IF(ISCL .EQ. 0) GOTO 90 
C 
C 
      IF(ISCL .EQ. 1) GOTO 75 
C 
C 
C 
C  CONVERT DBM TO RMS THEN CONVERT RMS TO P-P VALUE 
C 
      RMS= 10.0**(AMP/20.0)*.2236 
      GOTO 89 
C 
C 
75    RMS=AMP 
C 
C 
C SINE WAVE 
C 
89    IF(IBUF(2) .EQ. 0) PPV=RMS*2.828
C 
C SQUARE WAVE 
C 
      IF(IBUF(2) .EQ. 1) PPV=RMS*2
C 
C TRIANGLE AND RAMPS
C 
      IF(IBUF(2) .GE. 2) PPV=RMS*3.4632 
C 
C 
C 
C 
C DETERMINE RANGE OF AMPLITUDE
C 
90    IF((PPV .GE. .001*FMAX) .AND. (PPV .LT. .003334*FMAX)) IRNG=7 
C 
      IF((PPV .GE. .003334*FMAX) .AND. (PPV .LT. .01000*FMAX)) IRNG=6 
C 
      IF((PPV .GE. .0100*FMAX) .AND. (PPV .LT. .03334*FMAX)) IRNG=5 
C 
      IF((PPV .GE. .03334*FMAX) .AND. (PPV .LT. .10000*FMAX)) IRNG=4
C 
      IF((PPV .GE. .100*FMAX) .AND. (PPV .LT. .3334*FMAX)) IRNG=3 
C 
      IF((PPV .GE. .3334*FMAX) .AND. (PPV .LT. 1.000*FMAX)) IRNG=2
C 
      IF((PPV .GE. 1.000*FMAX) .AND. (PPV .LE. 10.000*FMAX)) IRNG=1 
C 
C 
C DETERMINE ATTENUATION FACTOR
C 
      IF(IRNG .EQ. 7) ATT=1000
C 
      IF(IRNG .EQ. 6) ATT=300 
C 
      IF(IRNG .EQ. 5) ATT =100
C 
      IF(IRNG .EQ. 4) ATT =30 
C 
      IF(IRNG .EQ. 3) ATT=10
C 
      IF(IRNG .EQ. 2) ATT=3 
C 
      IF(IRNG .EQ. 1) ATT=1 
C 
C 
C DETERMINE MINIMUM AND MAXIMUM DC OFFSET 
C 
C 
      PMAX=5.0*FMAX 
      PMIN=0
C 
C 
      IF(PPV .EQ. 0) GOTO 5 
C 
      PMAX=((5*FMAX/ATT)-(PPV/2)) 
C 
C 
5     IF(ISCL .EQ. 0) GOTO 100
C 
C DETERMINE WHICH WAVEFORM
C 
      IF(IBUF(2)-1)10,20,30 
C 
C 
C ********SINE WAVE************ 
C 
10    IF(ISCL-2)12,13 
C 
C  SET RMS LIMITS 
12    AMIN=.000354*FMAX 
      AMAX=3.536*FMAX 
      GOTO 100
C 
C  SET dBM LIMITS 
13    AMIN=-56.02 
      AMAX=23.98
C 
      IF(IBUF(1) .EQ. 0) GOTO 100 
C 
      AMIN=-43.94 
      AMAX=36.02
C 
      GOTO 100
C 
C 
C*********SQUARE WAVE ************* 
C 
20    IF(ISCL-2)22,23 
C 
C  SET RMS LIMITS 
22    AMIN=.0005*FMAX 
      AMAX=5.*FMAX
C 
      IF(IBUF(1) .EQ. 0) GOTO 100 
C 
      AMIN=-40.96 
      AMAX=39.03
C 
      GOTO 100
C 
C  SET dBM LIMITS 
23    AMIN=-53.01 
      AMAX=26.99
      GOTO 100
C 
C 
C***********TRIANGLE AND RAMP************ 
C    OR DC ONLY...IF DC ONLY THEN LIMITS ARE
C    ALREADY ESTABLISHED. 
C 
30    IF(IBUF(2) .EQ. 5) GOTO 100 
      IF(ISCL-2) 32,33
C 
C  SET RMS LIMITS 
32    AMIN=.0002890*FMAX
      AMAX=2.887*FMAX 
      GOTO 100
C 
C 
C  SET dBM LIMITS 
33    AMIN=-57.78 
      AMAX=22.22
C 
      IF(IBUF(1) .EQ. 0) GOTO 100 
C 
      AMIN=45.70
      AMAX=34.26
C 
C 
C CHECK PARAMETERS
C 
C 
C 
C 
C 
C*******************
C 
C 
C 
100   IF(AMP .LT. AMIN .OR. AMP .GT. AMAX) GOTO 8000
      IF(ISCL .LT. 0 .OR. ISCL .GT. 2) GOTO 8000
      BOFST=ABS(AOFST)
      IF (BOFST .GT. PMAX) GOTO 8000
C 
C 
C CLEAR OUTPUT BUFFER AND STRING BUFFER 
C 
      DO 88 I=1,10
      IVAL(I)=2H
      IOBUF(I)=2H 
88    IOFF(I)=2H
C 
C 
C PROCESS AMPLITUDE PARAMETER 
C 
      BMP=ABS(AMP)
      N=2 
      IFLAG=0 
C 
C 
40    IF(IFLAG .EQ. 0 .AND. ISCL .EQ. 2) GOTO 111 
C 
C FIND OUT HOW LARGE IS THE AMPLITUDE 
C 
      DO 44 I=1,-3,-1 
      FXP=FLOAT(I)
      IF(BMP .GE. 10.0**FXP) GOTO 111 
44    N=N+1 
      N=6 
C 
C 
C PROCESS ONLY FOUR SIGNIFICANT DIGITS
C 
111   CALL PDEC(BMP,N,XMP)
C 
C 
      IF(IFLAG .EQ. 1) GOTO 1000
C 
C 
      IF(AMP .LT. 0.) XMP=-XMP
C 
      IF(ABS(XMP) .LT. 1) GOTO 800
C 
C 
C 
      CALL F2A(XMP,IVAL)
C 
C 
C 
      GOTO 900
C 
C 
C PROCESS AMPLITUDE OR OFFSET  ONLY FOR VALUES <1 MV
C 
C 
800   XMP=ABS(XMP)+.0005
      IX1=INT(ABS(XMP)*10.) 
      IX2=INT(ABS(XMP)*100.)-(IX1*10) 
      IX3=INT(ABS(XMP)*1000.)-(IX1*100)-(IX2*10)
      ID1=IX1*2**8+30000B 
      ID2=IX2+60B 
      ID3=IX3+60B 
C 
      IF(IFLAG .EQ. 1) GOTO 1100
C 
C 
C 
C 
C 
      IF(XMP .LT. 0) IVAL(2)=2H-. 
      IF(XMP .LT. 0) IVAL(3)=IOR(ID1,ID2) 
C 
C 
      IF(XMP .GT. 0) IVAL(2)=27060B+IX1 
      IF(XMP .GT. 0) IVAL(3)=ID2*2**8 
      IF((XMP .GT. 0) .AND. (ISCL .NE. 2)) IVAL(3)=IOR(IVAL(3),ID3) 
      IVAL(4)=2H
C 
C 
900   IOBUF(3)=2HAM 
      IOBUF(4)=IVAL(2)
      IOBUF(5)=IVAL(3)
      IOBUF(6)=IAND(177440B,IVAL(4))
      IF((ISCL .EQ. 2) .AND. (AMP .LT. 0))IOBUF(6)=IVAL(4)
      IOBUF(7)=2HMV 
      IF((ISCL .EQ. 0) .AND. (AMP .GE. 1.0)) IOBUF(7)=2HVO
      IF((ISCL .EQ. 1) .AND. (AMP .GE. 1.0)) IOBUF(7)=2HVR
      IF((ISCL .EQ. 1) .AND. (AMP .LT. 1.0)) IOBUF(7)=2HMR
      IF(ISCL .EQ. 2) IOBUF(7)=2HDB 
C 
C 
C 
C PROCESS OFFSET PAREMETER
C*************************
C 
      BMP=ABS(AOFST)
      N=2 
      IFLAG=1 
      GOTO 40 
C 
C 
1000  IF(AOFST .LT. 0) XMP=-XMP 
C 
      IF(ABS(XMP) .LT. 1) GOTO 800
C 
C 
      CALL F2A(XMP,IOFF)
C 
      GOTO 1200 
C 
C 
1100  IOFF(2)=2H-.
      IOFF(3)=IOR(ID1,ID2)
      ID3=ID3*2**8
      IOFF(4)=IOR(ID3,40B)
C 
C 
      IF(AOFST .GT. 0.) IOFF(2)=2H+.
C 
C 
C 
1200  IOBUF(8)=2HOF 
      IOBUF(9)=IOFF(2)
      IOBUF(10)=IOFF(3) 
      IOBUF(11)=IOFF(4) 
      IF(ABS(AOFST) .LT. 1.0) IOBUF(12)=2HMV
      IF(ABS(AOFST) .GE. 1.0) IOBUF(12)=2HVO
C 
C 
C  IF PREVIOUS OFFSET IS GREATER THAN THE ALLOWED 
C  OFFSET FOR THE CURRENT AMPLITUDE THEN OUTPUT THE 
C  OFFSET PARAMETER FIRST AND AMPLITUDE SECOND. 
C 
      IF (COFF(2)  .LT. PMAX) GOTO 221
C 
C   REARRANGE OUTPUT BUFFER 
C 
      DO 210 I=3,7
      ITEMP=IOBUF(I)
      IOBUF(I)=IOBUF(5+I) 
210   IOBUF(5+I)=ITEMP
C 
C 
C 
C 
C  PROCESS OUTPUT SIGNAL CONTROL
C 
221   IOBUF(1)=2HRF 
      IF(IBUF(1) .EQ. 1) IOBUF(1)=2HHV
C 
      IOBUF(2)=2H1
      IF(IBUF(1) .EQ. 1 .AND. IOUT .EQ. 0) IOBUF(2)=2H0 
      IF(IBUF(1) .EQ. 0 .AND. IOUT .EQ. 0) IOBUF(2)=2H2 
C 
C 
C  STORE OFFSET AND FUNCTION BACK INTO CONFIGURATION TABLE
C 
      COFF(2)=BOFST 
C 
      CALL TIM(29,IU,2,IBUF,4,IER)
C 
C 
C 
C 
C 
C 
C 
C 
1990  KOUNT=12
      ICNT=10 
C 
C 
C  REMOTE ENABLE
C 
2000  CALL EXEC(100003B,1600B+LUIB) 
      GOTO 9000 
2010  CALL ABREG(IA,IB) 
      IF(IB .LT. 0) GOTO 8500 
C 
C 
2015  CALL REIO(100002B,LU1,IOBUF(1),KOUNT,IDUMY,0) 
      GOTO 9000 
C 
C 
2030  CALL ABREG(IA,IB) 
      IF(IB .LT. 0) GOTO 8500 
C 
C 
C 
C 
C 
C CLEAR SRQ 
C 
C 
      CALL EXEC(100003B,600B+LU1) 
      GOTO 9000 
2100  CALL ABREG(IA,IB) 
      IF(IB .LT. 0) GOTO 8500 
      IERMS=0 
      RETURN
C 
C 
C 
C-----------------------------
C 
C ERROR EXIT
C 
8000  IERR=1
      GOTO 8800 
C 
C 
9000  IERR=9
      GOTO 8800 
8500  IERR=IAND(IREG,377B)+11 
8800  IERR(2)=5 
      IERR(3)=2HSF
      IERR(4)=2HAM
      IERR(5)=2HP 
      RETURN
      END 
C===================================
C 
C 
      SUBROUTINE PDEC(ANUM,IND,BNUM), 
     +09580-16311 REV.2001 791023 
C 
C THIS SUBROUTINE POSITIONS THE DECIMAL POINT 
C SO THAT ONLY A MAXIMUM OF FOUR SIGNIFICANT
C DIGITS ARE RETURNED.
C 
      DO 555 I=1,IND
555   ANUM=ANUM*10.0
C 
      ANUM=ANUM+.05 
C 
C 
      INUM=INT(ANUM)
      BNUM=FLOAT(INUM)
C 
C 
      IF(IND .LT. 4) IND=IND+3
      MAX=IND-3 
C 
C 
      DO 300 I=1,MAX
300   BNUM=BNUM/10.0
C 
C 
      RETURN
C 
C 
C======================================== 
      END 
      END$