FTN4 SUBROUTINE CKLU1(LU,LU1,DFLT,IERR) +,92069-16187 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-18187 C RELOC: 92069-16187 C C C****************************************************************: C C C********************************************************** C SUBR TO CHECK THAT LU1 IS A VALID INTERACTIVE CONSOLE LU. C IF NO PARAMETER IS PASSED IN, IT DEFAULTS LU1 TO DFLT. C LU= ERROR LOG DEVICE C LU1=6-WORD ARRAY YOU'RE CHECKING. C DFLT= DEFAULT VALUE TO STUFF INTO LU1 IF NO PARAMETER THERE. C IERR= ERROR LOG IF ERROR OCCURS IN THE SUBR. C********************************************************** INTEGER LU,LU1(1),DFLT,IERR LOGICAL IFTTY INTEGER ERR1(17) DATA ERR1/2H C,2HON,2HSO,2HLE,2H L,2HU ,2HNO,2HT ,2HIN,2HTE, & 2HRA,2HCT,2HIV,2HE:,2H ,2H ,2H / C*********************************************************** C BRANCH ON THE TYPE OF PARAMETER PASSED IN(0=NONE,1=INT,3=NAMR) IERR = 0 IFLAG = LU1(4) IF (IFLAG .EQ. 0) GO TO 10 IF (IFLAG .EQ. 1) GO TO 20 IF (IFLAG .EQ. 3) GO TO 30 C*********************************************************** C PROCESS INTERNAL ERROR THAT SHOULDNT HAVE HAPPENED. C CALL DBER2(LU1,7777,6HXXXXXX,6HCKLU1 ,2HAB) C************************************************************* C PROCESS NO PARAMETER PASSED IN. DEFAULT TO VALUE IN DFLT. 10 LU1=DFLT LU1(4) = 1 RETURN C************************************************************ C PROCESS INTEGER PARAMETER PASSED IN. CHECK FOR INTERACTIVE. C IF ITS INTERACTIVE, LU1 IS LOADED PROPERLY SO RETURN. 20 CONTINUE IF(IFTTY(LU1))40,25 25 CALL CNUMD(LU1,ERR1(15)) GOTO 35 30 ERR1(15) = LU1 ERR1(16) = LU1(2) ERR1(17) = LU1(3) 35 CALL REIO(2,LU,ERR1,17) IERR = -241 CALL DBER2(LU,241,6HXXXXXX,6HCKLU1 ,2HXX) LU1=LU 40 RETURN END