FTN4
      SUBROUTINE CKROO(LU1,ROOT,IERR) 
     +,92069-16189 REV.2013 790316
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-18189
C     RELOC:     92069-16189
C 
C 
C****************************************************************:
C 
C 
C************************************************************** 
C SUBR TO CHECK THAT THE ROOT FILE NAMR PASSED IN IS REALLY AN
C ASCII STRING. IT DOES NOT OPEN OR CHECK THE FILE. 
C***************************************************************
      INTEGER LU1,ROOT(6),IERR
      REAL REG
      INTEGER STRING(40),TYPE,IA(2) 
C 
      EQUIVALENCE (REG,IA),(IA(2),IB) 
C 
C***************************************************************
C IF THE TYPE IS ASCII, NORMAL RETURN. ELSE RETURN ERROR. 
C 
5     CONTINUE
      IERR = 0
      TYPE = ROOT(4)
      IF (TYPE .EQ. 0) GO TO 10 
      IF (TYPE .EQ. 1) GO TO 20 
      IF (TYPE .EQ. 3) GO TO 30 
C************************************************************ 
C PROCESS INTERNAL ERROR. 
C 
      CALL DBER2(LU1,7777,6HXXXXXX,6HCKROO ,2HAB) 
C*************************************************************
C PROCESS NO PARAMETER BY PROMPTING THE USER AT THE CONSOLE LU. 
C READ THE PARAMETER, CALL PRAM TO FILL THE NAMR ARRAY, THEN
C LOOP BACK TO THE BRANCH POINT TO PROCESS THE NEW ENTRY. 
C 
10    CONTINUE
      CALL REIO(2,LU1,18H ROOT FILE NAMR? _,-18)
      REG = REIO(1,LU1+400B,STRING,40)
      LNGTH2=2*IB 
      ISTRC1=1
      CALL PRAM(LU1,STRING,LNGTH2,ISTRC1,ROOT)
      GO TO 5 
C*************************************************************
C PROCESS AN INTEGER PARAMETER AS AN ERROR. 
C 
20    CONTINUE
      CALL REIO(2,LU1,26H INCORRECT ROOT FILE NAME.,-26)
      IERR=-243 
      CALL DBER2(LU1,IERR,6HXXXXXX,6HCKROO ,2HXX) 
      RETURN
C*************************************************************
C IF ITS A NAMR PARAMETER PUT NEGATIVE SEC CODE INTO IT AND RETURN
C 
30    ROOT(5) = -(IABS(ROOT(5)))
      RETURN
      END 
                                                                                                                                                                                                  