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/2014/dev_r4743_NOC2_ZTS/NEMOGCM/NEMO/LIM_SRC_3 – NEMO

Context Navigation

source: branches/2014/dev_r4743_NOC2_ZTS/NEMOGCM/NEMO/LIM_SRC_3/limvar.F90 @ 4899

Last change on this file since 4899 was 4899, checked in by acc, 9 years ago
Branch 2014/dev_r4743_NOC2_ZTS. Merged in trunk changes from r4743 to r4879 in preparation for the annual merge. See ticket #1367 and https://forge.ipsl.jussieu.fr/nemo/wiki/ticket/1367_NOC2_ZTS
Property svn:keywords set to `Id`
File size: 22.8 KB

Rev	Line
[825]	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	!!======================================================================
[2715]	31	!! History : - ! 2006-01 (M. Vancoppenolle) Original code
	32	!! 4.0 ! 2011-02 (G. Madec) dynamical allocation
	33	!!----------------------------------------------------------------------
[888]	34	#if defined key_lim3
[825]	35	!!----------------------------------------------------------------------
[2715]	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	!!----------------------------------------------------------------------
[3625]	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)
[921]	56
[825]	57	IMPLICIT NONE
	58	PRIVATE
	59
[2715]	60	PUBLIC lim_var_agg !
	61	PUBLIC lim_var_glo2eqv !
	62	PUBLIC lim_var_eqv2glo !
	63	PUBLIC lim_var_salprof !
[4161]	64	PUBLIC lim_var_icetm !
[2715]	65	PUBLIC lim_var_bv !
	66	PUBLIC lim_var_salprof1d !
[825]	67
[4161]	68	REAL(wp) :: epsi10 = 1.e-10_wp ! - -
[825]	69
	70	!!----------------------------------------------------------------------
[4161]	71	!! NEMO/LIM3 4.0 , UCL - NEMO Consortium (2011)
[1156]	72	!! $Id$
[2715]	73	!! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
[825]	74	!!----------------------------------------------------------------------
	75	CONTAINS
	76
[2715]	77	SUBROUTINE lim_var_agg( kn )
[921]	78	!!------------------------------------------------------------------
	79	!! * ROUTINE lim_var_agg *
[2715]	80	!!
	81	!! ** Purpose : aggregates ice-thickness-category variables to all-ice variables
	82	!! i.e. it turns VGLO into VAGG
[921]	83	!! ** Method :
	84	!!
	85	!! ** Arguments : n = 1, at_i vt_i only
	86	!! n = 2 everything
	87	!!
	88	!! note : you could add an argument when you need only at_i, vt_i
	89	!! and when you need everything
	90	!!------------------------------------------------------------------
[2715]	91	INTEGER, INTENT( in ) :: kn ! =1 at_i & vt only ; = what is needed
	92	!
	93	INTEGER :: ji, jj, jk, jl ! dummy loop indices
[4161]	94	REAL(wp) :: zinda, zindb
[2715]	95	!!------------------------------------------------------------------
[825]	96
[921]	97	!--------------------
	98	! Compute variables
	99	!--------------------
[2715]	100	vt_i (:,:) = 0._wp
	101	vt_s (:,:) = 0._wp
	102	at_i (:,:) = 0._wp
	103	ato_i(:,:) = 1._wp
	104	!
[921]	105	DO jl = 1, jpl
	106	DO jj = 1, jpj
	107	DO ji = 1, jpi
[2715]	108	!
[921]	109	vt_i(ji,jj) = vt_i(ji,jj) + v_i(ji,jj,jl) ! ice volume
	110	vt_s(ji,jj) = vt_s(ji,jj) + v_s(ji,jj,jl) ! snow volume
	111	at_i(ji,jj) = at_i(ji,jj) + a_i(ji,jj,jl) ! ice concentration
[2715]	112	!
[4688]	113	zinda = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - epsi10 ) )
[4333]	114	icethi(ji,jj) = vt_i(ji,jj) / MAX( at_i(ji,jj) , epsi10 ) * zinda ! ice thickness
[921]	115	END DO
	116	END DO
	117	END DO
