FTN4,L SUBROUTINE STGET(LU,ISTAT),09580-16443 REV.2013 800131 C C******************************************************* C C RELOCATABLE 09580-16443 C SOURCE 09580-18443 C C BOB RICHARDS 790601 C BOB RICHARDS 791023 C BOB RICHARDS 800123 CHANGED NAME FROM 'GETST' TO 'STGET' C BOB RICHARDS 800131 C**************************************************** C C C !=================================================! C ! ! C ! (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980 ! C ! ALL RIGHTS RESERVED ! C ! ! C ! NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, ! C ! REPRODUCED OR TRANSLATED INTO ANOTHER PROGRAM ! C ! LANGUAGE WITHOUT THE PRIOR WRITTEN CONSENT OF ! C ! THE HEWLETT-PACKARD COMPANY. ! C ! ! C !-------------------------------------------------! C ! ! C ! TEST SYSTEM SOURCE SOFTWARE IS THE PROPRIETARY ! C ! MATERIAL OF THE HEWLETT-PACKARD COMPANY. ! C ! ! C ! THIS SOURCE DATA SHALL BE USED SOLELY IN ! C ! CONJUCTION WITH ELECTRONIC COMPUTER SYSTEMS ! C ! SUPPLIED TO THE USER BY HEWLETT-PACKARD. ! C ! ! C ! THIS PROPRIETARY DATA SHALL NOT BE COPIED OR ! C ! OTHERWISE REPRODUCED WITHOUT THE PRIOR WRITTEN ! C ! CONSENT OF HEWLETT-PACKARD, EXCEPT THAT ONE ! C ! COPY MAY BE MADE AND RETAINED BY THE USER FOR ! C ! ARCHIVE PURPOSES. ! C ! ! C ! THE USER SHALL NOT DISCLOSE THIS DATA TO ANY ! C ! THIRD PARTIES WITHOUT THE PRIOR WRITTEN CONSENT ! C ! OF HEWLETT-PACKARD. IN ADDITION, THE USER SHALL ! C ! USE AT LEAST THE SAME CARE AND SAFEGUARDS TO ! C ! PROTECT THIS DATA FROM UNAUTHORIZED USE OR ! C ! DISCLOSURE AS THE USER USES TO PROTECT ITS OWN ! C ! PROPRIETARY DATA. ! C ! ! C !=================================================! C C GENERAL: C -------- C C THE FOLLOWING DEVICE SUBROUTINE IS USED TO C GET THE STATUS OF A LOGICAL UNIT (LU) WHICH C HAS ALREADY BEEN DETERMINED BY "DVSTS" 09580-16442. C --------------------- C C BRANCH AND MNEMONIC TABLE ENTRY C C STGET(I,IV), OV=XX, ENT=STGET, FIL=%STGET C C C C*************************************** C C C STGET(LU,ISTAT) C C WHERE: C C LU = LU OF WHICH STATUS WORD IS DESIRED. C ISTAT = RETURNED STATUS WORD. C C************************************************************ C DIMENSION IBUF(64),IERMS(5) DATA IDTN/67/,IBUFL/64/,IERMS/1,5,2HST,2HGE,2HT / C C CHECK INPUT PARAMETER C IF(LU .LT. 0 .OR. LU .GT. 63) GOTO 8000 C C GET STATUS TABLE C CALL TIM(IDTN,1,1,IBUF,IBUFL,IER) IF(IER .NE. 0) RETURN C C GET STATUS WORD C ISTAT = IBUF(LU) C C RETURN C RETURN C C ERROR C 8000 CALL ERROR(IERMS,IERMS(2)) RETURN C END END$