FTN4,L,C
      SUBROUTINE DGNLD(IUNIT,MODE,IWORD,IBUFR,IBUFL), 
     +09580-16450 REV.2001 790803 
C 
C-------------------------------------------------------
C 
C  HP 8018A OPTION 001 PROGRAMMABLE DATA GENERATOR
C 
C  RELOCATABLE 09580-16450
C  SOURCE      09580-18450
C 
C  PROGRAMMER: ALAN SANDERSON 790803
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 HP 8018A DATA GENERATOR.
C 
C  HARDWARE REQUIRED: 
C  ------------------ 
C    A. HP 8018A WITH OPTION 001. 
C    B. HP59310B HPIB INTERFACE KIT.
C 
C         JUMPER POSITIONS: 
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    DGNLD(I,I,I,IA,I),    OV=XX,   ENT=DGNLD,   FIL=%DGNLD 
C    DGNOP(I,I,I,I),       OV=XX,   ENT=DGNOP,   FIL=%DGNLD 
C     XX=OVERLAY NUMBER 
C  CONFIGURATION TABLE ENTRIES: 
C  ---------------------------- 
C 
C    R 69,1,1 
C    U1 
C       -1     DATA NOT LOADED FLAG 
C 
C 
C 
C------------------------------------------------------ 
C    CALLING SEQUENCE:
C      CALL DGNLD(IUNIT,MODE,IWORD,IBUFR,IBUFL) 
C 
C    WHERE: 
C 
C       IUNIT = UNIT #
C 
C       MODE  = MODE OF OPERATION FOR DATA LOADING: 
C           1 = LOAD STARTING AT A ADDRESS
C           2 = LOAD STARTING AT B ADDRESS
C 
C       IWORD = STARTING WORD ADDRESS (STARTS WITH 1).
C 
C       IBUFR = INTEGER DATA ARRAY LOADED WITH 16-BIT 
C               DATA WORDS FOR SERIAL OUTPUT. 
C 
C       IBUFL = COUNT OF INTEGER DATA WORDS.
C 
C------------------------------------------------------ 
      DIMENSION IERMS(5)
      DATA IDTN / 69 /
      DATA IERMS / 10,5,2HDG,2HNL,2HD  /
C 
      IERMS=10
C 
C  FIND STATION AND LU #'S
C   ISTN = STATION #
C   LU1 = HP 8018A LU 
C   LUIB = HPIB 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 XDGSU(LU1,LUIB,IERMS,IUNIT,MODE,IWORD,IBUFR,IBUFL,0) 
      IF(IERMS)800,20,800 
C 
C 
C  ERROR EXIT 
C 
800   CALL ERROR(IERMS,IERMS(2))
20    END 
      SUBROUTINE DGNOP(IUNIT,MODE,IWPF,IBPW)
     1,09580-16450 REV.2001 790803
C 
C------------------------------------------------------ 
C    CALLING SEQUENCE:
C     CALL DGNOP(IUNIT,MODE,IWPF,IBPW)
C   WHERE:
C     IUNIT =  THE UNIT NUMBER OF THE DEVICE. 
C     MODE  =  THE OPERATIONAL MODE OF THE DEVICE.
C        0  =  TURN OFF THE DATA OUTPUT.
C        1  =  TURN ON THE DATA OUTPUT. 
C     IWPF  =  THE NUMBER OF WORDS PER FRAME, RANGE 1 TO 99, OR 
C              THE NUMBER OF BITS PER FRAME, RANGE -3 TO -2047. 
C     IBPW  =  THE NUMBER OF BITS PER WORD, OR ZERO IF BITS PER FRAME 
C              IS SPECIFIED.
C 
C 
C------------------------------------------------------ 
C 
      DIMENSION IERMS(5)
      DATA IDTN / 69 /
      DATA IERMS / 10,5,2HDG,2HNO,2HP  /
C 
      IERMS=10
C 
C  FIND STATION AND LU #'S
C   ISTN = STATION #
C   LU1 = HP 8018A LU 
C   LUIB = HPIB 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 XDGSU(LU1,LUIB,IERMS,IUNIT,MODE,IWPF,IBPW,1,1) 
      IF(IERMS)800,20,800 
C 
C 
C  ERROR EXIT 
C 
800   CALL ERROR(IERMS,IERMS(2))
20    END 
C 
C-------------------------------------------------------------------
C 
      SUBROUTINE XDGSU(LU1,LUIB,IERMS,IUNIT,MODE,IWORD,IBUFR,IBUFL,IFUN)
     +,09580-16450 REV.2001 790803
      DIMENSION IERMS(5),IBUFR(1),IREG(2),IBUF(1) 
      DIMENSION JBUF(66)
      EQUIVALENCE (REG,IREG,IA),(IREG(2),IB)
C 
      DATA IDTN/69/,ISDC/2000B/,IGET/4000B/ 
      DATA LETRA/2H A/,LETRB/2H B/,LETRM/2H M/,LETRN/2H N/,IUNL /37400B/
      DATA IGET /4000B /,IZERO/2H00/
C 
C-------------------------------------------------------------------
C 
C 
C  THE PARAMETERS IN THE CALLING SEQUENCE HAVE THE FOLLOWING
C  MEANINGS:
C 
C     LU1  = LU # OF THE HP 8018A DATA GENERATOR. 
C     LUIB = LU # OF THE HPIB BUS INTERFACE.
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        3 = ATTEMPT WAS MADE TO TURN ON OUTPUT BEFORE BUFFER WAS LOADED. 
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     IUNIT = THE UNIT NUMBER OF THE 8018A. 
C 
C     MODE  = THE OPERATIONAL MODE FOR THE FUNCTION BEING PERFORMED:
C             SEE DESCRIPTION UNDER IFUN. 
C 
C     IWORD = THE WORD NUMBER INTO WHICH THE FIRST DATA WORD WILL BE
C             LOADED (RANGE: 1 TO 64) [IFUN = 0], 
C             OR, FOR [IFUN=1], 
C             THE NUMBER OF WORDS PER FRAME OF DATA (1 TO 99), OR 
C             THE NUMBER OF BITS PER FRAME OF DATA (-3 TO -2048). 
C 
C     IBUFR = THE OUTPUT DATA BUFFER (16 BIT BINARY WORDS IN AN ARRAY - 
C             BIT 15 OF WORD 1 GOES OUT FIRST) [IFUN = 0], OR 
C             THE NUMBER OF BITS PER WORD OF DATA (IGNORED IF IWORD IS
C             NEGATIVE) [IFUN = 1]. 
C 
C     IBUFL = THE NUMBER OF WORDS IN IBUFR [IGNORED IF IFUN = 1]. 
C 
C     IFUN  = THE FUNCTION OF THIS CALL:
C             0 = LOAD DATA INTO THE MEMORY.
C                 MODE = 1  START LOADING THE A MEMORY. 
C                 MODE = 2  START LOADING THE B MEMORY. 
C             1 = PROGRAM THE OUTPUT. 
C                 MODE = 0  TURN OFF OUTPUT.
C                           (ADDITIONAL PARAMETERS NOT USED.) 
C                 MODE = 1  TURN ON OUTPUT. 
C                           (REQUIRES FRAMING PARAMETERS.)
C 
C-------------------------------------------------------------------
C 
C 
C  RETRIEVE CONFIGURATION DATA
C 
      CALL TIM(IDTN,IUNIT,1,IBUF,1,IER) 
      IF(IER .NE. 0)RETURN
      IERMS = 1 
C 
C  CHECK THE INPUT PARAMETERS 
C 
C  CHECK THE FUNCTION 
C 
      IF(IFUN.EQ.0)GO TO 1000 
      IF(IFUN.EQ.1)GO TO 2000 
      GO TO 8000
C 
C  PROCESS SETUP CALL 
C 
1000  LETTR=0 
      IF(MODE.EQ.1)LETTR=LETRA
      IF(MODE.EQ.2)LETTR=LETRB
      IF(LETTR.EQ.0)GO TO 8000
      JBUF(1)=LETTR 
C 
C  CHECK FOR PROPER ADDRESS RANGE OF 1 TO 64
C  AND PROPER BUFFER LENGTH CONSISTENT WITH THE STARTING ADDRESS. 
C 
      IF(IWORD.LT.1)GO TO 8000
      IF(IBUFL.LT.1)GO TO 8000
C 
C  MAX LENGTH = STARTING ADDR. + BUFFER LENGTH + 1
C 
      IF((IWORD+IBUFL).GT.65)GO TO 8000 
C 
C  SINCE WE HAVE TO STUFF COMMANDS INTO THE DATA BUFFER, WE MUST USE
C  A PACKING BUFFER INSIDE THE SUBROUTINE.  THIS JBUF IS 66 WORDS LONG. 
C  THE BINARY DATA IS PUT INTO JBUF FOR TRANSMISSION. 
C 
C  GENERATE THE STARTING ADDRESS
C 
      JWORD=IWORD 
      NWRDS=IBUFL 
C 
C 
      JBLEN=IBUFL+2 
C 
C  CONVERT STARTING ADDRESS TO ASCII WITH LEADING ZERO. 
C 
      JBUF(2)=IOR(IZERO,KCVT(JWORD))
C 
C  REVERSE THE BYTE ORDER BECAUSE THE 8018 HANDLES THE
C  BYTES IN THE OPPOSITE ORDER, I.E., IT EXPECTS THE
C  LOW BYTE FIRST, AND THE COMPUTER SENDS THE HIGH BYTE 
C  FIRST. 
C 
      DO 1004 I=3,JBLEN 
      ILBYT=IBUFR(I-2)
      ISIGN=0 
      IF(ILBYT.GE.0)GO TO 1001