[825]	118
[921]	119	DO jj = 1, jpj
	120	DO ji = 1, jpi
[2715]	121	ato_i(ji,jj) = MAX( 1._wp - at_i(ji,jj), 0._wp ) ! open water fraction
[921]	122	END DO
	123	END DO
[825]	124
[2715]	125	IF( kn > 1 ) THEN
	126	et_s (:,:) = 0._wp
	127	ot_i (:,:) = 0._wp
	128	smt_i(:,:) = 0._wp
	129	et_i (:,:) = 0._wp
	130	!
[921]	131	DO jl = 1, jpl
	132	DO jj = 1, jpj
	133	DO ji = 1, jpi
[4688]	134	zinda = MAX( 0._wp , SIGN( 1._wp , vt_i(ji,jj) - epsi10 ) )
	135	zindb = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - epsi10 ) )
[2715]	136	et_s(ji,jj) = et_s(ji,jj) + e_s(ji,jj,1,jl) ! snow heat content
[4333]	137	smt_i(ji,jj) = smt_i(ji,jj) + smv_i(ji,jj,jl) / MAX( vt_i(ji,jj) , epsi10 ) * zinda ! ice salinity
	138	ot_i(ji,jj) = ot_i(ji,jj) + oa_i(ji,jj,jl) / MAX( at_i(ji,jj) , epsi10 ) * zindb ! ice age
[921]	139	END DO
	140	END DO
	141	END DO
[2715]	142	!
[921]	143	DO jl = 1, jpl
	144	DO jk = 1, nlay_i
[2715]	145	et_i(:,:) = et_i(:,:) + e_i(:,:,jk,jl) ! ice heat content
[921]	146	END DO
	147	END DO
[2715]	148	!
	149	ENDIF
	150	!
[921]	151	END SUBROUTINE lim_var_agg
[825]	152
	153
[921]	154	SUBROUTINE lim_var_glo2eqv
	155	!!------------------------------------------------------------------
[2715]	156	!! * ROUTINE lim_var_glo2eqv *
[921]	157	!!
[2715]	158	!! ** Purpose : computes equivalent variables as function of global variables
	159	!! i.e. it turns VGLO into VEQV
[921]	160	!!------------------------------------------------------------------
[2715]	161	INTEGER :: ji, jj, jk, jl ! dummy loop indices
	162	REAL(wp) :: zq_i, zaaa, zbbb, zccc, zdiscrim ! local scalars
	163	REAL(wp) :: ztmelts, zindb, zq_s, zfac1, zfac2 ! - -
	164	!!------------------------------------------------------------------
[825]	165
	166	!-------------------------------------------------------
	167	! Ice thickness, snow thickness, ice salinity, ice age
	168	!-------------------------------------------------------
	169	DO jl = 1, jpl
	170	DO jj = 1, jpj
	171	DO ji = 1, jpi
[4161]	172	zindb = 1._wp - MAX( 0._wp , SIGN( 1._wp,- a_i(ji,jj,jl) + epsi10 ) ) !0 if no ice and 1 if yes
	173	ht_i(ji,jj,jl) = v_i (ji,jj,jl) / MAX( a_i(ji,jj,jl) , epsi10 ) * zindb
	174	ht_s(ji,jj,jl) = v_s (ji,jj,jl) / MAX( a_i(ji,jj,jl) , epsi10 ) * zindb
	175	o_i(ji,jj,jl) = oa_i(ji,jj,jl) / MAX( a_i(ji,jj,jl) , epsi10 ) * zindb
[825]	176	END DO
	177	END DO
	178	END DO
	179
[3625]	180	IF( num_sal == 2 )THEN
[921]	181	DO jl = 1, jpl
	182	DO jj = 1, jpj
	183	DO ji = 1, jpi
[4161]	184	zindb = 1._wp - MAX( 0._wp , SIGN( 1._wp,- a_i(ji,jj,jl) + epsi10 ) ) !0 if no ice and 1 if yes
	185	sm_i(ji,jj,jl) = smv_i(ji,jj,jl) / MAX( v_i(ji,jj,jl) , epsi10 ) * zindb
[921]	186	END DO
[825]	187	END DO
	188	END DO
	189	ENDIF
	190
[2715]	191	CALL lim_var_salprof ! salinity profile
[825]	192
	193	!-------------------
	194	! Ice temperatures
	195	!-------------------
[868]	196	!CDIR NOVERRCHK
[825]	197	DO jl = 1, jpl
[868]	198	!CDIR NOVERRCHK
[921]	199	DO jk = 1, nlay_i
[868]	200	!CDIR NOVERRCHK
[921]	201	DO jj = 1, jpj
[868]	202	!CDIR NOVERRCHK
[921]	203	DO ji = 1, jpi
[2715]	204	! ! Energy of melting q(S,T) [J.m-3]
[4333]	205	zindb = 1.0 - MAX( 0.0 , SIGN( 1.0 , - v_i(ji,jj,jl) + epsi10 ) ) ! zindb = 0 if no ice and 1 if yes
[4688]	206	zq_i = zindb * e_i(ji,jj,jk,jl) / area(ji,jj) / MAX( v_i(ji,jj,jl) , epsi10 ) * REAL(nlay_i,wp)
	207	zq_i = zq_i * unit_fac !convert units
[2715]	208	ztmelts = -tmut * s_i(ji,jj,jk,jl) + rtt ! Ice layer melt temperature
	209	!
	210	zaaa = cpic ! Conversion q(S,T) -> T (second order equation)
	211	zbbb = ( rcp - cpic ) * ( ztmelts - rtt ) + zq_i / rhoic - lfus
[921]	212	zccc = lfus * (ztmelts-rtt)
[2715]	213	zdiscrim = SQRT( MAX(zbbbzbbb - 4._wpzaaa*zccc , 0._wp) )
	214	t_i(ji,jj,jk,jl) = rtt + zindb ( - zbbb - zdiscrim ) / ( 2.0 zaaa )
	215	t_i(ji,jj,jk,jl) = MIN( rtt, MAX( 173.15_wp, t_i(ji,jj,jk,jl) ) ) ! 100-rtt < t_i < rtt
[921]	216	END DO
[825]	217	END DO
[921]	218	END DO
[825]	219	END DO
	220
	221	!--------------------
	222	! Snow temperatures
	223	!--------------------
[2715]	224	zfac1 = 1._wp / ( rhosn * cpic )
[825]	225	zfac2 = lfus / cpic
	226	DO jl = 1, jpl
[921]	227	DO jk = 1, nlay_s
	228	DO jj = 1, jpj
	229	DO ji = 1, jpi
	230	!Energy of melting q(S,T) [J.m-3]
[4333]	231	zindb = 1._wp - MAX( 0._wp , SIGN( 1._wp , - v_s(ji,jj,jl) + epsi10 ) ) ! zindb = 0 if no ice and 1 if yes
[4688]	232	zq_s = zindb * e_s(ji,jj,jk,jl) / ( area(ji,jj) * MAX( v_s(ji,jj,jl) , epsi10 ) ) * REAL(nlay_s,wp)
	233	zq_s = zq_s * unit_fac ! convert units
[2715]	234	!
[921]	235	t_s(ji,jj,jk,jl) = rtt + zindb * ( - zfac1 * zq_s + zfac2 )
[2715]	236	t_s(ji,jj,jk,jl) = MIN( rtt, MAX( 173.15, t_s(ji,jj,jk,jl) ) ) ! 100-rtt < t_i < rtt
[921]	237	END DO
[825]	238	END DO
[921]	239	END DO
[825]	240	END DO
	241
	242	!-------------------
	243	! Mean temperature
	244	!-------------------
[2715]	245	tm_i(:,:) = 0._wp
[825]	246	DO jl = 1, jpl
	247	DO jk = 1, nlay_i
	248	DO jj = 1, jpj
	249	DO ji = 1, jpi
