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.
sbcmod.F90 in tags/nemo_v3_1_beta/NEMO/OPA_SRC/SBC – NEMO

source: tags/nemo_v3_1_beta/NEMO/OPA_SRC/SBC/sbcmod.F90 @ 4189

Last change on this file since 4189 was 1242, checked in by rblod, 16 years ago

Fix runtime issues with AGRIF on NEC and add the ability to run without sea-ice on the fine grid hierarchy
  • Property svn:keywords set to Id
File size: 14.0 KB
Line 
1MODULE sbcmod
2   !!======================================================================
3   !!                       ***  MODULE  sbcmod  ***
4   !! Surface module :  provide to the ocean its surface boundary condition
5   !!======================================================================
6   !! History :  3.0   !  07-2006  (G. Madec)  Original code
7   !!             -    !  08-2008  (S. Masson, E. .... ) coupled interface
8   !!----------------------------------------------------------------------
9
10   !!----------------------------------------------------------------------
11   !!   sbc_init       : read namsbc namelist
12   !!   sbc            : surface ocean momentum, heat and freshwater boundary conditions
13   !!----------------------------------------------------------------------
14   USE oce             ! ocean dynamics and tracers
15   USE dom_oce         ! ocean space and time domain
16   USE daymod          ! calendar
17   USE phycst          ! physical constants
18
19   USE ice_oce         ! sea-ice model : LIM
20   USE sbc_oce         ! Surface boundary condition: ocean fields
21   USE sbcssm          ! surface boundary condition: sea-surface mean variables
22   USE sbcana          ! surface boundary condition: analytical formulation
23   USE sbcflx          ! surface boundary condition: flux formulation
24   USE sbcblk_clio     ! surface boundary condition: bulk formulation : CLIO
25   USE sbcblk_core     ! surface boundary condition: bulk formulation : CORE
26   USE sbcice_if       ! surface boundary condition: ice-if sea-ice model
27   USE sbcice_lim      ! surface boundary condition: LIM 3.0 sea-ice model
28   USE sbcice_lim_2    ! surface boundary condition: LIM 2.0 sea-ice model
29   USE sbccpl          ! surface boundary condition: coupled florulation
30   USE cpl_oasis3, ONLY:lk_cpl      ! are we in coupled mode?
31   USE sbcssr          ! surface boundary condition: sea surface restoring
32   USE sbcrnf          ! surface boundary condition: runoffs
33   USE sbcfwb          ! surface boundary condition: freshwater budget
34   USE closea          ! closed sea
35
36   USE prtctl          ! Print control                    (prt_ctl routine)
37   USE restart         ! ocean restart
38   USE iom
39   USE in_out_manager  ! I/O manager
40
41   IMPLICIT NONE
42   PRIVATE
43
44   PUBLIC   sbc        ! routine called by step.F90
45   
46   INTEGER ::   nsbc   ! type of surface boundary condition (deduced from namsbc informations)
47     
48   !! * Substitutions
49#  include "domzgr_substitute.h90"
50   !!----------------------------------------------------------------------
51   !! NEMO/OPA 3.0 , LOCEAN-IPSL (2008)
52   !! $Id$
53   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
54   !!----------------------------------------------------------------------
55
56CONTAINS
57
58   SUBROUTINE sbc_init
59      !!---------------------------------------------------------------------
60      !!                    ***  ROUTINE sbc_init ***
61      !!
62      !! ** Purpose :   Initialisation of the ocean surface boundary computation
63      !!
64      !! ** Method  :   Read the namsbc namelist and set derived parameters
65      !!
66      !! ** Action  : - read namsbc parameters
67      !!              - nsbc: type of sbc
68      !!----------------------------------------------------------------------
69      INTEGER ::   icpt      ! temporary integer
70      !!
71      NAMELIST/namsbc/ nn_fsbc, ln_ana, ln_flx, ln_blk_clio, ln_blk_core, ln_cpl,   &
72         &             nn_ice , ln_dm2dc, ln_rnf, ln_ssr, nn_fwb, nn_ico_cpl
73      !!----------------------------------------------------------------------
74
75      IF(lwp) THEN
76         WRITE(numout,*)
77         WRITE(numout,*) 'sbc_init : surface boundary condition setting'
78         WRITE(numout,*) '~~~~~~~~ '
79      ENDIF
80
81      REWIND( numnam )                   ! Read Namelist namsbc
82      READ  ( numnam, namsbc )
83
84      ! overwrite namelist parameter using CPP key information
85!!gm here no overwrite, test all option via namelist change: require more incore memory
86!!gm  IF( lk_sbc_cpl       ) THEN   ;   ln_cpl      = .TRUE.   ;   ELSE   ;   ln_cpl      = .FALSE.   ;   ENDIF
87#if defined key_agrif
88      IF ( Agrif_Root() ) THEN
89#endif
90        IF( lk_lim2 )            nn_ice      = 2
91        IF( lk_lim3 )            nn_ice      = 3
92#if defined key_agrif
93      ENDIF
94#endif
95      IF( cp_cfg == 'gyre' ) THEN
96          ln_ana      = .TRUE.   
97          nn_ice      =   0
98      ENDIF
99     
100      ! Control print
101      IF(lwp) THEN
102         WRITE(numout,*) '        Namelist namsbc (partly overwritten with CPP key setting)'
103         WRITE(numout,*) '           frequency update of sbc (and ice)             nn_fsbc     = ', nn_fsbc
104         WRITE(numout,*) '           Type of sbc : '
105         WRITE(numout,*) '              analytical formulation                     ln_ana      = ', ln_ana
106         WRITE(numout,*) '              flux       formulation                     ln_flx      = ', ln_flx
107         WRITE(numout,*) '              CLIO bulk  formulation                     ln_blk_clio = ', ln_blk_clio
108         WRITE(numout,*) '              CLIO bulk  formulation                     ln_blk_core = ', ln_blk_core
109         WRITE(numout,*) '              coupled    formulation (T if key_sbc_cpl)  ln_cpl      = ', ln_cpl
110         WRITE(numout,*) '           Misc. options of sbc : '
111         WRITE(numout,*) '              ice management in the sbc (=0/1/2/3)       nn_ice      = ', nn_ice 
112         WRITE(numout,*) '              ice-ocean stress computation (=0/1/2)      nn_ico_cpl  = ', nn_ico_cpl
113         WRITE(numout,*) '              daily mean to diurnal cycle qsr            ln_dm2dc    = ', ln_dm2dc 
114         WRITE(numout,*) '              runoff / runoff mouths                     ln_rnf      = ', ln_rnf
115         WRITE(numout,*) '              Sea Surface Restoring on SST and/or SSS    ln_ssr      = ', ln_ssr
116         WRITE(numout,*) '              FreshWater Budget control  (=0/1/2)        nn_fwb      = ', nn_fwb
117         WRITE(numout,*) '              closed sea (=0/1) (set in namdom)          nclosea     = ', nclosea
118      ENDIF
119
120      IF( .NOT. ln_rnf ) THEN                      ! no specific treatment in vicinity of river mouths
121         ln_rnf_mouth  = .false.                     
122         nkrnf         = 0
123         rnfmsk  (:,:) = 0.e0
124         rnfmsk_z(:)   = 0.e0
125      ENDIF
126      IF( nn_ice == 0  )   fr_i(:,:) = 0.e0        ! no ice in the domain, ice fraction is always zero
127
128      !                                            ! restartability   
129      IF( MOD( nitend - nit000 + 1, nn_fsbc) /= 0 .OR.   &
130          MOD( nstock             , nn_fsbc) /= 0 ) THEN
131         WRITE(ctmp1,*) 'experiment length (', nitend - nit000 + 1, ') or nstock (', nstock,   &
132            &           ' is NOT a multiple of nn_fsbc (', nn_fsbc, ')'
133         CALL ctl_stop( ctmp1, 'Impossible to properly do model restart' )
134      ENDIF
135      !
136      IF( MOD( rday, REAL(nn_fsbc, wp) * rdt ) /= 0 )   &
137         &  CALL ctl_warn( 'nn_fsbc is NOT a multiple of the number of time steps in a day' )
138      !
139      IF( nn_ice == 2 .AND. .NOT.( ln_blk_clio .OR. ln_blk_core .OR. lk_cpl ) )   &
140         &   CALL ctl_stop( 'sea-ice model requires a bulk formulation or coupled configuration' )
141     
142      ! Choice of the Surface Boudary Condition (set nsbc)
143      icpt = 0
144      IF( ln_ana          ) THEN   ;   nsbc =  1   ; icpt = icpt + 1   ;   ENDIF       ! analytical      formulation
145      IF( ln_flx          ) THEN   ;   nsbc =  2   ; icpt = icpt + 1   ;   ENDIF       ! flux            formulation
146      IF( ln_blk_clio     ) THEN   ;   nsbc =  3   ; icpt = icpt + 1   ;   ENDIF       ! CLIO bulk       formulation
147      IF( ln_blk_core     ) THEN   ;   nsbc =  4   ; icpt = icpt + 1   ;   ENDIF       ! CORE bulk       formulation
148      IF( ln_cpl          ) THEN   ;   nsbc =  5   ; icpt = icpt + 1   ;   ENDIF       ! Coupled         formulation
149      IF( cp_cfg == 'gyre') THEN   ;   nsbc =  0                       ;   ENDIF       ! GYRE analytical formulation
150      IF( lk_esopa        )            nsbc = -1                                       ! esopa test, ALL formulations
151
152      IF( icpt /= 1 .AND. .NOT.lk_esopa ) THEN
153         WRITE(numout,*)
154         WRITE(numout,*) '           E R R O R in setting the sbc, one and only one namelist/CPP key option '
155         WRITE(numout,*) '                     must be choosen. You choose ', icpt, ' option(s)'
156         WRITE(numout,*) '                     We stop'
157         nstop = nstop + 1
158      ENDIF
159      IF(lwp) THEN
160         WRITE(numout,*)
161         IF( nsbc == -1 )   WRITE(numout,*) '              ESOPA test All surface boundary conditions'
162         IF( nsbc ==  0 )   WRITE(numout,*) '              GYRE analytical formulation'
163         IF( nsbc ==  1 )   WRITE(numout,*) '              analytical formulation'
164         IF( nsbc ==  2 )   WRITE(numout,*) '              flux formulation'
165         IF( nsbc ==  3 )   WRITE(numout,*) '              CLIO bulk formulation'
166         IF( nsbc ==  4 )   WRITE(numout,*) '              CORE bulk formulation'
167         IF( nsbc ==  5 )   WRITE(numout,*) '              coupled formulation'
168      ENDIF
169      !
170   END SUBROUTINE sbc_init
171
172
173   SUBROUTINE sbc( kt )
174      !!---------------------------------------------------------------------
175      !!                    ***  ROUTINE sbc  ***
176      !!             
177      !! ** Purpose :   provide at each time-step the ocean surface boundary
178      !!                condition (momentum, heat and freshwater fluxes)
179      !!
180      !! ** Method  :   blah blah  to be written ?????????
181      !!                CAUTION : never mask the surface stress field (tke sbc)
182      !!
183      !! ** Action  : - set the ocean surface boundary condition, i.e. 
184      !!                utau, vtau, qns, qsr, emp, emps, qrp, erp
185      !!              - updte the ice fraction : fr_i
186      !!----------------------------------------------------------------------
187      INTEGER, INTENT(in) ::   kt       ! ocean time step
188      !!---------------------------------------------------------------------
189
190      IF( kt == nit000 )   CALL sbc_init         ! Read namsbc namelist : surface module
191
192      ! ocean to sbc mean sea surface variables (ss._m)
193      ! ---------------------------------------
194      CALL sbc_ssm( kt )                         ! sea surface mean currents (at U- and V-points),
195      !                                          ! temperature and salinity (at T-point) over nf_sbc time-step
196      !                                          ! (i.e. sst_m, sss_m, ssu_m, ssv_m)
197
198      ! sbc formulation
199      ! ---------------
200         
201      SELECT CASE( nsbc )                        ! Compute ocean surface boundary condition
202      !                                          ! (i.e. utau,vtau, qns, qsr, emp, emps)
203      CASE(  0 )   ;   CALL sbc_gyre    ( kt )                    ! analytical formulation : GYRE configuration
204      CASE(  1 )   ;   CALL sbc_ana     ( kt )                    ! analytical formulation : uniform sbc
205      CASE(  2 )   ;   CALL sbc_flx     ( kt )                    ! flux formulation
206      CASE(  3 )   ;   CALL sbc_blk_clio( kt )                    ! bulk formulation : CLIO for the ocean
207      CASE(  4 )   ;   CALL sbc_blk_core( kt )                    ! bulk formulation : CORE for the ocean
208      CASE(  5 )   ;   CALL sbc_cpl_rcv ( kt, nn_fsbc, nn_ice )   ! coupled formulation
209      CASE( -1 )                               
210                       CALL sbc_ana     ( kt )                    ! ESOPA, test ALL the formulations
211                       CALL sbc_gyre    ( kt )                    !
212                       CALL sbc_flx     ( kt )                    !
213                       CALL sbc_blk_clio( kt )                    !
214                       CALL sbc_blk_core( kt )                    !
215                       CALL sbc_cpl_rcv ( kt, nn_fsbc, nn_ice )   !
216      END SELECT
217
218      ! Misc. Options
219      ! -------------
220
221!!gm  IF( ln_dm2dc       )   CALL sbc_dcy( kt )                 ! Daily mean qsr distributed over the Diurnal Cycle
222     
223      SELECT CASE( nn_ice )                                     ! Update heat and freshwater fluxes over sea-ice areas
224      CASE(  1 )   ;       CALL sbc_ice_if   ( kt )                   ! Ice-cover climatology ("Ice-if" model)
225         !                                                     
226      CASE(  2 )   ;       CALL sbc_ice_lim_2( kt, nsbc )             ! LIM 2.0 ice model
227         !                                                     
228      CASE(  3 )   ;       CALL sbc_ice_lim  ( kt, nsbc, nn_ico_cpl)  ! LIM 3.0 ice model
229      END SELECT                                             
230
231      IF( ln_rnf       )   CALL sbc_rnf( kt )                   ! add runoffs to fresh water fluxes
232 
233      IF( ln_ssr       )   CALL sbc_ssr( kt )                   ! add SST/SSS damping term
234
235      IF( nn_fwb  /= 0 )   CALL sbc_fwb( kt, nn_fwb, nn_fsbc )  ! control the freshwater budget
236
237      IF( nclosea == 1 )   CALL sbc_clo( kt )                   ! treatment of closed sea in the model domain
238      !                                                         ! (update freshwater fluxes)
239      !
240      IF(ln_ctl) THEN         ! print mean trends (used for debugging)
241         CALL prt_ctl(tab2d_1=fr_i   , clinfo1=' fr_i - : ', mask1=tmask, ovlap=1 )
242         CALL prt_ctl(tab2d_1=emp    , clinfo1=' emp  - : ', mask1=tmask, ovlap=1 )
243         CALL prt_ctl(tab2d_1=emps   , clinfo1=' emps - : ', mask1=tmask, ovlap=1 )
244         CALL prt_ctl(tab2d_1=qns    , clinfo1=' qns  - : ', mask1=tmask, ovlap=1 )
245         CALL prt_ctl(tab2d_1=qsr    , clinfo1=' qsr  - : ', mask1=tmask, ovlap=1 )
246         CALL prt_ctl(tab3d_1=tmask  , clinfo1=' tmask  : ', mask1=tmask, ovlap=1, kdim=jpk )
247         CALL prt_ctl(tab3d_1=tn     , clinfo1=' sst  - : ', mask1=tmask, ovlap=1, kdim=1   )
248         CALL prt_ctl(tab3d_1=sn     , clinfo1=' sss  - : ', mask1=tmask, ovlap=1, kdim=1   )
249         CALL prt_ctl(tab2d_1=utau   , clinfo1=' utau - : ', mask1=umask,                      &
250            &         tab2d_2=vtau   , clinfo2=' vtau - : ', mask2=vmask, ovlap=1 )
251      ENDIF
252      !
253   END SUBROUTINE sbc
254
255   !!======================================================================
256END MODULE sbcmod
Note: See TracBrowser for help on using the repository browser.