source: branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/OPA_SRC/SBC/sbcmod.F90 @ 11101

Last change on this file since 11101 was 11101, checked in by frrh, 18 months ago

Merge changes from Met Office GMED ticket 450 to reduce unnecessary
text output from NEMO.
This output, which is typically not switchable, is rarely of interest
in normal (non-debugging) runs and simply redunantley consumes extra
file space.
Further, the presence of this text output has been shown to
significantly degrade performance of models which are run during
Met Office HPC RAID (disk) checks.
The new code introduces switches which are configurable via the
changes made in the associated Met Office MOCI ticket 399.

File size: 32.2 KB
Line 
1MODULE sbcmod
2   !!======================================================================
3   !!                       ***  MODULE  sbcmod  ***
4   !! Surface module :  provide to the ocean its surface boundary condition
5   !!======================================================================
6   !! History :  3.0  ! 2006-07  (G. Madec)  Original code
7   !!            3.1  ! 2008-08  (S. Masson, A. Caubel, E. Maisonnave, G. Madec) coupled interface
8   !!            3.3  ! 2010-04  (M. Leclair, G. Madec)  Forcing averaged over 2 time steps
9   !!            3.3  ! 2010-10  (S. Masson)  add diurnal cycle
10   !!            3.3  ! 2010-09  (D. Storkey) add ice boundary conditions (BDY)
11   !!             -   ! 2010-11  (G. Madec) ice-ocean stress always computed at each ocean time-step
12   !!             -   ! 2010-10  (J. Chanut, C. Bricaud, G. Madec)  add the surface pressure forcing
13   !!            3.4  ! 2011-11  (C. Harris) CICE added as an option
14   !!            3.5  ! 2012-11  (A. Coward, G. Madec) Rethink of heat, mass and salt surface fluxes
15   !!            3.6  ! 2014-11  (P. Mathiot, C. Harris) add ice shelves melting                   
16   !!----------------------------------------------------------------------
17
18   !!----------------------------------------------------------------------
19   !!   sbc_init       : read namsbc namelist
20   !!   sbc            : surface ocean momentum, heat and freshwater boundary conditions
21   !!----------------------------------------------------------------------
22   USE oce              ! ocean dynamics and tracers
23   USE dom_oce          ! ocean space and time domain
24   USE phycst           ! physical constants
25   USE sbc_oce          ! Surface boundary condition: ocean fields
26   USE trc_oce          ! shared ocean-passive tracers variables
27   USE sbc_ice          ! Surface boundary condition: ice fields
28   USE sbcdcy           ! surface boundary condition: diurnal cycle
29   USE sbcssm           ! surface boundary condition: sea-surface mean variables
30   USE sbcapr           ! surface boundary condition: atmospheric pressure
31   USE sbcana           ! surface boundary condition: analytical formulation
32   USE sbcflx           ! surface boundary condition: flux formulation
33   USE sbcblk_clio      ! surface boundary condition: bulk formulation : CLIO
34   USE sbcblk_core      ! surface boundary condition: bulk formulation : CORE
35   USE sbcblk_mfs       ! surface boundary condition: bulk formulation : MFS
36   USE sbcice_if        ! surface boundary condition: ice-if sea-ice model
37   USE sbcice_lim       ! surface boundary condition: LIM 3.0 sea-ice model
38   USE sbcice_lim_2     ! surface boundary condition: LIM 2.0 sea-ice model
39   USE sbcice_cice      ! surface boundary condition: CICE    sea-ice model
40   USE sbccpl           ! surface boundary condition: coupled florulation
41   USE cpl_oasis3       ! OASIS routines for coupling
42   USE sbcssr           ! surface boundary condition: sea surface restoring
43   USE sbcrnf           ! surface boundary condition: runoffs
44   USE sbcisf           ! surface boundary condition: ice shelf
45   USE sbcfwb           ! surface boundary condition: freshwater budget
46   USE closea           ! closed sea
47   USE icbstp           ! Icebergs!
48
49   USE prtctl           ! Print control                    (prt_ctl routine)
50   USE iom              ! IOM library
51   USE in_out_manager   ! I/O manager
52   USE lib_mpp          ! MPP library
53   USE timing           ! Timing
54   USE sbcwave          ! Wave module
55   USE bdy_par          ! Require lk_bdy
56
57   IMPLICIT NONE
58   PRIVATE
59
60   PUBLIC   sbc        ! routine called by step.F90
61   PUBLIC   sbc_init   ! routine called by opa.F90
62   
63   INTEGER ::   nsbc   ! type of surface boundary condition (deduced from namsbc informations)
64     
65   !! * Substitutions
66#  include "domzgr_substitute.h90"
67   !!----------------------------------------------------------------------
68   !! NEMO/OPA 4.0 , NEMO-consortium (2011)
69   !! $Id$
70   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
71   !!----------------------------------------------------------------------
72CONTAINS
73
74   SUBROUTINE sbc_init
75      !!---------------------------------------------------------------------
76      !!                    ***  ROUTINE sbc_init ***
77      !!
78      !! ** Purpose :   Initialisation of the ocean surface boundary computation
79      !!
80      !! ** Method  :   Read the namsbc namelist and set derived parameters
81      !!                Call init routines for all other SBC modules that have one
82      !!
83      !! ** Action  : - read namsbc parameters
84      !!              - nsbc: type of sbc
85      !!----------------------------------------------------------------------
86      INTEGER ::   icpt   ! local integer
87      !!
88      NAMELIST/namsbc/ nn_fsbc   , ln_ana    , ln_flx, ln_blk_clio, ln_blk_core, ln_mixcpl,   &
89         &             ln_blk_mfs, ln_apr_dyn, nn_ice, nn_ice_embd, ln_dm2dc   , ln_rnf   ,   &
90         &             ln_ssr    , nn_isf    , nn_fwb, ln_cdgw    , ln_wave    , ln_sdw   ,   &
91         &             nn_lsm    , nn_limflx , nn_components, ln_cpl
92      INTEGER  ::   ios
93      INTEGER  ::   ierr, ierr0, ierr1, ierr2, ierr3, jpm
94      LOGICAL  ::   ll_purecpl
95      !!----------------------------------------------------------------------
96
97      IF(lwp) THEN
98         WRITE(numout,*)
99         WRITE(numout,*) 'sbc_init : surface boundary condition setting'
100         WRITE(numout,*) '~~~~~~~~ '
101         IF(lflush) CALL flush(numout)
102      ENDIF
103
104      REWIND( numnam_ref )              ! Namelist namsbc in reference namelist : Surface boundary
105      READ  ( numnam_ref, namsbc, IOSTAT = ios, ERR = 901)
106901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc in reference namelist', lwp )
107
108      REWIND( numnam_cfg )              ! Namelist namsbc in configuration namelist : Parameters of the run
109      READ  ( numnam_cfg, namsbc, IOSTAT = ios, ERR = 902 )
110902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc in configuration namelist', lwp )
111      IF(lwm .AND. nprint > 2) WRITE ( numond, namsbc )
112
113      !                          ! overwrite namelist parameter using CPP key information
114      IF( Agrif_Root() ) THEN                ! AGRIF zoom
115        IF( lk_lim2 )   nn_ice      = 2
116        IF( lk_lim3 )   nn_ice      = 3
117        IF( lk_cice )   nn_ice      = 4
118      ENDIF
119      IF( cp_cfg == 'gyre' ) THEN            ! GYRE configuration
120          ln_ana      = .TRUE.   
121          nn_ice      =   0
122      ENDIF
123
124      IF(lwp) THEN               ! Control print
125         WRITE(numout,*) '        Namelist namsbc (partly overwritten with CPP key setting)'
126         WRITE(numout,*) '           frequency update of sbc (and ice)             nn_fsbc     = ', nn_fsbc
127         WRITE(numout,*) '           Type of sbc : '
128         WRITE(numout,*) '              analytical formulation                     ln_ana      = ', ln_ana
129         WRITE(numout,*) '              flux       formulation                     ln_flx      = ', ln_flx
130         WRITE(numout,*) '              CLIO bulk  formulation                     ln_blk_clio = ', ln_blk_clio
131         WRITE(numout,*) '              CORE bulk  formulation                     ln_blk_core = ', ln_blk_core
132         WRITE(numout,*) '              MFS  bulk  formulation                     ln_blk_mfs  = ', ln_blk_mfs
133         WRITE(numout,*) '              ocean-atmosphere coupled formulation       ln_cpl      = ', ln_cpl
134         WRITE(numout,*) '              forced-coupled mixed formulation           ln_mixcpl   = ', ln_mixcpl
135         WRITE(numout,*) '              OASIS coupling (with atm or sas)           lk_oasis    = ', lk_oasis
136         WRITE(numout,*) '              components of your executable              nn_components = ', nn_components
137         WRITE(numout,*) '              Multicategory heat flux formulation (LIM3) nn_limflx   = ', nn_limflx
138         WRITE(numout,*) '           Misc. options of sbc : '
139         WRITE(numout,*) '              Patm gradient added in ocean & ice Eqs.    ln_apr_dyn  = ', ln_apr_dyn
140         WRITE(numout,*) '              ice management in the sbc (=0/1/2/3)       nn_ice      = ', nn_ice 
141         WRITE(numout,*) '              ice-ocean embedded/levitating (=0/1/2)     nn_ice_embd = ', nn_ice_embd
142         WRITE(numout,*) '              daily mean to diurnal cycle qsr            ln_dm2dc    = ', ln_dm2dc 
143         WRITE(numout,*) '              runoff / runoff mouths                     ln_rnf      = ', ln_rnf
144         WRITE(numout,*) '              iceshelf formulation                       nn_isf      = ', nn_isf
145         WRITE(numout,*) '              Sea Surface Restoring on SST and/or SSS    ln_ssr      = ', ln_ssr
146         WRITE(numout,*) '              FreshWater Budget control  (=0/1/2)        nn_fwb      = ', nn_fwb
147         WRITE(numout,*) '              closed sea (=0/1) (set in namdom)          nn_closea   = ', nn_closea
148         WRITE(numout,*) '              n. of iterations if land-sea-mask applied  nn_lsm      = ', nn_lsm
149      ENDIF
150
151      ! LIM3 Multi-category heat flux formulation
152      SELECT CASE ( nn_limflx)
153      CASE ( -1 )
154         IF(lwp) WRITE(numout,*) '              Use of per-category fluxes (nn_limflx = -1) '
155      CASE ( 0  )
156         IF(lwp) WRITE(numout,*) '              Average per-category fluxes (nn_limflx = 0) ' 
157      CASE ( 1  )
158         IF(lwp) WRITE(numout,*) '              Average then redistribute per-category fluxes (nn_limflx = 1) '
159      CASE ( 2  )
160         IF(lwp) WRITE(numout,*) '              Redistribute a single flux over categories (nn_limflx = 2) '
161      END SELECT
162      !
163      IF(lwp .AND. lflush) CALL flush(numout)
164      !
165      IF ( nn_components /= jp_iam_nemo .AND. .NOT. lk_oasis )   &
166         &      CALL ctl_stop( 'STOP', 'sbc_init : OPA-SAS coupled via OASIS, but key_oasis3 disabled' )
167      IF ( nn_components == jp_iam_opa .AND. ln_cpl )   &
168         &      CALL ctl_stop( 'STOP', 'sbc_init : OPA-SAS coupled via OASIS, but ln_cpl = T in OPA' )
169      IF ( nn_components == jp_iam_opa .AND. ln_mixcpl )   &
170         &      CALL ctl_stop( 'STOP', 'sbc_init : OPA-SAS coupled via OASIS, but ln_mixcpl = T in OPA' )
171      IF ( ln_cpl .AND. .NOT. lk_oasis )    &
172         &      CALL ctl_stop( 'STOP', 'sbc_init : OASIS-coupled atmosphere model, but key_oasis3 disabled' )
173      IF( ln_mixcpl .AND. .NOT. lk_oasis )    &
174         &      CALL ctl_stop( 'the forced-coupled mixed mode (ln_mixcpl) requires the cpp key key_oasis3' )
175      IF( ln_mixcpl .AND. .NOT. ln_cpl )    &
176         &      CALL ctl_stop( 'the forced-coupled mixed mode (ln_mixcpl) requires ln_cpl = T' )
177      IF( ln_mixcpl .AND. nn_components /= jp_iam_nemo )    &
178         &      CALL ctl_stop( 'the forced-coupled mixed mode (ln_mixcpl) is not yet working with sas-opa coupling via oasis' )
179
180      !                              ! allocate sbc arrays
181      IF( sbc_oce_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'sbc_init : unable to allocate sbc_oce arrays' )
182
183      !                          ! Checks:
184      IF( nn_isf .EQ. 0 ) THEN                      ! variable initialisation if no ice shelf
185         IF( sbc_isf_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'sbc_init : unable to allocate sbc_isf arrays' )
186         fwfisf  (:,:)   = 0.0_wp ; fwfisf_b  (:,:)   = 0.0_wp
187         risf_tsc(:,:,:) = 0.0_wp ; risf_tsc_b(:,:,:) = 0.0_wp
188         rdivisf       = 0.0_wp
189      END IF
190      IF( nn_ice == 0 .AND. nn_components /= jp_iam_opa )   fr_i(:,:) = 0.e0 ! no ice in the domain, ice fraction is always zero
191
192      sfx(:,:) = 0.0_wp                            ! the salt flux due to freezing/melting will be computed (i.e. will be non-zero)
193                                                   ! only if sea-ice is present
194 
195      fmmflx(:,:) = 0.0_wp                        ! freezing-melting array initialisation
196     
197      taum(:,:) = 0.0_wp                           ! Initialise taum for use in gls in case of reduced restart
198
199      !                                            ! restartability   
200      IF( ( nn_ice == 2 .OR. nn_ice ==3 ) .AND. .NOT.( ln_blk_clio .OR. ln_blk_core .OR. ln_cpl ) )   &
201         &   CALL ctl_stop( 'LIM sea-ice model requires a bulk formulation or coupled configuration' )
202      IF( nn_ice == 4 .AND. .NOT.( ln_blk_core .OR. ln_cpl ) )   &
203         &   CALL ctl_stop( 'CICE sea-ice model requires ln_blk_core or ln_cpl' )
204      IF( nn_ice == 4 .AND. lk_agrif )   &
205         &   CALL ctl_stop( 'CICE sea-ice model not currently available with AGRIF' )
206      IF( ( nn_ice == 3 .OR. nn_ice == 4 ) .AND. nn_ice_embd == 0 )   &
207         &   CALL ctl_stop( 'LIM3 and CICE sea-ice models require nn_ice_embd = 1 or 2' )
208      IF( ( nn_ice /= 3 ) .AND. ( nn_limflx >= 0 ) )   &
209         &   WRITE(numout,*) 'The nn_limflx>=0 option has no effect if sea ice model is not LIM3'
210      IF( ( nn_ice == 3 ) .AND. ( ln_cpl ) .AND. ( ( nn_limflx == -1 ) .OR. ( nn_limflx == 1 ) ) )   &
211         &   CALL ctl_stop( 'The chosen nn_limflx for LIM3 in coupled mode must be 0 or 2' )
212      IF( ( nn_ice == 3 ) .AND. ( .NOT. ln_cpl ) .AND. ( nn_limflx == 2 ) )   &
213         &   CALL ctl_stop( 'The chosen nn_limflx for LIM3 in forced mode cannot be 2' )
214
215      IF( ln_dm2dc )   nday_qsr = -1   ! initialisation flag
216
217      IF( ln_dm2dc .AND. .NOT.( ln_flx .OR. ln_blk_core ) .AND. nn_components /= jp_iam_opa )   &
218         &   CALL ctl_stop( 'diurnal cycle into qsr field from daily values requires a flux or core-bulk formulation' )
219     
220      IF ( ln_wave ) THEN
221      !Activated wave module but neither drag nor stokes drift activated
222         IF ( .NOT.(ln_cdgw .OR. ln_sdw) )   THEN
223            CALL ctl_warn( 'Ask for wave coupling but nor drag coefficient (ln_cdgw=F) neither stokes drift activated (ln_sdw=F)' )
224      !drag coefficient read from wave model definable only with mfs bulk formulae and core
225         ELSEIF (ln_cdgw .AND. .NOT.(ln_blk_mfs .OR. ln_blk_core) )       THEN       
226             CALL ctl_stop( 'drag coefficient read from wave model definable only with mfs bulk formulae and core')
227         ENDIF
228      ELSE
229      IF ( ln_cdgw .OR. ln_sdw  )                                         & 
230         &   CALL ctl_stop('Not Activated Wave Module (ln_wave=F) but     &
231         & asked coupling with drag coefficient (ln_cdgw =T) or Stokes drift (ln_sdw=T) ')
232      ENDIF 
233      !                          ! Choice of the Surface Boudary Condition (set nsbc)
234      ll_purecpl = ln_cpl .AND. .NOT. ln_mixcpl
235      !
236      icpt = 0
237      IF( ln_ana          ) THEN   ;   nsbc = jp_ana     ; icpt = icpt + 1   ;   ENDIF       ! analytical           formulation
238      IF( ln_flx          ) THEN   ;   nsbc = jp_flx     ; icpt = icpt + 1   ;   ENDIF       ! flux                 formulation
239      IF( ln_blk_clio     ) THEN   ;   nsbc = jp_clio    ; icpt = icpt + 1   ;   ENDIF       ! CLIO bulk            formulation
240      IF( ln_blk_core     ) THEN   ;   nsbc = jp_core    ; icpt = icpt + 1   ;   ENDIF       ! CORE bulk            formulation
241      IF( ln_blk_mfs      ) THEN   ;   nsbc = jp_mfs     ; icpt = icpt + 1   ;   ENDIF       ! MFS  bulk            formulation
242      IF( ll_purecpl      ) THEN   ;   nsbc = jp_purecpl ; icpt = icpt + 1   ;   ENDIF       ! Pure Coupled         formulation
243      IF( cp_cfg == 'gyre') THEN   ;   nsbc = jp_gyre                        ;   ENDIF       ! GYRE analytical      formulation
244      IF( nn_components == jp_iam_opa )   &
245         &                  THEN   ;   nsbc = jp_none    ; icpt = icpt + 1   ;   ENDIF       ! opa coupling via SAS module
246      IF( lk_esopa        )            nsbc = jp_esopa                                       ! esopa test, ALL formulations
247      !
248      IF( icpt /= 1 .AND. .NOT.lk_esopa ) THEN
249         WRITE(numout,*)
250         WRITE(numout,*) '           E R R O R in setting the sbc, one and only one namelist/CPP key option '
251         WRITE(numout,*) '                     must be choosen. You choose ', icpt, ' option(s)'
252         WRITE(numout,*) '                     We stop'
253         nstop = nstop + 1
254      ENDIF
255      IF(lwp) THEN
256         WRITE(numout,*)
257         IF( nsbc == jp_esopa   )   WRITE(numout,*) '              ESOPA test All surface boundary conditions'
258         IF( nsbc == jp_gyre    )   WRITE(numout,*) '              GYRE analytical formulation'
259         IF( nsbc == jp_ana     )   WRITE(numout,*) '              analytical formulation'
260         IF( nsbc == jp_flx     )   WRITE(numout,*) '              flux formulation'
261         IF( nsbc == jp_clio    )   WRITE(numout,*) '              CLIO bulk formulation'
262         IF( nsbc == jp_core    )   WRITE(numout,*) '              CORE bulk formulation'
263         IF( nsbc == jp_purecpl )   WRITE(numout,*) '              pure coupled formulation'
264         IF( nsbc == jp_mfs     )   WRITE(numout,*) '              MFS Bulk formulation'
265         IF( nsbc == jp_none    )   WRITE(numout,*) '              OPA coupled to SAS via oasis'
266         IF( ln_mixcpl          )   WRITE(numout,*) '              + forced-coupled mixed formulation'
267         IF( nn_components/= jp_iam_nemo )  &
268            &                       WRITE(numout,*) '              + OASIS coupled SAS'
269         IF(lflush) CALL flush(numout)
270      ENDIF
271      !
272      IF( lk_oasis ) THEN
273         IF( sbc_cpl_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'sbc_cpl_alloc : unable to allocate arrays' )         
274         CALL sbc_cpl_init (nn_ice)   ! OASIS initialisation. must be done before: (1) first time step
275                                      !                                            (2) the use of nn_fsbc
276      ENDIF
277
278!     nn_fsbc initialization if OPA-SAS coupling via OASIS
279!     sas model time step has to be declared in OASIS (mandatory) -> nn_fsbc has to be modified accordingly
280      IF ( nn_components /= jp_iam_nemo ) THEN
281
282         IF ( nn_components == jp_iam_opa ) nn_fsbc = cpl_freq('O_SFLX') / NINT(rdt)
283         IF ( nn_components == jp_iam_sas ) nn_fsbc = cpl_freq('I_SFLX') / NINT(rdt)
284         !
285         IF(lwp)THEN
286            WRITE(numout,*)
287            WRITE(numout,*)"   OPA-SAS coupled via OASIS : nn_fsbc re-defined from OASIS namcouple ", nn_fsbc
288            WRITE(numout,*)
289            IF(lflush) CALL flush(numout)
290         ENDIF
291      ENDIF
292
293      IF( MOD( nitend - nit000 + 1, nn_fsbc) /= 0 .OR.   &
294          MOD( nstock             , nn_fsbc) /= 0 ) THEN
295         WRITE(ctmp1,*) 'experiment length (', nitend - nit000 + 1, ') or nstock (', nstock,   &
296            &           ' is NOT a multiple of nn_fsbc (', nn_fsbc, ')'
297         CALL ctl_stop( ctmp1, 'Impossible to properly do model restart' )
298      ENDIF
299      !
300      IF( MOD( rday, REAL(nn_fsbc, wp) * rdt ) /= 0 )   &
301         &  CALL ctl_warn( 'nn_fsbc is NOT a multiple of the number of time steps in a day' )
302      !
303      IF( ln_dm2dc .AND. ( ( NINT(rday) / ( nn_fsbc * NINT(rdt) ) )  < 8 ) )   &
304         &   CALL ctl_warn( 'diurnal cycle for qsr: the sampling of the diurnal cycle is too small...' )
305
306                               CALL sbc_ssm_init               ! Sea-surface mean fields initialisation
307      !
308      IF( ln_ssr           )   CALL sbc_ssr_init               ! Sea-Surface Restoring initialisation
309      !
310                               CALL sbc_rnf_init               ! Runof initialisation
311      !
312      IF( nn_ice == 3      )   CALL sbc_lim_init               ! LIM3 initialisation
313
314      IF( nn_ice == 4      )   CALL cice_sbc_init( nsbc )      ! CICE initialisation
315     
316   END SUBROUTINE sbc_init
317
318
319   SUBROUTINE sbc( kt )
320      !!---------------------------------------------------------------------
321      !!                    ***  ROUTINE sbc  ***
322      !!             
323      !! ** Purpose :   provide at each time-step the ocean surface boundary
324      !!                condition (momentum, heat and freshwater fluxes)
325      !!
326      !! ** Method  :   blah blah  to be written ?????????
327      !!                CAUTION : never mask the surface stress field (tke sbc)
328      !!
329      !! ** Action  : - set the ocean surface boundary condition at before and now
330      !!                time step, i.e. 
331      !!                utau_b, vtau_b, qns_b, qsr_b, emp_n, sfx_b, qrp_b, erp_b
332      !!                utau  , vtau  , qns  , qsr  , emp  , sfx  , qrp  , erp
333      !!              - updte the ice fraction : fr_i
334      !!----------------------------------------------------------------------
335      INTEGER, INTENT(in) ::   kt       ! ocean time step
336      !!---------------------------------------------------------------------
337      !
338      IF( nn_timing == 1 )  CALL timing_start('sbc')
339      !
340      !                                            ! ---------------------------------------- !
341      IF( kt /= nit000 ) THEN                      !          Swap of forcing fields          !
342         !                                         ! ---------------------------------------- !
343         utau_b(:,:) = utau(:,:)                         ! Swap the ocean forcing fields
344         vtau_b(:,:) = vtau(:,:)                         ! (except at nit000 where before fields
345         qns_b (:,:) = qns (:,:)                         !  are set at the end of the routine)
346         ! The 3D heat content due to qsr forcing is treated in traqsr
347         ! qsr_b (:,:) = qsr (:,:)
348         emp_b(:,:) = emp(:,:)
349         sfx_b(:,:) = sfx(:,:)
350         IF ( ln_rnf ) THEN
351            rnf_b    (:,:  ) = rnf    (:,:  )
352            rnf_tsc_b(:,:,:) = rnf_tsc(:,:,:)
353         ENDIF
354      ENDIF
355      !                                            ! ---------------------------------------- !
356      !                                            !        forcing field computation         !
357      !                                            ! ---------------------------------------- !
358      !
359      IF ( .NOT. lk_bdy ) then
360         IF( ln_apr_dyn ) CALL sbc_apr( kt )                ! atmospheric pressure provided at kt+0.5*nn_fsbc
361      ENDIF
362                                                         ! (caution called before sbc_ssm)
363      !
364      IF( nn_components /= jp_iam_sas )   CALL sbc_ssm( kt )   ! ocean sea surface variables (sst_m, sss_m, ssu_m, ssv_m)
365      !                                                        ! averaged over nf_sbc time-step
366
367      IF (ln_wave) CALL sbc_wave( kt )
368                                                   !==  sbc formulation  ==!
369                                                           
370      SELECT CASE( nsbc )                                ! Compute ocean surface boundary condition
371      !                                                  ! (i.e. utau,vtau, qns, qsr, emp, sfx)
372      CASE( jp_gyre  )   ;   CALL sbc_gyre    ( kt )                    ! analytical formulation : GYRE configuration
373      CASE( jp_ana   )   ;   CALL sbc_ana     ( kt )                    ! analytical formulation : uniform sbc
374      CASE( jp_flx   )   ;   CALL sbc_flx     ( kt )                    ! flux formulation
375      CASE( jp_clio  )   ;   CALL sbc_blk_clio( kt )                    ! bulk formulation : CLIO for the ocean
376      CASE( jp_core  )   
377         IF( nn_components == jp_iam_sas ) &
378            &                CALL sbc_cpl_rcv ( kt, nn_fsbc, nn_ice )   ! OPA-SAS coupling: SAS receiving fields from OPA
379                             CALL sbc_blk_core( kt )                    ! bulk formulation : CORE for the ocean
380                                                                        ! from oce: sea surface variables (sst_m, sss_m,  ssu_m,  ssv_m)
381      CASE( jp_purecpl )  ;  CALL sbc_cpl_rcv ( kt, nn_fsbc, nn_ice )   ! pure coupled formulation
382                                                                        !
383      CASE( jp_mfs   )   ;   CALL sbc_blk_mfs ( kt )                    ! bulk formulation : MFS for the ocean
384      CASE( jp_none  ) 
385         IF( nn_components == jp_iam_opa ) &
386                             CALL sbc_cpl_rcv ( kt, nn_fsbc, nn_ice )   ! OPA-SAS coupling: OPA receiving fields from SAS
387      CASE( jp_esopa )                               
388                             CALL sbc_ana     ( kt )                    ! ESOPA, test ALL the formulations
389                             CALL sbc_gyre    ( kt )                    !
390                             CALL sbc_flx     ( kt )                    !
391                             CALL sbc_blk_clio( kt )                    !
392                             CALL sbc_blk_core( kt )                    !
393                             CALL sbc_cpl_rcv ( kt, nn_fsbc, nn_ice )   !
394      END SELECT
395
396      IF( ln_mixcpl )        CALL sbc_cpl_rcv ( kt, nn_fsbc, nn_ice )   ! forced-coupled mixed formulation after forcing
397
398
399      !                                            !==  Misc. Options  ==!
400     
401      SELECT CASE( nn_ice )                                       ! Update heat and freshwater fluxes over sea-ice areas
402      CASE(  1 )   ;         CALL sbc_ice_if   ( kt )                ! Ice-cover climatology ("Ice-if" model)
403      CASE(  2 )   ;         CALL sbc_ice_lim_2( kt, nsbc )          ! LIM-2 ice model
404      CASE(  3 )   ;         CALL sbc_ice_lim  ( kt, nsbc )          ! LIM-3 ice model
405      CASE(  4 )   ;         CALL sbc_ice_cice ( kt, nsbc )          ! CICE ice model
406      END SELECT                                             
407
408      IF( ln_icebergs    )   CALL icb_stp( kt )                   ! compute icebergs
409
410      IF( nn_isf   /= 0  )   CALL sbc_isf( kt )                    ! compute iceshelves
411
412      IF( ln_rnf         )   CALL sbc_rnf( kt )                   ! add runoffs to fresh water fluxes
413 
414      IF( ln_ssr         )   CALL sbc_ssr( kt )                   ! add SST/SSS damping term
415
416      IF( nn_fwb    /= 0 )   CALL sbc_fwb( kt, nn_fwb, nn_fsbc )  ! control the freshwater budget
417
418      IF( nn_closea == 1 )   CALL sbc_clo( kt )                   ! treatment of closed sea in the model domain
419      !                                                           ! (update freshwater fluxes)
420!RBbug do not understand why see ticket 667
421!clem: it looks like it is necessary for the north fold (in certain circumstances). Don't know why.
422      CALL lbc_lnk( emp, 'T', 1. )
423      !
424      IF( kt == nit000 ) THEN                          !   set the forcing field at nit000 - 1    !
425         !                                             ! ---------------------------------------- !
426         IF( ln_rstart .AND.    &                               !* Restart: read in restart file
427            & iom_varid( numror, 'utau_b', ldstop = .FALSE. ) > 0 ) THEN
428            IF(lwp .AND. nprint > 0) THEN
429               WRITE(numout,*) '          nit000-1 surface forcing fields red in the restart file'
430               IF(lflush) CALL flush(numout)
431            ENDIF
432            IF(nn_timing == 2)  CALL timing_start('iom_rstget')
433            CALL iom_get( numror, jpdom_autoglo, 'utau_b', utau_b )   ! before i-stress  (U-point)
434            CALL iom_get( numror, jpdom_autoglo, 'vtau_b', vtau_b )   ! before j-stress  (V-point)
435            CALL iom_get( numror, jpdom_autoglo, 'qns_b' , qns_b  )   ! before non solar heat flux (T-point)
436            ! The 3D heat content due to qsr forcing is treated in traqsr
437            ! CALL iom_get( numror, jpdom_autoglo, 'qsr_b' , qsr_b  ) ! before     solar heat flux (T-point)
438            CALL iom_get( numror, jpdom_autoglo, 'emp_b', emp_b  )    ! before     freshwater flux (T-point)
439            ! To ensure restart capability with 3.3x/3.4 restart files    !! to be removed in v3.6
440            IF( iom_varid( numror, 'sfx_b', ldstop = .FALSE. ) > 0 ) THEN
441               CALL iom_get( numror, jpdom_autoglo, 'sfx_b', sfx_b )  ! before salt flux (T-point)
442            ELSE
443               sfx_b (:,:) = sfx(:,:)
444            ENDIF
445            IF(nn_timing == 2)  CALL timing_stop('iom_rstget')
446         ELSE                                                   !* no restart: set from nit000 values
447            IF(lwp) WRITE(numout,*) '          nit000-1 surface forcing fields set to nit000'
448            utau_b(:,:) = utau(:,:) 
449            vtau_b(:,:) = vtau(:,:)
450            qns_b (:,:) = qns (:,:)
451            emp_b (:,:) = emp(:,:)
452            sfx_b (:,:) = sfx(:,:)
453         ENDIF
454      ENDIF
455      !                                                ! ---------------------------------------- !
456      IF( lrst_oce ) THEN                              !      Write in the ocean restart file     !
457         !                                             ! ---------------------------------------- !
458         IF(lwp .AND. nprint > 0) THEN
459            WRITE(numout,*)
460            WRITE(numout,*) 'sbc : ocean surface forcing fields written in ocean restart file ',   &
461            &                    'at it= ', kt,' date= ', ndastp
462            WRITE(numout,*) '~~~~'
463            IF(lflush) CALL flush(numout)
464         ENDIF
465         IF(nn_timing == 2)  CALL timing_start('iom_rstput')
466         CALL iom_rstput( kt, nitrst, numrow, 'utau_b' , utau )
467         CALL iom_rstput( kt, nitrst, numrow, 'vtau_b' , vtau )
468         CALL iom_rstput( kt, nitrst, numrow, 'qns_b'  , qns  )
469         ! The 3D heat content due to qsr forcing is treated in traqsr
470         ! CALL iom_rstput( kt, nitrst, numrow, 'qsr_b'  , qsr  )
471         CALL iom_rstput( kt, nitrst, numrow, 'emp_b'  , emp  )
472         CALL iom_rstput( kt, nitrst, numrow, 'sfx_b'  , sfx  )
473         IF(nn_timing == 2)  CALL timing_stop('iom_rstput')
474      ENDIF
475
476      !                                                ! ---------------------------------------- !
477      !                                                !        Outputs and control print         !
478      !                                                ! ---------------------------------------- !
479      IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN
480         CALL iom_put( "empmr"  , emp    - rnf )                ! upward water flux
481         CALL iom_put( "empbmr" , emp_b  - rnf )                ! before upward water flux ( needed to recalculate the time evolution of ssh in offline )
482         CALL iom_put( "saltflx", sfx  )                        ! downward salt flux 
483                                                                ! (includes virtual salt flux beneath ice
484                                                                ! in linear free surface case)
485         CALL iom_put( "fmmflx", fmmflx  )                      ! Freezing-melting water flux
486         CALL iom_put( "qt"    , qns  + qsr )                   ! total heat flux
487         CALL iom_put( "qns"   , qns        )                   ! solar heat flux
488         CALL iom_put( "qsr"   ,       qsr  )                   ! solar heat flux
489         IF( nn_ice > 0 .OR. nn_components == jp_iam_opa )   CALL iom_put( "ice_cover", fr_i )   ! ice fraction
490         CALL iom_put( "taum"  , taum       )                   ! wind stress module
491         CALL iom_put( "wspd"  , wndm       )                   ! wind speed  module over free ocean or leads in presence of sea-ice
492      ENDIF
493      !
494      CALL iom_put( "utau", utau )   ! i-wind stress   (stress can be updated at
495      CALL iom_put( "vtau", vtau )   ! j-wind stress    each time step in sea-ice)
496      !
497      IF(ln_ctl) THEN         ! print mean trends (used for debugging)
498         CALL prt_ctl(tab2d_1=fr_i              , clinfo1=' fr_i     - : ', mask1=tmask, ovlap=1 )
499         CALL prt_ctl(tab2d_1=(emp-rnf + fwfisf), clinfo1=' emp-rnf  - : ', mask1=tmask, ovlap=1 )
500         CALL prt_ctl(tab2d_1=(sfx-rnf + fwfisf), clinfo1=' sfx-rnf  - : ', mask1=tmask, ovlap=1 )
501         CALL prt_ctl(tab2d_1=qns              , clinfo1=' qns      - : ', mask1=tmask, ovlap=1 )
502         CALL prt_ctl(tab2d_1=qsr              , clinfo1=' qsr      - : ', mask1=tmask, ovlap=1 )
503         CALL prt_ctl(tab3d_1=tmask            , clinfo1=' tmask    - : ', mask1=tmask, ovlap=1, kdim=jpk )
504         CALL prt_ctl(tab3d_1=tsn(:,:,:,jp_tem), clinfo1=' sst      - : ', mask1=tmask, ovlap=1, kdim=1   )
505         CALL prt_ctl(tab3d_1=tsn(:,:,:,jp_sal), clinfo1=' sss      - : ', mask1=tmask, ovlap=1, kdim=1   )
506         CALL prt_ctl(tab2d_1=utau             , clinfo1=' utau     - : ', mask1=umask,                      &
507            &         tab2d_2=vtau             , clinfo2=' vtau     - : ', mask2=vmask, ovlap=1 )
508      ENDIF
509
510      IF( kt == nitend )   CALL sbc_final         ! Close down surface module if necessary
511      !
512      IF( nn_timing == 1 )  CALL timing_stop('sbc')
513      !
514   END SUBROUTINE sbc
515
516
517   SUBROUTINE sbc_final
518      !!---------------------------------------------------------------------
519      !!                    ***  ROUTINE sbc_final  ***
520      !!
521      !! ** Purpose :   Finalize CICE (if used)
522      !!---------------------------------------------------------------------
523      !
524      IF( nn_ice == 4 )   CALL cice_sbc_final
525      !
526   END SUBROUTINE sbc_final
527
528   !!======================================================================
529END MODULE sbcmod
Note: See TracBrowser for help on using the repository browser.