I have discovered a bug that requires closing and re-opening of grid files
between Fortran subroutine calls.
The following Fortran code demonstrates the problem and the work-around.
I am using the wrapper functions
in wfuncs.c supplied with Oasis/Montaj.
c bugtest.f
c
c Demonstrates a bug requiring closing and reopening of grid files
c between subroutine calls.
c
subroutine bugtest(ifile,ierr)
character*(*) ifile
integer*4 inunit,scr1unit,scr2unit,ierr
data inunit/0/,scr1unit/0/,scr2unit/0/
c
c open and read header of input grid
c
call OpenGrid_WF(ifile,inunit,ierr)
if(ierr.ne.0) go to 9999
c call ReadHeader_WF(inunit,nc,nr,xo,dx,yo,dy,iproj,cmer,blat,ierr)
call GetGridInfo_WF(inunit,nc,nr,xo,yo,dx,dy,rot,ierr)
if(ierr.ne.0) go to 9999
c
c create a scratch grid
c
call NewGrid_WF(scr1unit,'scratch1.grd',nc,nr,xo,yo,dx,dy,rot,
1ierr)
if(ierr.ne.0) go to 9999
c
c copy the input grid to the scratch grid
c
call copy(inunit,scr1unit,nc,nr)
if(ierr.ne.0) go to 9999
call CloseGrid_WF(inunit,ierr)
if(ierr.ne.0) go to 9999
c
c The following four lines of code should not be necessary, but are a
c required work-around for an apparent bug in CloseGrid_WF
c
call CloseGrid_WF(scr1unit,ierr)
if(ierr.ne.0) go to 9999
call OpenGrid_WF('scratch1.grd',scr1unit,ierr)
if(ierr.ne.0) go to 9999
c
c create another scratch grid
c
call NewGrid_WF(scr2unit,'scratch2.grd',nc,nr,xo,yo,dx,dy,rot,
1ierr)
if(ierr.ne.0) go to 9999
c
c copy the first scratch grid to the second scratch grid
c
call copy(scr1unit,scr2unit,nc,nr)
if(ierr.ne.0) go to 9999
c
c Without the above work-around, the following error message results:
c "Cannot write to compressed grid file scratch1.grd out of sequence.
c Attempt to write to vector 1 while current vector was 0."
c
9999 return
end
c **************************************************************
subroutine copy(in,io,nc,nr)
c copy a grid
c in: input unit number
c io: output unit number
c nc: columns in input grid
c nr: rows in input grid
dimension g(8192)
do 10 j=1,nr
call GetRow_WF(in,j,nc,g,ierr)
if(ierr.ne.0) go to 9999
call PutRow_WF(io,j,nc,g,ierr)
if(ierr.ne.0) go to 9999
10 continue
9999 return
end
_____________________________________________________________
Jeffrey D. Phillips Research Geophysicist
U.S. Geological Survey phone: 303-236-1206
Denver Federal Center fax: 303-236-1425
Denver, CO 80225 USA email: [EMAIL PROTECTED]
_______________________________________________________
More mailing list info http://www.geosoft.com/support/listserv/index.html