[4161]	250	zindb = ( 1._wp - MAX( 0._wp , SIGN( 1._wp , - vt_i(ji,jj) + epsi10 ) ) )
	251	tm_i(ji,jj) = tm_i(ji,jj) + zindb * t_i(ji,jj,jk,jl) * v_i(ji,jj,jl) &
	252	& / ( REAL(nlay_i,wp) * MAX( vt_i(ji,jj) , epsi10 ) )
[825]	253	END DO
	254	END DO
	255	END DO
	256	END DO
[2715]	257	!
[825]	258	END SUBROUTINE lim_var_glo2eqv
	259
	260
	261	SUBROUTINE lim_var_eqv2glo
[921]	262	!!------------------------------------------------------------------
[2715]	263	!! * ROUTINE lim_var_eqv2glo *
	264	!!
	265	!! ** Purpose : computes global variables as function of equivalent variables
	266	!! i.e. it turns VEQV into VGLO
[921]	267	!! ** Method :
	268	!!
[2715]	269	!! ** History : (01-2006) Martin Vancoppenolle, UCL-ASTR
[921]	270	!!------------------------------------------------------------------
[2715]	271	!
[921]	272	v_i(:,:,:) = ht_i(:,:,:) * a_i(:,:,:)
	273	v_s(:,:,:) = ht_s(:,:,:) * a_i(:,:,:)
	274	smv_i(:,:,:) = sm_i(:,:,:) * v_i(:,:,:)
	275	oa_i (:,:,:) = o_i (:,:,:) * a_i(:,:,:)
[2715]	276	!
[921]	277	END SUBROUTINE lim_var_eqv2glo
[825]	278
	279
[921]	280	SUBROUTINE lim_var_salprof
	281	!!------------------------------------------------------------------
[2715]	282	!! * ROUTINE lim_var_salprof *
[921]	283	!!
[2715]	284	!! ** Purpose : computes salinity profile in function of bulk salinity
	285	!!
[921]	286	!! ** Method : If bulk salinity greater than s_i_1,
	287	!! the profile is assumed to be constant (S_inf)
	288	!! If bulk salinity lower than s_i_0,
	289	!! the profile is linear with 0 at the surface (S_zero)
	290	!! If it is between s_i_0 and s_i_1, it is a
	291	!! alpha-weighted linear combination of s_inf and s_zero
	292	!!
	293	!! ** References : Vancoppenolle et al., 2007 (in preparation)
	294	!!------------------------------------------------------------------
[2715]	295	INTEGER :: ji, jj, jk, jl ! dummy loop index
	296	REAL(wp) :: dummy_fac0, dummy_fac1, dummy_fac, zsal ! local scalar
	297	REAL(wp) :: zind0, zind01, zindbal, zargtemp , zs_zero ! - -
	298	REAL(wp), POINTER, DIMENSION(:,:,:) :: z_slope_s, zalpha ! 3D pointer
	299	!!------------------------------------------------------------------
[825]	300
[3294]	301	CALL wrk_alloc( jpi, jpj, jpl, z_slope_s, zalpha )
[825]	302
	303	!---------------------------------------
	304	! Vertically constant, constant in time
	305	!---------------------------------------
[3625]	306	IF( num_sal == 1 ) s_i(:,:,:,:) = bulk_sal
[825]	307
	308	!-----------------------------------
	309	! Salinity profile, varying in time
	310	!-----------------------------------
[3625]	311	IF( num_sal == 2 ) THEN
[2715]	312	!
[825]	313	DO jk = 1, nlay_i
	314	s_i(:,:,jk,:) = sm_i(:,:,:)
[2715]	315	END DO
	316	!
	317	DO jl = 1, jpl ! Slope of the linear profile
[825]	318	DO jj = 1, jpj
	319	DO ji = 1, jpi
[4688]	320	z_slope_s(ji,jj,jl) = 2._wp * sm_i(ji,jj,jl) / MAX( epsi10 , ht_i(ji,jj,jl) )
[2715]	321	END DO
	322	END DO
	323	END DO
	324	!
	325	dummy_fac0 = 1._wp / ( s_i_0 - s_i_1 ) ! Weighting factor between zs_zero and zs_inf
