Example programs

! The main program is a driver for the function roundoff, which
! truncates and rounds a floating-point number to a requested
! number of decimal places.  The main program prompts for two
! numbers, a double-precision number and an integer.  These are
! passed to the function roundoff as arguments.  The
! double-precision argument (x) is the value to be rounded, and
! the integer (n) represents the number of decimal places for
! rounding.  The function converts both arguments to character
! format, storing them in separate internal files.  The function
! uses the F edit descriptor (to which n in character format has
! been appended) to round x.  This rounded value is finally
! converted back from a character string to a double-precision
! number, which the function returns.
PROGRAM main
    REAL (KIND=8) :: x, y, roundoff
 
  ! Use nonadvancing I/O to suppress the newline and keep the
  !   prompt on the same line as the input.
  WRITE (6, '(X, A)', ADVANCE='NO') 'Enter a real number:  '
  READ (5, '(F14.0)') x
  WRITE (6, '(A)') 'How many significant digits (1 - 9) to the'
  WRITE (6,'(X, A)',ADVANCE='NO') 'right of the decimal point?  '
 
  ! Don’t enter a number greater than you input into x!
  READ (5, '(I1)') n
  y = roundoff(x, n)
  PRINT *, y
END PROGRAM main
 
  ! This function truncates and rounds x to the number of decimal
  ! places specified by n.  The function performs no error
  ! checking on either argument.
  REAL (KIND=8) FUNCTION roundoff(x, n)
  INTEGER :: n
  REAL (KIND=8) :: x
  CHARACTER (LEN=14) :: dp_val
  CHARACTER :: dec_digits
 
  ! Use an edit descriptor to convert the value of n to a
  !   character; write the result to the internal file 
  !   dec_digits.
  WRITE (dec_digits, '(I1)') n
 
  ! Concatenate dec_digits to the string 'F14.'.  The complete
  ! string forms an edit descriptor that will convert the
  ! binary value of x to a formatted value of x to a
  ! formatted character string that formats the
  ! value.  The character represents the requested level of
  ! precision.  The formatted number is stored in the internal
  ! file dp_val.
  WRITE (dp_val, '(F14.'//dec_digits//')') x
 
  ! Re-convert the formatted record in dp_val to a binary
  ! value that the function will return.
  READ (dp_val, '(F14.0)') roundoff
 
END FUNCTION roundoff

! This program uses nonadvancing I/O to read a series of
! sequential-file records, character by character.  Each 
! record is divided into fields.  The first field is the name 
! of a student and is 20 characters log.  Each of the  
! remaining fields s a numeric test score and is 3
! i characters long.  The name score fields.  The program
! reads the name field, then reads each score field
! until it encounters end-of-record.  When the
! program encounters end-of-record, it starts a new record.  
! When it encounters and end-of-file,
! the program is done.  For the sake of simplicity, the
! program does no error-checking.
PROGRAM main
  INTEGER :: grade, count, sum, average
  CHARACTER(LEN=20) name
 
  OPEN(20, FILE='grades')
  WRITE (6, 10) ”Name”, ”Average”
  WRITE (6, *) ”--------------------------”
  DO  ! read and process each record
    sum = 0
    count = 0
    ! Read the first field of each record, using nonadvancing
    ! I/O so as not to advance beyond that field.  The END=
    ! specifier causes the program to exit the loop and branch
    ! to the statement at 999 when it detects end-of-file.
    READ(20, ”(A20)”, ADVANCE='NO', END=999) name
 
    ! Read each of the score fields of the record, using
    ! nonadvancing I/O to avoid advancing to the next record
    ! after each read.  The EOR= specifier causes the program
    ! to break out of the loop and resume
    ! execution at the statement labeled 99.
    DO  ! inner loop to read scores
    ! read a score and convert it to integer
      READ(20, ”(I3)”, ADVANCE='NO', EOR=99) grade
 
      count = count + 1
      sum = sum + grade
    END DO
 
    ! calculate average
99  average = sum/count
    WRITE(6, 20) name, average  ! write student name and average
  END DO
 
10 FORMAT (X, A, T21, A)
20 FORMAT (X, A, I3)
999 CLOSE(20)
END PROGRAM main

Sandra Delford       79 85 81 72100100
Joan Arunsoelton      8 64 77 79
Herman Pritchard    100 92 87 65  0
Felicity Holmes      97 78 58 75 88 73
Anita Jayson         93 85 90 95 68 72 93
Phil Atley            9 27 35 49
Harriet Myrle        84 78 93 95 97 92 84 93
Pete Hartley         67 54 58 71 93 58

! This program uses an external file and a scratch file to
! insert a number into a list of numerically sorted numbers.
! The sorted list is held in a external file. The program uses
! the scratch file as a temporary holding place. The program
! uses direct access method with the scratch file.
PROGRAM main
  REAL :: number_to_insert, number_in_list
  INTEGER :: rec_num, ios1, ios2, i
 
  ! Initialize counter.
  rec_num = 0
 
  ! ios1 must be initialized to 0 so that the error-handling
  ! section at the end of the program will work correctly
  ios1= 0
 
  ! Open the scratch file and the sequential data file
  OPEN (18, FILE='list', STATUS='UNKNOWN', IOSTAT=ios1, ERR=99)
  OPEN (17, STATUS='SCRATCH', ACCESS='DIRECT', FORM='FORMATTED', 
  &
                IOSTAT=ios1, ERR=99, RECL=16)
  ! Use nonadvancing I/O to suppress newline at the end of output
  !   record, thus keeping the prompt on the same line with the
  !   input.
  WRITE (6, FMT='(A)', ADVANCE='NO')  &
       ' Enter number to insert in list:  '
  READ *, number_to_insert
 
  ! Read from sorted list and write to scratch file until we find
  !   where to insert number; then, write number_to_insert, and
  !   continue writing remaining sorted numbers to scratch file.
  DO WHILE (ios1 >= 0) ! loop only if OPEN didn’t encounter EOF
    ! The END=15 specifier in the READ statement gets us out of
    ! the loop, once we’re in it.
    READ (18, *, END=10, IOSTAT=ios2, ERR=99) number_in_list
    IF (number_to_insert <= number_in_list) THEN
      rec_num = rec_num + 1    ! add the new record
      WRITE(17, 100, REC=rec_num) number_to_insert
      DO
        rec_num = rec_num + 1
        WRITE(17, 100, REC=rec_num) number_in_list
        READ (18, *, END=15, IOSTAT=ios2, ERR=99) number_in_list
      END DO
    ELSE
      rec_num = rec_num + 1
      WRITE (17, 100, REC=rec_num) number_in_list
    END IF
  END DO
  ! The file is empty or the item goes at the end of file.  Add 1
  !   to rec_num for the record to be inserted.
10 rec_num = rec_num + 1
  WRITE (17, 100, REC=rec_num) number_to_insert
 
  ! Copy the scratch file to the data file.  But first rewind
  ! so that we start writing at beginning of the data file.
15 REWIND 18
 
  ! Read from scratch file and write to data file
  DO i = 1, rec_num
    READ (17, 100, REC=i) number_in_list
    WRITE (18, *) number_in_list
  END DO
  CLOSE (18)
  CLOSE (17)
  STOP 'Inserted!'
 
  ! Error handling section
99 IF (ios1 /= 0) THEN
    WRITE (7, 200) ”Open error = ”, ios1
  ELSE
    WRITE (7, 200) ”Read error = ”, ios2
  END IF
 
100 FORMAT (F16.6)
200 FORMAT (A, 2I6)
END PROGRAM main