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.

limvar.F90 in branches/2015/dev_r5044_CNRS_LIM3CLEAN/NEMOGCM/NEMO/LIM_SRC_3 – NEMO

Context Navigation

source: branches/2015/dev_r5044_CNRS_LIM3CLEAN/NEMOGCM/NEMO/LIM_SRC_3/limvar.F90 @ 5051

Last change on this file since 5051 was 5051, checked in by clem, 9 years ago
LIM3 initialization is now called at the same time as other sbc fields
Property svn:keywords set to `Id`
File size: 26.5 KB

Line
1	MODULE limvar
2	!!======================================================================
3	!! * MODULE limvar *
4	!! Different sets of ice model variables
5	!! how to switch from one to another
6	!!
7	!! There are three sets of variables
8	!! VGLO : global variables of the model
9	!! - v_i (jpi,jpj,jpl)
10	!! - v_s (jpi,jpj,jpl)
11	!! - a_i (jpi,jpj,jpl)
12	!! - t_s (jpi,jpj,jpl)
13	!! - e_i (jpi,jpj,nlay_i,jpl)
14	!! - smv_i(jpi,jpj,jpl)
15	!! - oa_i (jpi,jpj,jpl)
16	!! VEQV : equivalent variables sometimes used in the model
17	!! - ht_i(jpi,jpj,jpl)
18	!! - ht_s(jpi,jpj,jpl)
19	!! - t_i (jpi,jpj,nlay_i,jpl)
20	!! ...
21	!! VAGG : aggregate variables, averaged/summed over all
22	!! thickness categories
23	!! - vt_i(jpi,jpj)
24	!! - vt_s(jpi,jpj)
25	!! - at_i(jpi,jpj)
26	!! - et_s(jpi,jpj) !total snow heat content
27	!! - et_i(jpi,jpj) !total ice thermal content
28	!! - smt_i(jpi,jpj) !mean ice salinity
29	!! - ot_i(jpi,jpj) !average ice age
30	!!======================================================================
31	!! History : - ! 2006-01 (M. Vancoppenolle) Original code
32	!! 4.0 ! 2011-02 (G. Madec) dynamical allocation
33	!!----------------------------------------------------------------------
34	#if defined key_lim3
35	!!----------------------------------------------------------------------
36	!! 'key_lim3' LIM3 sea-ice model
37	!!----------------------------------------------------------------------
38	!! lim_var_agg :
39	!! lim_var_glo2eqv :
40	!! lim_var_eqv2glo :
41	!! lim_var_salprof :
42	!! lim_var_salprof1d :
43	!! lim_var_bv :
44	!!----------------------------------------------------------------------
45	USE par_oce ! ocean parameters
46	USE phycst ! physical constants (ocean directory)
47	USE sbc_oce ! Surface boundary condition: ocean fields
48	USE ice ! ice variables
49	USE par_ice ! ice parameters
50	USE thd_ice ! ice variables (thermodynamics)
51	USE dom_ice ! ice domain
52	USE in_out_manager ! I/O manager
53	USE lib_mpp ! MPP library
54	USE wrk_nemo ! work arrays
55	USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)
56
57	IMPLICIT NONE
58	PRIVATE
59
60	PUBLIC lim_var_agg !
61	PUBLIC lim_var_glo2eqv !
62	PUBLIC lim_var_eqv2glo !
63	PUBLIC lim_var_salprof !
64	PUBLIC lim_var_icetm !
65	PUBLIC lim_var_bv !
66	PUBLIC lim_var_salprof1d !
67	PUBLIC lim_var_zapsmall
68
69	!!----------------------------------------------------------------------
70	!! NEMO/LIM3 4.0 , UCL - NEMO Consortium (2011)
71	!! $Id$
72	!! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
73	!!----------------------------------------------------------------------
74	CONTAINS
75
76	SUBROUTINE lim_var_agg( kn )
77	!!------------------------------------------------------------------
78	!! * ROUTINE lim_var_agg *
79	!!
80	!! ** Purpose : aggregates ice-thickness-category variables to all-ice variables
81	!! i.e. it turns VGLO into VAGG
82	!! ** Method :
83	!!
84	!! ** Arguments : n = 1, at_i vt_i only
85	!! n = 2 everything
86	!!
87	!! note : you could add an argument when you need only at_i, vt_i
88	!! and when you need everything
89	!!------------------------------------------------------------------
90	INTEGER, INTENT( in ) :: kn ! =1 at_i & vt only ; = what is needed
91	!
92	INTEGER :: ji, jj, jk, jl ! dummy loop indices
93	!!------------------------------------------------------------------
94
95	!--------------------
96	! Compute variables
97	!--------------------
98	vt_i (:,:) = 0._wp
99	vt_s (:,:) = 0._wp
100	at_i (:,:) = 0._wp
101	ato_i(:,:) = 1._wp
102	!
103	DO jl = 1, jpl
104	DO jj = 1, jpj
105	DO ji = 1, jpi
106	!
107	vt_i(ji,jj) = vt_i(ji,jj) + v_i(ji,jj,jl) ! ice volume
108	vt_s(ji,jj) = vt_s(ji,jj) + v_s(ji,jj,jl) ! snow volume
109	at_i(ji,jj) = at_i(ji,jj) + a_i(ji,jj,jl) ! ice concentration
110	!
111	rswitch = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - epsi10 ) )
112	icethi(ji,jj) = vt_i(ji,jj) / MAX( at_i(ji,jj) , epsi10 ) * rswitch ! ice thickness
113	END DO
114	END DO
115	END DO
116
117	DO jj = 1, jpj
118	DO ji = 1, jpi
119	ato_i(ji,jj) = MAX( 1._wp - at_i(ji,jj), 0._wp ) ! open water fraction
120	END DO
121	END DO
122
123	IF( kn > 1 ) THEN
124	et_s (:,:) = 0._wp
125	ot_i (:,:) = 0._wp
126	smt_i(:,:) = 0._wp
127	et_i (:,:) = 0._wp
128	!
129	DO jl = 1, jpl
130	DO jj = 1, jpj
131	DO ji = 1, jpi
132	et_s(ji,jj) = et_s(ji,jj) + e_s(ji,jj,1,jl) ! snow heat content
133	rswitch = MAX( 0._wp , SIGN( 1._wp , vt_i(ji,jj) - epsi10 ) )
134	smt_i(ji,jj) = smt_i(ji,jj) + smv_i(ji,jj,jl) / MAX( vt_i(ji,jj) , epsi10 ) * rswitch ! ice salinity
135	rswitch = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - epsi10 ) )
136	ot_i(ji,jj) = ot_i(ji,jj) + oa_i(ji,jj,jl) / MAX( at_i(ji,jj) , epsi10 ) * rswitch ! ice age
137	END DO
138	END DO
139	END DO
140	!
141	DO jl = 1, jpl
142	DO jk = 1, nlay_i
143	et_i(:,:) = et_i(:,:) + e_i(:,:,jk,jl) ! ice heat content
144	END DO
145	END DO
146	!
147	ENDIF
148	!
149	END SUBROUTINE lim_var_agg
150
151
152	SUBROUTINE lim_var_glo2eqv
153	!!------------------------------------------------------------------
154	!! * ROUTINE lim_var_glo2eqv *
155	!!
156	!! ** Purpose : computes equivalent variables as function of global variables
157	!! i.e. it turns VGLO into VEQV
158	!!------------------------------------------------------------------
159	INTEGER :: ji, jj, jk, jl ! dummy loop indices
160	REAL(wp) :: zq_i, zaaa, zbbb, zccc, zdiscrim ! local scalars
161	REAL(wp) :: ztmelts, zq_s, zfac1, zfac2 ! - -
162	!!------------------------------------------------------------------
163
164	!-------------------------------------------------------
165	! Ice thickness, snow thickness, ice salinity, ice age
166	!-------------------------------------------------------
167	DO jl = 1, jpl
168	DO jj = 1, jpj
169	DO ji = 1, jpi
170	rswitch = 1._wp - MAX( 0._wp , SIGN( 1._wp,- a_i(ji,jj,jl) + epsi10 ) ) !0 if no ice and 1 if yes
171	ht_i(ji,jj,jl) = v_i (ji,jj,jl) / MAX( a_i(ji,jj,jl) , epsi10 ) * rswitch
172	ht_s(ji,jj,jl) = v_s (ji,jj,jl) / MAX( a_i(ji,jj,jl) , epsi10 ) * rswitch
173	o_i(ji,jj,jl) = oa_i(ji,jj,jl) / MAX( a_i(ji,jj,jl) , epsi10 ) * rswitch
174	END DO
175	END DO
176	END DO
177
178	IF( num_sal == 2 )THEN
179	DO jl = 1, jpl
180	DO jj = 1, jpj
181	DO ji = 1, jpi
182	rswitch = 1._wp - MAX( 0._wp , SIGN( 1._wp,- a_i(ji,jj,jl) + epsi10 ) ) !0 if no ice and 1 if yes
183	sm_i(ji,jj,jl) = smv_i(ji,jj,jl) / MAX( v_i(ji,jj,jl) , epsi10 ) * rswitch
184	END DO
185	END DO
186	END DO
187	ENDIF
188
189	CALL lim_var_salprof ! salinity profile
190
191	!-------------------
192	! Ice temperatures
193	!-------------------
194	!CDIR NOVERRCHK
195	DO jl = 1, jpl
196	!CDIR NOVERRCHK
197	DO jk = 1, nlay_i
198	!CDIR NOVERRCHK
199	DO jj = 1, jpj
200	!CDIR NOVERRCHK
201	DO ji = 1, jpi
202	! ! Energy of melting q(S,T) [J.m-3]
203	rswitch = 1.0 - MAX( 0.0 , SIGN( 1.0 , - v_i(ji,jj,jl) + epsi10 ) ) ! rswitch = 0 if no ice and 1 if yes
204	zq_i = rswitch * e_i(ji,jj,jk,jl) / area(ji,jj) / MAX( v_i(ji,jj,jl) , epsi10 ) * REAL(nlay_i,wp)
205	zq_i = zq_i * unit_fac !convert units
206	ztmelts = -tmut * s_i(ji,jj,jk,jl) + rtt ! Ice layer melt temperature
207	!
208	zaaa = cpic ! Conversion q(S,T) -> T (second order equation)
209	zbbb = ( rcp - cpic ) * ( ztmelts - rtt ) + zq_i / rhoic - lfus
210	zccc = lfus * (ztmelts-rtt)
211	zdiscrim = SQRT( MAX(zbbbzbbb - 4._wpzaaa*zccc , 0._wp) )
212	t_i(ji,jj,jk,jl) = rtt + rswitch ( - zbbb - zdiscrim ) / ( 2.0 zaaa )
213	t_i(ji,jj,jk,jl) = MIN( rtt, MAX( 173.15_wp, t_i(ji,jj,jk,jl) ) ) ! 100-rtt < t_i < rtt
214	END DO
215	END DO
216	END DO
217	END DO
218
219	!--------------------
220	! Snow temperatures
221	!--------------------
222	zfac1 = 1._wp / ( rhosn * cpic )
223	zfac2 = lfus / cpic
224	DO jl = 1, jpl
225	DO jk = 1, nlay_s
226	DO jj = 1, jpj
227	DO ji = 1, jpi
228	!Energy of melting q(S,T) [J.m-3]
229	rswitch = 1._wp - MAX( 0._wp , SIGN( 1._wp , - v_s(ji,jj,jl) + epsi10 ) ) ! rswitch = 0 if no ice and 1 if yes
230	zq_s = rswitch * e_s(ji,jj,jk,jl) / ( area(ji,jj) * MAX( v_s(ji,jj,jl) , epsi10 ) ) * REAL(nlay_s,wp)
231	zq_s = zq_s * unit_fac ! convert units
232	!
233	t_s(ji,jj,jk,jl) = rtt + rswitch * ( - zfac1 * zq_s + zfac2 )
234	t_s(ji,jj,jk,jl) = MIN( rtt, MAX( 173.15, t_s(ji,jj,jk,jl) ) ) ! 100-rtt < t_i < rtt
235	END DO
236	END DO
237	END DO
238	END DO
239
240	!-------------------
241	! Mean temperature
242	!-------------------
243	tm_i(:,:) = 0._wp
244	DO jl = 1, jpl
245	DO jk = 1, nlay_i
246	DO jj = 1, jpj
247	DO ji = 1, jpi
248	rswitch = ( 1._wp - MAX( 0._wp , SIGN( 1._wp , - vt_i(ji,jj) + epsi10 ) ) )
249	tm_i(ji,jj) = tm_i(ji,jj) + rswitch * t_i(ji,jj,jk,jl) * v_i(ji,jj,jl) &
250	& / ( REAL(nlay_i,wp) * MAX( vt_i(ji,jj) , epsi10 ) )
251	END DO
252	END DO
253	END DO
254	END DO
255	!
256	END SUBROUTINE lim_var_glo2eqv
257
258
259	SUBROUTINE lim_var_eqv2glo
260	!!------------------------------------------------------------------
261	!! * ROUTINE lim_var_eqv2glo *
262	!!
263	!! ** Purpose : computes global variables as function of equivalent variables
264	!! i.e. it turns VEQV into VGLO
265	!! ** Method :
266	!!
267	!! ** History : (01-2006) Martin Vancoppenolle, UCL-ASTR
268	!!------------------------------------------------------------------
269	!
270	v_i(:,:,:) = ht_i(:,:,:) * a_i(:,:,:)
271	v_s(:,:,:) = ht_s(:,:,:) * a_i(:,:,:)
272	smv_i(:,:,:) = sm_i(:,:,:) * v_i(:,:,:)
273	oa_i (:,:,:) = o_i (:,:,:) * a_i(:,:,:)
274	!
275	END SUBROUTINE lim_var_eqv2glo
276
277
278	SUBROUTINE lim_var_salprof
279	!!------------------------------------------------------------------
280	!! * ROUTINE lim_var_salprof *
281	!!
282	!! ** Purpose : computes salinity profile in function of bulk salinity
283	!!
284	!! ** Method : If bulk salinity greater than zsi1,
285	!! the profile is assumed to be constant (S_inf)
286	!! If bulk salinity lower than zsi0,
287	!! the profile is linear with 0 at the surface (S_zero)
288	!! If it is between zsi0 and zsi1, it is a
289	!! alpha-weighted linear combination of s_inf and s_zero
290	!!
291	!! ** References : Vancoppenolle et al., 2007 (in preparation)
292	!!------------------------------------------------------------------
293	INTEGER :: ji, jj, jk, jl ! dummy loop index
294	REAL(wp) :: dummy_fac0, dummy_fac1, dummy_fac, zsal
295	REAL(wp) :: zswi0, zswi01, zswibal, zargtemp , zs_zero
296	REAL(wp), POINTER, DIMENSION(:,:,:) :: z_slope_s, zalpha
297	REAL(wp), PARAMETER :: zsi0 = 3.5_wp
298	REAL(wp), PARAMETER :: zsi1 = 4.5_wp
299	!!------------------------------------------------------------------
300
301	CALL wrk_alloc( jpi, jpj, jpl, z_slope_s, zalpha )
302
303	!---------------------------------------
304	! Vertically constant, constant in time
305	!---------------------------------------
306	IF( num_sal == 1 ) s_i(:,:,:,:) = bulk_sal
307
308	!-----------------------------------
309	! Salinity profile, varying in time
310	!-----------------------------------
311	IF( num_sal == 2 ) THEN
312	!
313	DO jk = 1, nlay_i
314	s_i(:,:,jk,:) = sm_i(:,:,:)
315	END DO
316	!
317	DO jl = 1, jpl ! Slope of the linear profile
318	DO jj = 1, jpj
319	DO ji = 1, jpi
320	z_slope_s(ji,jj,jl) = 2._wp * sm_i(ji,jj,jl) / MAX( epsi10 , ht_i(ji,jj,jl) )
321	END DO
322	END DO
323	END DO
324	!
325	dummy_fac0 = 1._wp / ( zsi0 - zsi1 ) ! Weighting factor between zs_zero and zs_inf
326	dummy_fac1 = zsi1 / ( zsi1 - zsi0 )
327	!
328	zalpha(:,:,:) = 0._wp
329	DO jl = 1, jpl
330	DO jj = 1, jpj
331	DO ji = 1, jpi
332	! zswi0 = 1 if sm_i le zsi0 and 0 otherwise
333	zswi0 = MAX( 0._wp , SIGN( 1._wp , zsi0 - sm_i(ji,jj,jl) ) )
334	! zswi01 = 1 if sm_i is between zsi0 and zsi1 and 0 othws
335	zswi01 = ( 1._wp - zswi0 ) * MAX( 0._wp , SIGN( 1._wp , zsi1 - sm_i(ji,jj,jl) ) )
336	! If 2.sm_i GE sss_m then zswibal = 1
337	! this is to force a constant salinity profile in the Baltic Sea
338	zswibal = MAX( 0._wp , SIGN( 1._wp , 2._wp * sm_i(ji,jj,jl) - sss_m(ji,jj) ) )
339	zalpha(ji,jj,jl) = zswi0 + zswi01 * ( sm_i(ji,jj,jl) * dummy_fac0 + dummy_fac1 )
340	zalpha(ji,jj,jl) = zalpha(ji,jj,jl) * ( 1._wp - zswibal )
341	END DO
342	END DO
343	END DO
344
345	dummy_fac = 1._wp / REAL( nlay_i ) ! Computation of the profile
346	DO jl = 1, jpl
347	DO jk = 1, nlay_i
348	DO jj = 1, jpj
349	DO ji = 1, jpi
350	! ! linear profile with 0 at the surface
351	zs_zero = z_slope_s(ji,jj,jl) * ( REAL(jk,wp) - 0.5_wp ) * ht_i(ji,jj,jl) * dummy_fac
352	! ! weighting the profile
353	s_i(ji,jj,jk,jl) = zalpha(ji,jj,jl) * zs_zero + ( 1._wp - zalpha(ji,jj,jl) ) * sm_i(ji,jj,jl)
354	END DO ! ji
355	END DO ! jj
356	END DO ! jk
357	END DO ! jl
358	!
359	ENDIF ! num_sal
360
361	!-------------------------------------------------------
362	! Vertically varying salinity profile, constant in time
363	!-------------------------------------------------------
364
365	IF( num_sal == 3 ) THEN ! Schwarzacher (1959) multiyear salinity profile (mean = 2.30)
366	!
367	sm_i(:,:,:) = 2.30_wp
368	!
369	DO jl = 1, jpl
370	!CDIR NOVERRCHK
371	DO jk = 1, nlay_i
372	zargtemp = ( REAL(jk,wp) - 0.5_wp ) / REAL(nlay_i,wp)
373	zsal = 1.6_wp * ( 1._wp - COS( rpi * zargtemp**(0.407_wp/(0.573_wp+zargtemp)) ) )
374	s_i(:,:,jk,jl) = zsal
375	END DO
376	END DO
377	!
378	ENDIF ! num_sal
379	!
380	CALL wrk_dealloc( jpi, jpj, jpl, z_slope_s, zalpha )
381	!
382	END SUBROUTINE lim_var_salprof
383
384
385	SUBROUTINE lim_var_icetm
386	!!------------------------------------------------------------------
387	!! * ROUTINE lim_var_icetm *
388	!!
389	!! ** Purpose : computes mean sea ice temperature
390	!!------------------------------------------------------------------
391	INTEGER :: ji, jj, jk, jl ! dummy loop indices
392	!!------------------------------------------------------------------
393
394	! Mean sea ice temperature
395	tm_i(:,:) = 0._wp
396	DO jl = 1, jpl
397	DO jk = 1, nlay_i
398	DO jj = 1, jpj
399	DO ji = 1, jpi
400	rswitch = ( 1._wp - MAX( 0._wp , SIGN( 1._wp , - vt_i(ji,jj) + epsi10 ) ) )
401	tm_i(ji,jj) = tm_i(ji,jj) + rswitch * t_i(ji,jj,jk,jl) * v_i(ji,jj,jl) &
402	& / ( REAL(nlay_i,wp) * MAX( vt_i(ji,jj) , epsi10 ) )
403	END DO
404	END DO
405	END DO
406	END DO
407
408	END SUBROUTINE lim_var_icetm
409
410
411	SUBROUTINE lim_var_bv
412	!!------------------------------------------------------------------
413	!! * ROUTINE lim_var_bv *
414	!!
415	!! ** Purpose : computes mean brine volume (%) in sea ice
416	!!
417	!! ** Method : e = - 0.054 * S (ppt) / T (C)
418	!!
419	!! References : Vancoppenolle et al., JGR, 2007
420	!!------------------------------------------------------------------
421	INTEGER :: ji, jj, jk, jl ! dummy loop indices
422	REAL(wp) :: zbvi ! local scalars
423	!!------------------------------------------------------------------
424	!
425	bv_i(:,:) = 0._wp
426	DO jl = 1, jpl
427	DO jk = 1, nlay_i
428	DO jj = 1, jpj
429	DO ji = 1, jpi
430	rswitch = ( 1._wp - MAX( 0._wp , SIGN( 1._wp , (t_i(ji,jj,jk,jl) - rtt) + epsi10 ) ) )
431	zbvi = - rswitch * tmut * s_i(ji,jj,jk,jl) / MIN( t_i(ji,jj,jk,jl) - rtt, - epsi10 ) &
432	& * v_i(ji,jj,jl) / REAL(nlay_i,wp)
433	rswitch = ( 1._wp - MAX( 0._wp , SIGN( 1._wp , - vt_i(ji,jj) + epsi10 ) ) )
434	bv_i(ji,jj) = bv_i(ji,jj) + rswitch * zbvi / MAX( vt_i(ji,jj) , epsi10 )
435	END DO
436	END DO
437	END DO
438	END DO
439	!
440	END SUBROUTINE lim_var_bv
441
442
443	SUBROUTINE lim_var_salprof1d( kideb, kiut )
444	!!-------------------------------------------------------------------
445	!! * ROUTINE lim_thd_salprof1d *
446	!!
447	!! ** Purpose : 1d computation of the sea ice salinity profile
448	!! Works with 1d vectors and is used by thermodynamic modules
449	!!-------------------------------------------------------------------
450	INTEGER, INTENT(in) :: kideb, kiut ! thickness category index
451	!
452	INTEGER :: ji, jk ! dummy loop indices
453	INTEGER :: ii, ij ! local integers
454	REAL(wp) :: dummy_fac0, dummy_fac1, dummy_fac2, zargtemp, zsal ! local scalars
455	REAL(wp) :: zalpha, zswi0, zswi01, zswibal, zs_zero ! - -
456	!
457	REAL(wp), POINTER, DIMENSION(:) :: z_slope_s
458	REAL(wp), PARAMETER :: zsi0 = 3.5_wp
459	REAL(wp), PARAMETER :: zsi1 = 4.5_wp
460	!!---------------------------------------------------------------------
461
462	CALL wrk_alloc( jpij, z_slope_s )
463
464	!---------------------------------------
465	! Vertically constant, constant in time
466	!---------------------------------------
467	IF( num_sal == 1 ) s_i_1d(:,:) = bulk_sal
468
469	!------------------------------------------------------
470	! Vertically varying salinity profile, varying in time
471	!------------------------------------------------------
472
473	IF( num_sal == 2 ) THEN
474	!
475	DO ji = kideb, kiut ! Slope of the linear profile zs_zero
476	z_slope_s(ji) = 2._wp * sm_i_1d(ji) / MAX( epsi10 , ht_i_1d(ji) )
477	END DO
478
479	! Weighting factor between zs_zero and zs_inf
480	!---------------------------------------------
481	dummy_fac0 = 1._wp / ( zsi0 - zsi1 )
482	dummy_fac1 = zsi1 / ( zsi1 - zsi0 )
483	dummy_fac2 = 1._wp / REAL(nlay_i,wp)
484
485	!CDIR NOVERRCHK
486	DO jk = 1, nlay_i
487	!CDIR NOVERRCHK
488	DO ji = kideb, kiut
489	ii = MOD( npb(ji) - 1 , jpi ) + 1
490	ij = ( npb(ji) - 1 ) / jpi + 1
491	! zswi0 = 1 if sm_i le zsi0 and 0 otherwise
492	zswi0 = MAX( 0._wp , SIGN( 1._wp , zsi0 - sm_i_1d(ji) ) )
493	! zswi01 = 1 if sm_i is between zsi0 and zsi1 and 0 othws
494	zswi01 = ( 1._wp - zswi0 ) * MAX( 0._wp , SIGN( 1._wp , zsi1 - sm_i_1d(ji) ) )
495	! if 2.sm_i GE sss_m then zswibal = 1
496	! this is to force a constant salinity profile in the Baltic Sea
497	zswibal = MAX( 0._wp , SIGN( 1._wp , 2._wp * sm_i_1d(ji) - sss_m(ii,ij) ) )
498	!
499	zalpha = ( zswi0 + zswi01 * ( sm_i_1d(ji) * dummy_fac0 + dummy_fac1 ) ) * ( 1.0 - zswibal )
500	!
501	zs_zero = z_slope_s(ji) * ( REAL(jk,wp) - 0.5_wp ) * ht_i_1d(ji) * dummy_fac2
502	! weighting the profile
503	s_i_1d(ji,jk) = zalpha * zs_zero + ( 1._wp - zalpha ) * sm_i_1d(ji)
504	END DO ! ji
505	END DO ! jk
506
507	ENDIF ! num_sal
508
509	!-------------------------------------------------------
510	! Vertically varying salinity profile, constant in time
511	!-------------------------------------------------------
512
513	IF( num_sal == 3 ) THEN ! Schwarzacher (1959) multiyear salinity profile (mean = 2.30)
514	!
515	sm_i_1d(:) = 2.30_wp
516	!
517	!CDIR NOVERRCHK
518	DO jk = 1, nlay_i
519	zargtemp = ( REAL(jk,wp) - 0.5_wp ) / REAL(nlay_i,wp)
520	zsal = 1.6_wp * ( 1._wp - COS( rpi * zargtemp**(0.407_wp/(0.573_wp+zargtemp)) ) )
521	DO ji = kideb, kiut
522	s_i_1d(ji,jk) = zsal
523	END DO
524	END DO
525	!
526	ENDIF
527	!
528	CALL wrk_dealloc( jpij, z_slope_s )
529	!
530	END SUBROUTINE lim_var_salprof1d
531
532	SUBROUTINE lim_var_zapsmall
533	!!-------------------------------------------------------------------
534	!! * ROUTINE lim_var_zapsmall *
535	!!
536	!! ** Purpose : Remove too small sea ice areas and correct salt fluxes
537	!!
538	!! history : LIM3.5 - 01-2014 (C. Rousset) original code
539	!!-------------------------------------------------------------------
540	INTEGER :: ji, jj, jl, jk ! dummy loop indices
541
542	REAL(wp) :: zsal, zvi, zvs, zei, zes
543	!!-------------------------------------------------------------------
544
545	DO jl = 1, jpl
546
547	!-----------------------------------------------------------------
548	! Zap ice energy and use ocean heat to melt ice
549	!-----------------------------------------------------------------
550	DO jk = 1, nlay_i
551	DO jj = 1 , jpj
552	DO ji = 1 , jpi
553	rswitch = MAX( 0._wp , SIGN( 1._wp, a_i(ji,jj,jl) - epsi10 ) )
554	zei = e_i(ji,jj,jk,jl)
555	e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) * rswitch
556	t_i(ji,jj,jk,jl) = t_i(ji,jj,jk,jl) * rswitch + rtt * ( 1._wp - rswitch )
557	! update exchanges with ocean
558	hfx_res(ji,jj) = hfx_res(ji,jj) + ( e_i(ji,jj,jk,jl) - zei ) * unit_fac / area(ji,jj) * r1_rdtice ! W.m-2 <0
559	END DO
560	END DO
561	END DO
562
563	DO jj = 1 , jpj
564	DO ji = 1 , jpi
565	rswitch = MAX( 0._wp , SIGN( 1._wp, a_i(ji,jj,jl) - epsi10 ) )
566
567	zsal = smv_i(ji,jj, jl)
568	zvi = v_i (ji,jj, jl)
569	zvs = v_s (ji,jj, jl)
570	zes = e_s (ji,jj,1,jl)
571	!-----------------------------------------------------------------
572	! Zap snow energy
573	!-----------------------------------------------------------------
574	t_s(ji,jj,1,jl) = t_s(ji,jj,1,jl) * rswitch + rtt * ( 1._wp - rswitch )
575	e_s(ji,jj,1,jl) = e_s(ji,jj,1,jl) * rswitch
576
577	!-----------------------------------------------------------------
578	! zap ice and snow volume, add water and salt to ocean
579	!-----------------------------------------------------------------
580	ato_i(ji,jj) = a_i (ji,jj,jl) * ( 1._wp - rswitch ) + ato_i(ji,jj)
581	a_i (ji,jj,jl) = a_i (ji,jj,jl) * rswitch
582	v_i (ji,jj,jl) = v_i (ji,jj,jl) * rswitch
583	v_s (ji,jj,jl) = v_s (ji,jj,jl) * rswitch
584	t_su (ji,jj,jl) = t_su (ji,jj,jl) * rswitch + t_bo(ji,jj) * ( 1._wp - rswitch )
585	oa_i (ji,jj,jl) = oa_i (ji,jj,jl) * rswitch
586	smv_i(ji,jj,jl) = smv_i(ji,jj,jl) * rswitch
587
588	! ice salinity must stay in bounds
589	IF( num_sal == 2 ) THEN
590	smv_i(ji,jj,jl) = MAX( MIN( s_i_max * v_i(ji,jj,jl), smv_i(ji,jj,jl) ), s_i_min * v_i(ji,jj,jl) )
591	ENDIF
592	! update exchanges with ocean
593	sfx_res(ji,jj) = sfx_res(ji,jj) - ( smv_i(ji,jj,jl) - zsal ) * rhoic * r1_rdtice
594	wfx_res(ji,jj) = wfx_res(ji,jj) - ( v_i(ji,jj,jl) - zvi ) * rhoic * r1_rdtice
595	wfx_snw(ji,jj) = wfx_snw(ji,jj) - ( v_s(ji,jj,jl) - zvs ) * rhosn * r1_rdtice
596	hfx_res(ji,jj) = hfx_res(ji,jj) + ( e_s(ji,jj,1,jl) - zes ) * unit_fac / area(ji,jj) * r1_rdtice ! W.m-2 <0
597	END DO
598	END DO
599	END DO ! jl
600
601	! to be sure that at_i is the sum of a_i(jl)
602	at_i(:,:) = SUM( a_i(:,:,:), dim=3 )
603	!
604	END SUBROUTINE lim_var_zapsmall
605
606	#else
607	!!----------------------------------------------------------------------
608	!! Default option Dummy module NO LIM3 sea-ice model
609	!!----------------------------------------------------------------------
610	CONTAINS
611	SUBROUTINE lim_var_agg ! Empty routines
612	END SUBROUTINE lim_var_agg
613	SUBROUTINE lim_var_glo2eqv ! Empty routines
614	END SUBROUTINE lim_var_glo2eqv
615	SUBROUTINE lim_var_eqv2glo ! Empty routines
616	END SUBROUTINE lim_var_eqv2glo
617	SUBROUTINE lim_var_salprof ! Empty routines
618	END SUBROUTINE lim_var_salprof
619	SUBROUTINE lim_var_bv ! Emtpy routines
620	END SUBROUTINE lim_var_bv
621	SUBROUTINE lim_var_salprof1d ! Emtpy routines
622	END SUBROUTINE lim_var_salprof1d
623	SUBROUTINE lim_var_zapsmall
624	END SUBROUTINE lim_var_zapsmall
625	#endif
626
627	!!======================================================================
628	END MODULE limvar

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

Download in other formats: