fcntl byte range locks

[happyIntelCamper]

Hi,


Trying to implement byte range locks using fcntl in fortran 90. The file system honors them.
Structure on 'handle' seems to get created ok. But 'pxffcntl' call returns 9 which indicates a problem
with the call. What am I doing wrong?

! compile/link string
! ifort -I/pgsdev/com/intel/intel11.1.072/impi/4.0.0.028/include64
! -L/pgsdev/com/intel/intel11.1.072/impi/4.0.0.028/lib64 -lmpi -g
! PioProb.F90 -o pioprob -lmpiif -Bstatic
program PioProb
use ifposix
#include
integer ier, nprocs,rank,ix,iy,iz,bg,ed,mid,i
integer arg,arg2
logical conflict
integer(kind=8) ind,imgsze,start,length
real, allocatable,dimension(:,:) :: buf,master
integer:: locks(1)
integer,parameter :: nz=212
integer,parameter :: nx=4617
integer,parameter :: ny=602
integer,parameter :: cubesz=513
character(1000) :: ascii,dat
integer win,whichone,un,handle,iargout,ilen

allocate(buf(nz,nx))
allocate(master(nz,nx))

ascii = "/datadb/jimmccp/mde/testfile"
dat = "/cfs11/jimmcc/testfile_@"

call MPI_INIT(ier)
call MPI_Comm_size(MPI_COMM_WORLD,nprocs,ier)
! if(nprocs/=9)then
! stop "run this with 9 processes"
! endif
call MPI_Comm_rank(MPI_COMM_WORLD,rank,ier)



if(rank==0)then
open(10,file=ascii,status="unknown",form="formatted",iostat=ier)
if(ier/=0)then
stop "can not open ascii file"
endif
write(10,*)"axis=z xline subline"
write(10,*)"size.z= ",nz
write(10,*)"size.xline= ",nx
write(10,*)"size.subline= ",ny
write(10,*)"delta.z= 20"
write(10,*)"delta.xline= 1"
write(10,*)"delta.subline= 1"
write(10,*)"origin.z= 0"
write(10,*)"origin.xline= 1"
write(10,*)"origin.subline= 1"
write(10,*)"inc.z= 20 "
write(10,*)"inc.xline= 1"
write(10,*)"inc.subline= 1"
write(10,*)"base.z= 0"
write(10,*)"base.xline= 1"
write(10,*)"base.subline= 1"
write(10,*)"format=fcubex"
write(10,*)"data= "//trim(dat)
close(10)
open(20,file=dat,action="readwrite",status="unknown",access="stream", &
form="unformatted",iostat=ier)
un = 20
if(ier/=0)then
stop "can not open data file rank 0"
endif

buf = 0
do iy = 1, ny
write(un,iostat=ier)buf
enddo
endif



if(rank>0)then
open(20,file=dat,action="readwrite",status="old",access="stream", &
form="unformatted",iostat=ier)
un = 20
if(ier/=0)then
stop "can not open data file non zero rank "
endif
endif
imgsze = nx*nz*4
call MPI_Barrier(MPI_COMM_WORLD,ier)
CALL PXFSTRUCTCREATE ("flock",handle,ier)
call pxfintset(handle,"l_whence",ipxfconst("SEEK_SET"),ier)
do whichone = rank, 9, nprocs
do iy = 1, ny
length = 4*nx*nz
start = (iy-1)*length
write(*,*)'rank ',rank,' read/write offset=',iy
! lock
call pxfintset(handle,"l_type",ipxfconst("F_RDLCK"),ier)
call pxfint8set(handle,"l_start",start,ier)
call pxfint8set(handle,"l_len",length,ier)
CALL PXFFCNTL (un,ipxfconst("F_SETLKW"),handle,iargout,ier)

ind=imgsze*(iy-1)+1
read(un,pos=ind,iostat=ier)master
if(ier/=0)then
stop "can not read data file "
endif
bg = 1+whichone*cubesz
ed = 1+(whichone+1)*cubesz
mid = bg+256
buf = 0.0
do ix = bg+1, ed-1
val = sqrt(150.0**2-(float(ix-mid)**2+float(iy-301)**2))
iz = val
if(iz>=0 .and. iz<=nz)then
buf(iz,ix)=1.0
endif
enddo
master = master+buf
write(un,pos=ind,iostat=ier)master
if(ier/=0)then
stop "can not write data file "
endif
flush(un)
! unlock
call pxfintset(handle,"l_type",ipxfconst("F_UNLCK"),ier)
CALL PXFFCNTL (un,ipxfconst("F_SETLKW"),handle,iargout,ier)
enddo
enddo
close(un)

write(*,*)'rank ',rank,' at end'


deallocate(buf,master)
call MPI_Barrier(MPI_COMM_WORLD,ier)

end program PioProb