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/2013/dev_MERGE_2013/NEMOGCM/NEMO/LIM_SRC_3 – NEMO

Context Navigation

source: branches/2013/dev_MERGE_2013/NEMOGCM/NEMO/LIM_SRC_3/limvar.F90 @ 4333

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

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

Download in other formats: