      FTN4,L
C 
      SUBROUTINE WAVSA(IUN,IVAR),09580-16318 REV.2001 791023
C ****************************************************
C 
C       SOURCE          09580-18318 
C       RELOCATABLE     09580-16318 
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     791023 
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 SUBROUTINE PASSES ASCII STRINGS TO AUTEK 505
C 
C       WAVSA(IUNIT,IVAR) 
C 
C            WHERE: IUNIT = UNIT NUMBER 
C 
C                   IVAR   =  ASCII STRING
C 
C 
C     THIS SUBROUTINE, BASIC CALLABLE ONLY, IS USED TO CHECK
C     THE ASCII STRINGS PASSED TO THE AUTEK 505.  IF THE IN-
C     STRUMENT MUST BE PROGRAMMED IN FORTRAN, PASS THE ASCII
C     STRING IN A BUFFER WHERE THE FIRST WORD CONTAINS THE NUM- 
C     BER OF WORDS IN THE BUFFER. 
C 
C =========================================================== 
C 
C   BRANCH & MNEMONIC TABLE ENTRIES:
C 
C       WAVSA(I,IA),      OV=X,    ENT=WAVSA,  FIL=%WAVSA 
C 
C =========================================================== 
      DIMENSION IVAR(40),IBUFR(40),IFCDE(9),ITDIV(26) 
      DIMENSION IVERT(12),IERR(5),IREG(2) 
      EQUIVALENCE (REG,IREG,IA),(IREG(2),IB)
      DATA IFCDE /2HRA,2HAP,2HBP,2HST,2HSP,2HAM,2HBM,2HDC,2HTG/ 
      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 IVERT /2H20,2H50,2H10,2H21,2H51,2H11,2H22,2H52,
     S2H12,2H23,2H53,2H13/
      DATA IDTN /52/
C 
C     READ BUFFER STORAGE 
C 
      CALL TIM(IDTN,IUN,1,IBUFR,39,IERFG) 
      IF(IERFG.LT.0)GOTO 9000 
      NUMS = 8
      IF(IBUFR(2).NE.0)NUMS = 9 
      MAXNM = NUMS * 8
C 
C     NUMBERS OF CHARACTERS 
C 
      NUMBR = IAND(IVAR(1),377B)
      IF(NUMBR.GT.MAXNM)GOTO 9100 
      ICNTR = NUMBR 
      INX = 2 
10    CONTINUE
      IF(ICNTR.EQ.8)GOTO 20 
      IF(ICNTR.LT.8)GOTO 9100 
      ICNTR = ICNTR - 8 
      GO TO 10
C 
C     CHECK FIELD CHARACTERS
C 
20    IDX = 1 
      NWDS = NUMBR / 2
      DO 30  I=1,9
      IF(IVAR(INX).EQ.IFCDE(I))GOTO 40
30    IDX = IDX + 1 
      GO TO 9100
C 
40    INX = INX + 1 
      GO TO (100,200,200,400,400,600,600,800,900),IDX 
C 
C     RA FIELD
C 
100   JNX = INX 
      DO 110  I=1,26
      IF(IVAR(JNX).EQ.ITDIV(I))GOTO 120 
110   CONTINUE
      GO TO 9100
C 
120   JNX = JNX + 1 
      ICHAR = IAND(IVAR(JNX),177400B) 
      IF(ICHAR.LT.30000B.OR.ICHAR.GT.34400B)GOTO 9100 
      ICHAR = IAND(IVAR(JNX),377B)
      IF(ICHAR.LT.60B.OR.ICHAR.GT.71B)GOTO 9100 
C 
      JNX = JNX + 1 
      ICHAR = IAND(IVAR(JNX),177400B) 
      IF(ICHAR.LT.40400B.OR.ICHAR.GT.52000B)GOTO 9100 
      IF(ICHAR.GT.41000B.AND.ICHAR.LT.52000B)GOTO 9100
      ICHAR = IAND(IVAR(JNX),377B)
      IF(ICHAR.LT.60B.OR.ICHAR.GT.67B)GOTO 9100 
      GO TO 4000
