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) parameter (max_freq=20) C Declare/dimension variables implicit real*8(a-h,o-z) character*55 diafile,bathfile,gridfile,interpfile,outfile character*30 title character*10 name logical found dimension amp(mnp,max_freq),dir(mnp,max_freq) dimension 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 Fort.53 file containing data 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 fort.53 file saving only the values to interpolate write(*,*) ' Reading information in fort.53 file.........' write(*,*) ' ' read(21,*) num_freq write(24,*) num_freq do i=1,num_freq read(21,100) freq,factor,eq_arg,name write(24,100) freq,factor,eq_arg,name enddo read(21,*) np 100 format(5x,E16.10,2x,f9.7,3x,f10.8,2x,a10) if(np.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,np read(21,*) num do j=1,num_freq read(21,101) amp(i,j),dir(i,j) enddo enddo 101 format(3x,E15.8,4x,f8.4) 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,*) npo do i=1,npo write(24,*) i do k=1,num_freq znew_amp=0 znew_dir=0 do j=1,3 znew_amp=znew_amp+fact1(i,j)*amp(nn1(i,j),k) znew_dir=znew_dir+fact1(i,j)*dir(nn1(i,j),k) end do if (znew_dir.gt.360.) znew_dir=znew_dir-360.0 write(24,101) znew_amp,znew_dir end do enddo 2222 format(1x,i7,2(1x,f12.6),1x,f12.3) stop end