FTN4,L
      SUBROUTINE WAVSU(IUN,IFLD,ISBF,PVAL),09580-16317 REV.2013 800131
C 
C ****************************************************
C 
C       SOURCE          09580-18317 
C       RELOCATABLE     09580-16317 
C 
C       T. KONDO         12/11/78     REV. A
C       BOB RICHARDS     02/20/79     REV. B
C       BOB RICHARDS     05/02/79 
C       BOB RICHARDS     791120  THIS REV. IS USED TO PROGRAM 
C                                AUTEK 505'S WITH THE IEEE-488
C                                BUS MOD. 
C        BOB RICHARDS    800131 
C 
C     TEST SYSTEM SOURCE SOFTWARE IS THE PROPRIETRY 
C     MATERIAL OF THE HEWLETT-PACKARD COMPANY.
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     THIS DEVICE SUBROUTINE IS FOR AUTEK 505 WAVEFORM ANALYZER.
C 
C       SET-UP CALL:
C         WAVSU(IUN,IFLD,ISBF,PVAL) 
C           WHERE:
C                  IUN   =  UNIT NUMBER 
C                  IFLD  =  PROGRAM FIELD 
C                            1  = RA
C                            2  = AP
C                            3  = BP
C                            4  = ST
C                            5  = SP
C                            6  = AM
C                            7  = BM
C                            8  = DC
C                            9  = TG
C                  ISBF  =  PROGRAM SUBFIELD
C                           (1 THROUGH 4) 
C                  PVAL  =  PROGRAM VALUE 
C 
C       MEASUREMENT CALL: 
C         WAVMU(IUN,IFUNC,VAL,LSTAT)
C 
C           WHERE:
C                  IUN   = UNIT NUMBER
C                  IFUNC = FUNCTION 
C                          1 = PROGRAM,TRIGGER,& MEASURE
C                          2 = TRIGGER & MEASURE
C                          3 = TRIGGER ONLY 
C                          4 = MEASURE ONLY 
C                  VAL   = MEAUREMENT VALUE 
C                  LSTAT = MEASUREMENT STATUS 
C                          0 = VALID MEASUREMENT
C                          1 = OVER-RANGE 
C                          2 = MEASUREMENT IN PROGRESS
C                          3 = SEARCH FAIL
C                          4 = MEASUREMENT IN PROCESS / OVER RANGE
C                          5 = OVER RANGE / SEARCH FAIL 
C                          6 = MEASUREMENT IN PROCESS / SEARCH FAIL 
C                          8 = MEASUREMENT IN PROCESS / OVER RANGE /
C                              SEARCH FAIL
C 
C = * = * = * = * = * = * = * = * = * = * = 
C 
C     AUTEK 505 CONFIGURATION:
C 
C        BRANCH & MNEMONIC TABLES:
C          WAVSU(I,I,I,R),      OV=XX,   ENT=WAVSU,  FIL=%WAVSU 
C          WAVMU(I,I,RV,I),       OV=XX,   ENT=WAVMU,  FIL=%WAVSU 
C 
C        CONFIGURATION TABLE (ALLFL) ENTRIES: 
C          R   52,1,39
C          U1 
C             1    NUMBER OF PROBE MULTIPLERS 
C             1    NUMBER OF TRIGGER CONDITIONERS 
C             0    STORAGE
C             051101B    RA 
C             030466B    16 
C             032460B    50 
C             052060B    T0 
C 
C             040520B    AP 
C             030060B    00 
C             030461B    11 
C             025461B    +1 
C 
C             041120B    BP 
C             030061B    01 
C             030461B    11 
C             026461B    -1 
C 
C             051524B    ST 
C             032460B    50 
C             022501B    %A 
C             030455B    1+ 
C 
C             051520B    SP 
C             032460B    50 
C             022501B    %A 
C             031055B    2+ 
C 
C             040515B    AM 
C             030061B    01 
C             050071B    P9 
C             034520B    9P 
C 
C             041115B    BM 
C             030061B    01 
C             050071B    P9 
C             034520B    9P 
C 
C             042103B    DC 
C             030053B    0+ 
C             030060B    00 
C             030060B    00 
C 
C             052107B    TG 
C             030462B    12 
C             025460B    +0 
C             030053B    0+ 
C 
C = * = * = * = * = * = * = * = * = * = * = 
C 
      DIMENSION IERMS(5)
      DATA IERMS /10,5,2HWA,2HVS,2HU  / 
      DATA IDTN /52/
