gcc/testsuite/gfortran.dg/direct_io_2.f90

   1 ! { dg-do run }
   2 !
   3 ! this testcase derived from NIST test FM413.FOR
   4 ! tests writing direct access files in ascending and descending
   5 ! REC's.
   6       PROGRAM FM413
   7       IMPLICIT LOGICAL (L)
   8       IMPLICIT CHARACTER*14 (C)
   9       OPEN (7, ACCESS = 'DIRECT', RECL = 80, STATUS='REPLACE' )
  10       IRECN = 13
  11       IREC = 13
  12       DO 4132 I = 1,100
  13       IREC = IREC + 2
  14       IRECN = IRECN + 2
  15       WRITE(7, REC = IREC) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF,ICON21, ICON22, ICON31, ICON32, ICON33, ICON34, ICON55, ICON56
  16  4132 CONTINUE
  17       IRECN = 216
  18       IREC = 216
  19       DO 4133 I=1,100
  20       IREC = IREC - 2
  21       IRECN = IRECN - 2
  22       WRITE(7, REC = IREC) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF,ICON21, ICON22, ICON31, ICON32, ICON33, ICON34, ICON55, ICON56
  23  4133 CONTINUE
  24       IRECCK = 13
  25       IRECN = 0
  26       IREC = 13
  27       IVCOMP = 0
  28       DO 4134 I = 1,100
  29       IREC = IREC + 2
  30       IRECCK = IRECCK + 2
  31       READ(7, REC = IREC) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF,IVON21, IVON22, IVON31, IVON32, IVON33, IVON34, IVON55, IVON56
  32       IF (IRECN .NE. IRECCK) CALL ABORT
  33  4134 CONTINUE
  34       IRECCK = 216
  35       IRECN = 0
  36       IREC = 216
  37       DO 4135 I = 1,100
  38       IREC = IREC - 2
  39       IRECCK = IRECCK - 2
  40       READ(7, REC = IREC)  IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF,IVON21, IVON22, IVON31, IVON32, IVON33, IVON34, IVON55, IVON56
  41       IF (IRECN .NE. IRECCK) CALL ABORT
  42  4135 CONTINUE
  43       CLOSE(7, STATUS='DELETE')
  44       STOP
  45       END