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 branches/UKMO/2015_CO6_CO5_zenv_wr_direct_dwl_temp/NEMOGCM/NEMO/OPA_SRC/SBC – NEMO

source: branches/UKMO/2015_CO6_CO5_zenv_wr_direct_dwl_temp/NEMOGCM/NEMO/OPA_SRC/SBC/sbc_oce.F90 @ 5417

Last change on this file since 5417 was 5417, checked in by deazer, 9 years ago

Rolling back previous commit to allow application of removal of svn keywords.
Changes will be brought back in afterward. This should then allwo fcm to merge
for rose build.
  • Property svn:keywords set to Id
File size: 13.2 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   !!----------------------------------------------------------------------
13
14   !!----------------------------------------------------------------------
15   !!   sbc_oce_alloc : allocation of sbc arrays
16   !!   sbc_tau2wnd   : wind speed estimated from wind stress
17   !!----------------------------------------------------------------------
18   USE par_oce        ! ocean parameters
19   USE in_out_manager ! I/O manager
20   USE lib_mpp        ! MPP library
21
22   IMPLICIT NONE
23   PRIVATE
24
25   PUBLIC   sbc_oce_alloc   ! routine called in sbcmod.F90
26   PUBLIC   sbc_tau2wnd     ! routine called in several sbc modules
27   
28   !!----------------------------------------------------------------------
29   !!           Namelist for the Ocean Surface Boundary Condition
30   !!----------------------------------------------------------------------
31   !                                   !!* namsbc namelist *
32   LOGICAL , PUBLIC ::   ln_ana         !: analytical boundary condition flag
33   LOGICAL , PUBLIC ::   ln_flx         !: flux      formulation
34   LOGICAL , PUBLIC ::   ln_blk_clio    !: CLIO bulk formulation
35   LOGICAL , PUBLIC ::   ln_blk_core    !: CORE bulk formulation
36   LOGICAL , PUBLIC ::   ln_blk_mfs     !: MFS  bulk formulation
37#if defined key_oasis3
38   LOGICAL , PUBLIC ::   lk_cpl = .TRUE.  !: coupled formulation
39#else
40   LOGICAL , PUBLIC ::   lk_cpl = .FALSE. !: coupled formulation
41#endif
42   LOGICAL , PUBLIC ::   ln_dm2dc       !: Daily mean to Diurnal Cycle short wave (qsr)
43   LOGICAL , PUBLIC ::   ln_rnf         !: runoffs / runoff mouths
44   LOGICAL , PUBLIC ::   ln_ssr         !: Sea Surface restoring on SST and/or SSS     
45   LOGICAL , PUBLIC ::   ln_apr_dyn     !: Atmospheric pressure forcing used on dynamics (ocean & ice)
46   INTEGER , PUBLIC ::   nn_ice         !: flag for ice in the surface boundary condition (=0/1/2/3)
47   INTEGER , PUBLIC ::   nn_isf         !: flag for isf in the surface boundary condition (=0/1/2/3/4)
48   INTEGER , PUBLIC ::   nn_ice_embd    !: flag for levitating/embedding sea-ice in the ocean
49   !                                             !: =0 levitating ice (no mass exchange, concentration/dilution effect)
50   !                                             !: =1 levitating ice with mass and salt exchange but no presure effect
51   !                                             !: =2 embedded sea-ice (full salt and mass exchanges and pressure)
52   INTEGER , PUBLIC :: nn_limflx        !: LIM3 Multi-category heat flux formulation
53   !                                             !: =-1  Use of per-category fluxes
54   !                                             !: = 0  Average per-category fluxes
55   !                                             !: = 1  Average then redistribute per-category fluxes
56   !                                             !: = 2  Redistribute a single flux over categories
57   INTEGER , PUBLIC ::   nn_fwb         !: FreshWater Budget:
58   !                                             !:  = 0 unchecked
59   !                                             !:  = 1 global mean of e-p-r set to zero at each nn_fsbc time step
60   !                                             !:  = 2 annual global mean of e-p-r set to zero
61   LOGICAL , PUBLIC ::   ln_wave        !: true if some coupling with wave model
62   LOGICAL , PUBLIC ::   ln_cdgw        !: true if neutral drag coefficient from wave model
63   LOGICAL , PUBLIC ::   ln_sdw         !: true if 3d stokes drift from wave model
64   !
65   LOGICAL , PUBLIC ::   ln_icebergs    !: Icebergs
66   !
67   INTEGER , PUBLIC ::   nn_lsm         !: Number of iteration if seaoverland is applied
68   !!----------------------------------------------------------------------
69   !!           switch definition (improve readability)
70   !!----------------------------------------------------------------------
71   INTEGER , PUBLIC, PARAMETER ::   jp_gyre    = 0        !: GYRE analytical formulation
72   INTEGER , PUBLIC, PARAMETER ::   jp_ana     = 1        !: analytical      formulation
73   INTEGER , PUBLIC, PARAMETER ::   jp_flx     = 2        !: flux            formulation
74   INTEGER , PUBLIC, PARAMETER ::   jp_clio    = 3        !: CLIO bulk       formulation
75   INTEGER , PUBLIC, PARAMETER ::   jp_core    = 4        !: CORE bulk       formulation
76   INTEGER , PUBLIC, PARAMETER ::   jp_cpl     = 5        !: Coupled         formulation
77   INTEGER , PUBLIC, PARAMETER ::   jp_mfs     = 6        !: MFS  bulk       formulation
78   INTEGER , PUBLIC, PARAMETER ::   jp_esopa   = -1       !: esopa test, ALL formulations
79   
80   !!----------------------------------------------------------------------
81   !!              Ocean Surface Boundary Condition fields
82   !!----------------------------------------------------------------------
83   LOGICAL , PUBLIC ::   lhftau = .FALSE.        !: HF tau used in TKE: mean(stress module) - module(mean stress)
84   LOGICAL , PUBLIC ::   ltrcdm2dc               !: In case of Diurnal Cycle short wave, compute a Daily Mean short waves flux
85   !!                                   !!   now    ! before   !!
86   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   utau   , utau_b   !: sea surface i-stress (ocean referential)     [N/m2]
87   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   vtau   , vtau_b   !: sea surface j-stress (ocean referential)     [N/m2]
88   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   taum              !: module of sea surface stress (at T-point)    [N/m2]
89   !! wndm is used onmpute surface gases exchanges in ice-free ocean or leads
90   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wndm              !: wind speed module at T-point (=|U10m-Uoce|)  [m/s]
91   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   qsr               !: sea heat flux:     solar                     [W/m2]
92   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   qsr_mean          !: daily mean sea heat flux: solar              [W/m2]
93   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   qns    , qns_b    !: sea heat flux: non solar                     [W/m2]
94   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   qsr_tot           !: total     solar heat flux (over sea and ice) [W/m2]
95   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   qns_tot           !: total non solar heat flux (over sea and ice) [W/m2]
96   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   emp    , emp_b    !: freshwater budget: volume flux               [Kg/m2/s]
97   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sfx    , sfx_b    !: salt flux                                    [PSU/m2/s]
98   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   emp_tot           !: total E-P over ocean and ice                 [Kg/m2/s]
99   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   fmmflx            !: freshwater budget: freezing/melting          [Kg/m2/s]
100   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   rnf    , rnf_b    !: river runoff        [Kg/m2/s] 
101   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   fwfisf , fwfisf_b !: ice shelf melting   [Kg/m2/s] 
102   !!
103   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::  sbc_tsc, sbc_tsc_b  !: sbc content trend                      [K.m/s] jpi,jpj,jpts
104   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::  qsr_hc , qsr_hc_b   !: heat content trend due to qsr flux     [K.m/s] jpi,jpj,jpk
105   !!
106   !!
107   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   tprecip           !: total precipitation                          [Kg/m2/s]
108   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sprecip           !: solid precipitation                          [Kg/m2/s]
109   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   fr_i              !: ice fraction = 1 - lead fraction      (between 0 to 1)
110#if defined key_cpl_carbon_cycle
111   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   atm_co2           !: atmospheric pCO2                             [ppm]
112#endif
113
114   !!----------------------------------------------------------------------
115   !!                     Sea Surface Mean fields
116   !!----------------------------------------------------------------------
117   INTEGER , PUBLIC                     ::   nn_fsbc   !: frequency of sbc computation (as well as sea-ice model)
118   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ssu_m     !: mean (nn_fsbc time-step) surface sea i-current (U-point) [m/s]
119   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ssv_m     !: mean (nn_fsbc time-step) surface sea j-current (V-point) [m/s]
120   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sst_m     !: mean (nn_fsbc time-step) surface sea temperature     [Celsius]
121   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sss_m     !: mean (nn_fsbc time-step) surface sea salinity            [psu]
122   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ssh_m     !: mean (nn_fsbc time-step) sea surface height                [m]
123   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   e3t_m     !: mean (nn_fsbc time-step) sea surface layer thickness       [m]
124
125   !! * Substitutions
126#  include "vectopt_loop_substitute.h90"
127   !!----------------------------------------------------------------------
128   !! NEMO/OPA 4.0 , NEMO Consortium (2011)
129   !! $Id$
130   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
131   !!----------------------------------------------------------------------
132CONTAINS
133
134   INTEGER FUNCTION sbc_oce_alloc()
135      !!---------------------------------------------------------------------
136      !!                  ***  FUNCTION sbc_oce_alloc  ***
137      !!---------------------------------------------------------------------
138      INTEGER :: ierr(5)
139      !!---------------------------------------------------------------------
140      ierr(:) = 0
141      !
142      ALLOCATE( utau(jpi,jpj) , utau_b(jpi,jpj) , taum(jpi,jpj) ,     &
143         &      vtau(jpi,jpj) , vtau_b(jpi,jpj) , wndm(jpi,jpj) , STAT=ierr(1) ) 
144         !
145      ALLOCATE( qns_tot(jpi,jpj) , qns  (jpi,jpj) , qns_b(jpi,jpj),        &
146         &      qsr_tot(jpi,jpj) , qsr  (jpi,jpj) ,                        &
147         &      emp    (jpi,jpj) , emp_b(jpi,jpj) ,                        &
148         &      sfx    (jpi,jpj) , sfx_b(jpi,jpj) , emp_tot(jpi,jpj), fmmflx(jpi,jpj), STAT=ierr(2) )
149         !
150      ALLOCATE( fwfisf  (jpi,jpj), rnf  (jpi,jpj) , sbc_tsc  (jpi,jpj,jpts) , qsr_hc  (jpi,jpj,jpk) ,     &
151         &      fwfisf_b(jpi,jpj), rnf_b(jpi,jpj) , sbc_tsc_b(jpi,jpj,jpts) , qsr_hc_b(jpi,jpj,jpk) , STAT=ierr(3) )
152         !
153      ALLOCATE( tprecip(jpi,jpj) , sprecip(jpi,jpj) , fr_i(jpi,jpj) ,     &
154#if defined key_cpl_carbon_cycle
155         &      atm_co2(jpi,jpj) ,                                        &
156#endif
157         &      ssu_m  (jpi,jpj) , sst_m(jpi,jpj) ,                       &
158         &      ssv_m  (jpi,jpj) , sss_m  (jpi,jpj), ssh_m(jpi,jpj) , STAT=ierr(4) )
159         !
160#if defined key_vvl
161      ALLOCATE( e3t_m(jpi,jpj) , STAT=ierr(5) )
162#endif
163         !
164      IF( ltrcdm2dc ) ALLOCATE( qsr_mean(jpi,jpj) , STAT=ierr(5) )
165         !
166      sbc_oce_alloc = MAXVAL( ierr )
167      IF( lk_mpp            )   CALL mpp_sum ( sbc_oce_alloc )
168      IF( sbc_oce_alloc > 0 )   CALL ctl_warn('sbc_oce_alloc: allocation of arrays failed')
169      !
170   END FUNCTION sbc_oce_alloc
171
172
173   SUBROUTINE sbc_tau2wnd
174      !!---------------------------------------------------------------------
175      !!                    ***  ROUTINE sbc_tau2wnd  ***
176      !!                   
177      !! ** Purpose : Estimation of wind speed as a function of wind stress   
178      !!
179      !! ** Method  : |tau|=rhoa*Cd*|U|^2
180      !!---------------------------------------------------------------------
181      USE dom_oce         ! ocean space and time domain
182      USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
183      REAL(wp) ::   zrhoa  = 1.22         ! Air density kg/m3
184      REAL(wp) ::   zcdrag = 1.5e-3       ! drag coefficient
185      REAL(wp) ::   ztx, zty, ztau, zcoef ! temporary variables
186      INTEGER  ::   ji, jj                ! dummy indices
187      !!---------------------------------------------------------------------
188      zcoef = 0.5 / ( zrhoa * zcdrag ) 
189!CDIR NOVERRCHK
190      DO jj = 2, jpjm1
191!CDIR NOVERRCHK
192         DO ji = fs_2, fs_jpim1   ! vect. opt.
193            ztx = utau(ji-1,jj  ) + utau(ji,jj) 
194            zty = vtau(ji  ,jj-1) + vtau(ji,jj) 
195            ztau = SQRT( ztx * ztx + zty * zty )
196            wndm(ji,jj) = SQRT ( ztau * zcoef ) * tmask(ji,jj,1)
197         END DO
198      END DO
199      CALL lbc_lnk( wndm(:,:) , 'T', 1. )
200      !
201   END SUBROUTINE sbc_tau2wnd
202
203   !!======================================================================
204END MODULE sbc_oce
Note: See TracBrowser for help on using the repository browser.