C 
C     FIND LU # 
C 
      IERMS = 10
      ISTN =ISN(DUMMY)
      LU1 = LUDV(ISTN,IDTN,IUN) 
      LU0 = IBLU0(LU1)
      IF(LU1.LE.0.OR.LU0.LE.0)GOTO 800
      CALL XAVSU(LU0,LU1,IERMS,IUN,IFLD,ISBF,PVAL)
      IF(IERMS.NE.0)GOTO 800
20    RETURN
C 
C 
800   CALL ERROR(IERMS,IERMS(2))
      RETURN
      END 
C ------------------------------------- 
      SUBROUTINE WAVMU(IUN,IFUNC,VAL,LSTAT),09580-16317 REV.2013 800131 
      DIMENSION IERMS(5)
      DATA IERMS /10,5,2HWA,2HVM,2HU /
      DATA IDTN /52/
C 
C     FIND LU # 
C 
      IERMS = 10
      ISTN = ISN(DUMY)
      LU1 = LUDV(ISTN,IDTN,IUN) 
      LU0 = IBLU0(LU1)
      IF (LU1.LE.0.OR.LU0.LE.0)GOTO 800 
      CALL XAVMU(LU0,LU1,IERMS,IUN,IFUNC,VAL,LSTAT) 
      IF(IERMS.NE.0)GOTO 800
20    RETURN
C 
800   CALL ERROR(IERMS,IERMS(2))
      RETURN
      END 
C  -------------------------------------------------- 
      SUBROUTINE XAVSU(LU0,LU1,IERR,IUN,IFLD,ISBF,PVAL),09580-16317 REV.
     +2013 800131 
      DIMENSION TPERD(26),VERTS(12) 
      DIMENSION IBUFR(40),ITDIV(26),IVERT(12),IFCDE(9),IOBUF(5) 
      DIMENSION IERR(5),IREG(2) 
      EQUIVALENCE (REG,IREG,IA),(IREG(2),IB)
      DATA TPERD /.2E-9,.5E-9,1E-9,.2E-8,.5E-8,1E-8,.2E-7,
     S.5E-7,1E-7,.2E-6,.5E-6,1E-6,.2E-5,.5E-5,1E-5,.2E-4, 
     S.5E-4,1E-4,.0005,.001,.002,.005,.01,.02,.05,.1/ 
      DATA ITDIV /2H29,2H59,2H19,2H28,2H58,2H18,2H27,2H57,2H17, 
     S2H26,2H56,2H16,2H25,2H55,2H15,2H24,2H54,2H14,2H53,2H13, 
     S2H22,2H52,2H12,2H21,2H51,2H11/
      DATA VERTS /.002,.005,.01,.02,.05,.1,.2,.5,1.0,2.0,5.0,10.0/
      DATA IVERT /2H20,2H50,2H10,2H21,2H51,2H11,2H22,2H52,2H12, 
     S2H23,2H53,2H13/ 
      DATA IFCDE /2HRA,2HAP,2HBP,2HST,2HSP,2HAM,2HBM,2HDC,2HTG/ 
      DATA IDTN /52/
      DATA LEN /39/ 
C 
C 
C     READ OUTPUT BUFFER
C 
      CALL TIM(IDTN,IUN,1,IBUFR,LEN,IERFG)
      IF (IERFG.LT.0)GOTO 9900
      NUMS = 8
      IF(IBUFR(2).GT.0)NUMS = 9 
      IF (IFLD.LT.1.OR.IFLD.GT.NUMS)GOTO 9900 
      IF (ISBF.LT.1.OR.ISBF.GT.4)GOTO 9900
C 
C     RETRIEVE CURRENT PROGRAM FIELD
C 
      IERR = 0
      INDEX = IFLD * 4
      IOBUF(2) = IFCDE(IFLD)
      INX = INDEX + 1 
      DO 5  I=3,5 
      IOBUF(I) = IBUFR(INX) 
