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

Context Navigation

source: trunk/NEMOGCM/NEMO/LIM_SRC_3/limvar.F90 @ 3201

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

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

Download in other formats: