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