1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
|
! { dg-do run }
! pr35699 run-time abort writing zero sized section to direct access file
program directio
call qi0010 ( 10, 1, 2, 3, 4, 9, 2)
end
subroutine qi0010 (nf10, nf1, nf2, nf3, nf4,nf9, np2)
character(10) bda(nf10)
character(10) bda1(nf10), bval
integer j_len
bda1(1) = 'x'
do i = 2,10
bda1(i) = 'x'//bda1(i-1)
enddo
bda = 'unread'
inquire(iolength = j_len) bda1(nf1:nf10:nf2), bda1(nf4:nf3),
$ bda1(nf2:nf10:nf2)
open (unit=48,
$ access='direct',
$ status='scratch',
$ recl = j_len,
$ iostat = istat,
$ form='unformatted',
$ action='readwrite')
write (48,iostat = istat, rec = 3) bda1(nf1:nf10:nf2),
$ bda1(nf4:nf3), bda1(nf2:nf10:nf2)
if ( istat .ne. 0) then
call abort
endif
istat = -314
read (48,iostat = istat, rec = np2+1) bda(nf1:nf9:nf2),
$ bda(nf4:nf3), bda(nf2:nf10:nf2)
if ( istat .ne. 0) then
call abort
endif
do j1 = 1,10
bval = bda1(j1)
if (bda(j1) .ne. bval) call abort
enddo
end subroutine
|
