program arc2grd c c Program to read ArcView ASCII files and write them as c ASCII .GRD file formats for Surfer c c Variable names are mostly those used by Surfer. c c Chris Sherwood, USGS c October 10, 2000 c implicit none integer MAXX, MAXY parameter(MAXX=2501, MAXY=2501) character*40 ver /'arc2grd, version of October 10,2000'/ character*60 infn, outfn integer mx, ny, m, n double precision xlo, xhi, ylo, yhi, zlo, zhi real z(MAXX, MAXY) real conv /-1.0/ double precision nodata /1.d35/ double precision eps /0.1d0/ real fac /1.0/ integer nhedf /0/ write(*,'(1x,a)') ver write(*,*) ' Note: corrects for ARC export by increasing' write(*,*) ' xll, yll by 1/2 dx, dy' write(*,*) 'Enter input filename (max. 60 char): ' read(*,'(a60)') infn write(*,*) 'Enter output .grd filename (max. 60 char): ' read(*,'(a60)') outfn write(*,*) 'Enter conversion factor: ' read(*,*) conv call read_arc(50,infn,mx,ny,xlo,xhi,ylo,yhi, & nodata,z,MAXX,MAXY) c ...convert and find limits of z zlo = 99999.99 zhi = -99999.99 do n=1,ny do m=1,mx if( dabs(z(m,n)-nodata) .gt. eps )then z(m,n)=z(m,n)*conv if(z(m,n) .lt. zlo ) zlo=z(m,n) if(z(m,n) .gt. zhi ) zhi=z(m,n) endif enddo enddo call write_grd( 60, outfn, mx, ny, xlo, xhi, ylo, yhi, & zlo, zhi, z, nodata, MAXX, MAXY ) end c*********************************************************************** c subroutine read_arc(lfn,cfname,mx,ny,xlo,xhi,ylo,yhi, & nodata,z,MAXX,MAXY) c c Reads grid in ARC format c c*********************************************************************** implicit none character*60 cfname character*12 junk integer lfn, mx, ny, m, n, MAXX, MAXY double precision xlo,ylo,xhi,yhi,zlo,zhi,dx,dy,nodata real z(MAXX, MAXY) open(lfn,file=cfname,status='old') call ireadfil3(lfn,'ncols',5,0,0,mx) call ireadfil3(lfn,'nrows',5,0,0,ny) write(*,*) 'mx: ',mx write(*,*) 'ny: ',ny call dreadfil3(lfn,'xllcorner',9,0.d0,0,xlo) call dreadfil3(lfn,'yllcorner',9,0.d0,0,ylo) call dreadfil3(lfn,'cellsize',8,0.d0,0,dx) call dreadfil3(lfn,'NODATA_value',12,0.d0,0,nodata) dy = dx c ...next operation is needed because ARC is cell-based and c exported xllcorner, yllcorner is at corner of cell xlo = xlo+0.5*dx ylo = ylo+0.5*dy xhi = xlo+dble(mx-1)*dx yhi = ylo+dble(ny-1)*dy rewind(lfn) call skip_rec(lfn,6) do n=ny,1,-1 read(lfn,*) (z(m,n),m=1,mx) enddo close(lfn) end c*********************************************************************** c subroutine write_grd( lfn, cfname, mx, ny, xlo, xhi, ylo, yhi, & zlo, zhi, z, nodata, MAXX, MAXY ) c c Writes ASCII .grd file format for SURFER c c Note that the magic blanking value must be written exactly as c shown...thus the character writes, instead of free-format writes. c c*********************************************************************** implicit none character*60 cfname integer lfn, mx, ny, m, n, MAXX, MAXY double precision xlo, xhi, ylo, yhi, zlo, zhi, nodata double precision eps /0.1d0/ real z(MAXX, MAXY) character*4 ctag /'DSAA'/ character*14 blank /' 1.70141e+038'/, cout open(unit=lfn,file=cfname,status='unknown') write(lfn,'(a4)') ctag write(lfn,*) mx, ny write(lfn,*) xlo,xhi write(lfn,*) ylo,yhi write(lfn,*) zlo,zhi do n=1,ny do m=1,mx write(cout,'(a14)') blank if( dabs(z(m,n)-nodata) .gt. eps )then write(cout,'(g14.8)') z(m,n) endif write(lfn,'(a14)') cout enddo enddo close(lfn) end c****************************************************************************** c subroutine skip_rec(lfn,nrec) c c Reads a line of input from lfn and discards c Only works with ASCII files opened with formatting c character*1 c do i=1,nrec read(lfn,'(a)') c enddo return end c****************************************************************************** c subroutine ireadfil3(nin,anot,nchar,dvar,ifail,ivar) c c Reads INTEGER variable from file based on keyword. c Adapted from John Hunter's ireadfil2. c c Input: c nin ..... File input device c anot .... Keyword in file c nchar ... Number of characters in ANOT (max. 40) c dvar ... Default value to use c ifail ... 0 = Stop if not found c 1 = Warn and use default if not found c 2 = Silent and use default if not found c Returns: c ivar .... Resultant INTEGER variable c c****************************************************************************** integer nin,nchar,ivar,ifail,dvar character*(*) anot integer ios logical found character*80 buff logical isbot rewind(nin) ios=0 found=.false. do while(ios.eq.0.and..not.found) read(nin,1000,iostat=ios) buff 1000 format(a80) if(buff(1:nchar).eq.anot.and. & isbot( buff(nchar+1:nchar+1) )) then ! Match has been found read(buff(nchar+2:80),*,iostat=ios) ivar found=.true. endif end do if(ios.eq.0) then write(*,1400)anot,ivar 1400 format(1x,a,4x,i7) return ! Match found and no error else if(ifail.eq.0)then write(*,1100) anot 1100 format(1x,'Fatal error reading ',a) stop elseif(ifail.eq.1)then write(*,1200) anot 1200 format(1x,'Warning: Could not read ',a) ivar = dvar write(*,1300) ivar 1300 format(1x,'Using default value of: ',i8) return elseif(ifail.eq.2)then ivar = dvar return else stop 'Bad value of ifail passed to ireadfil3.' endif endif end c****************************************************************************** c subroutine dreadfil3(nin,anot,nchar,dvar,ifail,var) c c Reads double precision variable from file based on keyword. c Adapted from John Hunter's ireadfil2. c c Input: c nin ..... File input device c anot .... Keyword in file c nchar ... Number of characters in ANOT (max. 40) c ifail ... 0 = Stop if not found c 1 = Warn and use default if not found c 2 = Silent and use default if not found c Returns: c var .... Resultant double precision variable c c****************************************************************************** integer nin,nchar,ifail double precision dvar,var character*(*) anot integer ios logical found character*80 buff logical isbot rewind(nin) ios=0 found=.false. do while(ios.eq.0.and..not.found) read(nin,1000,iostat=ios) buff 1000 format(a80) if(buff(1:nchar).eq.anot.and. & isbot( buff(nchar+1:nchar+1) )) then ! Match has been found read(buff(nchar+2:80),*,iostat=ios) var found=.true. endif end do if(ios.eq.0) then write(*,1400)anot,var 1400 format(1x,a,4x,g14.8) return ! Match found and no error else if(ifail.eq.0)then write(*,1100) anot 1100 format(1x,'Fatal error reading ',a) stop elseif(ifail.eq.1)then write(*,1200) anot 1200 format(1x,'Warning: Could not read ',a) var = dvar write(*,1300) var 1300 format(1x,'Using default value of: ',g12.6) return elseif(ifail.eq.2)then var = dvar return else stop 'Bad value of ifail passed to dreadfil3.' endif endif end c**************************************************************** c logical function isbot( c ) c c Returns true if character is blank or tab c character*1 c character*1 b,t b = char(32) t = char(9) isbot = ((c .eq. b) .or. (c .eq. t)) return end