Context Navigation

← Previous Revision
Latest Revision
Next Revision →
Blame
Revision Log

sbcmod_tam.F90 @ 2587

Last change on this file since 2587 was 1885, checked in by rblod, 14 years ago
add TAM sources
File size: 20.8 KB

Line
1	MODULE sbcmod_tam
2	#ifdef key_tam
3	!!======================================================================
4	!! * MODULE sbcmod_tam *
5	!! Surface module : provide to the ocean its surface boundary condition
6	!! Tangent&Adjoint module
7	!!======================================================================
8	!! History of the direct module :
9	!! 3.0 ! 2006-07 (G. Madec) Original code
10	!! History of the T&A module :
11	!! 3.0 ! 2008-11 (A. Vidard) TAM of the 2006-07 version
12	!!----------------------------------------------------------------------
13
14	!!----------------------------------------------------------------------
15	!! sbc_init : read namsbc namelist
16	!! sbc : surface ocean momentum, heat and freshwater boundary conditions
17	!!----------------------------------------------------------------------
18	USE par_kind , ONLY: & ! Precision variables
19	& wp
20	USE phycst , ONLY: & !
21	& rday
22	! USE ice_oce ! sea-ice model : LIM
23	USE dom_oce , ONLY: & ! ocean space domain variables
24	& rdt, &
25	& cp_cfg
26	USE sbc_oce , ONLY: & ! Surface boundary condition: ocean fields
27	& nn_fsbc
28	USE sbc_oce_tam , ONLY: & ! Surface boundary condition: ocean fields
29	& fr_i_tl
30	USE sbcssm_tam , ONLY: & ! surface boundary condition: sea-surface mean variables
31	& sbc_ssm_tan, &
32	& sbc_ssm_adj, &
33	& sbc_ssm_adj_tst
34	USE sbcana_tam, ONLY: & ! surface boundary condition: analytical formulation
35	& sbc_gyre_tan, &
36	& sbc_gyre_adj, &
37	& sbc_gyre_adj_tst
38	!*B & sbc_ana_tan, &
39	!*B & sbc_ana_adj, &
40	!*B & sbc_ana_adj_tst
41	USE sbcflx_tam , ONLY: & ! surface boundary condition: flux formulation
42	& sbc_flx_tan, &
43	& sbc_flx_adj, &
44	& sbc_flx_adj_tst
45	! USE sbcblk_clio ! surface boundary condition: bulk formulation : CLIO
46	! USE sbcblk_core ! surface boundary condition: bulk formulation : CORE
47	! USE sbcice_if ! surface boundary condition: ice-if sea-ice model
48	! USE sbcice_lim ! surface boundary condition: LIM 3.0 sea-ice model
49	! USE sbcice_lim_2 ! surface boundary condition: LIM 2.0 sea-ice model
50	! USE sbccpl ! surface boundary condition: coupled florulation
51	USE sbcssr_tam , ONLY: & ! surface boundary condition: sea surface restoring
52	& sbc_ssr_tan, &
53	& sbc_ssr_adj, &
54	& sbc_ssr_adj_tst
55	USE closea_tam , ONLY: & !specific treatments associated with closed seas
56	& sbc_clo_tan, &
57	& sbc_clo_adj, &
58	& sbc_clo_adj_tst
59	! USE sbcrnf_tam ! surface boundary condition: runoffs
60	USE sbcrnf , ONLY: & ! surface boundary condition: runoffs
61	& rnfmsk, &
62	& rnfmsk_z, &
63	& ln_rnf_mouth, &
64	& nkrnf
65	USE sbcfwb_tam , ONLY: & ! surface boundary condition: freshwater budget
66	& sbc_fwb_tan, &
67	& sbc_fwb_adj, &
68	& sbc_fwb_adj_tst
69	USE closea , ONLY: & ! closed sea
70	& nclosea
71	USE in_out_manager, ONLY: & ! I/O manager
72	& lwp, &
73	& ctl_warn, &
74	& numout, &
75	& numnam, &
76	& nit000, &
77	& nitend, &
78	& nstop
79
80	IMPLICIT NONE
81	PRIVATE
82
83	PUBLIC sbc_tan ! routine called by step_tam.F90
84	PUBLIC sbc_adj ! routine called by step_tam.F90
85	PUBLIC sbc_adj_tst! routine called by tst.F90
86
87	!! * namsbc namelist (public variables)
88	LOGICAL , PUBLIC :: ln_ana = .FALSE. !: analytical boundary condition flag
89	LOGICAL , PUBLIC :: ln_flx = .FALSE. !: flux formulation
90	LOGICAL , PUBLIC :: ln_blk_clio = .FALSE. !: CLIO bulk formulation
91	LOGICAL , PUBLIC :: ln_blk_core = .FALSE. !: CORE bulk formulation
92	LOGICAL , PUBLIC :: ln_cpl = .FALSE. !: coupled formulation (overwritten by key_sbc_coupled )
93	LOGICAL , PUBLIC :: ln_dm2dc = .FALSE. !: Daily mean to Diurnal Cycle short wave (qsr)
94	LOGICAL , PUBLIC :: ln_rnf = .FALSE. !: runoffs / runoff mouths
95	LOGICAL , PUBLIC :: ln_ssr = .FALSE. !: Sea Surface restoring on SST and/or SSS
96	INTEGER , PUBLIC :: nn_ice = 0 !: flag on ice in the surface boundary condition (=0/1/2)
97	INTEGER , PUBLIC :: nn_fwb = 0 !: type of FreshWater Budget control (=0/1/2)
98	INTEGER :: nn_ico_cpl = 0 !: ice-ocean coupling indicator
99	! ! = 0 LIM-3 old case
100	! ! = 1 stresses computed using now ocean velocity
101	! ! = 2 combination of 0 and 1 cases
102
103	INTEGER :: nsbc ! type of surface boundary condition (deduced from namsbc informations)
104	INTEGER :: nice ! type of ice in the surface boundary condition (deduced from namsbc informations)
105	LOGICAL :: lfirst = .TRUE. ! initialisation flag
106
107	!! * Substitutions
108	# include "domzgr_substitute.h90"
109	!!----------------------------------------------------------------------
110	!! NEMO/OPA 3.0 , LOCEAN-IPSL (2008)
111	!! $Id: sbcmod.F90 1172 2008-09-10 15:32:47Z ctlod $
112	!! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
113	!!----------------------------------------------------------------------
114
115	CONTAINS
116
117	SUBROUTINE sbc_init_tam
118	!!---------------------------------------------------------------------
119	!! * ROUTINE sbc_init_tam *
120	!!
121	!! ** Purpose of the direct routine:
122	!! Initialisation of the ocean surface boundary computation
123	!!
124	!! ** Method : Read the namsbc namelist and set derived parameters
125	!!
126	!! ** Action : - read namsbc parameters
127	!! - nsbc: type of sbc
128	!!----------------------------------------------------------------------
129	INTEGER :: icpt ! temporary integer
130	!!
131	NAMELIST/namsbc/ nn_fsbc, ln_ana, ln_flx, ln_blk_clio, ln_blk_core, ln_cpl, &
132	& nn_ice , ln_dm2dc, ln_rnf, ln_ssr, nn_fwb, nn_ico_cpl
133	!!----------------------------------------------------------------------
134
135	IF (lfirst) THEN
136	IF(lwp) THEN
137	WRITE(numout,*)
138	WRITE(numout,*) 'sbc_init_tam : surface boundary condition setting'
139	WRITE(numout,*) '~~~~~~~~~~~~ '
140	ENDIF
141
142	REWIND ( numnam ) ! Read Namelist namsbc
143	READ ( numnam, namsbc )
144	! overwrite namelist parameter using CPP key information
145	!!gmhere no overwrite, test all option via namelist change: require more incore memory
146	!!gm IF( lk_sbc_cpl ) THEN ; ln_cpl = .TRUE. ; ELSE ; ln_cpl = .FALSE. ; ENDIF
147	!*B IF( lk_lim2 ) nn_ice = 2
148	!*B IF( lk_lim3 ) nn_ice = 3
149	!*B IF( cp_cfg == 'gyre' ) THEN
150	!*B ln_ana = .TRUE.
151	!*B nn_ice = 0
152	!*B ENDIF
153
154	! Control print
155	IF(lwp) THEN
156	WRITE(numout,*) ' Namelist namsbc (overwritten using CPP key defined)'
157	WRITE(numout,*) ' frequency update of sbc (and ice) nn_fsbc = ', nn_fsbc
158	WRITE(numout,*) ' Type of sbc : '
159	WRITE(numout,*) ' analytical formulation ln_ana = ', ln_ana
160	WRITE(numout,*) ' flux formulation ln_flx = ', ln_flx
161	!B WRITE(numout,) ' CLIO bulk formulation ln_blk_clio = ', ln_blk_clio
162	!B WRITE(numout,) ' CORE bulk formulation ln_blk_core = ', ln_blk_core
163	!B WRITE(numout,) ' coupled formulation (T if key_sbc_cpl) ln_cpl = ', ln_cpl
164	WRITE(numout,*) ' Misc. options of sbc : '
165	!B WRITE(numout,) ' ice management in the sbc (=0/1/2/3) nn_ice = ', nn_ice
166	!B WRITE(numout,) ' ice-ocean stress computation (=0/1/2) nn_ico_cpl = ', nn_ico_cpl
167	WRITE(numout,*) ' daily mean to diurnal cycle qsr ln_dm2dc = ', ln_dm2dc
168	WRITE(numout,*) ' runoff / runoff mouths ln_rnf = ', ln_rnf
169	WRITE(numout,*) ' Sea Surface Restoring on SST and/or SSS ln_ssr = ', ln_ssr
170	WRITE(numout,*) ' FreshWater Budget control (=0/1/2) nn_fwb = ', nn_fwb
171	WRITE(numout,*) ' closed sea (=0/1) (set in namdom) nclosea = ', nclosea
172	ENDIF
173
174	IF( .NOT. ln_rnf ) THEN ! no specific treatment in rivers mouths vicinity
175	ln_rnf_mouth = .FALSE.
176	nkrnf = 0
177	rnfmsk(:,:) = 0.e0
178	rnfmsk_z(:) = 0.e0
179	ENDIF
180	IF( nn_ice == 0 ) fr_i_tl(:,:) = 0.e0 ! no ice in the domain, ice fraction is always zero
181
182	! Check consistancy
183
184	!*B IF( nn_ice == 2 ) THEN
185	!*B IF( MOD( nitend - nit000 + 1, nn_fsbc) /= 0 ) THEN
186	!B WRITE(ctmp1,) 'experiment length (', nitend - nit000 + 1, ') is NOT a multiple of nn_fsbc (', nn_fsbc, ')'
187	!*B CALL ctl_stop( ctmp1, 'Impossible to do proper restart files' )
188	!*B ENDIF
189	!*B IF( MOD( nstock, nn_fsbc) /= 0 ) THEN
190	!B WRITE(ctmp1,) 'nstock (' , nstock , ') is NOT a multiple of nn_fsbc (', nn_fsbc, ')'
191	!*B CALL ctl_stop( ctmp1, 'Impossible to do proper restart files' )
192	!*B ENDIF
193	!*B ENDIF
194
195	IF( MOD( rday, nn_fsbc*rdt ) /= 0 ) CALL ctl_warn( 'nn_fsbc is NOT a multiple of the number of time steps in a day' )
196
197	!*B IF( nn_ice == 2 .AND. .NOT.( ln_blk_clio .OR. ln_blk_core ) ) &
198	!*B & CALL ctl_stop( 'sbc_init: sea-ice model requires a bulk formulation' )
199
200	! Choice of the Surface Boudary Condition (set nsbc)
201	icpt = 0
202	IF( ln_ana ) THEN ; nsbc = 1 ; icpt = icpt + 1 ; ENDIF ! analytical formulation
203	IF( ln_flx ) THEN ; nsbc = 2 ; icpt = icpt + 1 ; ENDIF ! flux formulation
204	IF( ln_blk_clio ) THEN ; nsbc = 3 ; icpt = icpt + 1 ; ENDIF ! CLIO bulk formulation
205	IF( ln_blk_core ) THEN ; nsbc = 4 ; icpt = icpt + 1 ; ENDIF ! CORE bulk formulation
206	IF( ln_cpl ) THEN ; nsbc = 5 ; icpt = icpt + 1 ; ENDIF ! Coupled formulation
207	IF( cp_cfg == 'gyre') THEN ; nsbc = 0 ; ENDIF ! GYRE analytical formulation
208
209	IF( icpt /= 1 ) THEN
210	WRITE(numout,*)
211	WRITE(numout,*) ' E R R O R in setting the sbc, one and only one namelist/CPP key option '
212	WRITE(numout,*) ' must be choosen. You choose ', icpt, ' option(s)'
213	WRITE(numout,*) ' We stop'
214	nstop = nstop + 1
215	ENDIF
216
217	IF( .NOT.((nsbc /= 2) .OR. (nsbc /= 0)) ) THEN
218	WRITE(numout,*)
219	WRITE(numout,*) ' E R R O R in setting the sbc, only ln_flx and cp_gyre available '
220	STOP
221	ENDIF
222	IF(lwp) THEN
223	WRITE(numout,*)
224	IF( nsbc == 0 ) WRITE(numout,*) ' GYRE analytical formulation'
225	IF( nsbc == 1 ) WRITE(numout,*) ' analytical formulation'
226	IF( nsbc == 2 ) WRITE(numout,*) ' flux formulation'
227	IF( nsbc == 3 ) WRITE(numout,*) ' CLIO bulk formulation'
228	IF( nsbc == 4 ) WRITE(numout,*) ' CORE bulk formulation'
229	IF( nsbc == 5 ) WRITE(numout,*) ' coupled formulation'
230	ENDIF
231	lfirst = .FALSE.
232	END IF
233	!
234	END SUBROUTINE sbc_init_tam
235
236
237	SUBROUTINE sbc_tan( kt )
238	!!---------------------------------------------------------------------
239	!! * ROUTINE sbc_tan *
240	!!
241	!! ** Purpose of the direct routine:
242	!! provide at each time-step the ocean surface boundary
243	!! condition (momentum, heat and freshwater fluxes)
244	!!
245	!! ** Method : blah blah to be written ?????????
246	!! CAUTION : never mask the surface stress field (tke sbc)
247	!!
248	!! ** Action : - set the ocean surface boundary condition, i.e.
249	!! utau, vtau, qns, qsr, emp, emps, qrp, erp
250	!! - updte the ice fraction : fr_i
251	!!----------------------------------------------------------------------
252	INTEGER, INTENT(in) :: kt ! ocean time step
253	!!---------------------------------------------------------------------
254
255	IF( kt == nit000 ) CALL sbc_init_tam ! Read namsbc namelist : surface module
256
257	! ocean to sbc mean sea surface variables (ss._m)
258	! ---------------------------------------
259	CALL sbc_ssm_tan( kt ) ! sea surface mean currents (at U- and V-points),
260	! ! temperature and salinity (at T-point) over nf_sbc time-step
261	! ! (i.e. sst_m, sss_m, ssu_m, ssv_m)
262
263	! sbc formulation
264	! ---------------
265
266	SELECT CASE( nsbc ) ! Compute ocean surface boundary condition
267	! ! (i.e. utau,vtau, qns, qsr, emp, emps)
268	CASE( 0 ) ; CALL sbc_gyre_tan ( kt ) ! analytical formulation : GYRE configuration
269	! no! in default
270	!CASE( 1 ) ; CALL sbc_ana_tan ( kt ) ! analytical formulation : uniform sbc
271	CASE( 2 ) ; CALL sbc_flx_tan ( kt ) ! flux formulation
272	!CASE( 3 ) ; CALL sbc_blk_clio_tan( kt ) ! bulk formulation : CLIO for the ocean
273	!CASE( 4 ) ; CALL sbc_blk_core_tan( kt ) ! bulk formulation : CORE for the ocean
274	!CASE( 5 ) ; CALL sbc_cpl_tan ( kt ) ! coupled formulation
275	END SELECT
276
277	! Misc. Options
278	! -------------
279	! not available
280	!*B SELECT CASE( nn_ice ) ! Update heat and freshwater fluxes over ice-covered areas
281	!*B CASE( 1 ) ; CALL sbc_ice_if_tan ( kt ) ! Ice-cover climatology ("Ice-if" model)
282	!*B !
283	!*B CASE( 2 ) ; CALL sbc_ice_lim_2_tan( kt, nsbc ) ! LIM 2.0 ice model
284	!*B !
285	!*B CASE( 3 ) ; CALL sbc_ice_lim_tan ( kt, nsbc, nn_ico_cpl) ! LIM 3.0 ice model
286	!*B END SELECT
287
288	! add runoffs to fresh water fluxes... not needed in tangent
289
290	IF( ln_ssr ) CALL sbc_ssr_tan( kt ) ! add SST/SSS damping term
291
292	IF( nn_fwb /= 0 ) CALL sbc_fwb_tan( kt, nn_fwb, nn_fsbc ) ! control the freshwater budget
293
294	IF( nclosea == 1 ) CALL sbc_clo_tan( kt ) ! treatment of closed sea in the model domain
295	! ! (update freshwater fluxes)
296	!
297	!
298	END SUBROUTINE sbc_tan
299
300	!!======================================================================
301	SUBROUTINE sbc_adj( kt )
302	!!---------------------------------------------------------------------
303	!! * ROUTINE sbc_adj *
304	!!
305	!! ** Purpose of the direct routine:
306	!! provide at each time-step the ocean surface boundary
307	!! condition (momentum, heat and freshwater fluxes)
308	!!
309	!! ** Method : blah blah to be written ?????????
310	!! CAUTION : never mask the surface stress field (tke sbc)
311	!!
312	!! ** Action : - set the ocean surface boundary condition, i.e.
313	!! utau, vtau, qns, qsr, emp, emps, qrp, erp
314	!! - updte the ice fraction : fr_i
315	!!----------------------------------------------------------------------
316	INTEGER, INTENT(in) :: kt ! ocean time step
317	!!---------------------------------------------------------------------
318
319	IF( kt == nitend ) CALL sbc_init_tam ! Read namsbc namelist : surface module
320
321	! Misc. Options
322	! -------------
323	IF( nclosea == 1 ) CALL sbc_clo_adj( kt ) ! treatment of closed sea in the model domain
324	IF( nn_fwb /= 0 ) CALL sbc_fwb_adj( kt, nn_fwb, nn_fsbc ) ! control the freshwater budget
325	IF( ln_ssr ) CALL sbc_ssr_adj( kt ) ! add SST/SSS damping term
326	SELECT CASE( nn_ice ) ! Update heat and freshwater fluxes over ice-covered areas
327	! CASE( 1 ) ; CALL sbc_ice_if_adj ( kt ) ! Ice-cover climatology ("Ice-if" model)
328	!
329	! CASE( 2 ) ; CALL sbc_ice_lim_2_adj( kt, nsbc ) ! LIM 2.0 ice model
330	!
331	! CASE( 3 ) ; CALL sbc_ice_lim_adj ( kt, nsbc, nn_ico_cpl) ! LIM 3.0 ice model
332	END SELECT
333	! sbc formulation
334	! ---------------
335
336	SELECT CASE( nsbc ) ! Compute ocean surface boundary condition
337	! ! (i.e. utau,vtau, qns, qsr, emp, emps)
338	CASE( 0 ) ; CALL sbc_gyre_adj ( kt ) ! analytical formulation : GYRE configuration
339	! CASE( 1 ) ; CALL sbc_ana_adj ( kt ) ! analytical formulation : uniform sbc
340	CASE( 2 ) ; CALL sbc_flx_adj ( kt ) ! flux formulation
341	! CASE( 3 ) ; CALL sbc_blk_clio_adj( kt ) ! bulk formulation : CLIO for the ocean
342	! CASE( 4 ) ; CALL sbc_blk_core_adj( kt ) ! bulk formulation : CORE for the ocean
343	! CASE( 5 ) ; CALL sbc_cpl_adj ( kt ) ! coupled formulation
344	END SELECT
345	! ocean to sbc mean sea surface variables (ss._m)
346	! ---------------------------------------
347	CALL sbc_ssm_adj( kt ) ! sea surface mean currents (at U- and V-points),
348	! ! temperature and salinity (at T-point) over nf_sbc time-step
349	! ! (i.e. sst_m, sss_m, ssu_m, ssv_m)
350
351
352	END SUBROUTINE sbc_adj
353	SUBROUTINE sbc_adj_tst( kumadt )
354	!!-----------------------------------------------------------------------
355	!!
356	!! * ROUTINE sbc_adj_tst *
357	!!
358	!! ** Purpose : Test the adjoint routine.
359	!!
360	!! ** Method : Verify the scalar product
361	!!
362	!! ( L dx )^T W dy = dx^T L^T W dy
363	!!
364	!! where L = tangent routine
365	!! L^T = adjoint routine
366	!! W = diagonal matrix of scale factors
367	!! dx = input perturbation (random field)
368	!! dy = L dx
369	!!
370	!!-----------------------------------------------------------------------
371	!! * Modules used
372
373	!! * Arguments
374	INTEGER, INTENT(IN) :: &
375	& kumadt ! Output unit
376	CALL sbc_init_tam ! Read namsbc namelist : surface module
377	!
378	CALL sbc_fwb_adj_tst( kumadt ) ! control the freshwater budget
379	CALL sbc_ssr_adj_tst( kumadt ) ! add SST/SSS damping term
380	! CALL sbc_rnf_adj_tst( kumadt ) ! add runoffs to fresh water fluxes
381	! CALL sbc_ice_if_adj_tst( kumadt ) ! Ice-cover climatology ("Ice-if" model)
382	! CALL sbc_ice_lim_2_adj_tst( kumadt ) ! LIM 2.0 ice model
383	! CALL sbc_ice_lim_adj_tst( kumadt ) ! LIM 3.0 ice model
384	CALL sbc_gyre_adj_tst( kumadt ) ! analytical formulation : GYRE configuration
385	! CALL sbc_ana_adj_tst( kumadt ) ! analytical formulation : uniform sbc
386	CALL sbc_flx_adj_tst( kumadt ) ! flux formulation
387	! CALL sbc_blk_clio_adj_tst( kumadt ) ! bulk formulation : CLIO for the ocean
388	! CALL sbc_blk_core_adj_tst( kumadt ) ! bulk formulation : CORE for the ocean
389	! CALL sbc_cpl_adj_tst( kumadt ) ! coupled formulation
390	CALL sbc_ssm_adj_tst( kumadt ) ! sea surface mean currents (at U- and V-points),
391	IF( nclosea == 1 ) CALL sbc_clo_adj_tst( kumadt ) ! closed seas,
392
393	END SUBROUTINE sbc_adj_tst
394	!!======================================================================
395	#endif
396	END MODULE sbcmod_tam

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

New URL for NEMO forge! http://forge.nemo-ocean.eu

Context Navigation

source: branches/TAM_V3_0/NEMOTAM/OPATAM_SRC/SBC/sbcmod_tam.F90 @ 2587

Download in other formats: