C This file: http://ftp.aset.psu.edu/pub/ger/fortran/hdk/append.for
C
C===Problem to Solve: Either create a file SAMPLE.DAT with
C   NUMADD records in it, or append NUMREC records to existing file
C   with same name. Here use VS Fortran code which conforms to the
C   ANSI X3.9-1978 and ISO R 1539-1972 Fortran 77 while documenting
C   any platform-dependent syntax or run-time logic that is
C   non-Standard conforming.
C
C   The following contributed significant portions of the problem and
C   solution:
C   B. J. Garrison, Penn State Chemistry Department.
C   H. D. Knoble, Penn State Center For Academic Computing (PSU).
C   Merle Beghtel, VS Fortran Development, San Jose.
C   Share 71, Fortran Project.                    August 14-19, 1988.
C
      CHARACTER*100 LINE
      CHARACTER*21 FILEID
      INTEGER NUMREC,IUNIT
      LOGICAL THERE
      FILEID='APPEND.DAT'
      IUNIT=25
C---NUMADD is the number of records to add of append to Fileid.
      NUMADD=5

C   Note that the INQUIRE should be done before the OPEN - another
C   implementation-defined phenomena, but one which for which we could
C   not find a platform on which it failed to work.

      INQUIRE(FILE=FILEID,EXIST=THERE)
      OPEN(UNIT=IUNIT,FILE=FILEID,STATUS='UNKNOWN')
      IF (THERE) THEN
C---Subroutine FILADD is shown below; it positions the file record
C   pointer to just after the last data record and sets NUMREC equal
C   to next logical record number.
        CALL FILADD(IUNIT,NUMREC)
      ELSE
        NUMREC=1
      ENDIF

C---Now begin writing (illustrative data in this case) at current EOF.
      DO 3 I=NUMREC,NUMREC+NUMADD-1
        WRITE(LINE,1) I
1       FORMAT('This is record number',I4)
        WRITE(IUNIT,2) LINE
2       FORMAT(A100)
3     CONTINUE
C---Wrap up and tell what happened.
      CLOSE(IUNIT)
      IF (NUMREC.EQ.1) THEN
        WRITE(*,*) NUMADD,' records written to file ',FILEID
                       ELSE
        WRITE(*,*) NUMADD,' records appended to file ',FILEID
        WRITE(*,*) '          beginning at record ',NUMREC
      ENDIF
      STOP
      END
      SUBROUTINE FILADD (K,NEXT)
C===Position the record pointer of IUNIT K at EOF and return the
C   next-record pointer, NEXT.
      INTEGER K,NEXT
      DO 1 NEXT=1,999999999
        READ(K,2,END=3)
2       FORMAT(A1)
        GOTO 1
C---To be conformable to the Fortran 77 Standard, ANSI X3.9-1978, and
C   proposed X3J3/S8.115 (Fortran 90), Subroutine FILEADD should not be
C   called when the file associated with Unit number K does not exist.
C   Reason: e.g. there the implementation of a null file (file
C   containing no records) is file-system (operating system) dependent.
3       IF (NEXT.GT.1)BACKSPACE(K)
        RETURN
1     CONTINUE
      RETURN
      END