5     INX = INX + 1 
C 
      IF(IFLD.EQ.1.AND.ISBF.EQ.1.OR.IFLD.EQ.2.AND.ISBF.EQ.2)GOTO 10 
      IF(IFLD.EQ.3.AND.ISBF.EQ.2)GOTO 10
      IVAL = PVAL 
C 
C     BRANCH TO FIELD TO BE EDITED
C 
10    CONTINUE
      GO TO (100,200,200,400,400,600,600,800,900),IFLD
C  ===========================
C     RA FIELD
C ============================
100   CONTINUE
      GO TO (110,120,130,140),ISBF
C 
C     TIME/DIV
C 
110   JNX = 0 
      IF(PVAL.LT.TPERD(1).OR.PVAL.GT.TPERD(26))GOTO 9900
      IF(PVAL.GT.TPERD(25))JNX = 26 
      IF(JNX.EQ.26)GOTO 116 
      DO 112  I=2,26
      JNX = JNX + 1 
      IF(PVAL.LT.TPERD(I))GOTO 116
112   CONTINUE
C 
116   IOBUF(3) = ITDIV(JNX) 
      GO TO 7700
C 
C     TRIGGER DELAY 
C 
120   IF(IVAL.LT.0)GOTO 9900
      IFLAG = 0 
      JNX = 4 
      GO TO 7000
C 
C     MEASUREMENT TYPE
C 
130   IF(IVAL.LT.0.OR.IVAL.GT.2)GOTO 9900 
      ICHAR = IAND(IOBUF(5),377B) 
      IF(IVAL.EQ.0)IOBUF(5)=52000B
      IF(IVAL.EQ.1)IOBUF(5)=40400B
      IF(IVAL.EQ.2)IOBUF(5)=41000B
      IOBUF(5) = IOR(IOBUF(5),ICHAR)
      GO TO 7700
C 
C     SWEEP TYPE
C 
140   IF(IVAL.LT.0.OR.IVAL.GT.7)GOTO 9900 
      ICHAR =IVAL + 60B 
      GO TO 645 
C ========================= 
C     AP####X#    BP####X#
C ========================= 
200   CONTINUE
      GO TO (210,220,230,230),ISBF
C 
C     PROBE # 
C 
210   IF(IVAL.LT.0)GOTO 9900
      IF(IBUFR.EQ.0.AND.IVAL.GT.1)GOTO 9900 
      IF(IVAL.GT.IBUFR*9)GOTO 9900
      GO TO 610 
C 
C     VERTICAL SENSITIVITY
C 
220   JNX = 0 
      IF(PVAL.LT.VERTS(1).OR.PVAL.GT.VERTS(12))GOTO 9900
      DO 222  I=1,12
      JNX = JNX +1
      IF(JNX.EQ.12)GOTO 222 
      IF(PVAL.GE.VERTS(I).AND.PVAL.LT.VERTS(I+1))GOTO 226 
222   CONTINUE
226   IOBUF(4) = IVERT(JNX) 
      GO TO 7700
C 
C     BASELINE OFFSET 
C 
230   IF(IABS(IVAL).GT.9)GOTO 9900
      ICHAR = IABS(IVAL)+60B
      IOBUF(5) = IOR(26400B,ICHAR)
      IF(IVAL.GE.0)IOBUF(5)=IOR(25400B,ICHAR) 
      GO TO 7700
C ======================
C     ST##XX#X   SP##XX#X 
C ======================
400   CONTINUE
      GO TO (410,420,430,440),ISBF
C 
C     PERCENTAGE LEVEL
C 
410   ICHAR = 22400B
      GO TO 425 
C 
C     PERCENTAGE OF VERTICAL FULL-SCALE 
C 
420   ICHAR = 26400B
      IF(IVAL.GE.0)ICHAR=25400B 
      IF(IVAL.LT.0)IVAL = -IVAL 
425   IOBUF(4) = IOR(ICHAR,IAND(IOBUF(4),377B)) 
      GO TO 610 
C 
C     CHANNEL 
C 
430   IF(IVAL.LT.1.OR.IVAL.GT.2)GOTO 9900 
      ICHAR = IAND(177400B,IOBUF(4))
      IOBUF(4) = IOR(ICHAR,IVAL+100B) 
      GO TO 7700
