Context Navigation

Back to Ticket #424

Ticket #424: sbcmod.F90

File sbcmod.F90, 14.2 KB (added by molines, 15 years ago)
sbcmod fix NOCS bug fix (lbc_lnk(emp ...))

Line
1	MODULE 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: sbcmod.F90 1242 2009-01-06 10:21:38Z rblod $
53	!! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
54	!!----------------------------------------------------------------------
55
56	CONTAINS
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	!! NOCS modification to get rid of bad input data
254	! Boundary condition on emp for free surface option
255	! -------------------------------------------------
256	CALL lbc_lnk( emp, 'T', 1. )
257
258	END SUBROUTINE sbc
259
260	!!======================================================================
261	END MODULE sbcmod

Download in other formats:

Original Format

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

Context Navigation

Ticket #424: sbcmod.F90

Download in other formats: