MODULE taumod !!====================================================================== !! *** MODULE taumod *** !! Ocean forcing : stress at the the ocean surface !!===================================================================== !!---------------------------------------------------------------------- !! tau : define the surface stress for the ocean !!---------------------------------------------------------------------- !! * Modules used USE dom_oce ! ocean space and time domain USE phycst ! physical constants USE in_out_manager ! I/O manager USE daymod ! calendar USE lbclnk ! IMPLICIT NONE PRIVATE !! * Routine accessibility PUBLIC tau ! routine called by step.F90 !! * Share modules variables REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: & taux, tauy, & !: surface stress components in (i,j) referential tauxg, tauyg !: surface stress components in geographical ! ! referential (used in output) !!---------------------------------------------------------------------- !! OPA 9.0 , LODYC-IPSL (2003) !!---------------------------------------------------------------------- #if defined key_tau_monthly ! Monthly climatology in (i,j) referential (i-comp. at U-pt and j-comp. at V-pt) # if defined key_fdir !!---------------------------------------------------------------------- !! 'key_tau_monthly' MONTHLY climatology stress !! 'key_fdir' direct access files !!---------------------------------------------------------------------- # include "tau_forced_monthly_fdir.h90" # else !!---------------------------------------------------------------------- !! 'key_tau_monthly' MONTHLY climatology stress !! default case NetCDF files !!---------------------------------------------------------------------- # include "tau_forced_monthly.h90" # endif # elif defined key_tau_daily !!---------------------------------------------------------------------- !! 'key_tau_daily' DAILY stress !! NetCDF files !!---------------------------------------------------------------------- ! Daily climatology/interannual in (i,j) referential (i-comp. at U-pt and j-comp. at V-pt) # include "tau_forced_daily.h90" #elif defined key_coupled ! Coupled case : stress at the coupling frequency # if defined key_ice_lim !!---------------------------------------------------------------------- !! 'key_coupled' Coupled Ocean/Atmosphere !! 'key_ice_lim' LIM sea-ice !!---------------------------------------------------------------------- ! New way: 3D referential link to the earth (avoid north pole pb) ! (3 component stress defined at U- and V-points) # include "tau_coupled_ice.h90" # else !!---------------------------------------------------------------------- !! 'key_coupled' Coupled Ocean/Atmosphere !! Default case NO sea-ice !!---------------------------------------------------------------------- ! old fashion: geographical referential ! (zonal and meridional stress defined at U- and V-points) # include "tau_coupled.h90" # endif #else !!---------------------------------------------------------------------- !! Default option constant forcing !!---------------------------------------------------------------------- !! * local modules variables INTEGER :: & !!! * Namelist numtau * ntau000 = 1 ! nb of time-step during which the surface stress ! ! increase from 0 to its nominal value (taudta) (>0) REAL(wp) :: & !!! * Namelist numtau * tau0x = 0.e0 , & ! constant wind stress value in i-direction tau0y = 0.e0 ! constant wind stress value in j-direction !!---------------------------------------------------------------------- CONTAINS SUBROUTINE tau( kt ) !!--------------------------------------------------------------------- !! *** ROUTINE tau *** !! !! ** Purpose : provide the ocean surface stress at each time step !! !! ** Method : Constant surface stress increasing from 0 to taudta !! value during the first ntau000 time-step (namelist) !! CAUTION: never mask the surface stress field ! !! !! ** Action : - update taux , tauy the stress in (i,j) ref. !! - update tauxg, tauyg the stress in geographic ref. !! !! History : !! 4.0 ! 91-03 (G. Madec) Original code !! 8.5 ! 02-11 (G. Madec) F90: Free form and module !!---------------------------------------------------------------------- !! * Arguments INTEGER, INTENT( in ) :: kt ! ocean time step REAL(wp) :: ztau, ztau_sais, & ! wind intensity and of the seasonal cycle ztime, & ! time in hour ztimemax, ztimemin, & ! 21th June, and 21th decem. if date0 = 1st january ztaun ! intensity INTEGER :: ji, jj, & ! dummy loop indices js ! indice for months INTEGER :: & zyear0, & ! initial year zmonth0, & ! initial month zday0, & ! initial day zday_year0, & ! initial day since january 1st zdaymax !! * Local declarations REAL(wp) :: zfacto ! NAMELIST/namtau/ ntau000, tau0x, tau0y !!--------------------------------------------------------------------- IF( cp_cfg == 'gyre' ) THEN ! same wind as in Wico !test date0 : ndate0 = 010203 zyear0 = ndate0 / 10000 zmonth0 = ( ndate0 - zyear0 * 10000 ) / 100 zday0 = ndate0 - zyear0 * 10000 - zmonth0 * 100 !Calculates nday_year, day since january 1st zday_year0 = zday0 !accumulates days of previous months of this year DO js = 1, zmonth0 IF(nleapy > 1) THEN zday_year0 = zday_year0 + nleapy ELSE IF( MOD(zyear0, 4 ) == 0 ) THEN zday_year0 = zday_year0 + nbiss(js) ELSE zday_year0 = zday_year0 + nobis(js) ENDIF ENDIF END DO ! day (in hours) since january the 1st ztime = FLOAT( kt ) * rdt / (rmmss * rhhmm) & ! incrementation in hour & - (nyear - 1) * rjjhh * raajj & ! - nber of hours the precedent years & + zday_year0 / 24 ! nber of hours initial date ! day 21th counted since the 1st January zdaymax = 21 ! 21th day of the month DO js = 1, 5 ! count each day until end May IF(nleapy > 1) THEN zdaymax = zdaymax + nleapy ELSE IF( MOD(zyear0, 4 ) == 0 ) THEN zdaymax = zdaymax + nbiss(js) ELSE zdaymax = zdaymax + nobis(js) ENDIF ENDIF END DO ! 21th june in hours ztimemax = zdaymax * 24 ! 21th december day in hours ztimemin = ztimemax + rjjhh * raajj / 2 ! rjjhh * raajj / 4 = 1 seasonal cycle in hours ztau = 0.105 / SQRT(2.) ! mean intensity at 0.105 ; srqt(2) because projected with 45° angle ztau_sais = 0.015 ! seasonal oscillation intensity ztaun = ztau - ztau_sais * COS( (ztime - ztimemax) / (ztimemin - ztimemax) * rpi ) DO jj = 1, jpj DO ji = 1, jpi ! domain from 15° to 50° and 1/2 period along 14° so 5/4 of half period with seasonal cycle taux (ji,jj) = - ztaun * SIN( rpi * (gphiu(ji,jj) - 15.) / (29.-15.) ) tauy (ji,jj) = ztaun * SIN( rpi * (gphiv(ji,jj) - 15.) / (29.-15.) ) END DO END DO IF( kt == nit000 ) THEN IF(lwp) WRITE(numout,*)' tau : Constant surface wind stress read in namelist' IF(lwp) WRITE(numout,*)' ~~~~~~~ ' IF(lwp) WRITE(numout,*)'nyear = ', nyear IF(lwp) WRITE(numout,*)'nmonth = ', nmonth IF(lwp) WRITE(numout,*)'nday = ', nday IF(lwp) WRITE(numout,*)'nday_year = ',nday_year IF(lwp) WRITE(numout,*)'ndastp = ',ndastp IF(lwp) WRITE(numout,*)'adatrj = ',adatrj IF(lwp) WRITE(numout,*)'ztime = ',ztime IF(lwp) WRITE(numout,*)'zdaymax = ',zdaymax IF(lwp) WRITE(numout,*)'ztimemax = ',ztimemax IF(lwp) WRITE(numout,*)'ztimemin = ',ztimemin IF(lwp) WRITE(numout,*)'zyear0 = ', zyear0 IF(lwp) WRITE(numout,*)'zmonth0 = ', zmonth0 IF(lwp) WRITE(numout,*)'zday0 = ', zday0 IF(lwp) WRITE(numout,*)'zday_year0 = ',zday_year0 IF(lwp) WRITE(numout,*)'nobis(2)', nobis(2) IF(lwp) WRITE(numout,*)'nobis(5)', nobis(5) IF(lwp) WRITE(numout,*)'nobis(6)', nobis(6) IF(lwp) WRITE(numout,*)'nobis(1)', nobis(1) IF(lwp) WRITE(numout,*)'nobis(zmonth0 -1)', nobis(zmonth0 - 1) IF(lwp) WRITE(numout,*)'raajj = ', raajj ENDIF ELSE IF( kt == nit000 ) THEN ! Read Namelist namtau : surface wind stress ! -------------------- REWIND ( numnam ) READ ( numnam, namtau ) IF(lwp) WRITE(numout,*)' ' IF(lwp) WRITE(numout,*)' tau : Constant surface wind stress read in namelist' IF(lwp) WRITE(numout,*)' ~~~~~~~ ' IF(lwp) WRITE(numout,*)' Namelist namtau: set the constant stress values' IF(lwp) WRITE(numout,*)' spin up of the stress ntau000 = ', ntau000, ' time-steps' IF(lwp) WRITE(numout,*)' constant i-stress tau0x = ', tau0x , ' N/m2' IF(lwp) WRITE(numout,*)' constant j-stress tau0y = ', tau0y , ' N/m2' ntau000 = MAX( ntau000, 1 ) ! must be >= 1 ENDIF ! Increase the surface stress to its nominal value in ntau000 time-step IF( kt <= ntau000 ) THEN zfacto = 0.5 * ( 1. - COS( rpi * FLOAT( kt ) / FLOAT( ntau000 ) ) ) taux (:,:) = zfacto * tau0x tauy (:,:) = zfacto * tau0y tauxg(:,:) = zfacto * tau0x tauyg(:,:) = zfacto * tau0y ENDIF ENDIF END SUBROUTINE tau #endif !!====================================================================== END MODULE taumod