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/UKMO/NEMO_4.0.1_icesheet_and_river_coupling/src/OCE/SBC – NEMO

source: NEMO/branches/UKMO/NEMO_4.0.1_icesheet_and_river_coupling/src/OCE/SBC/sbc_oce.F90 @ 12576

Last change on this file since 12576 was 12576, checked in by dancopsey, 4 years ago

Merge in iceberg calving stuff from dev_r5518_coupling_GSI7_GSI8_landice from the start of the branch to revision 6023.

File size: 18.4 KB
Line 
1MODULE sbc_oce
2   !!======================================================================
3   !!                       ***  MODULE  sbc_oce  ***
4   !! Surface module :   variables defined in core memory
5   !!======================================================================
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
11   !!            4.0  ! 2012-05  (C. Rousset) add attenuation coef for use in ice model
12   !!            4.0  ! 2016-06  (L. Brodeau) new unified bulk routine (based on AeroBulk)
13   !!----------------------------------------------------------------------
14
15   !!----------------------------------------------------------------------
16   !!   sbc_oce_alloc : allocation of sbc arrays
17   !!   sbc_tau2wnd   : wind speed estimated from wind stress
18   !!----------------------------------------------------------------------
19   USE par_oce        ! ocean parameters
20   USE in_out_manager ! I/O manager
21   USE lib_mpp        ! MPP library
22
23   IMPLICIT NONE
24   PRIVATE
25
26   PUBLIC   sbc_oce_alloc   ! routine called in sbcmod.F90
27   PUBLIC   sbc_tau2wnd     ! routine called in several sbc modules
28   
29   !!----------------------------------------------------------------------
30   !!           Namelist for the Ocean Surface Boundary Condition
31   !!----------------------------------------------------------------------
32   !                                   !!* namsbc namelist *
33   LOGICAL , PUBLIC ::   ln_usr         !: user defined formulation
34   LOGICAL , PUBLIC ::   ln_flx         !: flux      formulation
35   LOGICAL , PUBLIC ::   ln_blk         !: bulk formulation
36#if defined key_oasis3
37   LOGICAL , PUBLIC ::   lk_oasis = .TRUE.  !: OASIS used
38#else
39   LOGICAL , PUBLIC ::   lk_oasis = .FALSE. !: OASIS unused
40#endif
41   LOGICAL , PUBLIC ::   ln_cpl         !: ocean-atmosphere coupled formulation
42   LOGICAL , PUBLIC ::   ln_mixcpl      !: ocean-atmosphere forced-coupled mixed formulation
43   LOGICAL , PUBLIC ::   ln_dm2dc       !: Daily mean to Diurnal Cycle short wave (qsr)
44   LOGICAL , PUBLIC ::   ln_rnf         !: runoffs / runoff mouths
45   LOGICAL , PUBLIC ::   ln_isf         !: ice shelf melting
46   LOGICAL , PUBLIC ::   ln_ssr         !: Sea Surface restoring on SST and/or SSS     
47   LOGICAL , PUBLIC ::   ln_apr_dyn     !: Atmospheric pressure forcing used on dynamics (ocean & ice)
48   INTEGER , PUBLIC ::   nn_ice         !: flag for ice in the surface boundary condition (=0/1/2/3)
49   LOGICAL , PUBLIC ::   ln_ice_embd    !: flag for levitating/embedding sea-ice in the ocean
50   !                                             !: =F levitating ice (no presure effect) with mass and salt exchanges
51   !                                             !: =T embedded sea-ice (pressure effect + mass and salt exchanges)
52   INTEGER , PUBLIC ::   nn_components  !: flag for sbc module (including sea-ice) coupling mode (see component definition below)
53   INTEGER , PUBLIC ::   nn_fwb         !: FreshWater Budget:
54   !                                             !:  = 0 unchecked
55   !                                             !:  = 1 global mean of e-p-r set to zero at each nn_fsbc time step
56   !                                             !:  = 2 annual global mean of e-p-r set to zero
57   LOGICAL , PUBLIC ::   ln_wave        !: true if some coupling with wave model
58   LOGICAL , PUBLIC ::   ln_cdgw        !: true if neutral drag coefficient from wave model
59   LOGICAL , PUBLIC ::   ln_sdw         !: true if 3d stokes drift from wave model
60   LOGICAL , PUBLIC ::   ln_tauwoc       !: true if normalized stress from wave is used
61   LOGICAL , PUBLIC ::   ln_tauw        !: true if ocean stress components from wave is used
62   LOGICAL , PUBLIC ::   ln_stcor       !: true if Stokes-Coriolis term is used
63   !
64   INTEGER , PUBLIC ::   nn_sdrift      ! type of parameterization to calculate vertical Stokes drift
65   !
66   LOGICAL , PUBLIC ::   ln_icebergs    !: Icebergs
67   !
68   INTEGER , PUBLIC ::   nn_lsm         !: Number of iteration if seaoverland is applied
69   !
70   !                                   !!* namsbc_cpl namelist *
71   INTEGER , PUBLIC ::   nn_cats_cpl    !: Number of sea ice categories over which the coupling is carried out
72
73   !!----------------------------------------------------------------------
74   !!           switch definition (improve readability)
75   !!----------------------------------------------------------------------
76   INTEGER , PUBLIC, PARAMETER ::   jp_usr     = 1        !: user defined                  formulation
77   INTEGER , PUBLIC, PARAMETER ::   jp_flx     = 2        !: flux                          formulation
78   INTEGER , PUBLIC, PARAMETER ::   jp_blk     = 3        !: bulk                          formulation
79   INTEGER , PUBLIC, PARAMETER ::   jp_purecpl = 4        !: Pure ocean-atmosphere Coupled formulation
80   INTEGER , PUBLIC, PARAMETER ::   jp_none    = 5        !: for OPA when doing coupling via SAS module
81   
82   !!----------------------------------------------------------------------
83   !!           Stokes drift parametrization definition
84   !!----------------------------------------------------------------------
85   INTEGER , PUBLIC, PARAMETER ::   jp_breivik_2014 = 0     !: Breivik  2014: v_z=v_0*[exp(2*k*z)/(1-8*k*z)]
86   INTEGER , PUBLIC, PARAMETER ::   jp_li_2017      = 1     !: Li et al 2017: Stokes drift based on Phillips spectrum (Breivik 2016)
87                                                            !  with depth averaged profile
88   INTEGER , PUBLIC, PARAMETER ::   jp_peakfr       = 2     !: Li et al 2017: using the peak wave number read from wave model instead
89                                                            !  of the inverse depth scale
90   LOGICAL , PUBLIC            ::   ll_st_bv2014  = .FALSE. !  logical indicator, .true. if Breivik 2014 parameterisation is active.
91   LOGICAL , PUBLIC            ::   ll_st_li2017  = .FALSE. !  logical indicator, .true. if Li 2017 parameterisation is active.
92   LOGICAL , PUBLIC            ::   ll_st_bv_li   = .FALSE. !  logical indicator, .true. if either Breivik or Li parameterisation is active.
93   LOGICAL , PUBLIC            ::   ll_st_peakfr  = .FALSE. !  logical indicator, .true. if using Li 2017 with peak wave number
94
95   !!----------------------------------------------------------------------
96   !!           component definition
97   !!----------------------------------------------------------------------
98   INTEGER , PUBLIC, PARAMETER ::   jp_iam_nemo = 0      !: Initial single executable configuration
99                                                         !  (no internal OASIS coupling)
100   INTEGER , PUBLIC, PARAMETER ::   jp_iam_opa  = 1      !: Multi executable configuration - OPA component
101                                                         !  (internal OASIS coupling)
102   INTEGER , PUBLIC, PARAMETER ::   jp_iam_sas  = 2      !: Multi executable configuration - SAS component
103                                                         !  (internal OASIS coupling)
104   !!----------------------------------------------------------------------
105   !!              Ocean Surface Boundary Condition fields
106   !!----------------------------------------------------------------------
107   INTEGER , PUBLIC ::  ncpl_qsr_freq            !: qsr coupling frequency per days from atmosphere
108   !
109   LOGICAL , PUBLIC ::   lhftau = .FALSE.        !: HF tau used in TKE: mean(stress module) - module(mean stress)
110   !!                                   !!   now    ! before   !!
111   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   utau   , utau_b   !: sea surface i-stress (ocean referential)     [N/m2]
112   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   vtau   , vtau_b   !: sea surface j-stress (ocean referential)     [N/m2]
113   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   taum              !: module of sea surface stress (at T-point)    [N/m2]
114   !! wndm is used onmpute surface gases exchanges in ice-free ocean or leads
115   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wndm              !: wind speed module at T-point (=|U10m-Uoce|)  [m/s]
116   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   qsr               !: sea heat flux:     solar                     [W/m2]
117   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   qns    , qns_b    !: sea heat flux: non solar                     [W/m2]
118   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   qsr_tot           !: total     solar heat flux (over sea and ice) [W/m2]
119   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   qns_tot           !: total non solar heat flux (over sea and ice) [W/m2]
120   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   emp    , emp_b    !: freshwater budget: volume flux               [Kg/m2/s]
121   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sfx    , sfx_b    !: salt flux                                    [PSS.kg/m2/s]
122   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   emp_tot           !: total E-P over ocean and ice                 [Kg/m2/s]
123   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   fmmflx            !: freshwater budget: freezing/melting          [Kg/m2/s]
124   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   rnf    , rnf_b    !: river runoff        [Kg/m2/s] 
125   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   fwfisf , fwfisf_b !: ice shelf melting   [Kg/m2/s] 
126   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   fwficb , fwficb_b !: iceberg melting [Kg/m2/s] 
127
128   !!
129   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::  sbc_tsc, sbc_tsc_b  !: sbc content trend                      [K.m/s] jpi,jpj,jpts
130   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::  qsr_hc , qsr_hc_b   !: heat content trend due to qsr flux     [K.m/s] jpi,jpj,jpk
131   !!
132   !!
133   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   tprecip           !: total precipitation                          [Kg/m2/s]
134   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sprecip           !: solid precipitation                          [Kg/m2/s]
135   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   fr_i              !: ice fraction = 1 - lead fraction      (between 0 to 1)
136   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   atm_co2           !: atmospheric pCO2                             [ppm]
137   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: xcplmask          !: coupling mask for ln_mixcpl (warning: allocated in sbccpl)
138   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   greenland_icesheet_mass_array, greenland_icesheet_mask 
139   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   antarctica_icesheet_mass_array, antarctica_icesheet_mask 
140
141   !!----------------------------------------------------------------------
142   !!                     Sea Surface Mean fields
143   !!----------------------------------------------------------------------
144   INTEGER , PUBLIC                     ::   nn_fsbc   !: frequency of sbc computation (as well as sea-ice model)
145   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ssu_m     !: mean (nn_fsbc time-step) surface sea i-current (U-point) [m/s]
146   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ssv_m     !: mean (nn_fsbc time-step) surface sea j-current (V-point) [m/s]
147   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sst_m     !: mean (nn_fsbc time-step) surface sea temperature     [Celsius]
148   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sss_m     !: mean (nn_fsbc time-step) surface sea salinity            [psu]
149   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ssh_m     !: mean (nn_fsbc time-step) sea surface height                [m]
150   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   e3t_m     !: mean (nn_fsbc time-step) sea surface layer thickness       [m]
151   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   frq_m     !: mean (nn_fsbc time-step) fraction of solar net radiation absorbed in the 1st T level [-]
152
153   !!----------------------------------------------------------------------
154   !!  Surface scalars of total ice sheet mass for Greenland and Antarctica,
155   !! passed from atmosphere to be converted to dvol and hence a freshwater
156   !! flux  by using old values. New values are saved in the dump, to become
157   !! old values next coupling timestep. Freshwater fluxes split between
158   !! sub iceshelf melting and iceberg calving, scalled to flux per second
159   !!----------------------------------------------------------------------
160   
161   REAL(wp), PUBLIC  :: greenland_icesheet_mass, greenland_icesheet_mass_rate_of_change, greenland_icesheet_timelapsed 
162   REAL(wp), PUBLIC  :: antarctica_icesheet_mass, antarctica_icesheet_mass_rate_of_change, antarctica_icesheet_timelapsed
163
164   ! sbccpl namelist parameters associated with icesheet freshwater input code. Included here rather than in sbccpl.F90 to
165   ! avoid circular dependencies.
166   INTEGER, PUBLIC     ::   nn_coupled_iceshelf_fluxes     ! =0 : total freshwater input from iceberg calving and ice shelf basal melting
167                                                           ! taken from climatologies used (no action in coupling routines).
168                                                           ! =1 :  use rate of change of mass of Greenland and Antarctic icesheets to set the
169                                                           ! combined magnitude of the iceberg calving and iceshelf melting freshwater fluxes.
170                                                           ! =2 :  specify constant freshwater inputs in this namelist to set the combined
171                                                           ! magnitude of iceberg calving and iceshelf melting freshwater fluxes.
172   LOGICAL, PUBLIC     ::   ln_iceshelf_init_atmos         ! If true force ocean to initialise iceshelf masses from atmospheric values rather
173                                                           ! than values in ocean restart (applicable if nn_coupled_iceshelf_fluxes=1).
174   REAL(wp), PUBLIC    ::   rn_greenland_total_fw_flux    ! Constant total rate of freshwater input (kg/s) for Greenland (if nn_coupled_iceshelf_fluxes=2)
175   REAL(wp), PUBLIC    ::   rn_greenland_calving_fraction  ! Set fraction of total freshwater flux for iceberg calving - remainder goes to iceshelf melting.
176   REAL(wp), PUBLIC    ::   rn_antarctica_total_fw_flux   ! Constant total rate of freshwater input (kg/s) for Antarctica (if nn_coupled_iceshelf_fluxes=2)
177   REAL(wp), PUBLIC    ::   rn_antarctica_calving_fraction ! Set fraction of total freshwater flux for iceberg calving - remainder goes to iceshelf melting.
178   REAL(wp), PUBLIC    ::   rn_iceshelf_fluxes_tolerance   ! Absolute tolerance for detecting differences in icesheet masses.
179
180   !! * Substitutions
181#  include "vectopt_loop_substitute.h90"
182   !!----------------------------------------------------------------------
183   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
184   !! $Id$
185   !! Software governed by the CeCILL license (see ./LICENSE)
186   !!----------------------------------------------------------------------
187CONTAINS
188
189   INTEGER FUNCTION sbc_oce_alloc()
190      !!---------------------------------------------------------------------
191      !!                  ***  FUNCTION sbc_oce_alloc  ***
192      !!---------------------------------------------------------------------
193      INTEGER :: ierr(5)
194      !!---------------------------------------------------------------------
195      ierr(:) = 0
196      !
197      ALLOCATE( utau(jpi,jpj) , utau_b(jpi,jpj) , taum(jpi,jpj) ,     &
198         &      vtau(jpi,jpj) , vtau_b(jpi,jpj) , wndm(jpi,jpj) , STAT=ierr(1) ) 
199         !
200      ALLOCATE( qns_tot(jpi,jpj) , qns  (jpi,jpj) , qns_b(jpi,jpj),        &
201         &      qsr_tot(jpi,jpj) , qsr  (jpi,jpj) ,                        &
202         &      emp    (jpi,jpj) , emp_b(jpi,jpj) ,                        &
203         &      sfx    (jpi,jpj) , sfx_b(jpi,jpj) , emp_tot(jpi,jpj), fmmflx(jpi,jpj), STAT=ierr(2) )
204         !
205      ALLOCATE( fwfisf  (jpi,jpj), rnf  (jpi,jpj) , sbc_tsc  (jpi,jpj,jpts) , qsr_hc  (jpi,jpj,jpk) ,  &
206         &      fwfisf_b(jpi,jpj), rnf_b(jpi,jpj) , sbc_tsc_b(jpi,jpj,jpts) , qsr_hc_b(jpi,jpj,jpk) ,  &
207         &      fwficb  (jpi,jpj), fwficb_b(jpi,jpj), STAT=ierr(3) )
208         !
209      ALLOCATE( tprecip(jpi,jpj) , sprecip(jpi,jpj) , fr_i(jpi,jpj) ,     &
210         &      atm_co2(jpi,jpj) ,                                        &
211         &      ssu_m  (jpi,jpj) , sst_m(jpi,jpj) , frq_m(jpi,jpj) ,      &
212         &      ssv_m  (jpi,jpj) , sss_m(jpi,jpj) , ssh_m(jpi,jpj) , STAT=ierr(4) )
213         !
214      ALLOCATE( greenland_icesheet_mass_array(jpi,jpj) , antarctica_icesheet_mass_array(jpi,jpj) ) 
215      ALLOCATE( greenland_icesheet_mask(jpi,jpj) , antarctica_icesheet_mask(jpi,jpj) ) 
216         !
217      ALLOCATE( e3t_m(jpi,jpj) , STAT=ierr(5) )
218         !
219      sbc_oce_alloc = MAXVAL( ierr )
220      CALL mpp_sum ( 'sbc_oce', sbc_oce_alloc )
221      IF( sbc_oce_alloc > 0 )   CALL ctl_warn('sbc_oce_alloc: allocation of arrays failed')
222      !
223   END FUNCTION sbc_oce_alloc
224
225
226   SUBROUTINE sbc_tau2wnd
227      !!---------------------------------------------------------------------
228      !!                    ***  ROUTINE sbc_tau2wnd  ***
229      !!                   
230      !! ** Purpose : Estimation of wind speed as a function of wind stress   
231      !!
232      !! ** Method  : |tau|=rhoa*Cd*|U|^2
233      !!---------------------------------------------------------------------
234      USE dom_oce         ! ocean space and time domain
235      USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
236      REAL(wp) ::   zrhoa  = 1.22         ! Air density kg/m3
237      REAL(wp) ::   zcdrag = 1.5e-3       ! drag coefficient
238      REAL(wp) ::   ztx, zty, ztau, zcoef ! temporary variables
239      INTEGER  ::   ji, jj                ! dummy indices
240      !!---------------------------------------------------------------------
241      zcoef = 0.5 / ( zrhoa * zcdrag ) 
242      DO jj = 2, jpjm1
243         DO ji = fs_2, fs_jpim1   ! vect. opt.
244            ztx = utau(ji-1,jj  ) + utau(ji,jj) 
245            zty = vtau(ji  ,jj-1) + vtau(ji,jj) 
246            ztau = SQRT( ztx * ztx + zty * zty )
247            wndm(ji,jj) = SQRT ( ztau * zcoef ) * tmask(ji,jj,1)
248         END DO
249      END DO
250      CALL lbc_lnk( 'sbc_oce', wndm(:,:) , 'T', 1. )
251      !
252   END SUBROUTINE sbc_tau2wnd
253
254   !!======================================================================
255END MODULE sbc_oce
Note: See TracBrowser for help on using the repository browser.