C 
C     A & B PROBES
C 
200   JNX = INX 
      ICHAR = IAND(IVAR(JNX),177400B) 
      IF(ICHAR.LT.30000B.OR.ICHAR.GT.34400B)GOTO 9100 
      ICHAR = IAND(IVAR(JNX),377B)
      IF(ICHAR.LT.60B.OR.ICHAR.GT.71B)GOTO 9100 
C 
      JNX = JNX + 1 
      KNX = 1 
      DO 210   I=1,12 
      IF(IVAR(JNX).EQ.IVERT(KNX))GOTO 220 
210   KNX = KNX + 1 
      GO TO 9100
C 
220   JNX = JNX + 1 
      ICHAR = IAND(IVAR(JNX),177400B) 
      IF(ICHAR.EQ.25400B.OR.ICHAR.EQ.26400B)GOTO 230
      GO TO 9100
C 
230   ICHAR = IAND(IVAR(JNX),377B)
      IF(ICHAR.LT.60B.OR.ICHAR.GT.71B)GOTO 9100 
      GO TO 4000
C 
C     ST & SP FIELDS
C 
400   JNX = INX 
      ICHAR = IAND(IVAR(JNX),177400B) 
      IF(ICHAR.LT.30000B.OR.ICHAR.GT.34400B)GOTO 9100 
      ICHAR = IAND(IVAR(JNX),377B)
      IF(ICHAR.LT.60B.OR.ICHAR.GT.71B)GOTO 9100 
C 
      JNX = JNX + 1 
      ICHAR = IAND(IVAR(JNX),177400B) 
      IF(ICHAR.EQ.22400B.OR.ICHAR.EQ.25400B)GOTO 410
      IF(ICHAR.EQ.26400B)GOTO 410 
      GO TO 9100
C 
410   ICHAR = IAND(IVAR(JNX),377B)
      IF(ICHAR.LT.101B.OR.ICHAR.GT.102B)GOTO 9100 
      JNX = JNX + 1 
      ICHAR = IAND(IVAR(JNX),177400B) 
      IF(ICHAR.LT.30000B.OR.ICHAR.GT.34400B)GOTO 9100 
      ICHAR = IAND(IVAR(JNX),377B)
      IF(ICHAR.EQ.53B.OR.ICHAR.EQ.55B)GOTO 4000 
      GO TO 9100
C 
C     AM & BM FIELDS
C 
600   JNX = INX 
      ICHAR = IAND(IVAR(JNX),177400B) 
      IF(ICHAR.LT.30000B.OR.ICHAR.GT.34400B)GOTO 9100 
      KCHAR = IAND(IVAR(JNX),377B)
      IF(KCHAR.LT.0.OR.KCHAR.GT.71B)GOTO 9100 
      IF(ICHAR.EQ.60B.AND.KCHAR.EQ.60B)GOTO 9100
C 
      JNX = JNX + 1 
      ICHAR = IAND(IVAR(JNX),177400B) 
      IF(ICHAR.EQ.43400B.OR.ICHAR.EQ.50000B)GOTO 610
      IF(ICHAR.EQ.51000B)GOTO 610 
      GO TO 9100
C 
610   ICHAR = IAND(IVAR(JNX),377B)
      IF(ICHAR.LT.60B.OR.ICHAR.GT.71B)GOTO 9100 
      JNX = JNX + 1 
      KCHAR = IAND(IVAR(JNX),177400B) 
      IF(KCHAR.LT.30000B.OR.KCHAR.GT.34400B)GOTO 9100 
      IF(KCHAR.EQ.30000B.AND.ICHAR.EQ.60B)GOTO 9100 
      ICHAR = IAND(IVAR(JNX),377B)
      IF(ICHAR.EQ.107B.OR.ICHAR.EQ.120B)GOTO 4000 
      GO TO 9100
