FTN4
      SUBROUTINE CKLVL(LU1,LVLWD,IERR)
     +,92069-16190 REV.2013 790928
C 
C 
C*****************************************************************
C (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS RESERVED.
C NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, REPRODUCED, OR
C TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT THE PRIOR
C WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. 
C****************************************************************** 
C 
C 
C     SOURCE:    92069-18190
C     RELOC:     92069-16190
C 
C 
C****************************************************************:
C 
C 
C************************************************************** 
C CKLVL CHECKS THAT THE LEVEL WORD PASSED IN IS REALLY AN 
C ASCII STRING, AND NOT AN INTEGER VALUE. IF NO PARAMETER WAS 
C PASSED IN, CKLVL QUERIES THE USER AT CONSOLE LU, READS IN THE LEVEL 
C WORD, AND THEN CHECKS THAT ITS AN ASCII STRING. 
C***************************************************************
      INTEGER LU1,LVLWD(6),IERR 
      INTEGER IA(2) 
      EQUIVALENCE(REG,IA),(IA(2),IB)
C***************************************************************
C IF THE TYPE IS ASCII, NORMAL RETURN. ELSE RETURN ERROR. 
C 
5     CONTINUE
      LVL = LVLWD(4)
      IERR = 0
      IF (LVL .EQ. 0) GO TO 10
      IF (LVL .EQ. 1) GO TO 20
      IF (LVL .EQ. 3) GO TO 30
C************************************************************ 
C PROCESS INTERNAL ERROR. 
C 
      CALL DBER2(LU1,7777,6HXXXXXX,6HCKLVL ,2HAB) 
C*************************************************************
C PROCESS NO PARAMETER BY PROMPTING THE USER AT THE CONSOLE LU. 
C READ THE PARAMETER, CALL PRAM TO FILL THE LVLWD ARRAY, THEN 
C LOOP BACK TO THE BRANCH POINT TO PROCESS THE NEW ENTRY. 
C 
C IF THE USER ENTERS AN IMMEDIATE CARRIAGE RETURN, LEAVE BLANKS 
C FOR THE LEVEL WORD. 
C 
10    CONTINUE
      LVLWD=2H
      LVLWD(2)=2H 
      LVLWD(3)=2H 
      LVLWD(4)=3
      CALL REIO(2,LU1,28H HIGHEST LEVEL CODE WORD ? _,-28)
      REG = REIO(1,LU1+400B,STRING,40)
      LNGTH2=2*IB 
C 
C CKECK IF ALL BLANKS WERE ENTERED
C 
      IF (LNGTH2 .EQ. 0) RETURN 
      IF (JSCOM(STRING,1,LNGTH2,6H      ,1,IERR) .EQ.0) RETURN
      ISTRC=1 
      CALL PRAM(LU1,STRING,LNGTH2,ISTRC,LVLWD)
      GO TO 5 
C*************************************************************
C PROCESS AN INTEGER PARAMETER AS AN ERROR. 
C 
20    CONTINUE
      CALL REIO(2,LU1,29H THE LEVEL WORD IS NOT ASCII.,-29) 
      IERR=-211 
      CALL DBER2(LU1,IERR,6HXXXXXX,6HCKLVL ,2HXX) 
      RETURN
C*************************************************************
C PROCESS A NAMR PARAMETER AS OK. 
C 
30    RETURN
      END 
                                                                                                          