C 
C     TRANSITION & SLOPE
C 
440   IF(IABS(IVAL).GT.9)GOTO 9900
      ICHAR =(60B+IABS(IVAL))*400B
      IOBUF(5) = IOR(ICHAR,53B) 
      IF(IVAL.LT.0)IOBUF(5)=IOR(ICHAR,55B)
      GO TO 7700
C ====================
C     AM##X##X   BM##X##X 
C ====================
600   CONTINUE
      GO TO (610,620,630,640),ISBF
C 
C     0% REFERENCE
C 
610   IFLAG = 0 
      IF(IVAL.LT.0)GOTO 9900
      JNX = 3 
      GO TO 7000
C 
C     MEMORY OPERATION
C 
620   IF(IVAL.LT.0.OR.IVAL.GT.2)GOTO 9900 
      ICHAR = 50000B
      IF(IVAL.EQ.1)ICHAR=51000B 
      IF(IVAL.EQ.2)ICHAR=43400B 
      IOBUF(4) = IOR(ICHAR,IAND(IOBUF(4),377B)) 
      GO TO 7700
C 
C     100% REFERENCE
C 
630   IF(IVAL.LT.0)GOTO 9900
      IOBUF(4) = IAND(IOBUF(4),177400B) 
      GO TO 935 
C 
C     100% MEMORY OPERATION 
C 
640   IF(IVAL.LT.0.OR.IVAL.EQ.1.OR.IVAL.GT.2)GOTO 9900
      ICHAR =120B 
      IF(IVAL.GT.0)ICHAR = 107B 
645   IOBUF(5) = IOR(IAND(177400B,IOBUF(5)),ICHAR)
      GO TO 7700
C =================== 
C     DCXX#000
C =================== 
800   CONTINUE
      GO TO (810,820,9900,9900),ISBF
C 
C     AUTO-DELAY
C 
810   IF(IABS(IVAL).GT.2)GOTO 9900
      IF(IVAL.EQ.0)IOBUF(3)=30053B
      IF(IVAL.EQ.0)GOTO 7700
      ICHAR = 40400B
      IF(IABS(IVAL).EQ.2)ICHAR = 41000B 
      IOBUF(3) = IOR(ICHAR,53B) 
      IF(IVAL.LT.0)IOBUF(3) = IOR(ICHAR,55B)
      GO TO 7700
C 
C     CAL ON/OFF
C 
820   IF(IVAL.GT.1)GOTO 9900
      IOBUF(4) = 30060B 
      IF(IVAL.EQ.1)IOBUF(4)=30460B
      GO TO 7700
C 
C     TG######
C 
900   CONTINUE
      GO TO (910,920,930,940),ISBF
C 
C     TRIGGER SOURCE
C 
910   IF(IVAL.LT.1.OR.IVAL.GT.8)GOTO 9900 
      ICHAR = IAND(IOBUF(3),377B) 
      IOBUF(3) = IOR((60B+IVAL)*400B,ICHAR) 
      GO TO 7700
C 
C     TRIGGER CONDITION 
C 
920   IF(IVAL.LT.1.OR.IVAL.GT.3)GOTO 9900 
      ICHAR = IAND(177400B,IOBUF(3))
      IOBUF(3) = IOR(ICHAR,60B+IVAL)
      GO TO 7700
C 
C     TRIGGER DISCRIMINATOR LEVEL 
C 
930   IOBUF(4) = 25400B 
      IF(IVAL.LT.0)IOBUF(4) = 26400B
935   IOBUF(5) = IAND(IOBUF(5),377B)
      IFLAG = 1 
      JNX = 4 
      GO TO 7000
C 
C     TRIGGER SLOPE 
C 
940   IF(IVAL.EQ.0.OR.IABS(IVAL).GT.1)GOTO 9900 
      ICHAR =IAND(177400B,IOBUF(5)) 
      IOBUF(5) = IOR(ICHAR,53B) 
      IF(IVAL.LT.1)IOBUF(5)=IOR(ICHAR,55B)
      GO TO 7700
C 
C     CONVERT TO ASCII - NUMERIC
C 
7000  MSD = 60B 
      LSD = IABS(IVAL)
      IF(LSD.GT.99)GOTO 9900
