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 NEMO/branches/2019/dev_r11613_ENHANCE-04_namelists_as_internalfiles/src/OCE/SBC – NEMO

Context Navigation

source: NEMO/branches/2019/dev_r11613_ENHANCE-04_namelists_as_internalfiles/src/OCE/SBC/sbcmod.F90 @ 11671

Last change on this file since 11671 was 11671, checked in by acc, 5 years ago
Branch 2019/dev_r11613_ENHANCE-04_namelists_as_internalfiles. Final, non-substantive changes to complete this branch. These changes remove all REWIND statements on the old namelist fortran units (now character variables for internal files). These changes have been left until last since they are easily repeated via a script and it may be preferable to use the previous revision for merge purposes and reapply these last changes separately. This branch has been fully SETTE tested.
Property svn:keywords set to `Id`
File size: 34.3 KB

Line
1	MODULE 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	!! 4.0 ! 2016-06 (L. Brodeau) new general bulk formulation
17	!!----------------------------------------------------------------------
18
19	!!----------------------------------------------------------------------
20	!! sbc_init : read namsbc namelist
21	!! sbc : surface ocean momentum, heat and freshwater boundary conditions
22	!! sbc_final : Finalize CICE ice model (if used)
23	!!----------------------------------------------------------------------
24	USE oce ! ocean dynamics and tracers
25	USE dom_oce ! ocean space and time domain
26	USE phycst ! physical constants
27	USE sbc_oce ! Surface boundary condition: ocean fields
28	USE trc_oce ! shared ocean-passive tracers variables
29	USE sbc_ice ! Surface boundary condition: ice fields
30	USE sbcdcy ! surface boundary condition: diurnal cycle
31	USE sbcssm ! surface boundary condition: sea-surface mean variables
32	USE sbcflx ! surface boundary condition: flux formulation
33	USE sbcblk ! surface boundary condition: bulk formulation
34	USE sbcice_if ! surface boundary condition: ice-if sea-ice model
35	#if defined key_si3
36	USE icestp ! surface boundary condition: SI3 sea-ice model
37	#endif
38	USE sbcice_cice ! surface boundary condition: CICE sea-ice model
39	USE sbcisf ! surface boundary condition: ice-shelf
40	USE sbccpl ! surface boundary condition: coupled formulation
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 sbcapr ! surface boundary condition: atmo pressure
45	USE sbcisf ! surface boundary condition: ice shelf
46	USE sbcfwb ! surface boundary condition: freshwater budget
47	USE icbstp ! Icebergs
48	USE icb_oce , ONLY : ln_passive_mode ! iceberg interaction mode
49	USE traqsr ! active tracers: light penetration
50	USE sbcwave ! Wave module
51	USE bdy_oce , ONLY: ln_bdy
52	USE usrdef_sbc ! user defined: surface boundary condition
53	USE closea ! closed sea
54	!
55	USE prtctl ! Print control (prt_ctl routine)
56	USE iom ! IOM library
57	USE in_out_manager ! I/O manager
58	USE lib_mpp ! MPP library
59	USE timing ! Timing
60	USE wet_dry
61	USE diurnal_bulk, ONLY: ln_diurnal_only ! diurnal SST diagnostic
62
63	IMPLICIT NONE
64	PRIVATE
65
66	PUBLIC sbc ! routine called by step.F90
67	PUBLIC sbc_init ! routine called by opa.F90
68
69	INTEGER :: nsbc ! type of surface boundary condition (deduced from namsbc informations)
70
71	!!----------------------------------------------------------------------
72	!! NEMO/OCE 4.0 , NEMO Consortium (2018)
73	!! $Id$
74	!! Software governed by the CeCILL license (see ./LICENSE)
75	!!----------------------------------------------------------------------
76	CONTAINS
77
78	SUBROUTINE sbc_init
79	!!---------------------------------------------------------------------
80	!! * ROUTINE sbc_init *
81	!!
82	!! ** Purpose : Initialisation of the ocean surface boundary computation
83	!!
84	!! ** Method : Read the namsbc namelist and set derived parameters
85	!! Call init routines for all other SBC modules that have one
86	!!
87	!! ** Action : - read namsbc parameters
88	!! - nsbc: type of sbc
89	!!----------------------------------------------------------------------
90	INTEGER :: ios, icpt ! local integer
91	LOGICAL :: ll_purecpl, ll_opa, ll_not_nemo ! local logical
92	!!
93	NAMELIST/namsbc/ nn_fsbc , &
94	& ln_usr , ln_flx , ln_blk , &
95	& ln_cpl , ln_mixcpl, nn_components, &
96	& nn_ice , ln_ice_embd, &
97	& ln_traqsr, ln_dm2dc , &
98	& ln_rnf , nn_fwb , ln_ssr , ln_isf , ln_apr_dyn , &
99	& ln_wave , ln_cdgw , ln_sdw , ln_tauwoc , ln_stcor , &
100	& ln_tauw , nn_lsm, nn_sdrift
101	!!----------------------------------------------------------------------
102	!
103	IF(lwp) THEN
104	WRITE(numout,*)
105	WRITE(numout,*) 'sbc_init : surface boundary condition setting'
106	WRITE(numout,*) '~~~~~~~~ '
107	ENDIF
108	!
109	! !** read Surface Module namelist
110	READ ( numnam_ref, namsbc, IOSTAT = ios, ERR = 901)
111	901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc in reference namelist' )
112	READ ( numnam_cfg, namsbc, IOSTAT = ios, ERR = 902 )
113	902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namsbc in configuration namelist' )
114	IF(lwm) WRITE( numond, namsbc )
115	!
116	#if defined key_mpp_mpi
117	ncom_fsbc = nn_fsbc ! make nn_fsbc available for lib_mpp
118	#endif
119	! !* overwrite namelist parameter using CPP key information
120	#if defined key_agrif
121	IF( Agrif_Root() ) THEN ! AGRIF zoom (cf r1242: possibility to run without ice in fine grid)
122	IF( lk_si3 ) nn_ice = 2
123	IF( lk_cice ) nn_ice = 3
124	ENDIF
125	#else
126	IF( lk_si3 ) nn_ice = 2
127	IF( lk_cice ) nn_ice = 3
128	#endif
129	!
130	IF(lwp) THEN !* Control print
131	WRITE(numout,*) ' Namelist namsbc (partly overwritten with CPP key setting)'
132	WRITE(numout,*) ' frequency update of sbc (and ice) nn_fsbc = ', nn_fsbc
133	WRITE(numout,*) ' Type of air-sea fluxes : '
134	WRITE(numout,*) ' user defined formulation ln_usr = ', ln_usr
135	WRITE(numout,*) ' flux formulation ln_flx = ', ln_flx
136	WRITE(numout,*) ' bulk formulation ln_blk = ', ln_blk
137	WRITE(numout,*) ' Type of coupling (Ocean/Ice/Atmosphere) : '
138	WRITE(numout,*) ' ocean-atmosphere coupled formulation ln_cpl = ', ln_cpl
139	WRITE(numout,*) ' mixed forced-coupled formulation ln_mixcpl = ', ln_mixcpl
140	!!gm lk_oasis is controlled by key_oasis3 ===>>> It shoud be removed from the namelist
141	WRITE(numout,*) ' OASIS coupling (with atm or sas) lk_oasis = ', lk_oasis
142	WRITE(numout,*) ' components of your executable nn_components = ', nn_components
143	WRITE(numout,*) ' Sea-ice : '
144	WRITE(numout,*) ' ice management in the sbc (=0/1/2/3) nn_ice = ', nn_ice
145	WRITE(numout,*) ' ice embedded into ocean ln_ice_embd = ', ln_ice_embd
146	WRITE(numout,*) ' Misc. options of sbc : '
147	WRITE(numout,*) ' Light penetration in temperature Eq. ln_traqsr = ', ln_traqsr
148	WRITE(numout,*) ' daily mean to diurnal cycle qsr ln_dm2dc = ', ln_dm2dc
149	WRITE(numout,*) ' Sea Surface Restoring on SST and/or SSS ln_ssr = ', ln_ssr
150	WRITE(numout,*) ' FreshWater Budget control (=0/1/2) nn_fwb = ', nn_fwb
151	WRITE(numout,*) ' Patm gradient added in ocean & ice Eqs. ln_apr_dyn = ', ln_apr_dyn
152	WRITE(numout,*) ' runoff / runoff mouths ln_rnf = ', ln_rnf
153	WRITE(numout,*) ' iceshelf formulation ln_isf = ', ln_isf
154	WRITE(numout,*) ' nb of iterations if land-sea-mask applied nn_lsm = ', nn_lsm
155	WRITE(numout,*) ' surface wave ln_wave = ', ln_wave
156	WRITE(numout,*) ' Stokes drift corr. to vert. velocity ln_sdw = ', ln_sdw
157	WRITE(numout,*) ' vertical parametrization nn_sdrift = ', nn_sdrift
158	WRITE(numout,*) ' wave modified ocean stress ln_tauwoc = ', ln_tauwoc
159	WRITE(numout,*) ' wave modified ocean stress component ln_tauw = ', ln_tauw
160	WRITE(numout,*) ' Stokes coriolis term ln_stcor = ', ln_stcor
161	WRITE(numout,*) ' neutral drag coefficient (CORE,NCAR) ln_cdgw = ', ln_cdgw
162	ENDIF
163	!
164	IF( .NOT.ln_wave ) THEN
165	ln_sdw = .false. ; ln_cdgw = .false. ; ln_tauwoc = .false. ; ln_tauw = .false. ; ln_stcor = .false.
166	ENDIF
167	IF( ln_sdw ) THEN
168	IF( .NOT.(nn_sdrift==jp_breivik_2014 .OR. nn_sdrift==jp_li_2017 .OR. nn_sdrift==jp_peakfr) ) &
169	CALL ctl_stop( 'The chosen nn_sdrift for Stokes drift vertical velocity must be 0, 1, or 2' )
170	ENDIF
171	ll_st_bv2014 = ( nn_sdrift==jp_breivik_2014 )
172	ll_st_li2017 = ( nn_sdrift==jp_li_2017 )
173	ll_st_bv_li = ( ll_st_bv2014 .OR. ll_st_li2017 )
174	ll_st_peakfr = ( nn_sdrift==jp_peakfr )
175	IF( ln_tauwoc .AND. ln_tauw ) &
176	CALL ctl_stop( 'More than one method for modifying the ocean stress has been selected ', &
177	'(ln_tauwoc=.true. and ln_tauw=.true.)' )
178	IF( ln_tauwoc ) &
179	CALL ctl_warn( 'You are subtracting the wave stress to the ocean (ln_tauwoc=.true.)' )
180	IF( ln_tauw ) &
181	CALL ctl_warn( 'The wave modified ocean stress components are used (ln_tauw=.true.) ', &
182	'This will override any other specification of the ocean stress' )
183	!
184	IF( .NOT.ln_usr ) THEN ! the model calendar needs some specificities (except in user defined case)
185	IF( MOD( rday , rdt ) /= 0. ) CALL ctl_stop( 'the time step must devide the number of second of in a day' )
186	IF( MOD( rday , 2. ) /= 0. ) CALL ctl_stop( 'the number of second of in a day must be an even number' )
187	IF( MOD( rdt , 2. ) /= 0. ) CALL ctl_stop( 'the time step (in second) must be an even number' )
188	ENDIF
189	! !** check option consistency
190	!
191	IF(lwp) WRITE(numout,) ! Single / Multi - executable (NEMO / OPA+SAS)
192	SELECT CASE( nn_components )
193	CASE( jp_iam_nemo )
194	IF(lwp) WRITE(numout,*) ' ==>>> NEMO configured as a single executable (i.e. including both OPA and Surface module)'
195	CASE( jp_iam_opa )
196	IF(lwp) WRITE(numout,*) ' ==>>> Multi executable configuration. Here, OPA component'
197	IF( .NOT.lk_oasis ) CALL ctl_stop( 'sbc_init : OPA-SAS coupled via OASIS, but key_oasis3 disabled' )
198	IF( ln_cpl ) CALL ctl_stop( 'sbc_init : OPA-SAS coupled via OASIS, but ln_cpl = T in OPA' )
199	IF( ln_mixcpl ) CALL ctl_stop( 'sbc_init : OPA-SAS coupled via OASIS, but ln_mixcpl = T in OPA' )
200	CASE( jp_iam_sas )
201	IF(lwp) WRITE(numout,*) ' ==>>> Multi executable configuration. Here, SAS component'
202	IF( .NOT.lk_oasis ) CALL ctl_stop( 'sbc_init : OPA-SAS coupled via OASIS, but key_oasis3 disabled' )
203	IF( ln_mixcpl ) CALL ctl_stop( 'sbc_init : OPA-SAS coupled via OASIS, but ln_mixcpl = T in OPA' )
204	CASE DEFAULT
205	CALL ctl_stop( 'sbc_init : unsupported value for nn_components' )
206	END SELECT
207	! !* coupled options
208	IF( ln_cpl ) THEN
209	IF( .NOT. lk_oasis ) CALL ctl_stop( 'sbc_init : coupled mode with an atmosphere model (ln_cpl=T)', &
210	& ' required to defined key_oasis3' )
211	ENDIF
212	IF( ln_mixcpl ) THEN
213	IF( .NOT. lk_oasis ) CALL ctl_stop( 'sbc_init : mixed forced-coupled mode (ln_mixcpl=T) ', &
214	& ' required to defined key_oasis3' )
215	IF( .NOT.ln_cpl ) CALL ctl_stop( 'sbc_init : mixed forced-coupled mode (ln_mixcpl=T) requires ln_cpl = T' )
216	IF( nn_components /= jp_iam_nemo ) &
217	& CALL ctl_stop( 'sbc_init : the mixed forced-coupled mode (ln_mixcpl=T) ', &
218	& ' not yet working with sas-opa coupling via oasis' )
219	ENDIF
220	! !* sea-ice
221	SELECT CASE( nn_ice )
222	CASE( 0 ) !- no ice in the domain
223	CASE( 1 ) !- Ice-cover climatology ("Ice-if" model)
224	CASE( 2 ) !- SI3 ice model
225	CASE( 3 ) !- CICE ice model
226	IF( .NOT.( ln_blk .OR. ln_cpl ) ) CALL ctl_stop( 'sbc_init : CICE sea-ice model requires ln_blk or ln_cpl = T' )
227	IF( lk_agrif ) CALL ctl_stop( 'sbc_init : CICE sea-ice model not currently available with AGRIF' )
228	CASE DEFAULT !- not supported
229	END SELECT
230	!
231	! !** allocate and set required variables
232	!
233	! !* allocate sbc arrays
234	IF( sbc_oce_alloc() /= 0 ) CALL ctl_stop( 'sbc_init : unable to allocate sbc_oce arrays' )
235	#if ! defined key_si3 && ! defined key_cice
236	IF( sbc_ice_alloc() /= 0 ) CALL ctl_stop( 'sbc_init : unable to allocate sbc_ice arrays' )
237	#endif
238	!
239	IF( .NOT.ln_isf ) THEN !* No ice-shelf in the domain : allocate and set to zero
240	IF( sbc_isf_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'sbc_init : unable to allocate sbc_isf arrays' )
241	fwfisf (:,:) = 0._wp ; risf_tsc (:,:,:) = 0._wp
242	fwfisf_b(:,:) = 0._wp ; risf_tsc_b(:,:,:) = 0._wp
243	END IF
244	IF( nn_ice == 0 ) THEN !* No sea-ice in the domain : ice fraction is always zero
245	IF( nn_components /= jp_iam_opa ) fr_i(:,:) = 0._wp ! except for OPA in SAS-OPA coupled case
246	ENDIF
247	!
248	sfx (:,:) = 0._wp !* salt flux due to freezing/melting
249	fmmflx(:,:) = 0._wp !* freezing minus melting flux
250
251	taum(:,:) = 0._wp !* wind stress module (needed in GLS in case of reduced restart)
252
253	! ! Choice of the Surface Boudary Condition (set nsbc)
254	IF( ln_dm2dc ) THEN !* daily mean to diurnal cycle
255	nday_qsr = -1 ! allow initialization at the 1st call
256	IF( .NOT.( ln_flx .OR. ln_blk ) .AND. nn_components /= jp_iam_opa ) &
257	& CALL ctl_stop( 'qsr diurnal cycle from daily values requires a flux or bulk formulation' )
258	ENDIF
259	! !* Choice of the Surface Boudary Condition
260	! (set nsbc)
261	!
262	ll_purecpl = ln_cpl .AND. .NOT.ln_mixcpl
263	ll_opa = nn_components == jp_iam_opa
264	ll_not_nemo = nn_components /= jp_iam_nemo
265	icpt = 0
266	!
267	IF( ln_usr ) THEN ; nsbc = jp_usr ; icpt = icpt + 1 ; ENDIF ! user defined formulation
268	IF( ln_flx ) THEN ; nsbc = jp_flx ; icpt = icpt + 1 ; ENDIF ! flux formulation
269	IF( ln_blk ) THEN ; nsbc = jp_blk ; icpt = icpt + 1 ; ENDIF ! bulk formulation
270	IF( ll_purecpl ) THEN ; nsbc = jp_purecpl ; icpt = icpt + 1 ; ENDIF ! Pure Coupled formulation
271	IF( ll_opa ) THEN ; nsbc = jp_none ; icpt = icpt + 1 ; ENDIF ! opa coupling via SAS module
272	!
273	IF( icpt /= 1 ) CALL ctl_stop( 'sbc_init : choose ONE and only ONE sbc option' )
274	!
275	IF(lwp) THEN !- print the choice of surface flux formulation
276	WRITE(numout,*)
277	SELECT CASE( nsbc )
278	CASE( jp_usr ) ; WRITE(numout,*) ' ==>>> user defined forcing formulation'
279	CASE( jp_flx ) ; WRITE(numout,*) ' ==>>> flux formulation'
280	CASE( jp_blk ) ; WRITE(numout,*) ' ==>>> bulk formulation'
281	CASE( jp_purecpl ) ; WRITE(numout,*) ' ==>>> pure coupled formulation'
282	!!gm abusive use of jp_none ?? ===>>> need to be check and changed by adding a jp_sas parameter
283	CASE( jp_none ) ; WRITE(numout,*) ' ==>>> OPA coupled to SAS via oasis'
284	IF( ln_mixcpl ) WRITE(numout,*) ' + forced-coupled mixed formulation'
285	END SELECT
286	IF( ll_not_nemo ) WRITE(numout,*) ' + OASIS coupled SAS'
287	ENDIF
288	!
289	! !* OASIS initialization
290	!
291	IF( lk_oasis ) CALL sbc_cpl_init( nn_ice ) ! Must be done before: (1) first time step
292	! ! (2) the use of nn_fsbc
293	! nn_fsbc initialization if OPA-SAS coupling via OASIS
294	! SAS time-step has to be declared in OASIS (mandatory) -> nn_fsbc has to be modified accordingly
295	IF( nn_components /= jp_iam_nemo ) THEN
296	IF( nn_components == jp_iam_opa ) nn_fsbc = cpl_freq('O_SFLX') / NINT(rdt)
297	IF( nn_components == jp_iam_sas ) nn_fsbc = cpl_freq('I_SFLX') / NINT(rdt)
298	!
299	IF(lwp)THEN
300	WRITE(numout,*)
301	WRITE(numout,*)" OPA-SAS coupled via OASIS : nn_fsbc re-defined from OASIS namcouple ", nn_fsbc
302	WRITE(numout,*)
303	ENDIF
304	ENDIF
305	!
306	! !* check consistency between model timeline and nn_fsbc
307	IF( ln_rst_list .OR. nn_stock /= -1 ) THEN ! we will do restart files
308	IF( MOD( nitend - nit000 + 1, nn_fsbc) /= 0 ) THEN
309	WRITE(ctmp1,*) 'sbc_init : experiment length (', nitend - nit000 + 1, ') is NOT a multiple of nn_fsbc (', nn_fsbc, ')'
310	CALL ctl_stop( ctmp1, 'Impossible to properly do model restart' )
311	ENDIF
312	IF( .NOT. ln_rst_list .AND. MOD( nn_stock, nn_fsbc) /= 0 ) THEN ! we don't use nn_stock if ln_rst_list
313	WRITE(ctmp1,*) 'sbc_init : nn_stock (', nn_stock, ') is NOT a multiple of nn_fsbc (', nn_fsbc, ')'
314	CALL ctl_stop( ctmp1, 'Impossible to properly do model restart' )
315	ENDIF
316	ENDIF
317	!
318	IF( MOD( rday, REAL(nn_fsbc, wp) * rdt ) /= 0 ) &
319	& CALL ctl_warn( 'sbc_init : nn_fsbc is NOT a multiple of the number of time steps in a day' )
320	!
321	IF( ln_dm2dc .AND. NINT(rday) / ( nn_fsbc * NINT(rdt) ) < 8 ) &
322	& CALL ctl_warn( 'sbc_init : diurnal cycle for qsr: the sampling of the diurnal cycle is too small...' )
323	!
324
325	! !** associated modules : initialization
326	!
327	CALL sbc_ssm_init ! Sea-surface mean fields initialization
328	!
329	IF( ln_blk ) CALL sbc_blk_init ! bulk formulae initialization
330
331	IF( ln_ssr ) CALL sbc_ssr_init ! Sea-Surface Restoring initialization
332	!
333	IF( ln_isf ) CALL sbc_isf_init ! Compute iceshelves
334	!
335	CALL sbc_rnf_init ! Runof initialization
336	!
337	IF( ln_apr_dyn ) CALL sbc_apr_init ! Atmo Pressure Forcing initialization
338	!
339	#if defined key_si3
340	IF( lk_agrif .AND. nn_ice == 0 ) THEN ! allocate ice arrays in case agrif + ice-model + no-ice in child grid
341	IF( sbc_ice_alloc() /= 0 ) CALL ctl_stop('STOP', 'sbc_ice_alloc : unable to allocate arrays' )
342	ELSEIF( nn_ice == 2 ) THEN
343	CALL ice_init ! ICE initialization
344	ENDIF
345	#endif
346	IF( nn_ice == 3 ) CALL cice_sbc_init( nsbc ) ! CICE initialization
347	!
348	IF( ln_wave ) CALL sbc_wave_init ! surface wave initialisation
349	!
350	IF( lwxios ) THEN
351	CALL iom_set_rstw_var_active('utau_b')
352	CALL iom_set_rstw_var_active('vtau_b')
353	CALL iom_set_rstw_var_active('qns_b')
354	! The 3D heat content due to qsr forcing is treated in traqsr
355	! CALL iom_set_rstw_var_active('qsr_b')
356	CALL iom_set_rstw_var_active('emp_b')
357	CALL iom_set_rstw_var_active('sfx_b')
358	ENDIF
359
360	END SUBROUTINE sbc_init
361
362
363	SUBROUTINE sbc( kt )
364	!!---------------------------------------------------------------------
365	!! * ROUTINE sbc *
366	!!
367	!! ** Purpose : provide at each time-step the ocean surface boundary
368	!! condition (momentum, heat and freshwater fluxes)
369	!!
370	!! ** Method : blah blah to be written ?????????
371	!! CAUTION : never mask the surface stress field (tke sbc)
372	!!
373	!! ** Action : - set the ocean surface boundary condition at before and now
374	!! time step, i.e.
375	!! utau_b, vtau_b, qns_b, qsr_b, emp_n, sfx_b, qrp_b, erp_b
376	!! utau , vtau , qns , qsr , emp , sfx , qrp , erp
377	!! - updte the ice fraction : fr_i
378	!!----------------------------------------------------------------------
379	INTEGER, INTENT(in) :: kt ! ocean time step
380	!
381	LOGICAL :: ll_sas, ll_opa ! local logical
382	!
383	REAL(wp) :: zthscl ! wd tanh scale
384	REAL(wp), DIMENSION(jpi,jpj) :: zwdht, zwght ! wd dep over wd limit, wgt
385
386	!!---------------------------------------------------------------------
387	!
388	IF( ln_timing ) CALL timing_start('sbc')
389	!
390	! ! ---------------------------------------- !
391	IF( kt /= nit000 ) THEN ! Swap of forcing fields !
392	! ! ---------------------------------------- !
393	utau_b(:,:) = utau(:,:) ! Swap the ocean forcing fields
394	vtau_b(:,:) = vtau(:,:) ! (except at nit000 where before fields
395	qns_b (:,:) = qns (:,:) ! are set at the end of the routine)
396	emp_b (:,:) = emp (:,:)
397	sfx_b (:,:) = sfx (:,:)
398	IF ( ln_rnf ) THEN
399	rnf_b (:,: ) = rnf (:,: )
400	rnf_tsc_b(:,:,:) = rnf_tsc(:,:,:)
401	ENDIF
402	IF( ln_isf ) THEN
403	fwfisf_b (:,: ) = fwfisf (:,: )
404	risf_tsc_b(:,:,:) = risf_tsc(:,:,:)
405	ENDIF
406	!
407	ENDIF
408	! ! ---------------------------------------- !
409	! ! forcing field computation !
410	! ! ---------------------------------------- !
411	!
412	ll_sas = nn_components == jp_iam_sas ! component flags
413	ll_opa = nn_components == jp_iam_opa
414	!
415	IF( .NOT.ll_sas ) CALL sbc_ssm ( kt ) ! mean ocean sea surface variables (sst_m, sss_m, ssu_m, ssv_m)
416	IF( ln_wave ) CALL sbc_wave( kt ) ! surface waves
417
418	!
419	! !== sbc formulation ==!
420	!
421	SELECT CASE( nsbc ) ! Compute ocean surface boundary condition
422	! ! (i.e. utau,vtau, qns, qsr, emp, sfx)
423	CASE( jp_usr ) ; CALL usrdef_sbc_oce( kt ) ! user defined formulation
424	CASE( jp_flx ) ; CALL sbc_flx ( kt ) ! flux formulation
425	CASE( jp_blk )
426	IF( ll_sas ) CALL sbc_cpl_rcv ( kt, nn_fsbc, nn_ice ) ! OPA-SAS coupling: SAS receiving fields from OPA
427	CALL sbc_blk ( kt ) ! bulk formulation for the ocean
428	!
429	CASE( jp_purecpl ) ; CALL sbc_cpl_rcv ( kt, nn_fsbc, nn_ice ) ! pure coupled formulation
430	CASE( jp_none )
431	IF( ll_opa ) CALL sbc_cpl_rcv ( kt, nn_fsbc, nn_ice ) ! OPA-SAS coupling: OPA receiving fields from SAS
432	END SELECT
433	!
434	IF( ln_mixcpl ) CALL sbc_cpl_rcv ( kt, nn_fsbc, nn_ice ) ! forced-coupled mixed formulation after forcing
435	!
436	IF ( ln_wave .AND. (ln_tauwoc .OR. ln_tauw) ) CALL sbc_wstress( ) ! Wind stress provided by waves
437	!
438	! !== Misc. Options ==!
439	!
440	SELECT CASE( nn_ice ) ! Update heat and freshwater fluxes over sea-ice areas
441	CASE( 1 ) ; CALL sbc_ice_if ( kt ) ! Ice-cover climatology ("Ice-if" model)
442	#if defined key_si3
443	CASE( 2 ) ; CALL ice_stp ( kt, nsbc ) ! SI3 ice model
444	#endif
445	CASE( 3 ) ; CALL sbc_ice_cice ( kt, nsbc ) ! CICE ice model
446	END SELECT
447
448	IF( ln_icebergs ) THEN
449	CALL icb_stp( kt ) ! compute icebergs
450	! icebergs may advect into haloes during the icb step and alter emp.
451	! A lbc_lnk is necessary here to ensure restartability (#2113)
452	IF( .NOT. ln_passive_mode ) CALL lbc_lnk( 'sbcmod', emp, 'T', 1. ) ! ensure restartability with icebergs
453	ENDIF
454
455	IF( ln_isf ) CALL sbc_isf( kt ) ! compute iceshelves
456
457	IF( ln_rnf ) CALL sbc_rnf( kt ) ! add runoffs to fresh water fluxes
458
459	IF( ln_ssr ) CALL sbc_ssr( kt ) ! add SST/SSS damping term
460
461	IF( nn_fwb /= 0 ) CALL sbc_fwb( kt, nn_fwb, nn_fsbc ) ! control the freshwater budget
462
463	! Special treatment of freshwater fluxes over closed seas in the model domain
464	! Should not be run if ln_diurnal_only
465	IF( l_sbc_clo .AND. (.NOT. ln_diurnal_only) ) CALL sbc_clo( kt )
466
467	!!$!RBbug do not understand why see ticket 667
468	!!$!clem: it looks like it is necessary for the north fold (in certain circumstances). Don't know why.
469	!!$ CALL lbc_lnk( 'sbcmod', emp, 'T', 1. )
470	IF ( ll_wd ) THEN ! If near WAD point limit the flux for now
471	zthscl = atanh(rn_wd_sbcfra) ! taper frac default is .999
472	zwdht(:,:) = sshn(:,:) + ht_0(:,:) - rn_wdmin1 ! do this calc of water
473	! depth above wd limit once
474	WHERE( zwdht(:,:) <= 0.0 )
475	taum(:,:) = 0.0
476	utau(:,:) = 0.0
477	vtau(:,:) = 0.0
478	qns (:,:) = 0.0
479	qsr (:,:) = 0.0
480	emp (:,:) = min(emp(:,:),0.0) !can allow puddles to grow but not shrink
481	sfx (:,:) = 0.0
482	END WHERE
483	zwght(:,:) = tanh(zthscl*zwdht(:,:))
484	WHERE( zwdht(:,:) > 0.0 .and. zwdht(:,:) < rn_wd_sbcdep ) ! 5 m hard limit here is arbitrary
485	qsr (:,:) = qsr(:,:) * zwght(:,:)
486	qns (:,:) = qns(:,:) * zwght(:,:)
487	taum (:,:) = taum(:,:) * zwght(:,:)
488	utau (:,:) = utau(:,:) * zwght(:,:)
489	vtau (:,:) = vtau(:,:) * zwght(:,:)
490	sfx (:,:) = sfx(:,:) * zwght(:,:)
491	emp (:,:) = emp(:,:) * zwght(:,:)
492	END WHERE
493	ENDIF
494	!
495	IF( kt == nit000 ) THEN ! set the forcing field at nit000 - 1 !
496	! ! ---------------------------------------- !
497	IF( ln_rstart .AND. & !* Restart: read in restart file
498	& iom_varid( numror, 'utau_b', ldstop = .FALSE. ) > 0 ) THEN
499	IF(lwp) WRITE(numout,*) ' nit000-1 surface forcing fields red in the restart file'
500	CALL iom_get( numror, jpdom_autoglo, 'utau_b', utau_b, ldxios = lrxios ) ! before i-stress (U-point)
501	CALL iom_get( numror, jpdom_autoglo, 'vtau_b', vtau_b, ldxios = lrxios ) ! before j-stress (V-point)
502	CALL iom_get( numror, jpdom_autoglo, 'qns_b' , qns_b, ldxios = lrxios ) ! before non solar heat flux (T-point)
503	! The 3D heat content due to qsr forcing is treated in traqsr
504	! CALL iom_get( numror, jpdom_autoglo, 'qsr_b' , qsr_b, ldxios = lrxios ) ! before solar heat flux (T-point)
505	CALL iom_get( numror, jpdom_autoglo, 'emp_b', emp_b, ldxios = lrxios ) ! before freshwater flux (T-point)
506	! To ensure restart capability with 3.3x/3.4 restart files !! to be removed in v3.6
507	IF( iom_varid( numror, 'sfx_b', ldstop = .FALSE. ) > 0 ) THEN
508	CALL iom_get( numror, jpdom_autoglo, 'sfx_b', sfx_b, ldxios = lrxios ) ! before salt flux (T-point)
509	ELSE
510	sfx_b (:,:) = sfx(:,:)
511	ENDIF
512	ELSE !* no restart: set from nit000 values
513	IF(lwp) WRITE(numout,*) ' nit000-1 surface forcing fields set to nit000'
514	utau_b(:,:) = utau(:,:)
515	vtau_b(:,:) = vtau(:,:)
516	qns_b (:,:) = qns (:,:)
517	emp_b (:,:) = emp (:,:)
518	sfx_b (:,:) = sfx (:,:)
519	ENDIF
520	ENDIF
521	! ! ---------------------------------------- !
522	IF( lrst_oce ) THEN ! Write in the ocean restart file !
523	! ! ---------------------------------------- !
524	IF(lwp) WRITE(numout,*)
525	IF(lwp) WRITE(numout,*) 'sbc : ocean surface forcing fields written in ocean restart file ', &
526	& 'at it= ', kt,' date= ', ndastp
527	IF(lwp) WRITE(numout,*) '~~~~'
528	IF( lwxios ) CALL iom_swap( cwxios_context )
529	CALL iom_rstput( kt, nitrst, numrow, 'utau_b' , utau, ldxios = lwxios )
530	CALL iom_rstput( kt, nitrst, numrow, 'vtau_b' , vtau, ldxios = lwxios )
531	CALL iom_rstput( kt, nitrst, numrow, 'qns_b' , qns, ldxios = lwxios )
532	! The 3D heat content due to qsr forcing is treated in traqsr
533	! CALL iom_rstput( kt, nitrst, numrow, 'qsr_b' , qsr )
534	CALL iom_rstput( kt, nitrst, numrow, 'emp_b' , emp, ldxios = lwxios )
535	CALL iom_rstput( kt, nitrst, numrow, 'sfx_b' , sfx, ldxios = lwxios )
536	IF( lwxios ) CALL iom_swap( cxios_context )
537	ENDIF
538	! ! ---------------------------------------- !
539	! ! Outputs and control print !
540	! ! ---------------------------------------- !
541	IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN
542	CALL iom_put( "empmr" , emp - rnf ) ! upward water flux
543	CALL iom_put( "empbmr" , emp_b - rnf ) ! before upward water flux ( needed to recalculate the time evolution of ssh in offline )
544	CALL iom_put( "saltflx", sfx ) ! downward salt flux (includes virtual salt flux beneath ice in linear free surface case)
545	CALL iom_put( "fmmflx", fmmflx ) ! Freezing-melting water flux
546	CALL iom_put( "qt" , qns + qsr ) ! total heat flux
547	CALL iom_put( "qns" , qns ) ! solar heat flux
548	CALL iom_put( "qsr" , qsr ) ! solar heat flux
549	IF( nn_ice > 0 .OR. ll_opa ) CALL iom_put( "ice_cover", fr_i ) ! ice fraction
550	CALL iom_put( "taum" , taum ) ! wind stress module
551	CALL iom_put( "wspd" , wndm ) ! wind speed module over free ocean or leads in presence of sea-ice
552	ENDIF
553	!
554	CALL iom_put( "utau", utau ) ! i-wind stress (stress can be updated at each time step in sea-ice)
555	CALL iom_put( "vtau", vtau ) ! j-wind stress
556	!
557	IF(ln_ctl) THEN ! print mean trends (used for debugging)
558	CALL prt_ctl(tab2d_1=fr_i , clinfo1=' fr_i - : ', mask1=tmask )
559	CALL prt_ctl(tab2d_1=(emp-rnf + fwfisf), clinfo1=' emp-rnf - : ', mask1=tmask )
560	CALL prt_ctl(tab2d_1=(sfx-rnf + fwfisf), clinfo1=' sfx-rnf - : ', mask1=tmask )
561	CALL prt_ctl(tab2d_1=qns , clinfo1=' qns - : ', mask1=tmask )
562	CALL prt_ctl(tab2d_1=qsr , clinfo1=' qsr - : ', mask1=tmask )
563	CALL prt_ctl(tab3d_1=tmask , clinfo1=' tmask - : ', mask1=tmask, kdim=jpk )
564	CALL prt_ctl(tab3d_1=tsn(:,:,:,jp_tem), clinfo1=' sst - : ', mask1=tmask, kdim=1 )
565	CALL prt_ctl(tab3d_1=tsn(:,:,:,jp_sal), clinfo1=' sss - : ', mask1=tmask, kdim=1 )
566	CALL prt_ctl(tab2d_1=utau , clinfo1=' utau - : ', mask1=umask, &
567	& tab2d_2=vtau , clinfo2=' vtau - : ', mask2=vmask )
568	ENDIF
569
570	IF( kt == nitend ) CALL sbc_final ! Close down surface module if necessary
571	!
572	IF( ln_timing ) CALL timing_stop('sbc')
573	!
574	END SUBROUTINE sbc
575
576
577	SUBROUTINE sbc_final
578	!!---------------------------------------------------------------------
579	!! * ROUTINE sbc_final *
580	!!
581	!! ** Purpose : Finalize CICE (if used)
582	!!---------------------------------------------------------------------
583	!
584	IF( nn_ice == 3 ) CALL cice_sbc_final
585	!
586	END SUBROUTINE sbc_final
587
588	!!======================================================================
589	END MODULE sbcmod

Note: See TracBrowser for help on using the repository browser.

Download in other formats: