FTN4,L
      SUBROUTINE DSVMU(IUNIT,ABUF,IN),
     +09580-16137 REV.2001 791113 
C************************************************************** 
C 
C     RELOC.       09580-16137
C     SOURCE       09580-18137
C 
C     R. UNTALAN      4 15 77     REV. A
C     R. UNTALAN      770901
C     R. UNTALAN      790112
C     R. UNTALAN      790727
C     BOB RICHARDS    791113
C 
C     HP 92425B TEST SYSTEM SOFTWARE IS THE PROPRIETARY 
C     MATERIAL OF THE HEWLETT-PACKARD COMPANY.  USE AND 
C     DISCLOSURE THEREOF ARE RESTRICTED BY WRITTEN AGREEMENT. 
C 
C     (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. 
C     ALL RIGHTS RESERVED.  NO PART OF THIS PROGRAM 
C     MAY BE PHOTOCOPIED, REPRODUCED OR TRANSLATED
C     TO ANOTHER PROGRAM LANGUAGE WITHOUT THE PRIOR 
C     WRITTEN CONSENT OF THE HEWLETT-PACKARD COMPANY. 
C 
C 
C************************************************************** 
C 
C  GENERAL
C  -------
C     THE FOLLOWING DEVICE SUBROUTINE WILL ALLOW THE APPLICATION
C  PROGRAMMER TO MAKE MEASUREMENTS WITH THE 3437A. IT WILL PROGRAM
C  THE DESIRED NUMBER OF READINGS ALONG WITH THE MODE OF DATA 
C  TRANSFER.
C 
C  HARDWARE ENVIRONMENT:
C  ---------------------
C 
C     21MX SERIES COMPUTER
C     HP 3437A SYSTEM VOLTMETER 
C     HP 59310A/B INTERFACE BUS I/O KIT 
C 
C 
C    BRANCH AND MNEMONIC TABLE ENTRIES
C    ---------------------------------
C    DSVMU(I,RVA,I),     OV=XX,       ENT=DSVMU, FIL=%DSVMU 
C 
C 
C  BUFFER FOR NUMBER OF READINGS (3 WORDS)
C  ---------------------------------------
C 
C     WORD 1 =NX    WHERE ASCII N IS THE PREFIX FOR NO. OF READINGS.
C                   X = ASCII NUMBER 0-9
C     WORD 2 =XX
C     WORD 3 =XS    ASCII S = STORE COMMAND 
C 
C 
C  INPUT WORD FORMAT
C  -----------------
C 
C               8----DIO------1 
C     1RST BYTE 1 0 1 0 0 0 1 1 
C               --- - - ------- 
C              !R  !S!M!  2SD  !
C              !M  !B!S!       !
C                    !D!
C 
C     2ND  BYTE 0 0 1 0 0 1 0 0 
C              ! 3SD   !  LSD  !
C 
C    RM= RANGE MULTIPLIER 
C    SB= SIGN BIT 
C    MSD= MOST SIGNIFICANT DIGIT
C    2SD= SECOND SIGNIFICANT DIGIT
C    3SD= THIRD SIGNIFICANT DIGIT 
C    LSD= LEAST SIGNIFICANT DIGIT 
C 
C  EACH READING IS FIRST CONVERTED TO ASCII THEN IT IS
C  CONVERTED TO A FLOATING POINT NUMBER SO THAT IT CAN
C  BE USED BY BASIC.
C   THE DATA IS TRANSFERED DIRECTLY TO THE CALLING PROGRAM
C   VIA SAM . 
C 
C***************************************************************
      DIMENSION IERMS(5)
      DIMENSION ABUF(250) 
      DATA IDTB/9/
      DATA IDTN/43/ 
      DATA IERMS/10,5,2HDS,2HVM,2HU / 
C 
C 
C  INTERFACE MODULE FOR HP3437A MEASUREMENT DEVICE
C  SUBROUTINE.
C 
C 
      IERMS=10
      ISTN=ISN(DUMMY) 
      LU2=LUDV(ISTN,IDTN,IUNIT) 
      LU1=IBLU0(LU2)
      IF(ISTN.EQ.0.OR.LU1.EQ.0.OR.LU2.EQ.0)GO TO 500
      CALL XSVMU(LU1,LU2,IERMS,IUNIT,ABUF,IN) 
C 
C 
      IF(IERMS)500,20,500 
20    RETURN
500   CALL ERROR(IERMS,IERMS(2))
C 
C 
C 
C 
C 
C 
      RETURN
      END 
C 
C 
      SUBROUTINE XSVMU(LU1,LU2,IERMS,IUNIT,ABUF,IN),
     +09580-16137 REV.2001 791113 
C************************************************************** 
C     THIS THE MEASUREMENT DEVICE SUBROUTINE FOR THE 3437A
C   SVM.  THE PARAMETERS IN THE CALLING SEQUENCE
C   HAVE THE FOLLOWING MEANING: 
C 
C    LU1= LU NUMBER OF HPIB CARD
C    LU2= LU NUMBER OF 3437A
C 
C    IERR IS A 5 WORD ERROR ARRAY WITH IERR(1) = ERROR CODE WHERE:
C 
C     0=NO ERROR
C     1=PARAMETER ERROR 
C     4= BAD DATA FROM 3437A
C 
C 
C     ERROR MESSAGES WHICH PERTAIN TO THE HPIB
C 
C     9= I/O CALL REJECTED
C     10= LU1 OR LU2 NOT ASSIGNED TO STATION
C     11= DMA INPUT REQUEST PREMATURELY TERMINATED
C     12= I/O DEVICE TIME OUT 
C     13= IFC (INTERFACE CLEAR) DETECTED DURING I/O REQUEST 
C     14= SRQ SERVICE ABORTED 
C     15= NON-EXISTENT ALARM PROGRAM
C     16= ILLEGAL CONTROL REQUEST 
C     17= EQT EXTENSION AREA FULL, NO NEW DEVICE MAY BE ADDED ON LINE 
C 
C 
C  ABUF=NAME OF BUFFER
C 
C  IN=NUMBER OF READINGS
C     MAXIMUM NUMBER OF READINGS IS 250 
C 
C 
C 
C***************************************************************
      DIMENSION IERMS(5)
      DIMENSION IOBUF(3),IASBF(6) 
      DIMENSION IREG(2),IBUF(250) 
      DIMENSION ABUF(250) 
C 
C 
      EQUIVALENCE(REG,IREG,IA),(IREG(2),IB) 
C 
C 
C 
C 
      IDTN=43 
      IERMS=0 
      IPRAM=37000B
      IERR=1
      ICNWD=2500B 
      IASBF(1)=10.
C 
C 
      IF(IN.GT.250 .OR. IN.LE.0)IERMS=1 
      IF(IERMS.EQ.1)GOTO 9000 
C 
C 
C**CONFIGURE DRIVER WORD (DMA TRNSFER)*** 
C 
      REG=EXEC(3,2500B+LU2,IPRAM) 
C 
C 
C 
C****PICK UP NUMBER OF READINGS ******
C 
705   IN1=IN/1000 
      IX1=IN1+60B 
      IOBUF(1)=IOR(47000B,IX1)
C 
C 
      IN2=(IN-IN1*1000)/100 
      IX2=(IN2*2**8)+30000B 
C 
C 
C 
C 
      IN3=(IN-((IN1*1000)+(IN2*100)))/10
      IX3=IN3+60B 
C 
C 
      IN4=IN-((IN1*1000)+(IN2*100)+(IN3*10))
      IX4=(IN4*2**8)+30000B 
C 
C 
      IOBUF(2)=IOR(IX2,IX3) 
      IOBUF(3)=IOR(IX4,123B)
C 
C 
C******OUTPUT NUMBER OF READINGS********
C 
C 
      CALL EXEC(100002B,LU2,IOBUF,3,IDUMY,0)
      GO TO 700 
C 
260   CALL ABREG(IA,IB) 
      IF (IB.LT.0)GO TO 900 
C 
C***CONFIGURE DRIVER WORD**** 
C 
C*****READ DATA  FIXED BINARY ****
C 
      CALL EXEC(100001B,100B+LU2,IBUF(1),IN,IDUMY,0)
      GOTO 700
C 
280   CALL ABREG(IA,IB) 
C 
C 
C 
      IF (IB.LT.0)GO TO 900 
      I=1 
      J=1 
      JEND=177777B
C 
C 
C 
C 
C****SAVE MSD &LSD **** 
C 
100   IRDNG=IAND(IBUF(I),17777B)
C 
C  SAVE RANGE AND SIGN
C 
      IR=IAND(IBUF(I),140000B)
      ISGN=IAND(IBUF(I),20000B) 
C 
C 
C ***CONVERT BINARY DATA TO ASCII**** 
C 
C  SIGN 
C 
C 
      IF(ISGN.EQ.0)ISGN1=26400B 
      IF(ISGN.NE.0)ISGN1=25400B 
C***IF OVERLOAD (1999) CONVERT TO (9999) ***
      IF (IRDNG.EQ.14631B)IDGT1=71B 
      IF(IRDNG.EQ.14631B)GO TO 800
C 
C  1RST DGT 
C 
      IDGT1=IAND(IRDNG,10000B)
      IDGT1=IOR(IDGT1/2**12,60B)
C 
800   IASBF(2)=IOR(ISGN1,IDGT1) 
C 
C 
C  2ND DGT
C 
      IDGT2=IAND(IRDNG,7400B) 
      IDGT2=IOR(IDGT2/2**8,60B) 
C 
      IASBF(3)=IOR(27000B,IDGT2)
C 
C  3RD DGT
C 
      IDGT3=IAND(IRDNG,360B)
      IDGT3=IOR(IDGT3*2**4,30000B)
C 
C 
C  4TH DGT
C 
      IDGT4=IAND(IRDNG,17B) 
      IDGT4=IOR(IDGT4,60B)
C 
C 
      IASBF(4)=IOR(IDGT3,IDGT4) 
C 
C 
      IEX=42400B
      JSGN=53B
      IF(IR.EQ.40000B)JSGN=55B
C 
C 
C****SAVE E+/- ****** 
C 
      IASBF(5)=IOR(IEX,JSGN)
C 
      IMPY=30061B 
      IF(IR.EQ.140000B)IMPY=30060B
C 
C 
      IASBF(6)=IMPY 
      IF (IRDNG.EQ.14631B)IASBF(6)=31470B 
C 
C 
C******CONVERT ASCII TO FLOATING POINT **** 
C 
      IREG=A2F(IASBF,1,10,ABUF(I))
      IF(IREG)650,600 
600   IF(I.EQ.IN)GO TO 320
      I=I+1 
      GO TO 100 
C 
320   RETURN
C**ERRORS*****
C 
650   IERMS=4 
      GOTO 9000 
700   IERMS=9 
      GO TO 9000
C 
900   IERMS=IAND(IREG,377B)+11
C 
9000  IERMS(2)=5
      IERMS(3)=2HDS 
      IERMS(4)=2HVM 
      IERMS(5)=2HU
      RETURN
      END 
      END$
                                                                                                                                                                                                