7010  CONTINUE
      IF(LSD.LE.9)GOTO 7020 
      LSD = LSD - 10
      MSD = MSD + 1 
      GO TO 7010
C 
7020  LSD = LSD + 60B 
      IF(IFLAG.EQ.0)IOBUF(JNX)=IOR(MSD*400B,LSD)
      IF(IFLAG.EQ.0)GOTO 7700 
      IOBUF(JNX) = IOR(IOBUF(JNX),MSD)
      IOBUF(JNX+1) = IOR(LSD*400B,IOBUF(JNX+1)) 
C 
C     OUTPUT NEW 8-CHARRACTER FIELD 
C 
7700  CONTINUE
      CALL EXEC(100003B,1600B+LU0)
      GOTO 9000 
7710  CALL ABREG(IA,IB) 
      IF(IB.LT.0)GOTO 9100
C 
C     DETERMINE NUMBER OF FIELDS TO BE TRANSMITTED
C 
      INX = INDEX 
      DO 7720  I=2,5
      IBUFR(INX) = IOBUF(I) 
7720  INX = INX + 1 
      IOBUF = 4 
      CALL REIO(100002B,LU1,IOBUF(2),IOBUF,IDUMY,0) 
      GOTO 9000 
7730  CALL ABREG(IA,IB) 
      IF(IB.LT.0)GOTO 9100
C 
C     UPDATE FIELD CODE 
C 
8000  IBUFR(3) = 1
      CALL TIM(IDTN,IUN,2,IBUFR,LEN,IERFG)
      IF (IERFG.LT.0)GOTO 9900
      RETURN
C 
C     ERROR ROUTINE 
C 
9000  IERR = 9
      GOTO 9910 
9100  IERR = IAND(IREG,377B) + 11 
      GO TO 9910
9900  IERR = 1
9910  IERR(2) = 5 
      IERR(3) = 2HWF
      IERR(4) = 2HAS
      IERR(5) = 2HU 
      RETURN
      END 
C 
C  ---------------------------------------------------------
      SUBROUTINE XAVMU(LU0,LU1,IERR,IUN,IFUNC,VAL,LSTAT),09580-16317 REV
     +.2013 800131
      DIMENSION IBUFR(40),IOBUF(6),IERR(5),IREG(2)
      EQUIVALENCE (REG,IREG,IA),(IREG(2),IB)
      DATA MTRGO /2HGO/ 
      DATA IDTN /52/
C 
      VAL = 1E+38 
      LSTAT = 0 
      ITIME = 0 
      IERR = 0
      MIPTR = 0 
      IF(IFUNC.LT.1.OR.IFUNC.GT.4)GOTO 9900 
      IF(IFUNC.NE.1)GOTO 50 
C 
C   READ DATA FROM BUFFER 
C 
      CALL TIM(IDTN,IUN,1,IBUFR,39,IERFG) 
      IF(IERFG.LT.0)GOTO 9900 
C 
C   REMOTE ENABLE 
C 
50    CONTINUE
      CALL EXEC(100003B,1600B+LU0)
      GO TO 9000
60    CALL ABREG(IA,IB) 
      IF(IB.LT.0)GOTO 9100
C 
      IF(IFUNC.EQ.4)GOTO 300
      IF(IFUNC.GT.1)GOTO 100
      LENTH = 32
      IF(IBUFR(2).GT.0)LENTH = 36 
C 
C    OUTPUT FIELD CODES 
C 
      CALL REIO(100002B,LU1,IBUFR(4),LENTH,IDUMY,0) 
      GO TO 9000
70    CALL ABREG(IA,IB) 
      IF(IB.LT.0)GOTO 9100
C 
C     OUTPUT 'GO' 
C 
100   CONTINUE
      CALL REIO(100002B,LU1,MTRGO,1,IDUMY,0)
      GO TO 9000
110   CALL ABREG(IA,IB) 
      IF(IB.LT.0)GOTO 9100
      IF(IFUNC.EQ.3)RETURN
C 
C   WAIT FOR STATUS 
C 
160   IOFST = -20 
      CALL EXEC(12,0,1,0,IOFST) 
170   CONTINUE
      CALL EXEC(100003B,600B+LU1) 
      GO TO 9000