C 
C  PROCESS NEGATIVE SIGN
C 
      ISIGN=200B
      ILBYT=IAND(77777B,ILBYT)
1001  IHBYT=IAND(377B,ILBYT)*256
      ILBYT=ILBYT/256+ISIGN 
1004  JBUF(I)=IOR(ILBYT,IHBYT)
C 
C  SEND A REMOTE ENABLE 
C 
      CALL EXEC(100003B,1600B+LUIB) 
      GO TO 9000
70    CALL ABREG(IA,IB) 
      IF(IB.LT.0)GO TO 8500 
C 
C  SEND SDC 
C 
      CALL EXEC(100003B,LU1)
      GO TO 9000
75    CALL ABREG(IA,IB) 
      IF(IB.LT.0)GO TO 8500 
C 
C  SEND OUTPUT BUFFER 
C 
      CALL REIO(100002B,100B+LU1,JBUF,JBLEN)
      GO TO 9000
71    CALL ABREG(IA,IB) 
      IF(IB.LT.0)GO TO 8500 
C 
C  SEND UNLISTEN
C 
      CALL EXEC(100002B,10000B+LUIB,IDUMY,0,IUNL,-1)
      GO TO 9000
76    CALL ABREG(IA,IB) 
      IF(IB.LT.0)GO TO 8500 
C 
C 
C  CHECK TO SEE IF TIM FLAG HAS BEEN SET. 
C 
      IF(IBUF.EQ.1)GO TO 7000 
C 
C  IF THE DEVICE WAS LOADED, SET THE FLAG.
C 
      IBUF=1
      CALL TIM(IDTN,IUNIT,2,IBUF,1,IER) 
      IF(IER.NE.0)RETURN
      GO TO 7000
C 
C  PROGRAM THE OUTPUT 
C 
C  RETRIEVE THE CONFIGURATION DATA
C 
2000  CALL TIM(IDTN,IUNIT,1,IBUF,1,IER) 
      IF(IER.NE.0)RETURN
C 
C  IF DATA HAS NOT BEEN LOADED, REJECT THE OUTPUT CALL. 
C 
      IERMS=3 
      IF(IBUF.NE.1)GO TO 8000 
      IERMS=1 
C 
C  CHECK MODE FOR 0 OR 1
C 
      IF(MODE.EQ.0)GO TO 2015 
      IF(MODE.NE.1)GO TO 8000 
C 
C  CHECK INPUT PARAMETERS 
C 
      IF(IWORD.GT.0)GO TO 2005
      IF(IWORD.GT.-3.OR.IWORD.LT.-2048)GO TO 8000 
      JWORD=-IWORD/100
      LWORD=-IWORD-JWORD*100
      GO TO 2010
2005  IF(IWORD.GT.99)GO TO 8000 
      IF(IBUFR.LT.3.OR.IBUFR.GT.99)GO TO 8000 
      JWORD=IWORD 
      LWORD=IBUFR 
2010  JBUF(1)=LETRN 
      JBUF(2)=IOR(IZERO,KCVT(JWORD))
      JBUF(3)=LETRM 
      JBUF(4)=IOR(IZERO,KCVT(LWORD))
C 
C  REMOTE ENABLE
C 
2015  CALL EXEC(100003B,1600B+LUIB) 
      GOTO 9000 
72    CALL ABREG(IA,IB) 
      IF(IB .LT. 0) GOTO 8500 
C 
C  CHECK THE MODE AGAIN 
C 
      IF(MODE.EQ.0)GO TO 2020 
C 
C  SEND OUTPUT BUFFER 
C 
      CALL REIO(100002B,100B+LU1,JBUF,4)
      GOTO 9000 
73    CALL ABREG(IA,IB) 
      IF(IB .LT. 0) GOTO 8500 
C 
C  SEND A "GET" CONTROL FUNCTION
C 
      CALL EXEC(100002B,10000B+LU1,IDUMY,0,IGET,-1) 
      GO TO 9000
74    CALL ABREG(IA,IB) 
      IF(IB.LT.0)GO TO 8500 
      GO TO 7000
C 
C  SEND SDC FOR TURN OFF OUTPUT 
C 
2020  CALL EXEC(100003B,LU1)
      GO TO 9000
77    CALL ABREG(IA,IB) 
      IF(IB.LT.0)GO TO 8500 
C 
C 
C  GOOD EXIT
C 
7000  IERMS=0 
      GO TO 8000
C 
C  ERROR EXIT 
C 
8500  IERMS=IAND(IA,377B)+11
      GOTO 8000 
9000  IERMS=9 
8000  RETURN
      END 
      END$