C++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C.IDENTIFICATION        ISTFHD.FOR
C.AUTHOR:               J.D.PONZ  ESA-VILSPA        
C.KEYWORDS              IUE, GO FORMAT, FILE HEADER
C.PURPOSE
C  \begin{TeX}
C  Reads from 2nd record until the end of the IUE GO file header.
C  The routine performs the following functions (routine names in brackets)
C  \begin{enumerate}
C  \item Reads record record (ISTREC)
C  \item Translates EBCDIC into ASCII (ISTEAS)
C  \item Displays the header according to the argument DSPFLG (STTPUT)
C  \item If it is not the last header record go to 1.
C  \end{enumerate}
C  \end{TeX}
C         
C.LANGUAGE              F77 
C.COMMENTS
C  \begin{TeX}
C    The following extensions are used:
C  \begin{itemize}
C   \item IMPLICIT NONE
C   \item INCLUDE statement
C   \item long variable names
C   \item underscore character
C  \end{itemize}
C  \end{TeX}
C.VERSION: 1.0  INITIAL CODING  09 JUL 1990
C.VERSION:1.1   REMOVE VMS EXTENSIONS 14 APR 1992
C------------------------------------------------------------------
      SUBROUTINE ISTFHD(CHANL,BUFF,DSPFLG,STATUS)
C
      IMPLICIT NONE
      INTEGER       CHANL             ! IN: tape channel number
      CHARACTER*(*) BUFF              ! IN: buffer with the ascii header
      INTEGER       DSPFLG            ! IN: display flag
      INTEGER       STATUS            ! OUT: status
C
       INTEGER                I, NLEN, LEN, ICOUNT
       CHARACTER*72           TEXT2, TEXT3, TEXT4
       CHARACTER*360          CBUFF
       CHARACTER*1            CC
       LOGICAL                LAST
       DATA                   TEXT2
     ./'.........1.........2.........3.........4.........5.........6....
     ......7..'/
       DATA                    TEXT3
     ./'1234567890123456789012345678901234567890123456789012345678901234
     .56789012'/
       DATA                    TEXT4
     ./'----------------------------------------------------------------
     .--------'/
C
      NLEN   = 360
      STATUS = 0
      IF (DSPFLG.GE.1) THEN
        CALL STTPUT(TEXT2,STATUS)
        CALL STTPUT(TEXT3,STATUS)
        CALL STTPUT(TEXT4,STATUS)
      ENDIF
C
C ... writes the first header lines
C
      LAST = .FALSE.
      DO 10 I = 72, NLEN, 72
           IF (DSPFLG.GE.1) CALL STTPUT(BUFF(I-71:I),STATUS)
           IF (BUFF(I:I).EQ.'L') LAST = .TRUE.
 10   CONTINUE
      IF (LAST) THEN
        IF (DSPFLG.GE.1)  CALL STTPUT(TEXT4,STATUS)
        RETURN
      ENDIF
      ICOUNT = 6
C
C ... skip records
C
 15   CALL ISTREC(CHANL,CBUFF,NLEN,LEN,STATUS)
      IF (NLEN.NE.LEN .OR. STATUS.NE.0) RETURN
      DO 20  I = 72, NLEN, 72
         IF (DSPFLG.GE.2 .AND. .NOT.LAST .AND.
     .       (ICOUNT.LT.38 .OR. ICOUNT.GT.100))
     .                 CALL STTPUT(CBUFF(I-71:I),STATUS)
         ICOUNT = ICOUNT + 1
         CC = CBUFF(I:I)
         IF (CC.EQ.'L') LAST = .TRUE.
 20   CONTINUE
      IF (.NOT.LAST) GOTO 15
      RETURN
      END