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