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 ! #if defined key_oasis3 || defined key_oasis4 USE geo2ocean, only : repcmo USE ice, only : frld ! : leads fraction = 1-a/totalarea #if defined key_oasis3 USE cpl_oasis3 ! OASIS3 coupling (to ECHAM5) #elif defined key_oasis4 USE cpl_oasis4 ! OASIS4 coupling (to ECHAM5) #endif #endif 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 ! TAU BUG #if defined key_lim3 tauxw, tauyw, & !: surface wind stress components in (i,j) referential slotx, sloty, & !: time-slope for surface windstress in (i,j) referential tauxg, tauyg !: surface stress components in geographical ! ! referential (used in output) #endif !!---------------------------------------------------------------------- !! OPA 9.0 , LOCEAN-IPSL (2005) !! $Header$ !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt !!---------------------------------------------------------------------- #if defined key_tau_monthly ! Monthly climatology in (i,j) referential (i-comp. at U-pt and j-comp. at V-pt) !!---------------------------------------------------------------------- !! 'key_tau_monthly' MONTHLY climatology stress !! default case NetCDF files !!---------------------------------------------------------------------- # include "tau_forced_monthly.h90" # 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_oasis3 || defined key_oasis4 ! Coupled case : stress at the coupling frequency !!---------------------------------------------------------------------- !! 'key_oasis3' or 'key_oasis4' and Coupled Ocean/Atmosphere !! 'key_lim3'or 'key_lim2' 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_oasis_ice.h90" #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. !! !! 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 INTEGER :: & zyear0, & ! initial year zmonth0, & ! initial month zday0, & ! initial day zday_year0 ! initial day since january 1st !! * Local declarations REAL(wp) :: zfacto ! NAMELIST/namtau/ ntau000, tau0x, tau0y !!--------------------------------------------------------------------- IF( cp_cfg == 'gyre' ) THEN zyear0 = ndate0 / 10000 ! initial year zmonth0 = ( ndate0 - zyear0 * 10000 ) / 100 ! initial month zday0 = ndate0 - zyear0 * 10000 - zmonth0 * 100 ! initial day betwen 1 and 30 zday_year0 = (zmonth0-1)*30.+zday0 ! initial day betwen 1 and 360 ! current day (in hours) since january the 1st of the current year ztime = FLOAT( kt ) * rdt / (rmmss * rhhmm) & ! total incrementation (in hours) & - (nyear - 1) * rjjhh * raajj ! minus years since beginning of experiment (in hours) ! 21th june at 24h in hours ztimemax = ((5.*30.)+21.)* 24. ! 21th december day in hours ! rjjhh * raajj / 4 = 1 seasonal cycle in hours ztimemin = ztimemax + rjjhh * raajj / 2 ! mean intensity at 0.105/srqt(2) because projected with 45deg angle ztau = 0.105 / SQRT(2.) ! seasonal oscillation intensity ztau_sais = 0.015 ztaun = ztau - ztau_sais * COS( (ztime - ztimemax) / (ztimemin - ztimemax) * rpi ) DO jj = 1, jpj DO ji = 1, jpi ! domain from 15deg to 50deg and 1/2 period along 14deg ! 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 .AND. lwp ) THEN WRITE(numout,*)' tau : analytical formulation for gyre' WRITE(numout,*)' ~~~~~~~ ' WRITE(numout,*)' nyear = ', nyear WRITE(numout,*)' nmonth = ', nmonth WRITE(numout,*)' nday = ', nday WRITE(numout,*)' nday_year = ',nday_year WRITE(numout,*)' ndastp = ',ndastp WRITE(numout,*)' adatrj = ',adatrj WRITE(numout,*)' ztime = ',ztime WRITE(numout,*)' ztimemax = ',ztimemax WRITE(numout,*)' ztimemin = ',ztimemin WRITE(numout,*)' zyear0 = ', zyear0 WRITE(numout,*)' zmonth0 = ', zmonth0 WRITE(numout,*)' zday0 = ', zday0 WRITE(numout,*)' zday_year0 = ',zday_year0 WRITE(numout,*)' raajj = ', raajj WRITE(numout,*)' ztau = ', ztau WRITE(numout,*)' ztau_sais = ', ztau_sais WRITE(numout,*)' ztaun = ', ztaun 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 ENDIF ENDIF END SUBROUTINE tau #endif !!====================================================================== END MODULE taumod