New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
sbc_oce.F90 in NEMO/branches/2021/dev_r14116_HPC-10_mcastril_Mixed_Precision_implementation/src/OCE/SBC – NEMO

source: NEMO/branches/2021/dev_r14116_HPC-10_mcastril_Mixed_Precision_implementation/src/OCE/SBC/sbc_oce.F90

Last change on this file was 15540, checked in by sparonuz, 3 years ago

Mixed precision version, tested up to 30 years on ORCA2.
  • Property svn:keywords set to Id
File size: 16.5 KB
RevLine 
[888]1MODULE sbc_oce
2   !!======================================================================
3   !!                       ***  MODULE  sbc_oce  ***
[12377]4   !! Surface module :   variables defined in core memory
[888]5   !!======================================================================
[2528]6   !! History :  3.0  ! 2006-06  (G. Madec)  Original code
7   !!             -   ! 2008-08  (G. Madec)  namsbc moved from sbcmod
8   !!            3.3  ! 2010-04  (M. Leclair, G. Madec)  Forcing averaged over 2 time steps
9   !!             -   ! 2010-11  (G. Madec) ice-ocean stress always computed at each ocean time-step
10   !!            3.3  ! 2010-10  (J. Chanut, C. Bricaud)  add the surface pressure forcing
[12377]11   !!            4.0  ! 2012-05  (C. Rousset) add attenuation coef for use in ice model
[7646]12   !!            4.0  ! 2016-06  (L. Brodeau) new unified bulk routine (based on AeroBulk)
[12377]13   !!            4.0  ! 2019-03  (F. Lemarié, G. Samson) add compatibility with ABL mode
[14007]14   !!            4.2  ! 2020-12  (G. Madec, E. Clementi) modified wave parameters in namelist
[888]15   !!----------------------------------------------------------------------
16
[2715]17   !!----------------------------------------------------------------------
18   !!   sbc_oce_alloc : allocation of sbc arrays
19   !!   sbc_tau2wnd   : wind speed estimated from wind stress
20   !!----------------------------------------------------------------------
21   USE par_oce        ! ocean parameters
22   USE in_out_manager ! I/O manager
23   USE lib_mpp        ! MPP library
24
[888]25   IMPLICIT NONE
26   PRIVATE
[2715]27
28   PUBLIC   sbc_oce_alloc   ! routine called in sbcmod.F90
29   PUBLIC   sbc_tau2wnd     ! routine called in several sbc modules
[12377]30
[888]31   !!----------------------------------------------------------------------
[1218]32   !!           Namelist for the Ocean Surface Boundary Condition
33   !!----------------------------------------------------------------------
[4147]34   !                                   !!* namsbc namelist *
[7646]35   LOGICAL , PUBLIC ::   ln_usr         !: user defined formulation
[4147]36   LOGICAL , PUBLIC ::   ln_flx         !: flux      formulation
[7646]37   LOGICAL , PUBLIC ::   ln_blk         !: bulk formulation
[12377]38   LOGICAL , PUBLIC ::   ln_abl         !: Atmospheric boundary layer model
[14007]39   LOGICAL , PUBLIC ::   ln_wave        !: wave in the system (forced or coupled)
[4990]40#if defined key_oasis3
[5407]41   LOGICAL , PUBLIC ::   lk_oasis = .TRUE.  !: OASIS used
[4990]42#else
[5407]43   LOGICAL , PUBLIC ::   lk_oasis = .FALSE. !: OASIS unused
[4990]44#endif
[5407]45   LOGICAL , PUBLIC ::   ln_cpl         !: ocean-atmosphere coupled formulation
46   LOGICAL , PUBLIC ::   ln_mixcpl      !: ocean-atmosphere forced-coupled mixed formulation
[4147]47   LOGICAL , PUBLIC ::   ln_dm2dc       !: Daily mean to Diurnal Cycle short wave (qsr)
[4230]48   LOGICAL , PUBLIC ::   ln_rnf         !: runoffs / runoff mouths
[12377]49   LOGICAL , PUBLIC ::   ln_ssr         !: Sea Surface restoring on SST and/or SSS
[4147]50   LOGICAL , PUBLIC ::   ln_apr_dyn     !: Atmospheric pressure forcing used on dynamics (ocean & ice)
51   INTEGER , PUBLIC ::   nn_ice         !: flag for ice in the surface boundary condition (=0/1/2/3)
[9019]52   LOGICAL , PUBLIC ::   ln_ice_embd    !: flag for levitating/embedding sea-ice in the ocean
53   !                                             !: =F levitating ice (no presure effect) with mass and salt exchanges
54   !                                             !: =T embedded sea-ice (pressure effect + mass and salt exchanges)
[12377]55   INTEGER , PUBLIC ::   nn_components  !: flag for sbc module (including sea-ice) coupling mode (see component definition below)
56   INTEGER , PUBLIC ::   nn_fwb         !: FreshWater Budget:
57   !                                             !:  = 0 unchecked
[1220]58   !                                             !:  = 1 global mean of e-p-r set to zero at each nn_fsbc time step
59   !                                             !:  = 2 annual global mean of e-p-r set to zero
[4147]60   LOGICAL , PUBLIC ::   ln_icebergs    !: Icebergs
[4161]61   !
[4990]62   INTEGER , PUBLIC ::   nn_lsm         !: Number of iteration if seaoverland is applied
[9019]63   !
64   !                                   !!* namsbc_cpl namelist *
65   INTEGER , PUBLIC ::   nn_cats_cpl    !: Number of sea ice categories over which the coupling is carried out
[14007]66   !
67   !                                   !!* namsbc_wave namelist *
68   LOGICAL , PUBLIC ::   ln_sdw         !: =T 3d stokes drift from wave model
69   LOGICAL , PUBLIC ::   ln_stcor       !: =T if Stokes-Coriolis and tracer advection terms are used
70   LOGICAL , PUBLIC ::   ln_cdgw        !: =T neutral drag coefficient from wave model
71   LOGICAL , PUBLIC ::   ln_tauoc       !: =T if normalized stress from wave is used
72   LOGICAL , PUBLIC ::   ln_wave_test   !: =T wave test case (constant Stokes drift)
73   LOGICAL , PUBLIC ::   ln_charn       !: =T Chranock coefficient from wave model
74   LOGICAL , PUBLIC ::   ln_taw         !: =T wind stress corrected by wave intake
[14072]75   LOGICAL , PUBLIC ::   ln_phioc       !: =T TKE surface BC from wave model
[14007]76   LOGICAL , PUBLIC ::   ln_bern_srfc   !: Bernoulli head, waves' inuced pressure
77   LOGICAL , PUBLIC ::   ln_breivikFV_2016 !: Breivik 2016 profile
78   LOGICAL , PUBLIC ::   ln_vortex_force !: vortex force activation
79   LOGICAL , PUBLIC ::   ln_stshear     !: Stoked Drift shear contribution in zdftke
80   !
[1218]81   !!----------------------------------------------------------------------
[4990]82   !!           switch definition (improve readability)
83   !!----------------------------------------------------------------------
[7646]84   INTEGER , PUBLIC, PARAMETER ::   jp_usr     = 1        !: user defined                  formulation
[5407]85   INTEGER , PUBLIC, PARAMETER ::   jp_flx     = 2        !: flux                          formulation
[7646]86   INTEGER , PUBLIC, PARAMETER ::   jp_blk     = 3        !: bulk                          formulation
[12377]87   INTEGER , PUBLIC, PARAMETER ::   jp_abl     = 4        !: Atmospheric boundary layer    formulation
88   INTEGER , PUBLIC, PARAMETER ::   jp_purecpl = 5        !: Pure ocean-atmosphere Coupled formulation
[14644]89   INTEGER , PUBLIC, PARAMETER ::   jp_none    = 6        !: for OCE when doing coupling via SAS module
[14007]90   !
[4990]91   !!----------------------------------------------------------------------
[5407]92   !!           component definition
93   !!----------------------------------------------------------------------
[12377]94   INTEGER , PUBLIC, PARAMETER ::   jp_iam_nemo = 0      !: Initial single executable configuration
95   !  (no internal OASIS coupling)
[14644]96   INTEGER , PUBLIC, PARAMETER ::   jp_iam_oce  = 1      !: Multi executable configuration - OCE component
[12377]97   !  (internal OASIS coupling)
[5407]98   INTEGER , PUBLIC, PARAMETER ::   jp_iam_sas  = 2      !: Multi executable configuration - SAS component
[12377]99   !  (internal OASIS coupling)
[5407]100   !!----------------------------------------------------------------------
[888]101   !!              Ocean Surface Boundary Condition fields
102   !!----------------------------------------------------------------------
[12132]103   INTEGER , PUBLIC ::  ncpl_qsr_freq = 0        !: qsr coupling frequency per days from atmosphere (used by top)
[5385]104   !
[2528]105   !!                                   !!   now    ! before   !!
[15540]106   REAL(dp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   utau   , utau_b   !: sea surface i-stress (ocean referential)     [N/m2]
107   REAL(dp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   vtau   , vtau_b   !: sea surface j-stress (ocean referential)     [N/m2]
108   REAL(dp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   taum              !: module of sea surface stress (at T-point)    [N/m2]
[12377]109   !! wndm is used compute surface gases exchanges in ice-free ocean or leads
[15540]110   REAL(dp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wndm              !: wind speed module at T-point (=|U10m-Uoce|)  [m/s]
[12377]111   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   rhoa              !: air density at "rn_zu" m above the sea       [kg/m3]
[2715]112   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   qsr               !: sea heat flux:     solar                     [W/m2]
[15540]113   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)  :: qns!: sea heat flux: non solar                     [W/m2]
114   REAL(dp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)  :: qns_b!: sea heat flux: non solar                     [W/m2]
[2715]115   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   qsr_tot           !: total     solar heat flux (over sea and ice) [W/m2]
116   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   qns_tot           !: total non solar heat flux (over sea and ice) [W/m2]
[15540]117   REAL(dp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   emp    , emp_b    !: freshwater budget: volume flux               [Kg/m2/s]
118   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)  :: sfx!: salt flux                                    [PSS.kg/m2/s]
119   REAL(dp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)  :: sfx_b!: salt flux                                    [PSS.kg/m2/s]
[2715]120   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   emp_tot           !: total E-P over ocean and ice                 [Kg/m2/s]
[4148]121   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   fmmflx            !: freshwater budget: freezing/melting          [Kg/m2/s]
[15540]122   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)  :: rnf!: river runoff                                 [Kg/m2/s]
123   REAL(dp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)  :: rnf_b!: river runoff                                 [Kg/m2/s]
[12377]124   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   fwficb , fwficb_b !: iceberg melting                              [Kg/m2/s]
[2528]125   !!
[15540]126   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)  :: sbc_tsc!: sbc content trend                      [K.m/s] jpi,jpj,jpts
127   REAL(dp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)  :: sbc_tsc_b!: sbc content trend                      [K.m/s] jpi,jpj,jpts
128   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)  :: qsr_hc!: heat content trend due to qsr flux     [K.m/s] jpi,jpj,jpk
129   REAL(dp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)  :: qsr_hc_b!: heat content trend due to qsr flux     [K.m/s] jpi,jpj,jpk
[2528]130   !!
[4161]131   !!
[2715]132   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   tprecip           !: total precipitation                          [Kg/m2/s]
133   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sprecip           !: solid precipitation                          [Kg/m2/s]
[15540]134   REAL(dp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   fr_i              !: ice fraction = 1 - lead fraction      (between 0 to 1)
[2715]135   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   atm_co2           !: atmospheric pCO2                             [ppm]
[15540]136   REAL(dp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: xcplmask          !: coupling mask for ln_mixcpl (warning: allocated in sbccpl)
[13472]137   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   cloud_fra         !: cloud cover (fraction of cloud in a gridcell) [-]
[888]138
[12377]139   !!---------------------------------------------------------------------
140   !! ABL Vertical Domain size
141   !!---------------------------------------------------------------------
142   INTEGER , PUBLIC            ::   jpka   = 2     !: ABL number of vertical levels (default definition)
143   INTEGER , PUBLIC            ::   jpkam1 = 1     !: jpka-1
[15540]144   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)    :: ghw_abl!: ABL geopotential height (needed for iom)
145   REAL(dp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)    :: ght_abl!: ABL geopotential height (needed for iom)
[12377]146   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)   ::   e3t_abl, e3w_abl          !: ABL vertical scale factors (needed for iom)
147
[888]148   !!----------------------------------------------------------------------
149   !!                     Sea Surface Mean fields
150   !!----------------------------------------------------------------------
151   INTEGER , PUBLIC                     ::   nn_fsbc   !: frequency of sbc computation (as well as sea-ice model)
[15540]152   REAL(dp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ssu_m     !: mean (nn_fsbc time-step) surface sea i-current (U-point) [m/s]
153   REAL(dp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ssv_m     !: mean (nn_fsbc time-step) surface sea j-current (V-point) [m/s]
154   REAL(dp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sst_m     !: mean (nn_fsbc time-step) surface sea temperature     [Celsius]
155   REAL(dp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sss_m     !: mean (nn_fsbc time-step) surface sea salinity            [psu]
156   REAL(dp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ssh_m     !: mean (nn_fsbc time-step) sea surface height                [m]
157   REAL(dp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   tsk_m     !: mean (nn_fsbc time-step) SKIN surface sea temp.      [Celsius]
158   REAL(dp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   e3t_m     !: mean (nn_fsbc time-step) sea surface layer thickness       [m]
159   REAL(dp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   frq_m     !: mean (nn_fsbc time-step) fraction of solar net radiation absorbed in the 1st T level [-]
[888]160
[14072]161   !!----------------------------------------------------------------------
162   !!                     Surface atmospheric fields
163   !!----------------------------------------------------------------------
164   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: q_air_zt       !: specific humidity of air at z=zt [kg/kg]ww
165   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: theta_air_zt   !: potential temperature of air at z=zt [K]
166
167
[2715]168   !! * Substitutions
[12377]169#  include "do_loop_substitute.h90"
[888]170   !!----------------------------------------------------------------------
[9598]171   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
[2528]172   !! $Id$
[10068]173   !! Software governed by the CeCILL license (see ./LICENSE)
[2715]174   !!----------------------------------------------------------------------
175CONTAINS
176
177   INTEGER FUNCTION sbc_oce_alloc()
178      !!---------------------------------------------------------------------
179      !!                  ***  FUNCTION sbc_oce_alloc  ***
180      !!---------------------------------------------------------------------
[14072]181      INTEGER :: ierr(6)
[2715]182      !!---------------------------------------------------------------------
183      ierr(:) = 0
184      !
185      ALLOCATE( utau(jpi,jpj) , utau_b(jpi,jpj) , taum(jpi,jpj) ,     &
[12377]186         &      vtau(jpi,jpj) , vtau_b(jpi,jpj) , wndm(jpi,jpj) , rhoa(jpi,jpj) , STAT=ierr(1) )
187      !
[3625]188      ALLOCATE( qns_tot(jpi,jpj) , qns  (jpi,jpj) , qns_b(jpi,jpj),        &
189         &      qsr_tot(jpi,jpj) , qsr  (jpi,jpj) ,                        &
190         &      emp    (jpi,jpj) , emp_b(jpi,jpj) ,                        &
[4148]191         &      sfx    (jpi,jpj) , sfx_b(jpi,jpj) , emp_tot(jpi,jpj), fmmflx(jpi,jpj), STAT=ierr(2) )
[12377]192      !
193      ALLOCATE( rnf  (jpi,jpj) , sbc_tsc  (jpi,jpj,jpts) , qsr_hc  (jpi,jpj,jpk) ,  &
194         &      rnf_b(jpi,jpj) , sbc_tsc_b(jpi,jpj,jpts) , qsr_hc_b(jpi,jpj,jpk) ,  &
[7788]195         &      fwficb  (jpi,jpj), fwficb_b(jpi,jpj), STAT=ierr(3) )
[12377]196      !
[2715]197      ALLOCATE( tprecip(jpi,jpj) , sprecip(jpi,jpj) , fr_i(jpi,jpj) ,     &
[13472]198         &      atm_co2(jpi,jpj) , tsk_m(jpi,jpj) , cloud_fra(jpi,jpj),   &
[5407]199         &      ssu_m  (jpi,jpj) , sst_m(jpi,jpj) , frq_m(jpi,jpj) ,      &
200         &      ssv_m  (jpi,jpj) , sss_m(jpi,jpj) , ssh_m(jpi,jpj) , STAT=ierr(4) )
[12377]201      !
[4292]202      ALLOCATE( e3t_m(jpi,jpj) , STAT=ierr(5) )
[12377]203      !
[14072]204      ALLOCATE( q_air_zt(jpi,jpj) , theta_air_zt(jpi,jpj) , STAT=ierr(6) ) !#LB
205      !
[2715]206      sbc_oce_alloc = MAXVAL( ierr )
[10425]207      CALL mpp_sum ( 'sbc_oce', sbc_oce_alloc )
[2715]208      IF( sbc_oce_alloc > 0 )   CALL ctl_warn('sbc_oce_alloc: allocation of arrays failed')
209      !
210   END FUNCTION sbc_oce_alloc
211
212
213   SUBROUTINE sbc_tau2wnd
214      !!---------------------------------------------------------------------
215      !!                    ***  ROUTINE sbc_tau2wnd  ***
216      !!
[12377]217      !! ** Purpose : Estimation of wind speed as a function of wind stress
218      !!
[2715]219      !! ** Method  : |tau|=rhoa*Cd*|U|^2
220      !!---------------------------------------------------------------------
221      USE dom_oce         ! ocean space and time domain
222      USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
[15540]223      REAL(dp) ::   zrhoa  = 1.22         ! Air density kg/m3
224      REAL(dp) ::   zcdrag = 1.5e-3       ! drag coefficient
225      REAL(dp) ::   ztx, zty, ztau, zcoef ! temporary variables
[2715]226      INTEGER  ::   ji, jj                ! dummy indices
227      !!---------------------------------------------------------------------
[12377]228      zcoef = 0.5 / ( zrhoa * zcdrag )
[13295]229      DO_2D( 0, 0, 0, 0 )
[12377]230         ztx = utau(ji-1,jj  ) + utau(ji,jj)
231         zty = vtau(ji  ,jj-1) + vtau(ji,jj)
232         ztau = SQRT( ztx * ztx + zty * zty )
233         wndm(ji,jj) = SQRT ( ztau * zcoef ) * tmask(ji,jj,1)
234      END_2D
[13226]235      CALL lbc_lnk( 'sbc_oce', wndm(:,:) , 'T', 1.0_wp )
[2715]236      !
237   END SUBROUTINE sbc_tau2wnd
238
[888]239   !!======================================================================
240END MODULE sbc_oce
Note: See TracBrowser for help on using the repository browser.