MODULE bdytides !!================================================================================= !! *** MODULE bdytides *** !! Ocean dynamics: Tidal forcing at open boundaries !!================================================================================= #if defined key_bdy_tides !!--------------------------------------------------------------------------------- !! PUBLIC !! tide_init : read of namelist !! tide_data : read in and initialisation of tidal constituents at boundary !! tide_update : calculation of tidal forcing at each timestep !! PRIVATE !! uvset :\ !! vday : | Routines to correct tidal harmonics forcing for !! shpen : | start time of integration !! ufset : | !! vset :/ !!--------------------------------------------------------------------------------- !!--------------------------------------------------------------------------------- !! * Modules used USE oce ! ocean dynamics and tracers USE dom_oce ! ocean space and time domain USE iom USE in_out_manager ! I/O units USE phycst ! physical constants USE lbclnk ! ocean lateral boundary conditions (or mpp link) USE bdy_par ! Unstructured boundary parameters USE bdy_oce ! ocean open boundary conditions USE daymod ! calendar IMPLICIT NONE PRIVATE !! * Accessibility PUBLIC tide_init ! routine called in bdyini PUBLIC tide_data ! routine called in bdyini PUBLIC tide_update ! routine called in bdydyn !! * Module variables LOGICAL, PUBLIC, PARAMETER :: lk_bdy_tides = .TRUE. !: tidal forcing at boundaries. CHARACTER(len=80), PUBLIC :: & filtide !: Filename root for tidal input files INTEGER, PUBLIC, PARAMETER :: ntide_max = 15 ! Max number of tidal contituents INTEGER, PUBLIC :: ntide ! Actual number of tidal constituents CHARACTER(len=4), PUBLIC, DIMENSION(ntide_max) :: & tide_cpt !: Names of tidal components used. logical, PUBLIC :: ln_tide_date ! if true correct tide phases and amplitude for model start date REAL(wp), PUBLIC, DIMENSION(ntide_max) :: tide_speed ! Phase speed of tidal constituent (deg/hr) INTEGER, DIMENSION(ntide_max) :: indx REAL(wp), DIMENSION(jpbdim,ntide_max) :: & ssh1, ssh2, & !: Tidal constituents : SSH u1 , u2 , & !: Tidal constituents : U v1 , v2 !: Tidal constituents : V !!--------------------------------------------------------------------------------- CONTAINS SUBROUTINE tide_init !!------------------------------------------------------------------------------ !! SUBROUTINE tide_init !! *********************** !! ** Purpose : - Read in namelist for tides !! !! History : !! NEMO v2.0 ! 07-01 (D.Storkey) Original !!------------------------------------------------------------------------------ !! * Local declarations INTEGER :: jtide ! dummy loop index ! different from nblendta!) !!------------------------------------------------------------------------------ !! OPA 9.0, LODYC-IPSL (2007) !!------------------------------------------------------------------------------ NAMELIST/namtide/filtide, tide_cpt, tide_speed, ln_tide_date !!---------------------------------------------------------------------- IF(lwp) WRITE(numout,*) IF(lwp) WRITE(numout,*) 'tide_init : initialization of tidal harmonic forcing at open boundaries' IF(lwp) WRITE(numout,*) '~~~~~~~~~' ! 0. Read namelist parameters ! --------------------------- do jtide = 1, ntide_max tide_cpt(jtide) = '' enddo REWIND( numnam ) READ ( numnam, namtide ) ! control prints IF(lwp) WRITE(numout,*) ' namtide' ! Count number of components specified: ntide=ntide_max do jtide = 1, ntide_max if ( tide_cpt(jtide) == '' ) then ntide = jtide-1 exit endif enddo ! find constients in standard list do jtide = 1, ntide indx(jtide) = 0 if ( TRIM(tide_cpt(jtide)) == 'Q1' ) indx(jtide) = 1 if ( TRIM(tide_cpt(jtide)) == 'O1' ) indx(jtide) = 2 if ( TRIM(tide_cpt(jtide)) == 'P1' ) indx(jtide) = 3 if ( TRIM(tide_cpt(jtide)) == 'S1' ) indx(jtide) = 4 if ( TRIM(tide_cpt(jtide)) == 'K1' ) indx(jtide) = 5 if ( TRIM(tide_cpt(jtide)) == '2N2' ) indx(jtide) = 6 if ( TRIM(tide_cpt(jtide)) == 'MU2' ) indx(jtide) = 7 if ( TRIM(tide_cpt(jtide)) == 'N2' ) indx(jtide) = 8 if ( TRIM(tide_cpt(jtide)) == 'NU2' ) indx(jtide) = 9 if ( TRIM(tide_cpt(jtide)) == 'M2' ) indx(jtide) = 10 if ( TRIM(tide_cpt(jtide)) == 'L2' ) indx(jtide) = 11 if ( TRIM(tide_cpt(jtide)) == 'T2' ) indx(jtide) = 12 if ( TRIM(tide_cpt(jtide)) == 'S2' ) indx(jtide) = 13 if ( TRIM(tide_cpt(jtide)) == 'K2' ) indx(jtide) = 14 if ( TRIM(tide_cpt(jtide)) == 'M4' ) indx(jtide) = 15 if (indx(jtide) == 0 ) then if(lwp) write(numout,*) 'WARNING: constitunent', jtide,':', tide_cpt(jtide) & , 'not in standard list' endif enddo ! if ( ntide < 1 ) then if(lwp) write(numout,*) if(lwp) write(numout,*) ' E R R O R : Did not find any tidal components in namelist.' if(lwp) write(numout,*) ' ========== ' if(lwp) write(numout,*) nstop = nstop + 1 else if(lwp) write(numout,*) if(lwp) write(numout,*) ntide,' tidal components specified : ' if(lwp) write(numout,*) tide_cpt(1:ntide) if(lwp) write(numout,*) ntide,' phase speeds (deg/hr) : ' if(lwp) write(numout,*) tide_speed(1:ntide) endif ! Initialisation of tidal harmonics arrays sshtide(:) = 0.e0 utide(:) = 0.e0 vtide(:) = 0.e0 END SUBROUTINE tide_init SUBROUTINE tide_data !!------------------------------------------------------------------------------ !! SUBROUTINE tide_data !! *********************** !! ** Purpose : - Read in tidal harmonics data and adjust for the start time of !! the model run. !! !! History : !! NEMO v2.0 ! 07-01 (D.Storkey) Original !! ! 08-01 (J.Holt) Add date correction. !!------------------------------------------------------------------------------ !! * Local declarations CHARACTER(len=80) :: tidefile ! full file name for tidal input file INTEGER :: jtide, jgrd, jb ! dummy loop indices INTEGER :: ipi, ipj, inum, idvar ! temporary integers (netcdf read) INTEGER, DIMENSION(3) :: lendta ! length of data in the file (note may be ! different from nblendta!) INTEGER :: iday,imonth,iyear REAL(wp) :: arg, atde, btde,z1t,z2t REAL(wp), DIMENSION(jpbdta,1) :: & pdta ! temporary array for data fields REAL(WP), DIMENSION(ntide_max) :: vplu, ftc !!------------------------------------------------------------------------------ !! OPA 9.0, LODYC-IPSL (2007) !!------------------------------------------------------------------------------ ! 1. Open files and read in tidal forcing data ! -------------------------------------------- ipj = 1 do jtide = 1 ,ntide ! SSH fields ! ---------- tidefile = TRIM(filtide)//TRIM(tide_cpt(jtide))//'_grid_T.nc' if(lwp) write(numout,*) 'Reading data from file ',tidefile CALL iom_open( tidefile, inum ) jgrd = 1 IF ( nblendta(jgrd) .le. 0 ) THEN idvar = iom_varid( inum,'z1' ) if(lwp) write(numout,*) 'iom_file(1)%ndims(idvar) : ',iom_file%ndims(idvar) nblendta(jgrd) = iom_file(inum)%dimsz(1,idvar) WRITE(numout,*) 'Dim size for z1 is ',nblendta(jgrd) ENDIF ipi=nblendta(jgrd) CALL iom_get ( inum, jpdom_unknown, 'z1', pdta(1:ipi,1:ipj) ) DO jb=1, nblenrim(jgrd) ssh1(jb,jtide) = pdta(nbmap(jb,jgrd),1) END DO CALL iom_get ( inum, jpdom_unknown, 'z2', pdta(1:ipi,1:ipj) ) DO jb=1, nblenrim(jgrd) ssh2(jb,jtide) = pdta(nbmap(jb,jgrd),1) END DO CALL iom_close( inum ) ! U fields ! -------- tidefile = TRIM(filtide)//TRIM(tide_cpt(jtide))//'_grid_U.nc' if(lwp) write(numout,*) 'Reading data from file ',tidefile CALL iom_open( tidefile, inum ) jgrd = 2 IF ( lendta(jgrd) .le. 0 ) THEN idvar = iom_varid( inum,'u1' ) lendta(jgrd) = iom_file(inum)%dimsz(1,idvar) WRITE(numout,*) 'Dim size for u1 is ',lendta(jgrd) ENDIF ipi=lendta(jgrd) CALL iom_get ( inum, jpdom_unknown, 'u1', pdta(1:ipi,1:ipj) ) DO jb=1, nblenrim(jgrd) u1(jb,jtide) = pdta(nbmap(jb,jgrd),1) END DO CALL iom_get ( inum, jpdom_unknown, 'u2', pdta(1:ipi,1:ipj) ) DO jb=1, nblenrim(jgrd) u2(jb,jtide) = pdta(nbmap(jb,jgrd),1) END DO CALL iom_close( inum ) ! V fields ! -------- tidefile = TRIM(filtide)//TRIM(tide_cpt(jtide))//'_grid_V.nc' if(lwp) write(numout,*) 'Reading data from file ',tidefile CALL iom_open( tidefile, inum ) jgrd = 3 IF ( lendta(jgrd) .le. 0 ) THEN idvar = iom_varid( inum,'v1' ) lendta(jgrd) = iom_file(inum)%dimsz(1,idvar) WRITE(numout,*) 'Dim size for v1 is ',lendta(jgrd) ENDIF ipi=lendta(jgrd) CALL iom_get ( inum, jpdom_unknown, 'v1', pdta(1:ipi,1:ipj) ) DO jb=1, nblenrim(jgrd) v1(jb,jtide) = pdta(nbmap(jb,jgrd),1) END DO CALL iom_get ( inum, jpdom_unknown, 'v2', pdta(1:ipi,1:ipj) ) DO jb=1, nblenrim(jgrd) v2(jb,jtide) = pdta(nbmap(jb,jgrd),1) END DO CALL iom_close( inum ) enddo ! end loop on tidal components ! ! correct for date factors ! if( ln_tide_date ) then ! Calculate date corrects for 15 standard consituents iyear = int(ndate0 / 10000 ) ! initial year imonth = int((ndate0 - iyear * 10000 ) / 100 ) ! initial month iday = int(ndate0 - iyear * 10000 - imonth * 100) ! initial day betwen 1 and 30 call uvset(0,iday,imonth,iyear,ftc,vplu) ! if(lwp) write(numout,*) 'Correcting tide for date:',iday,imonth,iyear do jtide = 1, ntide ! if(indx(jtide) .ne. 0) then arg=3.14159265d0*vplu(indx(jtide))/180.0d0 atde=ftc(indx(jtide))*cos(arg) btde=ftc(indx(jtide))*sin(arg) if(lwp) then write(numout,'(2i5,8f10.6)') jtide,indx(jtide),tide_speed(jtide), & ftc(indx(jtide)),vplu(indx(jtide)) endif else atde = 1.0_wp btde = 0.0_wp endif ! elevation jgrd = 1 do jb=1, nblenrim(jgrd) z1t=atde*ssh1(jb,jtide)+btde*ssh2(jb,jtide) z2t=atde*ssh2(jb,jtide)-btde*ssh1(jb,jtide) ssh1(jb,jtide) = z1t ssh2(jb,jtide) = z2t end do ! u jgrd = 2 do jb=1, nblenrim(jgrd) z1t=atde*u1(jb,jtide)+btde*u2(jb,jtide) z2t=atde*u2(jb,jtide)-btde*u1(jb,jtide) u1(jb,jtide) = z1t u2(jb,jtide) = z2t end do ! v jgrd = 3 do jb=1, nblenrim(jgrd) z1t=atde*v1(jb,jtide)+btde*v2(jb,jtide) z2t=atde*v2(jb,jtide)-btde*v1(jb,jtide) v1(jb,jtide) = z1t v2(jb,jtide) = z2t end do enddo ! end loop on tidal components endif ! date correction END SUBROUTINE tide_data SUBROUTINE tide_update ( kt, jit ) !!------------------------------------------------------------------------------ !! SUBROUTINE tide_update !! ************************ !! ** Purpose : - Add tidal forcing to sshbdy, ubtbdy and vbtbdy arrays. !! !! !! History : !! NEMO v2.0 ! 06-12 (D.Storkey) Original !!------------------------------------------------------------------------------ !! * Arguments INTEGER, INTENT( in ) :: kt ! Main timestep counter INTEGER, INTENT( in ) :: jit ! Barotropic timestep counter (for timesplitting option) !! * Local declarations INTEGER :: jtide, jgrd, jb ! dummy loop indices REAL(wp) :: arg, sarg REAL(wp), DIMENSION(ntide_max) :: sist, cost !!------------------------------------------------------------------------------ !! OPA 9.0, LODYC-IPSL (2003) !!------------------------------------------------------------------------------ ! Note tide phase speeds are in deg/hour, so we need to convert the ! elapsed time in seconds to hours by dividing by 3600.0 if ( jit .eq. 0 ) then arg = kt*rdt*rad/3600.0 else ! we are in a barotropic subcycle (for timesplitting option) arg = ( (kt-1)*rdt + jit*rdtbt ) * rad/3600.0 endif do jtide = 1,ntide sarg = arg*tide_speed(jtide) cost(jtide) = cos(sarg) sist(jtide) = sin(sarg) enddo !! summing of tidal constituents into BDY arrays sshtide(:) = 0.0 utide(:) = 0.0 vtide(:) = 0.0 do jtide = 1 ,ntide jgrd=1 !: SSH on tracer grid. do jb = 1, nblenrim(jgrd) sshtide(jb) =sshtide(jb)+ ssh1(jb,jtide)*cost(jtide) + ssh2(jb,jtide)*sist(jtide) ! if(lwp) write(numout,*) 'z',jb,jtide,sshtide(jb), ssh1(jb,jtide),ssh2(jb,jtide) enddo jgrd=2 !: U grid do jb=1, nblenrim(jgrd) utide(jb) = utide(jb)+ u1(jb,jtide)*cost(jtide) + u2(jb,jtide)*sist(jtide) ! if(lwp) write(numout,*) 'u',jb,jtide,utide(jb), u1(jb,jtide),u2(jb,jtide) enddo jgrd=3 !: V grid do jb=1, nblenrim(jgrd) vtide(jb) = vtide(jb)+ v1(jb,jtide)*cost(jtide) + v2(jb,jtide)*sist(jtide) ! if(lwp) write(numout,*) 'v',jb,jtide,vtide(jb), v1(jb,jtide),v2(jb,jtide) enddo enddo END SUBROUTINE tide_update ! ! SUBROUTINE uvset (ihs,iday,imnth,iyr,f,vplu) !!------------------------------------------------------------------------------ !! SUBROUTINE uvset !! ************************ !! ** Purpose : - adjust tidal forcing for date factors !! !! !! History : !! !! Origins POLCOMS v6.3 2007 !! NEMO v2.3 ! Jason Holt !!------------------------------------------------------------------------------ implicit none !! * Arguments INTEGER, INTENT( in ) :: ihs ! Start time hours INTEGER, INTENT( in ) :: iday ! start time days INTEGER, INTENT( in ) :: imnth ! start time month INTEGER, INTENT( in ) :: iyr ! start time year INTEGER, PARAMETER :: nc =15 ! maximum number of constituents REAL(WP) :: f(nc) ! nodal correction REAL(WP) :: vplu(nc) ! phase correction ! INTEGER :: year,vd,ivdy,ndc,i,k REAL(WP) :: u(nc),v(nc),zig(nc),rtd REAL(WP) :: ss,h,p,en,p1 CHARACTER(len=8), DIMENSION(nc) :: cname ! !!------------------------------------------------------------------------------ !! OPA 9.0, LODYC-IPSL (2007) !!------------------------------------------------------------------------------ data cname/ 'q1', 'o1', 'p1', 's1', 'k1', & '2n2','mu2', 'n2','nu2', 'm2', 'l2', 't2', 's2', 'k2', & 'm4'/ data zig/.2338507481,.2433518789,.2610826055,.2617993878 & , .2625161701 & , .4868657873,.4881373225,.4963669182,.4976384533 & , .5058680490,.5153691799,.5228820265,.5235987756 & , .5250323419 & , 1.011736098/ ! ! ihs - start time gmt on ... ! iday/imnth/iyr - date e.g. 12/10/87 ! call vday(iday,imnth,iyr,ivdy) vd=ivdy ! !rp note change of year number for d. blackman shpen !rp if(iyr.ge.1000) year=iyr-1900 !rp if(iyr.lt.1000) year=iyr year = iyr ! !.....year = year of required data !.....vd = day of required data..set up for 0000gmt day year ! ndc = nc !.....ndc = number of constituents allowed ! rtd = 360.0/6.2831852 do i = 1,ndc zig(i) = zig(i)*rtd ! sigo(i)= zig(i) enddo ! if(year == 0) then return endif call shpen (year,vd,ss,h,p,en,p1) call ufset (p,en,u,f) call vset (ss,h,p,en,p1,v) ! do k=1,nc vplu(k)=v(k)+u(k) vplu(k)=vplu(k)+dble(ihs)*zig(k) ! do while ( vplu(k) < 0 ) vplu(k) = vplu(k) + 360.0 enddo ! do while (vplu(k) > 360. ) vplu(k) = vplu(k) - 360.0 enddo ! enddo ! END SUBROUTINE uvset SUBROUTINE vday(iday,imnth,iy,ivdy) !!------------------------------------------------------------------------------ !! SUBROUTINE vday !! **************** !! ** Purpose : - adjust tidal forcing for date factors !! !! !! History : !! !! Origins POLCOMS v6.3 2007 !! NEMO v2.3 ! Jason Holt !!------------------------------------------------------------------------------ implicit none ! ! subroutine arguments integer :: iday,imnth,iy,ivdy ! ! local variables integer iyr !!------------------------------------------------------------------------------ !! NEMO 2.3, LODYC-IPSL (2008) !!------------------------------------------------------------------------------ ! ================================================================= ! ! calculate day number in year from day/month/year ! ! ================================================================= if(imnth.eq.1) ivdy=iday if(imnth.eq.2) ivdy=iday+31 if(imnth.eq.3) ivdy=iday+59 if(imnth.eq.4) ivdy=iday+90 if(imnth.eq.5) ivdy=iday+120 if(imnth.eq.6) ivdy=iday+151 if(imnth.eq.7) ivdy=iday+181 if(imnth.eq.8) ivdy=iday+212 if(imnth.eq.9) ivdy=iday+243 if(imnth.eq.10) ivdy=iday+273 if(imnth.eq.11) ivdy=iday+304 if(imnth.eq.12) ivdy=iday+334 iyr=iy if(mod(iyr,4).eq.0.and.imnth.gt.2) ivdy=ivdy+1 if(mod(iyr,100).eq.0.and.imnth.gt.2) ivdy=ivdy-1 if(mod(iyr,400).eq.0.and.imnth.gt.2) ivdy=ivdy+1 RETURN END SUBROUTINE vday SUBROUTINE shpen (year,vd,s,h,p,en,p1) !!------------------------------------------------------------------------------ !! SUBROUTINE shpen !! ***************** !! ** Purpose : - calculate astronomical arguments for tides !! this version from d. blackman 30 nove 1990 !! !! History : !! !! Origins POLCOMS v6.3 2007 !! NEMO v2.3 ! Jason Holt !!------------------------------------------------------------------------------ implicit none ! subroutine arguments integer ::year,vd real(wp) :: s,h,p,en,p1 ! local variables integer yr,ilc,icent,it,iday,ild,ipos,nn,iyd REAL(wp) :: cycle,t,td,delt(84),delta,deltat !!------------------------------------------------------------------------------ !! NEMO 2.3, LODYC-IPSL (2008) !!------------------------------------------------------------------------------ data delt /-5.04,-3.90,-2.87,-0.58,0.71,1.80, & 3.08, 4.63, 5.86, 7.21, 8.58,10.50,12.10, & 12.49,14.41,15.59,15.81,17.52,19.01,18.39, & 19.55,20.36,21.01,21.81,21.76,22.35,22.68, & 22.94,22.93,22.69,22.94,23.20,23.31,23.63, & 23.47,23.68,23.62,23.53,23.59,23.99,23.80, & 24.20,24.99,24.97,25.72,26.21,26.37,26.89, & 27.68,28.13,28.94,29.42,29.66,30.29,30.96, & 31.09,31.59,31.52,31.92,32.45,32.91,33.39, & 33.80,34.23,34.73,35.40,36.14,36.99,37.87, & 38.75,39.70,40.70,41.68,42.82,43.96,45.00, & 45.98,47.00,48.03,49.10,50.10,50.97,51.81, & 52.57/ ! cycle = 360.0 ilc = 0 icent = year/100 yr = year - icent*100 t = icent - 20 ! ! for the following equations ! time origin is fixed at 00 hr of jan 1st,2000. ! see notes by cartwright ! it = icent - 20 if (it) 1,2,2 1 iday = it/4 -it go to 3 2 iday = (it+3)/4 - it ! ! t is in julian century ! correction in gegorian calander where only century year divisible ! by 4 is leap year. ! 3 continue ! td = 0.0 ! if (yr) 4,5,4 ! 4 iyd = 365*yr ild = (yr-1)/4 if((icent - (icent/4)*4) .eq. 0) ilc = 1 td = iyd + ild + ilc ! 5 td = td + iday + vd -1.0 - 0.5 t = t + (td/36525.0) ! ipos=year-1899 if (ipos .lt. 0) go to 7 if (ipos .gt. 83) go to 6 ! delta = (delt(ipos+1)+delt(ipos))/2.0 go to 7 ! 6 delta= (65.0-50.5)/20.0*(year-1980)+50.5 ! 7 deltat = delta * 1.0e-6 ! s = 218.3165 + 481267.8813*t - 0.0016*t*t + 152.0*deltat h = 280.4661 + 36000.7698*t + 0.0003*t*t + 11.0*deltat p = 83.3535 + 4069.0139*t - 0.0103*t*t + deltat en = 234.9555 + 1934.1363*t - 0.0021*t*t + deltat p1 = 282.9384 + 1.7195*t + 0.0005*t*t ! nn = s/cycle s = s - nn*cycle if ( s .lt. 0.0) s = s+cycle ! nn = h/cycle h = h-cycle*nn if (h .lt. 0.0) h = h+cycle ! nn = p/cycle p = p- cycle*nn if (p .lt. 0.0) p = p+cycle ! nn = en/cycle en = en-cycle*nn if(en .lt. 0.0) en = en + cycle en = cycle - en ! nn = p1/cycle p1 = p1 - nn*cycle ! RETURN ! END SUBROUTINE shpen SUBROUTINE ufset (p,cn,b,a) !!------------------------------------------------------------------------------ !! SUBROUTINE ufset !! ***************** !! ** Purpose : - calculate nodal parameters for the tides !! !! !! History : !! !! Origins POLCOMS v6.3 2007 !! NEMO v2.3 ! Jason Holt !!------------------------------------------------------------------------------ implicit none integer nc parameter (nc=15) ! subroutine arguments real(wp) p,cn ! ! ! local variables real(wp) :: w1,w2,w3,w4,w5,w6,w7,w8,nw,pw,rad real(wp) :: a(nc),b(nc) integer ndc,k ! !!------------------------------------------------------------------------------ !! NEMO 2.3, LODYC-IPSL (2008) !!------------------------------------------------------------------------------ ndc=nc ! ! a=f , b =u ! t is zero as compared to tifa. rad = 6.2831852d0/360.0 pw = p*rad nw = cn*rad w1 = cos(nw) w2 = cos(2*nw) w3 = cos(3*nw) w4 = sin(nw) w5 = sin(2*nw) w6 = sin(3*nw) w7 = 1 -0.2505*cos(2*pw) -0.1102*cos(2*pw-nw) & -0.156*cos(2*pw-2*nw) -0.037*cos(nw) w8 = -0.2505*sin(2*pw) -0.1102*sin(2*pw-nw) & -0.0156*sin(2*pw-2*nw) -0.037*sin(nw) ! a(1) = 1.0089+0.1871*w1-0.0147*w2+0.0014*w3 b(1) = 0.1885*w4 - 0.0234*w5+.0033*w6 ! q1 a(2) = a(1) b(2) = b(1) ! o1 a(3) = 1.0 b(3) = 0.0 ! p1 a(4) = 1.0 b(4) = 0.0 ! s1 a(5) = 1.0060+0.1150*w1- 0.0088*w2 +0.0006*w3 b(5) = -0.1546*w4 + 0.0119*w5 -0.0012*w6 ! k1 a(6) =1.0004 -0.0373*w1+ 0.0002*w2 b(6) = -0.0374*w4 ! 2n2 a(7) = a(6) b(7) = b(6) ! mu2 a(8) = a(6) b(8) = b(6) ! n2 a(9) = a(6) b(9) = b(6) ! nu2 a(10) = a(6) b(10) = b(6) ! m2 a(11) = sqrt(w7*w7+w8*w8) b(11) = atan(w8/w7) if(w7.lt.0) b(11) = b(11) + 3.141992 ! l2 a(12) = 1.0 b(12) = 0.0 ! t2 a(13)= a(12) b(13)= b(12) ! s2 a(14) = 1.0241+0.2863*w1+0.0083*w2 -0.0015*w3 b(14) = -0.3096*w4 + 0.0119*w5 - 0.0007*w6 ! k2 a(15) = a(6)*a(6) b(15) = 2*b(6) ! m4 ! do 40 k = 1,ndc b(k) = b(k)/rad 32 if (b(k)) 34,35,35 34 b(k) = b(k) + 360.0 go to 32 35 if (b(k)-360.0) 40,37,37 37 b(k) = b(k)-360.0 go to 35 40 continue RETURN END SUBROUTINE ufset SUBROUTINE vset( s,h,p,en,p1,v) !!------------------------------------------------------------------------------ !! SUBROUTINE vset !! **************** !! ** Purpose : - calculate tidal phases for 0000gmt on start day of run !! !! !! History : !! !! Origins POLCOMS v6.3 2007 !! NEMO v2.3 ! Jason Holt !!------------------------------------------------------------------------------ implicit none integer nc parameter (nc=15) ! subroutine arguments real(wp) s,h,p,en,p1 real(wp) v(nc) ! integer ndc,k !!------------------------------------------------------------------------------ !! NEMO 2.3, LODYC-IPSL (2008) !!------------------------------------------------------------------------------ ndc = nc ! v s are computed here. v(1) =-3*s +h +p +270 ! q1 v(2) =-2*s +h +270.0 ! o1 v(3) =-h +270 ! p1 v(4) =180 ! s1 v(5) =h +90.0 ! k1 v(6) =-4*s +2*h +2*p ! 2n2 v(7) =-4*(s-h) ! mu2 v(8) =-3*s +2*h +p ! n2 v(9) =-3*s +4*h -p ! mu2 v(10) =-2*s +2*h ! m2 v(11) =-s +2*h -p +180 ! l2 v(12) =-h +p1 ! t2 v(13) =0 ! s2 v(14) =h+h ! k2 v(15) =2*v(10) ! m4 ! do 72 k = 1, ndc 69 if (v(k) ) 70,71,71 70 v(k)=v(k)+360.0 go to 69 71 if ( v(k) - 360.0) 72,73,73 73 v(k)=v(k)-360.0 go to 71 72 continue RETURN END SUBROUTINE vset #else !!================================================================================= !! *** MODULE bdytides *** !!================================================================================= LOGICAL, PUBLIC, PARAMETER :: lk_bdy_tides = .FALSE. !: tidal forcing at boundaries. CHARACTER(len=80), PUBLIC :: & filtide !: Filename root for tidal input files CHARACTER(len=4), PUBLIC, DIMENSION(1) :: & tide_cpt !: Names of tidal components used. CONTAINS SUBROUTINE tide_init ! No tidal forcing at boundaries ==> empty routine END SUBROUTINE tide_init SUBROUTINE tide_data ! No tidal forcing at boundaries ==> empty routine END SUBROUTINE tide_data SUBROUTINE tide_update( kt, jit ) INTEGER :: kt, jit WRITE(*,*) 'tide_update: You should not have seen this print! error?', kt, jit ! No tidal forcing at boundaries ==> empty routine END SUBROUTINE tide_update #endif END MODULE bdytides