C 
C     AUTO DELAY & CALIBRATOR 
C 
800   CONTINUE
      JNX = INX 
      ICHAR = IAND(IVAR(JNX),177400B) 
      IF(ICHAR.EQ.40400B.OR.ICHAR.EQ.41000B.OR.ICHAR.EQ.30000B)GOTO 810 
      GO TO 9100
810   ICHAR = IAND(IVAR(JNX),377B)
      IF(ICHAR.EQ.53B.OR.ICHAR.EQ.55B)GOTO 815
      GO TO 9100
815   JNX = JNX + 1 
      ICHAR = IAND(IVAR(JNX),177400B) 
      IF(ICHAR.LT.30000B.OR.ICHAR.GT.30400B)GOTO 9100 
      ICHAR = IAND(IVAR(JNX),377B)
      IF(ICHAR.NE.60B)GOTO 9100 
      IF(IVAR(JNX+1).NE.30060B)GOTO 9100
      GO TO 4000
C 
C     TRIGGER SOURCE
C 
900   CONTINUE
      JNX = INX 
      ICHAR = IAND(IVAR(JNX),177400B) 
      IF(ICHAR.LT.30000B.OR.ICHAR.GT.34000B)GOTO 9100 
      ICHAR = IAND(IVAR(JNX),377B)
      IF(ICHAR.LT.61B.OR.ICHAR.GT.63B)GOTO 9100 
      JNX = JNX + 1 
      ICHAR = IAND(IVAR(JNX),177400B) 
      IF(ICHAR.EQ.25400B.OR.ICHAR.EQ.26400B)GOTO 910
      GO TO 9100
910   ICHAR = IAND(IVAR(JNX),377B)
      IF(ICHAR.LT.30000B.OR.ICHAR.GT.34400B)GOTO 9100 
      JNX = JNX + 1 
      ICHAR = IAND(IVAR(JNX),177400B) 
      IF(ICHAR.LT.30000B.OR.ICHAR.GT.34400B)GOTO 9100 
      ICHAR = IAND(IVAR(JNX),377B)
      IF(ICHAR.NE.53B .OR. ICHAR .NE. 55B) GOTO 9100
C 
C     STORE NEW DATA IN STORAGE BUFFER
C 
4000  KNX = IDX * 4 + 1 
      DO 4100  I=1,3
      IBUFR(KNX) = IVAR(INX)
      INX = INX + 1 
4100  KNX = KNX + 1 
      NUMBR = NUMBR - 8 
      IF(NUMBR.NE.0)GOTO 20 
C 
C     OUTPUT NEW PROGRAM
C 
5000  CONTINUE
      ISTN = ISN(DUMY)
      LU1 = LUDV(ISTN,IDTN,IUN) 
      LU0 =IBLU0(LU1) 
      CALL EXEC(100003B,1600B+LU0)
      GO TO 9200
5100  CALL ABREG(IA,IB) 
      IF(IB.LT.0)GOTO 9300
      CALL REIO(100002B,LU1,IVAR(2),NWDS,IDUMY,0) 
      GO TO 9200
5200  CALL ABREG(IA,IB) 
      IF(IB.LT.0)GOTO 9300
      CALL TIM(IDTN,IUN,2,IBUFR,39,IERFG) 
      IF(IERFG.LT.0)GOTO 9000 
      RETURN
C 
C     ERROR ROUTINE 
C 
9000  IERR = 10 
      GO TO 9900
9100  IERR = 1
      GO TO 9900
9200  IERR = 9
      GO TO 9900
9300  IERR = IAND(IREG,377B) + 11 
9900  IERR(2) = 5 
      IERR(3) = 2HWA
      IERR(4) = 2HVS
      IERR(5) = 2HA 
      CALL ERROR(IERR,IERR(2))
      RETURN
      END 
                                                                                                                                                                        