[825]	326	dummy_fac1 = s_i_1 / ( s_i_1 - s_i_0 )
[3625]	327	!
[2715]	328	zalpha(:,:,:) = 0._wp
[825]	329	DO jl = 1, jpl
	330	DO jj = 1, jpj
	331	DO ji = 1, jpi
	332	! zind0 = 1 if sm_i le s_i_0 and 0 otherwise
[4161]	333	zind0 = MAX( 0._wp , SIGN( 1._wp , s_i_0 - sm_i(ji,jj,jl) ) )
[825]	334	! zind01 = 1 if sm_i is between s_i_0 and s_i_1 and 0 othws
[4161]	335	zind01 = ( 1._wp - zind0 ) * MAX( 0._wp , SIGN( 1._wp , s_i_1 - sm_i(ji,jj,jl) ) )
[888]	336	! If 2.sm_i GE sss_m then zindbal = 1
[4333]	337	! this is to force a constant salinity profile in the Baltic Sea
[4161]	338	zindbal = MAX( 0._wp , SIGN( 1._wp , 2._wp * sm_i(ji,jj,jl) - sss_m(ji,jj) ) )
	339	zalpha(ji,jj,jl) = zind0 + zind01 * ( sm_i(ji,jj,jl) * dummy_fac0 + dummy_fac1 )
	340	zalpha(ji,jj,jl) = zalpha(ji,jj,jl) * ( 1._wp - zindbal )
[825]	341	END DO
	342	END DO
	343	END DO
[4161]	344
	345	dummy_fac = 1._wp / REAL( nlay_i ) ! Computation of the profile
[825]	346	DO jl = 1, jpl
	347	DO jk = 1, nlay_i
	348	DO jj = 1, jpj
	349	DO ji = 1, jpi
[2715]	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)
[825]	354	END DO ! ji
	355	END DO ! jj
	356	END DO ! jk
	357	END DO ! jl
[3625]	358	!
[825]	359	ENDIF ! num_sal
	360
	361	!-------------------------------------------------------
	362	! Vertically varying salinity profile, constant in time
	363	!-------------------------------------------------------
[921]	364
[3625]	365	IF( num_sal == 3 ) THEN ! Schwarzacher (1959) multiyear salinity profile (mean = 2.30)
[2715]	366	!
	367	sm_i(:,:,:) = 2.30_wp
	368	!
[825]	369	DO jl = 1, jpl
[868]	370	!CDIR NOVERRCHK
[825]	371	DO jk = 1, nlay_i
[2715]	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
[3625]	377	!
[825]	378	ENDIF ! num_sal
[2715]	379	!
[3294]	380	CALL wrk_dealloc( jpi, jpj, jpl, z_slope_s, zalpha )
[2715]	381	!
[825]	382	END SUBROUTINE lim_var_salprof
	383
	384
[4161]	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	REAL(wp) :: zindb ! - -
	393	!!------------------------------------------------------------------
	394
	395	! Mean sea ice temperature
	396	tm_i(:,:) = 0._wp
	397	DO jl = 1, jpl
	398	DO jk = 1, nlay_i
	399	DO jj = 1, jpj
	400	DO ji = 1, jpi
	401	zindb = ( 1._wp - MAX( 0._wp , SIGN( 1._wp , - vt_i(ji,jj) + epsi10 ) ) )
	402	tm_i(ji,jj) = tm_i(ji,jj) + zindb * t_i(ji,jj,jk,jl) * v_i(ji,jj,jl) &
	403	& / ( REAL(nlay_i,wp) * MAX( vt_i(ji,jj) , epsi10 ) )
	404	END DO
	405	END DO
	406	END DO
	407	END DO
	408
	409	END SUBROUTINE lim_var_icetm
	410
	411
[825]	412	SUBROUTINE lim_var_bv
[921]	413	!!------------------------------------------------------------------
[2715]	414	!! * ROUTINE lim_var_bv *
[921]	415	!!
[2715]	416	!! ** Purpose : computes mean brine volume (%) in sea ice
	417	!!
