subroutine read_tide (tstart,nocomp,iomega,iphase,t0tid,sftdcx, & utidcx,vtidcx) c c======================================================================= c === c This routine reads the spatial component of the tidal fields. === c === c ------ === c Input: === c ------ === c === c TSTART Starting date of model run. (modified Julian day) === c === c Common Blocks: === c === c /IOUNITS/ === c === c STDOUT standard output logical unit. === c TIDEDAT Name for netCDF input file containing tidal fields. === c TDPHDAT Name for ASCII input file containing tide phase data. === c TDPHIN Unit number for file containing tide phase data. === c === c ------- === c Output: === c ------- === c === c NOCOMP number of tidal components. === c IOMEGA tidal frequencies. (s-1; complex) === c IPHASE tidal phases. (complex) === c T0TID offset between model & tide clocks. (s; real) === c SFTDCX tidal surface elevation. (cm; complex) === c UTIDCX barotropic zonal tidal velocity. (cm/s; complex)=== c VTIDCX barotropic meridional tidal velocity. (cm/s; complex)=== c === c Common Blocks: === c === c /PE_NETCFD/ === c === c NCTDID NetCDF ID for input tidal data file. === c NCTDST Status flag for input tidal data file. === c === c======================================================================= c c----------------------------------------------------------------------- c Define global data. c----------------------------------------------------------------------- c #include #include #include #include #include #include c c----------------------------------------------------------------------- c Define local data. c----------------------------------------------------------------------- c integer i,icard,indx,ios,j,lenstr,n,ncard,ncmp,nocomp,sbgn,send integer count(5),start(5) integer no_digit,tid_indx logical fnd_comp(maxcomp) FLOAT & tstart FLOAT & rwk(imt),iwk(imt),omwk(maxcomp),t0tid(maxcomp) COMPLEX & iomega(maxcomp),iphase(maxcomp),sftdcx(imt,jmt,maxcomp), & utidcx(imt,jmt,maxcomp),vtidcx(imt,jmt,maxcomp) character*2 comp,dum,compnam(maxcomp) character*80 dimnam,fmt,mess c equivalence (iwk(1), omwk(1)) c data start,count /7*1,imt,2*1/ data fnd_comp /maxcomp*.false./ c c======================================================================= c Begin executable code. c======================================================================= c c----------------------------------------------------------------------- c Open netCDF input file. c----------------------------------------------------------------------- c call length (tidedat,lenstr,sbgn,send) c nctdid = ncopn (tidedat(sbgn:send),ncnowrit,rcode) c if (rcode.eq.0) then nctdst=2 else write (stdout,910) 'open',tidedat(sbgn:send) call exitus ('READ_TIDE') end if c c----------------------------------------------------------------------- c Determine number of tidal components. c----------------------------------------------------------------------- c varid = ncdid (nctdid,'component',rcode) if (rcode.ne.0) then write (stdout,920) 'find dimension','component', & tidedat(sbgn:send) call exitus ('READ_TIDE') end if c call ncdinq (nctdid,varid,dimnam,nocomp,rcode) if (rcode.ne.0) then write (stdout,920) 'read dimension','component', & tidedat(sbgn:send) call exitus ('READ_TIDE') else if (nocomp.gt.maxcomp) then write (stdout,930) tidedat(sbgn:send),nocomp,maxcomp call exitus ('READ_TIDE') end if c c----------------------------------------------------------------------- c Get tidal frequencies. c----------------------------------------------------------------------- c varid = ncvid (nctdid,'freqtide',rcode) if (rcode.ne.0) then write (stdout,920) 'find variable','freqtide', & tidedat(sbgn:send) call exitus ('READ_TIDE') end if c count(5)=nocomp call ncvgt (nctdid,varid,start(5),count(5),omwk,rcode) if (rcode.ne.0) then write (stdout,920) 'read variable','freqtide', & tidedat(sbgn:send) call exitus ('READ_TIDE') end if count(5)=1 c do 10 n=1,nocomp iomega(n) = CMPLX ( c0, omwk(n) ) 10 continue c c----------------------------------------------------------------------- c Get tidal surface elevations. c----------------------------------------------------------------------- c varid = ncvid (nctdid,'srftide',rcode) if (rcode.ne.0) then write (stdout,920) 'find variable','srftide', & tidedat(sbgn:send) call exitus ('READ_TIDE') end if c do 20 n=1,nocomp start(5)=n do 20 j=1,jmt start(2)=1 start(4)=j call ncvgt (nctdid,varid,start(2),count(2),rwk,rcode) if (rcode.ne.0) then write (stdout,940) 'srftide:real',tidedat(sbgn:send),j,n call exitus ('READ_TIDE') end if start(2)=2 call ncvgt (nctdid,varid,start(2),count(2),iwk,rcode) if (rcode.ne.0) then write (stdout,940) 'srftide:imag',tidedat(sbgn:send),j,n call exitus ('READ_TIDE') end if do 20 i=1,imt sftdcx(i,j,n) = CMPLX ( m2cm*rwk(i), m2cm*iwk(i) ) 20 continue c c----------------------------------------------------------------------- c Get tidal velocities. c----------------------------------------------------------------------- c varid = ncvid (nctdid,'vtide',rcode) if (rcode.ne.0) then write (stdout,920) 'find variable','vtide', & tidedat(sbgn:send) call exitus ('READ_TIDE') end if c c Zonal component. c start(2)=1 c do 30 n=1,nocomp start(5)=n do 30 j=1,jmt start(1)=1 start(4)=j call ncvgt (nctdid,varid,start,count,rwk,rcode) if (rcode.ne.0) then write (stdout,940) 'vtide:u:real',tidedat(sbgn:send),j,n call exitus ('READ_TIDE') end if start(1)=2 call ncvgt (nctdid,varid,start,count,iwk,rcode) if (rcode.ne.0) then write (stdout,940) 'vtide:u:imag',tidedat(sbgn:send),j,n call exitus ('READ_TIDE') end if do 30 i=1,imt utidcx(i,j,n) = CMPLX ( rwk(i), iwk(i) ) 30 continue c c Meridional component. c start(2)=2 c do 40 n=1,nocomp start(5)=n do 40 j=1,jmt start(1)=1 start(4)=j call ncvgt (nctdid,varid,start,count,rwk,rcode) if (rcode.ne.0) then write (stdout,940) 'vtide:v:real',tidedat(sbgn:send),j,n call exitus ('READ_TIDE') end if start(1)=2 call ncvgt (nctdid,varid,start,count,iwk,rcode) if (rcode.ne.0) then write (stdout,940) 'vtide:v:imag',tidedat(sbgn:send),j,n call exitus ('READ_TIDE') end if do 40 i=1,imt vtidcx(i,j,n) = CMPLX ( rwk(i), iwk(i) ) 40 continue c c----------------------------------------------------------------------- c Get component names. c----------------------------------------------------------------------- c varid = ncvid (nctdid,'component',rcode) if (rcode.ne.0) then write (stdout,920) 'find variable','component', & tidedat(sbgn:send) call exitus ('READ_TIDE') end if c start(1) = 1 count(1) = 2 count(2) = 1 c do 50 n = 1, nocomp c start(2) = n call ncvgtc (nctdid,varid,start,count,dum,2,rcode) if (rcode.ne.0) then write (stdout,950) 'component',tidedat(sbgn:send),n call exitus ('READ_TIDE') end if c call all_uc (dum,compnam(n)) c 50 continue c c----------------------------------------------------------------------- c Close netCDF input file. c----------------------------------------------------------------------- c call ncclos (nctdid,rcode) c if (rcode.eq.0) then nctdst=0 else write (stdout,910) 'close',tidedat(sbgn:send) call exitus ('READ_TIDE') end if c c----------------------------------------------------------------------- c Read tidal phases from ASCII input file. c----------------------------------------------------------------------- c call length (tdphdat,lenstr,sbgn,send) c c Open phase data file. c open (tdphin, file=tdphdat(sbgn:send), status='old', iostat=ios) if (ios.ne.0) then write (stdout,910) 'open',tdphdat(sbgn:send) call exitus ('READ_TIDE') end if c c Read phase data. c ncmp = 0 ncard = 1 read (tdphin,*,iostat=ios) icard c do 60 while ((icard.gt.0).and.(ios.eq.0)) c read (tdphin,*,iostat=ios) dum,omwk(1),omwk(2) c if (ios.eq.0) then ncard = ncard + 1 call all_uc (dum,comp) indx = tid_indx (comp,nocomp,compnam) if (indx.gt.0) then if (.not.fnd_comp(indx)) then fnd_comp(indx) = .true. ncmp = ncmp + 1 iphase(indx) = CMPLX ( c0, omwk(1)*deg2rad ) t0tid(indx) = (tstart-omwk(2))*day2sec end if else write (stdout,960) comp,tdphdat(sbgn:send) end if read (tdphin,*,iostat=ios) icard end if c 60 continue c if (ncmp.ne.nocomp) write (stdout,970) nocomp,ncmp c do 70 n = 1, nocomp if (.not.fnd_comp(n)) write (stdout,980) compnam(n) 70 continue c write (fmt,990) no_digit(ncard) write (mess,fmt) ncard call errio (stdout,'READ_TIDE',mess,ios) c if (ncmp.ne.nocomp) call exitus ('READ_TIDE') c c Close phase data file. c close (tdphin) c return c 900 format (/'***Error: READ_TIDE - invalid name for ',a/11x,'blank', & ' field') 910 format (/'***Error: READ_TIDE - unable to ',a,' file:'/11x,1h",a, & 1h") 920 format (/'***Error: READ_TIDE - unable to ',a,1h",a,1h", & 'in file:'/11x,1h",a,1h") 930 format (/'***Error: READ_TIDE - parameter MAXCOMP too small for', & ' file:'/11x,1h",a,1h"/11x,'NOCOMP = ',i10/11x, & 'MAXCOMP = ',i10/11x,'edit param.h',' and recompile') 940 format (/'***Error: READ_TIDE - unable to read variable ',1h",a, & 1h",' in file:'/11x,1h",a,1h"/11x,'j=',i10/11x,'n=',i10) 950 format (/'***Error: READ_TIDE - unable to read variable ',1h",a, & 1h",' in file:'/11x,1h",a,1h"/11x,'n=',i10) 960 format (/'+++Warning: READ_TIDE - no tidal fields associated wit' & 'h component ',1h",a,1h",' in phase file:'/11x,1h",a,1h") 970 format (/'***Error: READ_TIDE - incompatible number of tidal ', & 'components.'/11x,'Number tidal components: ',i10/11x, & 'Number of tidal phases: ',i10) 980 format (/'***Error: READ_TIDE - unable to find phase data for ', & 'tidal component ',a) 990 format ('(',1h','reading tidal phase card ',3h',i,i2,')') c end