! { dg-do run }
|
! { dg-do run }
|
!
|
!
|
! this testcase derived from NIST test FM413.FOR
|
! this testcase derived from NIST test FM413.FOR
|
! tests writing direct access files in ascending and descending
|
! tests writing direct access files in ascending and descending
|
! REC's.
|
! REC's.
|
PROGRAM FM413
|
PROGRAM FM413
|
IMPLICIT LOGICAL (L)
|
IMPLICIT LOGICAL (L)
|
IMPLICIT CHARACTER*14 (C)
|
IMPLICIT CHARACTER*14 (C)
|
OPEN (7, ACCESS = 'DIRECT', RECL = 80, STATUS='REPLACE', FILE="FOO" )
|
OPEN (7, ACCESS = 'DIRECT', RECL = 80, STATUS='REPLACE', FILE="FOO" )
|
IRECN = 13
|
IRECN = 13
|
IREC = 13
|
IREC = 13
|
DO 4132 I = 1,100
|
DO 4132 I = 1,100
|
IREC = IREC + 2
|
IREC = IREC + 2
|
IRECN = IRECN + 2
|
IRECN = IRECN + 2
|
WRITE(7, REC = IREC) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF,ICON21, ICON22, ICON31, ICON32, ICON33, ICON34, ICON55, ICON56
|
WRITE(7, REC = IREC) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF,ICON21, ICON22, ICON31, ICON32, ICON33, ICON34, ICON55, ICON56
|
4132 CONTINUE
|
4132 CONTINUE
|
IRECN = 216
|
IRECN = 216
|
IREC = 216
|
IREC = 216
|
DO 4133 I=1,100
|
DO 4133 I=1,100
|
IREC = IREC - 2
|
IREC = IREC - 2
|
IRECN = IRECN - 2
|
IRECN = IRECN - 2
|
WRITE(7, REC = IREC) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF,ICON21, ICON22, ICON31, ICON32, ICON33, ICON34, ICON55, ICON56
|
WRITE(7, REC = IREC) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF,ICON21, ICON22, ICON31, ICON32, ICON33, ICON34, ICON55, ICON56
|
4133 CONTINUE
|
4133 CONTINUE
|
IRECCK = 13
|
IRECCK = 13
|
IRECN = 0
|
IRECN = 0
|
IREC = 13
|
IREC = 13
|
IVCOMP = 0
|
IVCOMP = 0
|
DO 4134 I = 1,100
|
DO 4134 I = 1,100
|
IREC = IREC + 2
|
IREC = IREC + 2
|
IRECCK = IRECCK + 2
|
IRECCK = IRECCK + 2
|
READ(7, REC = IREC) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF,IVON21, IVON22, IVON31, IVON32, IVON33, IVON34, IVON55, IVON56
|
READ(7, REC = IREC) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF,IVON21, IVON22, IVON31, IVON32, IVON33, IVON34, IVON55, IVON56
|
IF (IRECN .NE. IRECCK) CALL ABORT
|
IF (IRECN .NE. IRECCK) CALL ABORT
|
4134 CONTINUE
|
4134 CONTINUE
|
IRECCK = 216
|
IRECCK = 216
|
IRECN = 0
|
IRECN = 0
|
IREC = 216
|
IREC = 216
|
DO 4135 I = 1,100
|
DO 4135 I = 1,100
|
IREC = IREC - 2
|
IREC = IREC - 2
|
IRECCK = IRECCK - 2
|
IRECCK = IRECCK - 2
|
READ(7, REC = IREC) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF,IVON21, IVON22, IVON31, IVON32, IVON33, IVON34, IVON55, IVON56
|
READ(7, REC = IREC) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF,IVON21, IVON22, IVON31, IVON32, IVON33, IVON34, IVON55, IVON56
|
IF (IRECN .NE. IRECCK) CALL ABORT
|
IF (IRECN .NE. IRECCK) CALL ABORT
|
4135 CONTINUE
|
4135 CONTINUE
|
CLOSE(7, STATUS='DELETE')
|
CLOSE(7, STATUS='DELETE')
|
STOP
|
STOP
|
END
|
END
|
|
|