[921]	418	!! ** Method : e = - 0.054 * S (ppt) / T (C)
	419	!!
[2715]	420	!! References : Vancoppenolle et al., JGR, 2007
[921]	421	!!------------------------------------------------------------------
[2715]	422	INTEGER :: ji, jj, jk, jl ! dummy loop indices
[4161]	423	REAL(wp) :: zbvi, zinda, zindb ! local scalars
[2715]	424	!!------------------------------------------------------------------
	425	!
	426	bv_i(:,:) = 0._wp
[921]	427	DO jl = 1, jpl
	428	DO jk = 1, nlay_i
	429	DO jj = 1, jpj
	430	DO ji = 1, jpi
[4333]	431	zinda = ( 1._wp - MAX( 0._wp , SIGN( 1._wp , (t_i(ji,jj,jk,jl) - rtt) + epsi10 ) ) )
	432	zindb = ( 1._wp - MAX( 0._wp , SIGN( 1._wp , - vt_i(ji,jj) + epsi10 ) ) )
	433	zbvi = - zinda * tmut * s_i(ji,jj,jk,jl) / MIN( t_i(ji,jj,jk,jl) - rtt, - epsi10 ) &
[2715]	434	& * v_i(ji,jj,jl) / REAL(nlay_i,wp)
[4333]	435	bv_i(ji,jj) = bv_i(ji,jj) + zindb * zbvi / MAX( vt_i(ji,jj) , epsi10 )
[921]	436	END DO
	437	END DO
	438	END DO
	439	END DO
[2715]	440	!
[921]	441	END SUBROUTINE lim_var_bv
[825]	442
	443
[2715]	444	SUBROUTINE lim_var_salprof1d( kideb, kiut )
[825]	445	!!-------------------------------------------------------------------
	446	!! * ROUTINE lim_thd_salprof1d *
	447	!!
	448	!! ** Purpose : 1d computation of the sea ice salinity profile
[2715]	449	!! Works with 1d vectors and is used by thermodynamic modules
[825]	450	!!-------------------------------------------------------------------
[2715]	451	INTEGER, INTENT(in) :: kideb, kiut ! thickness category index
	452	!
	453	INTEGER :: ji, jk ! dummy loop indices
[4161]	454	INTEGER :: ii, ij ! local integers
[2715]	455	REAL(wp) :: dummy_fac0, dummy_fac1, dummy_fac2, zargtemp, zsal ! local scalars
	456	REAL(wp) :: zalpha, zind0, zind01, zindbal, zs_zero ! - -
	457	!
	458	REAL(wp), POINTER, DIMENSION(:) :: z_slope_s
	459	!!---------------------------------------------------------------------
[825]	460
[3294]	461	CALL wrk_alloc( jpij, z_slope_s )
[825]	462
	463	!---------------------------------------
	464	! Vertically constant, constant in time
	465	!---------------------------------------
[4899]	466	IF( num_sal == 1 ) s_i_1d(:,:) = bulk_sal
[825]	467
	468	!------------------------------------------------------
	469	! Vertically varying salinity profile, varying in time
	470	!------------------------------------------------------
	471
[3625]	472	IF( num_sal == 2 ) THEN
[2715]	473	!
	474	DO ji = kideb, kiut ! Slope of the linear profile zs_zero
[4899]	475	z_slope_s(ji) = 2._wp * sm_i_1d(ji) / MAX( epsi10 , ht_i_1d(ji) )
[2715]	476	END DO
[825]	477
	478	! Weighting factor between zs_zero and zs_inf
	479	!---------------------------------------------
[2715]	480	dummy_fac0 = 1._wp / ( s_i_0 - s_i_1 )
[825]	481	dummy_fac1 = s_i_1 / ( s_i_1 - s_i_0 )
[2715]	482	dummy_fac2 = 1._wp / REAL(nlay_i,wp)
[825]	483
[868]	484	!CDIR NOVERRCHK
[825]	485	DO jk = 1, nlay_i
[868]	486	!CDIR NOVERRCHK
[825]	487	DO ji = kideb, kiut
[4161]	488	ii = MOD( npb(ji) - 1 , jpi ) + 1
	489	ij = ( npb(ji) - 1 ) / jpi + 1
