FTN4
      SUBROUTINE RING(LU1,TAPE,P5,IERR) 
     +,92069-16204 REV.2013 790413
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-18204
C     RELOC:     92069-16204
C 
C 
C****************************************************************:
C 
C 
C**************************************************** 
C RING CHECKS THAT THE TAPE LU HAS A WRITE RING IN IT.
C IF IT DOES, RING IMMEDIATELY RETURNS. 
C IF IT DOESNT, RING CHECKS P5 AND ABORTS IF P5 RETURNS 
C AB, AND PROMPTS THE USER TO INSERT A WRITE RING IF
C THE USER SPECIFIED NO ABORT.
C*****************************************************
      INTEGER LU1,TAPE,P5,IERR
      INTEGER ERR1(17)
      INTEGER NUM(3)
      DATA ERR1/2H T,2HAP,2HE ,2HLU,2H X,2HXX,2HXX,2HX ,2HHA,2HS ,
     &     2HNO,2H W,2HRI,2HTE,2H R,2HIN,2HG./
C*****************************************************************
C GET DYNAMIC STATUS. 
C 
      CALL EXEC(13,TAPE,ISTAT)
      ISTAT=IAND(ISTAT,4B)
      IF (ISTAT .EQ. 0) IERR=0
      IF (IERR .EQ. 0) RETURN 
C*****************************************************************
C TAPE HAS NO WRITE RING. 
C 
      CALL CNUMD(TAPE,NUM)
      CALL SMOVE(NUM,1,6,ERR1,10) 
      CALL REIO(2,LU1,ERR1,17)
      IERR=-230 
      CALL DBER2(LU1,IERR,6HXXXXXX,6HRING  ,2HXX) 
      RETURN
      END 
                                                                                                                