180   CALL ABREG(IA,IB) 
      ISTAT = IAND(IA,377B) 
      IF(ISTAT.GE.100B)GOTO 210 
      ITIME = ITIME + 1 
      IF(ITIME.LE.110)GOTO 160
C$
C$ ALL LINES COMMENTED OUT WITH 'C$' ARE PRE REV 2013 
C$    IF(ITIME.LE.55)GOTO 160 
C$
      GO TO 220 
C 
C     CHECK STATUS: 
C     MEASUREMENT-IN-PROCESS  OVER RANGE   SEARCH FAIL
C 
210   CONTINUE
      IF(ISTAT.EQ.100B)GOTO 300 
      IF(ISTAT.EQ.101B)GOTO 230 
215   LSTAT = 5 
      IF(ISTAT.EQ.102B)LSTAT = 1
      IF(ISTAT.EQ.103B)LSTAT = 4
      IF(ISTAT.EQ.104B)LSTAT = 3
      IF(ISTAT.EQ.105B)LSTAT = 6
      IF(ISTAT.EQ.106B)LSTAT = 8
      RETURN
C 
220   LSTAT = 2 
      RETURN
C 
230   MIPTR = MIPTR + 1 
      IF (MIPTR.GT.40)GOTO 220
C$
C$    IF (MIPTR.GT.20)GOTO 220
C$
      IOFST = -50 
      CALL EXEC(12,0,1,0,IOFST) 
C 
C   READ DATA FROM BUS
C 
300   CONTINUE
C 
C  ALL LINES COMMENTED OUT WITH 'C$' ARE PRE REV 2013 
C 
C$    CALL REIO(100001B,100B+LU1,IOBUF(2),4,IDUMY,0)
      CALL REIO(100001B,100B+LU1,IOBUF(2),5,IDUMY,0)
      GO TO 9000
310   CALL ABREG(IA,IB) 
      IF(IB.LT.0)GOTO 9100
      ISTAT = IAND(IOBUF(2),177400B)/256
      IF(ISTAT.EQ.101B)GOTO 230 
      IF(ISTAT.GT.101B)GOTO 215 
      IOBUF(1) = 10 
C  THE FOLLOWING 2 LINES ARE REV 2013 
      IF (IOBUF(2) .EQ. 40053B) IOBUF(2) = 2H+0 
      IF (IOBUF(2) .EQ. 40055B) IOBUF(2) = 2H-0 
C 
C$    ICHAR = IAND(IOBUF(5),177400B)
      ICHAR = IAND(IOBUF(5),377B) 
C$    NCHAR = IAND(IOBUF(5),377B) 
      NCHAR = IAND(IOBUF(6),177400B)/256
      IOBUF(5) = IAND(IOBUF(5),177400B) 
      IOBUF(5) = IOBUF(5) + 105B
C$    IF(ICHAR.EQ.20000B)IOBUF(5)=42453B
      IF(ICHAR.EQ.40B)IOBUF(6)=2H+0 
C$    IF(ICHAR.EQ.47000B)IOBUF(6)=34440B
      IF(ICHAR.EQ.116B)IOBUF(6)=2H-9
C$    IF(ICHAR.EQ.46400B)IOBUF(6)=31440B
      IF(ICHAR.EQ.115B)IOBUF(6)=2H-3
C$    IF(ICHAR.EQ.52400B)IOBUF(6)=33040B
      IF(ICHAR.EQ.125B)IOBUF(6)=2H-6
C$    IF(ICHAR.EQ.20000B.AND.NCHAR.EQ.126B)IOBUF(6)=30060B
      IF(ICHAR.EQ.40B.AND.NCHAR.EQ.126B)IOBUF(6)=30060B 
      IERR = A2F(IOBUF,1,IOBUF,VAL) 
      IF(IERR.NE.0)GOTO 9300
400   CONTINUE
      RETURN
C 
C     ERROR EXIT
C 
9000  IERR = 9
      GO TO 9910
9100  IERR = IAND(IREG,377B) + 11 
      GO TO 9910
9200  IERR = 4
      GO TO 9910
9300  IERR = 3
      GO TO 9910
9900  IERR = 1
9910  IERR(2) = 5 
      IERR(3) = 2HWF
      IERR(4) = 2HAM
      IERR(5) = 2HU 
      RETURN
      END 
      END$