[825]	490	! zind0 = 1 if sm_i le s_i_0 and 0 otherwise
[4899]	491	zind0 = MAX( 0._wp , SIGN( 1._wp , s_i_0 - sm_i_1d(ji) ) )
[825]	492	! zind01 = 1 if sm_i is between s_i_0 and s_i_1 and 0 othws
[4899]	493	zind01 = ( 1._wp - zind0 ) * MAX( 0._wp , SIGN( 1._wp , s_i_1 - sm_i_1d(ji) ) )
[888]	494	! if 2.sm_i GE sss_m then zindbal = 1
[4333]	495	! this is to force a constant salinity profile in the Baltic Sea
[4899]	496	zindbal = MAX( 0._wp , SIGN( 1._wp , 2._wp * sm_i_1d(ji) - sss_m(ii,ij) ) )
[2715]	497	!
[4899]	498	zalpha = ( zind0 + zind01 * ( sm_i_1d(ji) * dummy_fac0 + dummy_fac1 ) ) * ( 1.0 - zindbal )
[2715]	499	!
[4899]	500	zs_zero = z_slope_s(ji) * ( REAL(jk,wp) - 0.5_wp ) * ht_i_1d(ji) * dummy_fac2
[825]	501	! weighting the profile
[4899]	502	s_i_1d(ji,jk) = zalpha * zs_zero + ( 1._wp - zalpha ) * sm_i_1d(ji)
[825]	503	END DO ! ji
	504	END DO ! jk
	505
	506	ENDIF ! num_sal
	507
	508	!-------------------------------------------------------
	509	! Vertically varying salinity profile, constant in time
	510	!-------------------------------------------------------
	511
[2715]	512	IF( num_sal == 3 ) THEN ! Schwarzacher (1959) multiyear salinity profile (mean = 2.30)
	513	!
[4899]	514	sm_i_1d(:) = 2.30_wp
[2715]	515	!
[868]	516	!CDIR NOVERRCHK
[2715]	517	DO jk = 1, nlay_i
	518	zargtemp = ( REAL(jk,wp) - 0.5_wp ) / REAL(nlay_i,wp)
	519	zsal = 1.6_wp * ( 1._wp - COS( rpi * zargtemp**(0.407_wp/(0.573_wp+zargtemp)) ) )
	520	DO ji = kideb, kiut
[4899]	521	s_i_1d(ji,jk) = zsal
[2715]	522	END DO
	523	END DO
	524	!
	525	ENDIF
	526	!
[3294]	527	CALL wrk_dealloc( jpij, z_slope_s )
[2715]	528	!
[825]	529	END SUBROUTINE lim_var_salprof1d
	530
	531	#else
[2715]	532	!!----------------------------------------------------------------------
	533	!! Default option Dummy module NO LIM3 sea-ice model
	534	!!----------------------------------------------------------------------
[825]	535	CONTAINS
	536	SUBROUTINE lim_var_agg ! Empty routines
	537	END SUBROUTINE lim_var_agg
	538	SUBROUTINE lim_var_glo2eqv ! Empty routines
	539	END SUBROUTINE lim_var_glo2eqv
	540	SUBROUTINE lim_var_eqv2glo ! Empty routines
	541	END SUBROUTINE lim_var_eqv2glo
	542	SUBROUTINE lim_var_salprof ! Empty routines
	543	END SUBROUTINE lim_var_salprof
	544	SUBROUTINE lim_var_bv ! Emtpy routines
[921]	545	END SUBROUTINE lim_var_bv
[825]	546	SUBROUTINE lim_var_salprof1d ! Emtpy routines
	547	END SUBROUTINE lim_var_salprof1d
[2715]	548	#endif
[825]	549
[2715]	550	!!======================================================================
[834]	551	END MODULE limvar

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

Download in other formats: