c************************************************************************* c Program to interpolate bathymetry from one ADCIRC grid file to * c another. * c * c Prior to using this program, interpolating factors must be computed * c using the program INTERP.FOR. * c * c A complete summary of the information used to execute the run as * c well as any diagnostic error messages are printed in a diagnostic * c output file. * c * c************************************************************************* c * c The program is run interactively and the user is asked for * c * c DIAFILE - File name to use to write diagnostic output. * c BATHFILE - File name containing ADCIRC grid file with bathymetry * c information to be used. NOTE: this must have been the * c "from" file used in INTERP.FOR * c GRIDFILE - File name containing ADCIRC grid file onto which * c bathymetry information will be interpolated. NOTE: * c this must have been the "to" file used in INTERP.FOR * c INTERPFILE - Name of the interpolation file generated by INTERP.FOR * c to be used to interpolate bathymetry * c OUTFILE - File name of ADCIRC grid file with interpolated * c bathymetry to be generated by the program. * c * c************************************************************************* c * c Programmed by Rick Luettich, UNC Institute of Marine Sciences * c last modification 6/15/95 * c * c * c************************************************************************* program bath parameter (mnp=100000) C Declare/dimension variables implicit real*8(a-h,o-z) character*55 diafile,bathfile,gridfile,interpfile,outfile character*30 title logical found dimension b(mnp),nn1(mnp,3),fact1(mnp,3) C Specify character input formats 1200 format(a30) 1055 FORMAT(a55) 1110 FORMAT(' File ',A55,' WAS NOT FOUND!',/,' **** Try again *****',/) 1111 FORMAT(' File ',A55,' WAS FOUND!',/) C Open diagnostic output file write(*,*)' ' write(*,*)' Enter the file to write diagnositc messages to:' write(*,*)' ' read(*,1055) diafile open(unit=11,file=diafile,status='unknown') C Prompt for input and output files 1000 format(/,' Enter the ADCIRC grid file containing bathymetry to ', & 'interpolate from:',/) write(11,1000) 31 write(*,1000) read(*,1055) bathfile inquire(file=bathfile,exist=found) if(found) goto 32 write(*,1110) bathfile goto 31 32 write(*,1111) bathfile write(11,1111) bathfile open(21,file=bathfile) 1010 format(/,' Enter the ADCIRC grid file to interpolate onto:',/) write(11,1010) 33 write(*,1010) read(*,1055) gridfile inquire(file=gridfile,exist=found) if(found) goto 34 write(*,1110) gridfile goto 33 34 write(*,1111) gridfile write(11,1111) gridfile open(22,file=gridfile) 1020 format(/,' Enter the INTERP.FOR file of interpolating factors:',/) write(11,1020) 35 write(*,1020) read(*,1055) interpfile inquire(file=interpfile,exist=found) if(found) goto 36 write(*,1110) interpfile goto 35 36 write(*,1111) interpfile write(11,1111) interpfile open(23,file=interpfile) 1030 format(/,' Enter the ADCIRC grid file to create:',/) write(11,1030) write(*,1030) read(*,1055) outfile write(11,1055) outfile open(24,file=outfile) C Read in the bathymetry file saving only the bathymetric depths write(*,*) ' Reading information in bathymetry grid file.........' write(*,*) ' ' read(21,1200) title read(21,*) NEb,NPb if(npb.gt.mnp) then write(*,1001) write(*,1002) 1002 Format(' The # nodes in the bathymetry file ',/, & ' is > than the parameter MNP. Respecify MNP in ',/, & ' the parameter statement and recompile the code.') write(*,1003) stop endif 1001 format(' ***************** Dimensioning Error ******************') 1003 format(' ***************** Program Terminated ******************') do i=1,npb read(21,*) jki,x,y,b(jki) enddo C Read beginning of grid file to interpolate onto read(22,1200) title read(22,*) neo,npo if(npo.gt.mnp) then write(*,1001) write(*,1004) 1004 Format(' The # nodes in the bathymetry file ',/, & ' is > than the parameter MNP. Respecify MNP in ',/, & ' the parameter statement and recompile the code.') write(*,1003) stop endif C Read interpolation information from INTERP output files and setup C interpolation coefficient matricies write(*,*)' Reading interpolation factors....... ' read(23,1200) title read(23,*) npi do i=1,npo read(23,*) node,n1,n2,n3,fact1(i,1),fact1(i,2),fact1(i,3) nn1(i,1) = abs(n1) nn1(i,2) = abs(n2) nn1(i,3) = abs(n3) if (nn1(i,1).ne.n1) then write(*,3010) node write(11,3010) node 3010 format(1x,'Warning node # ',i7,' in the output grid ', & 'lies outside the bathymetry grid') endif end do C Read grid file, interpolate bathymetry and write output on the fly write(*,*)' Begin interpolation....... ' write(24,1200) title write(24,*) neo,npo do i=1,npo read(22,*) n,x,y,zold znew=0 do j=1,3 znew=znew+fact1(i,j)*b(nn1(i,j)) end do write(24,2222) n,x,y,znew end do 2222 format(1x,i7,2(1x,f12.6),1x,f12.3) C Read in and write out element table write(*,*)' Copy over element table... ' do i=1,neo read(22,*) n,id,i1,i2,i3 write(24,*) n,id,i1,i2,i3 end do stop end