subroutine tide_aux c c======================================================================= c === c This routine gets the current tidal fields for the specified row. === c === c ------ === c Input: === c ------ === c === c J Desired row number. === c === c Common Blocks: === c === c /FULLWD/ === c === #ifdef resetjulian c D0START Starting time. (modified Julian day) === #else c DSTART starting time. (modified Julian day) === #endif c TTSEC current elapsed time. (s) === c === c /SCALAR/ === c === c DTTS length of timestep on tracer (sec). === c === c ------- === c Output: === c ------- === c === c Common Blocks: === c === c /TIDESP/ === c === c SRFTD tidal elevation present time step. === c UTIDE zonal component of tidal velocity southern row. === c UTIDEP zonal component of tidal velocity northern row. === c VTIDE meridional component of tidal velocity southern row. === c VTIDEP meridional component of tidal velocity northern row. === # ifdef tide_zero c TUUX residual tidal stress uux c TVUY residual tidal stress vuy c TWUZ residual tidal stress wuz c TUVX residual tidal stress uvx c TVVY residual tidal stress vvy c TWVZ residual tidal stress wvz # endif c === c======================================================================= c c----------------------------------------------------------------------- c Define global data. c----------------------------------------------------------------------- c #include #include #include #include #include #include #if defined tide_zero #include #endif c c----------------------------------------------------------------------- c Define local data. c----------------------------------------------------------------------- c integer i,j,k,n,nocomp,jj logical first FLOAT * tstart FLOAT * t0tid(maxcomp) COMPLEX & cxtime,e_iomt COMPLEX & iomega(maxcomp),iphase(maxcomp),sftdcx(imt,jmt,maxcomp), & utidcx(imt,jmt,maxcomp),vtidcx(imt,jmt,maxcomp) c #if defined tide_zero COMPLEX & uval,duyp,duym,duxm,duxp,vval,dvyp,dvym,dvxm,dvxp c integer im1,ip1,jm1,jp1 FLOAT & ramp #endif FLOAT & ut,vt c save first,nocomp,tstart,iomega,iphase,sftdcx,utidcx,vtidcx c data first /.true./ c c======================================================================= c Begin executable code. c======================================================================= c c======================================================================= c Entry to construct tidal velocities. c======================================================================= c entry get_tide (j) c c----------------------------------------------------------------------- c On first call, read tidal data. c----------------------------------------------------------------------- c if (first) then #ifndef resetjulian tstart=dstart #else tstart=d0start #endif call read_tide (tstart,nocomp,iomega,iphase,t0tid,sftdcx, & utidcx,vtidcx) first = .false. end if c c----------------------------------------------------------------------- c Construct barotropic tidal fields. c----------------------------------------------------------------------- c c Set time, clear working arrays. c do 10 i=1,imt utidep(i,1)=c0 vtidep(i,1)=c0 btidep(i )=c0 10 continue c c Compute barotropic tidal fields. c do 20 n=1,nocomp cxtime = CMPLX ( t0tid(n)*day2sec+ttsec, c0 ) e_iomt = exp(iomega(n)*cxtime + iphase(n)) do 20 i=1,imt ut=ReaL(utidcx(i,j+1,n)*e_iomt) vt=ReaL(vtidcx(i,j+1,n)*e_iomt) utidep(i,1)=utidep(i,1)+ut vtidep(i,1)=vtidep(i,1)+vt btidep(i )=btidep(i )+ut*ut+vt*vt 20 continue c if (j.eq.1) then do 30 i=1,imt do 25 jj=1,jmt srftd(i,jj)=c0 25 continue utide(i,1)=c0 vtide(i,1)=c0 btide(i )=c0 30 continue do 40 n=1,nocomp e_iomt = exp(iomega(n)*cxtime + iphase(n)) do 40 i=1,imt do 35 jj=1,jmt srftd(i,jj)=srftd(i,jj)+ReaL(sftdcx(i,jj,n)*e_iomt) 35 continue ut=ReaL(utidcx(i,j,n)*e_iomt) utide(i,1)=utide(i,1)+ut vt=ReaL(vtidcx(i,j,n)*e_iomt) vtide(i,1)=vtide(i,1)+vt btide(i )=btide(i )+ut*ut+vt*vt 40 continue end if #ifndef barotropic c c----------------------------------------------------------------------- c Spread throughout water column. c----------------------------------------------------------------------- c do 50 k=2,km do 50 i=1,imt utidep(i,k)=utidep(i,1) vtidep(i,k)=vtidep(i,1) 50 continue c if (j.eq.1) then do 60 k=2,km do 60 i=1,imt utide(i,k)=utide(i,1) vtide(i,k)=vtide(i,1) 60 continue end if #endif c return c c======================================================================= c Entry to construct residual tidal stress. c======================================================================= c entry tide_stress0 (j) c #ifdef tide_zero do 200 k=1,km do 200 i=1,imt tuux(i,k)=c0 tvuy(i,k)=c0 twuz(i,k)=c0 tuvx(i,k)=c0 tvvy(i,k)=c0 twvz(i,k)=c0 200 continue jp1=min(j+1,jmt) jm1=max(j-1,1) ramp=min(ttsec/86400,c1/c2) do 210 n=1,nocomp do 210 i=1,imt im1=max(i-1,1) ip1=min(i+1,imt) c uval=utidcx(i,j,n) duyp=conjg( utidcx(i,jp1,n)-uval )*dytr(jp1) duym=conjg( uval-utidcx(i,jm1,n) )*dytr(j) duxm=conjg( uval-utidcx(im1,j,n) )*dxtr(i)*cstr(j) duxp=conjg( utidcx(ip1,j,n)-uval )*dxtr(ip1)*cstr(j) c vval=vtidcx(i,j,n) dvyp=conjg( vtidcx(i,jp1,n)-vval )*dytr(jp1) dvym=conjg( vval-vtidcx(i,jm1,n) )*dytr(j) dvxm=conjg( vval-vtidcx(im1,j,n) )*dxtr(i)*cstr(j) dvxp=conjg( vtidcx(ip1,j,n)-vval )*dxtr(ip1)*cstr(j) c tuux(i,1)=tuux(i,1)-p25*ReaL(uval*(duxm+duxp))*ramp tvuy(i,1)=tvuy(i,1)-p25*ReaL(vval*(duym+duyp))*ramp c tuvx(i,1)=tuvx(i,1)-p25*ReaL(uval*(dvxm+dvxp))*ramp tvvy(i,1)=tvvy(i,1)-p25*ReaL(vval*(dvym+dvyp))*ramp # if defined show_tide_zero if(itt.eq.1) then write(99,"(5(1x,e18.7))") $ tuux(i,1)/ramp,tvuy(i,1)/ramp, $ tuvx(i,1)/ramp,tvvy(i,1)/ramp, $ c2*omega*sine(i,j) endif # endif # if defined tide_zero_clip if (abs(tuux(i,1)).gt.c27) then tuux(i,1)=c27*tuux(i,1)/abs(tuux(i,1)) tvuy(i,1)=c27*tvuy(i,1)/abs(tvuy(i,1)) tuvx(i,1)=c27*tuvx(i,1)/abs(tuvx(i,1)) tvvy(i,1)=c27*tvvy(i,1)/abs(tvvy(i,1)) endif # endif 210 continue c do 220 k=1,km do 220 i=1,imt tuux(i,k)=tuux(i,1) tvuy(i,k)=tvuy(i,1) tuvx(i,k)=tuvx(i,1) tvvy(i,k)=tvvy(i,1) 220 continue c #endif return end