CamCASP/CodeExamples/DirectAccess

program directaccess
!Write a direct access file and read it.
!Written with the hope of tracing a bug in gfortran - if it is a bug!
implicit none
integer, parameter :: dp = kind(1d0)
!integer, parameter :: reclen = 32760     !record length
integer :: reclen
integer, parameter :: maxlen = 2728      !max len of arrays x() n() in a rec
integer, parameter :: lenval = maxlen + 1366
character(30) :: filename='tmp_directaccess.tmp'
integer :: fileunit
integer :: stat, numrows, i, j
real(dp), dimension(100000) :: values
character(80) :: accesstype, fileform
logical :: iexist
integer :: recordlen, next_rec, num_entries

fileunit = 7

print *,'Number of rows '
read *,numrows

reclen=numrows*dp + 4 + 4
print *,'reclen = ',reclen

open(fileunit,file=filename,status='unknown',access='direct',&
    recl=reclen,form='unformatted',action='readwrite',iostat=stat)
print *,trim(filename),' open with stat = ',stat

do i = 1, numrows
  do j = 1, numrows
    values(j) = real(i+j,kind=dp)
  enddo
  write(fileunit,rec=i)i+1, maxlen, values(1:numrows)
enddo

close(fileunit)

! Overwrite:

numrows = numrows + 1000
reclen=numrows*dp + 4 + 4
print *,'reclen = ',reclen

open(fileunit,file=filename,status='unknown',access='direct',&
    recl=reclen,form='unformatted',action='readwrite',iostat=stat)
print *,trim(filename),' open with stat = ',stat

do i = 1, numrows
  do j = 1, numrows
    values(j) = real(i+2*j,kind=dp)
  enddo
  write(fileunit,rec=i)i+1, maxlen, values(1:numrows)
enddo

close(fileunit)


open(fileunit,file=filename,status='unknown',access='direct',&
    recl=reclen,form='unformatted',action='read',iostat=stat)

inquire(file=filename,exist=iexist,access=accesstype,form=fileform,&
   recl=recordlen)
print *,'Inquire: exists= ',iexist
print *,'       : access= ',trim(accesstype)
print *,'       : form  = ',trim(fileform)
print *,'       : reclen= ',recordlen

do i = 1, min(10,numrows)
  read(fileunit,rec=i,iostat=stat)next_rec,num_entries,values(1:numrows)
  print '(1x,a,4(i6,1x))','rec and stat ',i,stat,next_rec,num_entries
  print '(a,10(f5.1,1x))','    vals: ',values(1:10)
enddo
do i = max(1,numrows-10),max(10,numrows)
  read(fileunit,rec=i,iostat=stat)next_rec,num_entries,values(1:numrows)
  print '(1x,a,4(i6,1x))','rec and stat ',i,stat,next_rec,num_entries
  print '(a,10(f10.1,1x))','    vals: ',values(1:10)
enddo


close(fileunit)


end program directaccess

--alston 12:10, 14 May 2010 (BST)