FTN4
      SUBROUTINE TLOCL(LU1,TAPE,IERR) 
     +,92069-16200 REV.2013 791124
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-18200
C     RELOC:     92069-16200
C 
C 
C****************************************************************:
C 
C 
C*****************************************************
C TLOCL DOES THE FOLLOWING: 
C 1) ERROR 210 IF TAPE IS NOT A TAPE DEVICE.
C 2) ERROR 231 IF TAPE OFF-LINE.
C 3) OTHERWISE RETURNS NORMALLY.
C*******************************************************
C FORMAL PARAMETER DECLARATIONS.
C 
      INTEGER LU1,TAPE,IERR 
C*********************************************************
C TEST THAT TAPE IS TRULY A TAPE DEVICE (CHECK THAT THE DRIVER
C TYPE IS BETWEEN 20 AND 27 INCLUSIVELY). 
C 
      CALL EXEC(13+100000B,TAPE,ISTA1,ISTA2)
      GO TO 9000
1     ITEST=IAND(ISTA1,37400B)/256
      IF ((ITEST .GE. 20B) .AND. (ITEST .LE. 27B)) GO TO 900
C*******************************************************
C TAPE IS NOT A TAPE DEVICE.
C 
      CALL REIO(2,LU1,40H SPECIFIED STORAGE UNIT IS NOT LEGAL.   ,20) 
      IERR=-210 
      GOTO 950
C*********************************************************
C MAKE SURE TAPE IS ON-LINE.
C 
900   IERR=LOCAL(TAPE)
      IF (IERR .GE. 0) IERR=0 
      IF (IERR .EQ. 0) RETURN 
      CALL REIO(2,LU1,21H TAPE LU IS OFF-LINE.,-21) 
      IERR=-231 
950   CALL DBER2(LU1,IERR,6HXXXXXX,6HTLOCL ,2HXX) 
      RETURN
C*************************************************************
C RTE REJECTED THE EXEC CALL. 
C 
9000  CONTINUE
      CALL REIO(2,LU1,13H BAD TAPE LU.,-13) 
      IERR = -210 
      GOTO 950
      END 
                                          