FTN4 SUBROUTINE CKP51(LU1,P5,IERR) +,92069-16191 REV.2013 790402 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-18191 C RELOC: 92069-16191 C C C****************************************************************: C C C************************************************************** C CKP51 CHECKS THAT THE ABORT WORD PASSED IN IS REALLY AN C ASCII STRING, OR AN INTEGER VALUE. IF NO PARAMETER WAS C PASSED IN, CKP51 QUERIES THE USER AT CONSOLE LU, READS IN THE ABORT C WORD, AND THEN CHECKS THAT ITS ASCII OR INTEGER. C*************************************************************** INTEGER LU1,P5(1),IERR C*************************************************************** C IF THE TYPE IS ASCII, NORMAL RETURN. ELSE RETURN ERROR. C C PROCESS AN INTEGER PARAMETER AS AN ERROR. C 5 CONTINUE IERR = 0 ITYPE = P5(4) IF (ITYPE .EQ. 0) GO TO 10 IF (ITYPE .EQ. 1) GO TO 3000 IF (ITYPE .EQ. 3) GO TO 30 C************************************************************ C PROCESS INTERNAL ERROR. C CALL DBER2(LU1,7777,6HXXXXXX,6HCKP51 ,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 C 10 CONTINUE CALL REIO(2,LU1,39H OVERWRITE EXISTING FILES(YES OR NO)? _,-39) CALL REIO(1,LU1+400B,ITEMP,1) IF((ITEMP .NE. 2HYE) .AND. (ITEMP .NE. 2HNO)) GOTO 10 P5=2HAB IF (ITEMP .EQ. 2HYE) P5=2HCO P5(4)=3 RETURN C************************************************************* C CHECK A NAMR PARAMETER FOR VALIDITY. C 30 CONTINUE IF ((P5 .EQ. 2HAB) .OR. (P5 .EQ. 2HCO)) RETURN C*********************************************************** C BAD ABORT WORD IN THE RUN STRING. C 3000 CONTINUE CALL REIO(2,LU1,20H ILLEGAL ABORT WORD.,-20) IERR=-248 CALL DBER2(LU1,IERR,6HXXXXXX,6HCKP51 ,2HXX) RETURN END