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 @ 5050

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