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.

icethd.F90 in branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/LIM_SRC_3 – NEMO

Context Navigation

source: branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/LIM_SRC_3/icethd.F90 @ 8531

Last change on this file since 8531 was 8531, checked in by clem, 7 years ago
changes in style - part6 - more clarity (still not finished)
File size: 33.5 KB

Rev	Line
[8422]	1	MODULE icethd
	2	!!======================================================================
	3	!! * MODULE icethd *
	4	!! LIM-3 : ice thermodynamic
	5	!!======================================================================
	6	!! History : LIM ! 2000-01 (M.A. Morales Maqueda, H. Goosse, T. Fichefet) LIM-1
	7	!! 2.0 ! 2002-07 (C. Ethe, G. Madec) LIM-2 (F90 rewriting)
	8	!! 3.0 ! 2005-11 (M. Vancoppenolle) LIM-3 : Multi-layer thermodynamics + salinity variations
	9	!! - ! 2007-04 (M. Vancoppenolle) add ice_thd_glohec, ice_thd_con_dh and ice_thd_con_dif
	10	!! 3.2 ! 2009-07 (M. Vancoppenolle, Y. Aksenov, G. Madec) bug correction in wfx_snw
	11	!! 3.3 ! 2010-11 (G. Madec) corrected snow melting heat (due to factor betas)
	12	!! 4.0 ! 2011-02 (G. Madec) dynamical allocation
	13	!! - ! 2012-05 (C. Rousset) add penetration solar flux
	14	!!----------------------------------------------------------------------
	15	#if defined key_lim3
	16	!!----------------------------------------------------------------------
[8486]	17	!! 'key_lim3' LIM3 sea-ice model
[8422]	18	!!----------------------------------------------------------------------
	19	!! ice_thd : thermodynamic of sea ice
	20	!! ice_thd_init : initialisation of sea-ice thermodynamic
	21	!!----------------------------------------------------------------------
	22	USE phycst ! physical constants
	23	USE dom_oce ! ocean space and time domain variables
	24	USE ice ! sea-ice variables
[8486]	25	!!gm list trop longue ==>>> why not passage en argument d'appel ?
[8422]	26	USE sbc_oce , ONLY : sss_m, sst_m, e3t_m, utau, vtau, ssu_m, ssv_m, frq_m, qns_tot, qsr_tot, sprecip, ln_cpl
	27	USE sbc_ice , ONLY : qsr_oce, qns_oce, qemp_oce, qsr_ice, qns_ice, dqns_ice, evap_ice, qprec_ice, qevap_ice, &
[8512]	28	& fr1_i0, fr2_i0
[8422]	29	USE ice1D ! thermodynamic sea-ice variables
[8531]	30	USE icethd_zdf ! vertical diffusion
[8422]	31	USE icethd_dh ! ice-snow growth and melt
	32	USE icethd_da ! lateral melting
	33	USE icethd_sal ! ice salinity
	34	USE icethd_ent ! ice enthalpy redistribution
[8531]	35	USE icethd_do ! lateral accretion
[8422]	36	USE iceitd ! remapping thickness distribution
	37	USE icetab ! 1D <==> 2D transformation
[8424]	38	USE icevar !
[8422]	39	USE icectl ! control print
	40	!
	41	USE in_out_manager ! I/O manager
	42	USE lbclnk ! lateral boundary condition - MPP links
	43	USE lib_mpp ! MPP library
	44	USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)
	45	USE timing ! Timing
	46
	47	IMPLICIT NONE
	48	PRIVATE
	49
	50	PUBLIC ice_thd ! called by limstp module
	51	PUBLIC ice_thd_init ! called by ice_init
	52
[8531]	53	!! namelist (namthd)
	54	LOGICAL :: ln_icedH ! activate ice thickness change from growing/melting (T) or not (F)
	55	LOGICAL :: ln_icedA ! activate lateral melting param. (T) or not (F)
	56	LOGICAL :: ln_icedO ! activate ice growth in open-water (T) or not (F)
	57	LOGICAL :: ln_icedS ! activate gravity drainage and flushing (T) or not (F)
	58
[8422]	59	!! * Substitutions
	60	# include "vectopt_loop_substitute.h90"
	61	!!----------------------------------------------------------------------
[8486]	62	!! NEMO/ICE 4.0 , NEMO Consortium (2017)
[8422]	63	!! $Id: icethd.F90 8420 2017-08-08 12:18:46Z clem $
	64	!! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
	65	!!----------------------------------------------------------------------
	66	CONTAINS
	67
	68	SUBROUTINE ice_thd( kt )
	69	!!-------------------------------------------------------------------
	70	!! * ROUTINE ice_thd *
	71	!!
	72	!! ** Purpose : This routine manages ice thermodynamics
	73	!!
	74	!! ** Action : - Initialisation of some variables
	75	!! - Some preliminary computation (oceanic heat flux
	76	!! at the ice base, snow acc.,heat budget of the leads)
	77	!! - selection of the icy points and put them in an array
[8531]	78	!! - call ice_thd_zdf for vertical heat diffusion
[8422]	79	!! - call ice_thd_dh for vertical ice growth and melt
	80	!! - call ice_thd_ent for enthalpy remapping
	81	!! - call ice_thd_sal for ice desalination
	82	!! - call ice_thd_temp to retrieve temperature from ice enthalpy
[8531]	83	!! - call ice_thd_lam for extra lateral ice melt if monocat
	84	!! - call ice_thd_da for lateral ice melt
[8422]	85	!! - back to the geographic grid
	86	!!---------------------------------------------------------------------
	87	INTEGER, INTENT(in) :: kt ! number of iteration
	88	!
	89	INTEGER :: ji, jj, jk, jl ! dummy loop indices
	90	REAL(wp) :: zfric_u, zqld, zqfr, zqfr_neg
	91	REAL(wp), PARAMETER :: zfric_umin = 0._wp ! lower bound for the friction velocity (cice value=5.e-04)
	92	REAL(wp), PARAMETER :: zch = 0.0057_wp ! heat transfer coefficient
	93	REAL(wp), DIMENSION(jpi,jpj) :: zu_io, zv_io, zfric ! ice-ocean velocity (m/s) and frictional velocity (m2/s2)
	94	!
	95	!!-------------------------------------------------------------------
[8517]	96	! controls
	97	IF( nn_timing == 1 ) CALL timing_start('icethd') ! timing
	98	IF( ln_icediachk ) CALL ice_cons_hsm(0, 'icethd', rdiag_v, rdiag_s, rdiag_t, rdiag_fv, rdiag_fs, rdiag_ft) ! conservation
[8422]	99
	100	IF( kt == nit000 .AND. lwp ) THEN
[8426]	101	WRITE(numout,*)
[8512]	102	WRITE(numout,*) 'ice_thd: sea-ice thermodynamics'
	103	WRITE(numout,*) '~~~~~~~'
[8422]	104	ENDIF
	105
[8424]	106	CALL ice_var_glo2eqv
[8422]	107
	108	!---------------------------------------------!
	109	! computation of friction velocity at T points
	110	!---------------------------------------------!
[8512]	111	IF( ln_icedyn ) THEN
[8422]	112	zu_io(:,:) = u_ice(:,:) - ssu_m(:,:)
	113	zv_io(:,:) = v_ice(:,:) - ssv_m(:,:)
	114	DO jj = 2, jpjm1
	115	DO ji = fs_2, fs_jpim1
	116	zfric(ji,jj) = rn_cio * ( 0.5_wp * &
	117	& ( zu_io(ji,jj) * zu_io(ji,jj) + zu_io(ji-1,jj) * zu_io(ji-1,jj) &
	118	& + zv_io(ji,jj) * zv_io(ji,jj) + zv_io(ji,jj-1) * zv_io(ji,jj-1) ) ) * tmask(ji,jj,1)
	119	END DO
	120	END DO
	121	ELSE ! if no ice dynamics => transmit directly the atmospheric stress to the ocean
	122	DO jj = 2, jpjm1
	123	DO ji = fs_2, fs_jpim1
	124	zfric(ji,jj) = r1_rau0 * SQRT( 0.5_wp * &
	125	& ( utau(ji,jj) * utau(ji,jj) + utau(ji-1,jj) * utau(ji-1,jj) &
	126	& + vtau(ji,jj) * vtau(ji,jj) + vtau(ji,jj-1) * vtau(ji,jj-1) ) ) * tmask(ji,jj,1)
	127	END DO
	128	END DO
	129	ENDIF
	130	CALL lbc_lnk( zfric, 'T', 1. )
	131	!
	132	ftr_ice(:,:,:) = 0._wp ! initialization (part of solar radiation transmitted through the ice)
	133
	134	!--------------------------------------------------------------------!
	135	! Partial computation of forcing for the thermodynamic sea ice model
	136	!--------------------------------------------------------------------!
	137	DO jj = 1, jpj
	138	DO ji = 1, jpi
	139	rswitch = tmask(ji,jj,1) * MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - epsi10 ) ) ! 0 if no ice
	140	!
	141	! ! solar irradiance transmission at the mixed layer bottom and used in the lead heat budget
	142	! ! practically no "direct lateral ablation"
	143	!
	144	! ! net downward heat flux from the ice to the ocean, expressed as a function of ocean
	145	! ! temperature and turbulent mixing (McPhee, 1992)
	146	!
	147	! --- Energy received in the lead, zqld is defined everywhere (J.m-2) --- !
	148	zqld = tmask(ji,jj,1) * rdt_ice * &
	149	& ( ( 1._wp - at_i_b(ji,jj) ) * qsr_oce(ji,jj) * frq_m(ji,jj) + &
	150	& ( 1._wp - at_i_b(ji,jj) ) * qns_oce(ji,jj) + qemp_oce(ji,jj) )
	151
	152	! --- Energy needed to bring ocean surface layer until its freezing (<0, J.m-2) --- !
	153	! includes supercooling potential energy (>0) or "above-freezing" energy (<0)
	154	zqfr = tmask(ji,jj,1) * rau0 * rcp * e3t_m(ji,jj) * ( t_bo(ji,jj) - ( sst_m(ji,jj) + rt0 ) )
	155
	156	! --- Above-freezing sensible heat content (J/m2 grid)
	157	zqfr_neg = tmask(ji,jj,1) * rau0 * rcp * e3t_m(ji,jj) * MIN( ( t_bo(ji,jj) - ( sst_m(ji,jj) + rt0 ) ), 0._wp )
	158
	159	! --- Sensible ocean-to-ice heat flux (W/m2)
	160	zfric_u = MAX( SQRT( zfric(ji,jj) ), zfric_umin )
	161	fhtur(ji,jj) = rswitch * rau0 * rcp * zch * zfric_u * ( ( sst_m(ji,jj) + rt0 ) - t_bo(ji,jj) ) ! W.m-2
	162
	163	fhtur(ji,jj) = rswitch * MIN( fhtur(ji,jj), - zqfr_neg * r1_rdtice / MAX( at_i(ji,jj), epsi10 ) )
	164	! upper bound for fhtur: the heat retrieved from the ocean must be smaller than the heat necessary to reach
	165	! the freezing point, so that we do not have SST < T_freeze
	166	! This implies: - ( fhtur(ji,jj) * at_i(ji,jj) * rtdice ) - zqfr >= 0
	167
	168	!-- Energy Budget of the leads (J.m-2), source of lateral accretion. Must be < 0 to form ice
	169	qlead(ji,jj) = MIN( 0._wp , zqld - ( fhtur(ji,jj) * at_i(ji,jj) * rdt_ice ) - zqfr )
	170
	171	! If there is ice and leads are warming, then transfer energy from the lead budget and use it for bottom melting
	172	IF( zqld > 0._wp ) THEN
	173	fhld (ji,jj) = rswitch * zqld * r1_rdtice / MAX( at_i(ji,jj), epsi10 ) ! divided by at_i since this is (re)multiplied by a_i in icethd_dh.F90
	174	qlead(ji,jj) = 0._wp
	175	ELSE
	176	fhld (ji,jj) = 0._wp
	177	ENDIF
	178	!
	179	! Net heat flux on top of the ice-ocean [W.m-2]
	180	! ---------------------------------------------
	181	hfx_in(ji,jj) = qns_tot(ji,jj) + qsr_tot(ji,jj)
	182	END DO
	183	END DO
	184
	185	! In case we bypass open-water ice formation
[8514]	186	IF( .NOT. ln_icedO ) qlead(:,:) = 0._wp
[8422]	187	! In case we bypass growing/melting from top and bottom: we suppose ice is impermeable => ocean is isolated from atmosphere
[8514]	188	IF( .NOT. ln_icedH ) THEN
[8483]	189	hfx_in(:,:) = ( 1._wp - at_i_b(:,:) ) * ( qns_oce(:,:) + qsr_oce(:,:) ) + qemp_oce(:,:)
	190	fhtur (:,:) = 0._wp
	191	fhld (:,:) = 0._wp
	192	ENDIF
[8422]	193
	194	! ---------------------------------------------------------------------
	195	! Net heat flux on top of the ocean after ice thermo (1st step) [W.m-2]
	196	! ---------------------------------------------------------------------
	197	! First step here : non solar + precip - qlead - qturb
	198	! Second step in icethd_dh : heat remaining if total melt (zq_rema)
	199	! Third step in iceupdate.F90 : heat from ice-ocean mass exchange (zf_mass) + solar
[8498]	200	hfx_out(:,:) = ( 1._wp - at_i_b(:,:) ) * qns_oce(:,:) + qemp_oce(:,:) & ! Non solar heat flux received by the ocean
	201	& - qlead(:,:) * r1_rdtice & ! heat flux taken from the ocean where there is open water ice formation
	202	& - at_i (:,:) * fhtur(:,:) & ! heat flux taken by turbulence
	203	& - at_i (:,:) * fhld(:,:) ! heat flux taken during bottom growth/melt
	204	! (fhld should be 0 while bott growth)
[8422]	205	!-------------------------------------------------------------------------------------------!
	206	! Thermodynamic computation (only on grid points covered by ice) => loop over ice categories
	207	!-------------------------------------------------------------------------------------------!
	208	DO jl = 1, jpl
	209
	210	! select ice covered grid points
	211	nidx = 0 ; idxice(:) = 0
	212	DO jj = 1, jpj
	213	DO ji = 1, jpi
	214	IF ( a_i(ji,jj,jl) > epsi10 ) THEN
	215	nidx = nidx + 1
	216	idxice(nidx) = (jj - 1) * jpi + ji
	217	ENDIF
	218	END DO
	219	END DO
	220
	221	IF( lk_mpp ) CALL mpp_ini_ice( nidx , numout )
	222
	223	IF( nidx > 0 ) THEN ! If there is no ice, do nothing.
	224	!
	225	CALL ice_thd_1d2d( jl, 1 ) ! --- Move to 1D arrays --- !
	226	! ! --- & Change units of e_i, e_s from J/m2 to J/m3 --- !
	227	!
	228	s_i_new (1:nidx) = 0._wp ; dh_s_tot (1:nidx) = 0._wp ! --- some init --- ! (important to have them here)
	229	dh_i_surf (1:nidx) = 0._wp ; dh_i_bott(1:nidx) = 0._wp
	230	dh_snowice(1:nidx) = 0._wp ; dh_i_sub (1:nidx) = 0._wp
	231	!
[8514]	232	IF( ln_icedH ) THEN ! --- growing/melting --- !
[8531]	233	CALL ice_thd_zdf ! Ice/Snow Temperature profile
[8486]	234	CALL ice_thd_dh ! Ice/Snow thickness
	235	CALL ice_thd_ent( e_i_1d(1:nidx,:) ) ! Ice enthalpy remapping
	236	ENDIF
[8422]	237	!
[8531]	238	CALL ice_thd_sal( ln_icedS ) ! --- Ice salinity --- !
[8422]	239	!
	240	CALL ice_thd_temp ! --- temperature update --- !
	241	!
[8486]	242	!!gm please create a new logical (l_thd_lam or a better explicit name) set one for all in icestp.F90 module
[8514]	243	!!gm l_thd_lam = ln_icedH .AND. ( ( nn_monocat == 1 .OR. nn_monocat == 4 ) .AND. jpl == 1 )
[8486]	244	!!gm by the way, the different options associated with nn_monocat =1 to 4 are quite impossible to identify
	245	!!gm more comment to add when ready the namelist, with an explicit print in the ocean.output
[8514]	246	IF( ln_icedH ) THEN
[8422]	247	IF ( ( nn_monocat == 1 .OR. nn_monocat == 4 ) .AND. jpl == 1 ) THEN
	248	CALL ice_thd_lam ! --- extra lateral melting if monocat --- !
	249	END IF
	250	END IF
	251	!
[8514]	252	IF( ln_icedA ) CALL ice_thd_da ! --- lateral melting --- !
[8422]	253	!
	254	CALL ice_thd_1d2d( jl, 2 ) ! --- Change units of e_i, e_s from J/m3 to J/m2 --- !
	255	! ! --- & Move to 2D arrays --- !
	256	!
	257	IF( lk_mpp ) CALL mpp_comm_free( ncomm_ice ) !RB necessary ??
	258	ENDIF
	259	!
	260	END DO
	261	! update ice age (in case a_i changed, i.e. becomes 0 or lateral melting)
	262	oa_i(:,:,:) = o_i(:,:,:) * a_i(:,:,:)
	263
[8517]	264	IF( ln_icediachk ) CALL ice_cons_hsm(1, 'icethd', rdiag_v, rdiag_s, rdiag_t, rdiag_fv, rdiag_fs, rdiag_ft)
[8422]	265	!
[8486]	266	CALL ice_var_zapsmall ! --- remove very small ice concentration (<1e-10) --- !
	267	! ! & make sure at_i=SUM(a_i) & ato_i=1 where at_i=0
[8422]	268	!
[8486]	269	IF( jpl > 1 ) CALL ice_itd_rem( kt ) ! --- Transport ice between thickness categories --- !
[8422]	270	!
[8531]	271	IF( ln_icedO ) CALL ice_thd_do ! --- frazil ice growing in leads --- !
[8422]	272	!
[8517]	273	! controls
	274	IF( ln_icectl ) CALL ice_prt (kt, iiceprt, jiceprt, 1, ' - ice thermodyn. - ') ! prints
	275	IF( ln_ctl ) CALL ice_prt3D ('icethd') ! prints
	276	IF( nn_timing == 1 ) CALL timing_stop('icethd') ! timing
[8422]	277	!
	278	END SUBROUTINE ice_thd
	279
	280
	281	SUBROUTINE ice_thd_temp
	282	!!-----------------------------------------------------------------------
	283	!! * ROUTINE ice_thd_temp *
	284	!!
	285	!! ** Purpose : Computes sea ice temperature (Kelvin) from enthalpy
	286	!!
	287	!! ** Method : Formula (Bitz and Lipscomb, 1999)
	288	!!-------------------------------------------------------------------
	289	INTEGER :: ji, jk ! dummy loop indices
[8522]	290	REAL(wp) :: ztmelts, zbbb, zccc ! local scalar
[8422]	291	!!-------------------------------------------------------------------
	292	! Recover ice temperature
	293	DO jk = 1, nlay_i
	294	DO ji = 1, nidx
[8498]	295	ztmelts = -tmut * s_i_1d(ji,jk)
[8422]	296	! Conversion q(S,T) -> T (second order equation)
[8498]	297	zbbb = ( rcp - cpic ) * ztmelts + e_i_1d(ji,jk) * r1_rhoic - lfus
	298	zccc = SQRT( MAX( zbbb * zbbb - 4._wp * cpic * lfus * ztmelts, 0._wp ) )
[8522]	299	t_i_1d(ji,jk) = rt0 - ( zbbb + zccc ) * 0.5_wp * r1_cpic
[8422]	300
	301	! mask temperature
[8498]	302	rswitch = 1._wp - MAX( 0._wp , SIGN( 1._wp , - ht_i_1d(ji) ) )
	303	t_i_1d(ji,jk) = rswitch * t_i_1d(ji,jk) + ( 1._wp - rswitch ) * rt0
[8422]	304	END DO
	305	END DO
	306	!
	307	END SUBROUTINE ice_thd_temp
	308
	309
	310	SUBROUTINE ice_thd_lam
	311	!!-----------------------------------------------------------------------
	312	!! * ROUTINE ice_thd_lam *
	313	!!
	314	!! ** Purpose : Lateral melting in case monocategory
	315	!! ( dA = A/2h dh )
	316	!!-----------------------------------------------------------------------
	317	INTEGER :: ji ! dummy loop indices
	318	REAL(wp) :: zhi_bef ! ice thickness before thermo
	319	REAL(wp) :: zdh_mel, zda_mel ! net melting
	320	REAL(wp) :: zvi, zvs ! ice/snow volumes
	321	!!-----------------------------------------------------------------------
	322	!
	323	DO ji = 1, nidx
	324	zdh_mel = MIN( 0._wp, dh_i_surf(ji) + dh_i_bott(ji) + dh_snowice(ji) + dh_i_sub(ji) )
	325	IF( zdh_mel < 0._wp .AND. a_i_1d(ji) > 0._wp ) THEN
	326	zvi = a_i_1d(ji) * ht_i_1d(ji)
	327	zvs = a_i_1d(ji) * ht_s_1d(ji)
	328	! lateral melting = concentration change
	329	zhi_bef = ht_i_1d(ji) - zdh_mel
	330	rswitch = MAX( 0._wp , SIGN( 1._wp , zhi_bef - epsi20 ) )
	331	zda_mel = rswitch * a_i_1d(ji) * zdh_mel / ( 2._wp * MAX( zhi_bef, epsi20 ) )
	332	a_i_1d(ji) = MAX( epsi20, a_i_1d(ji) + zda_mel )
	333	! adjust thickness
	334	ht_i_1d(ji) = zvi / a_i_1d(ji)
	335	ht_s_1d(ji) = zvs / a_i_1d(ji)
	336	! retrieve total concentration
	337	at_i_1d(ji) = a_i_1d(ji)
	338	END IF
	339	END DO
	340	!
	341	END SUBROUTINE ice_thd_lam
	342
	343
[8486]	344	SUBROUTINE ice_thd_1d2d( kl, kn )
[8422]	345	!!-----------------------------------------------------------------------
	346	!! * ROUTINE ice_thd_1d2d *
	347	!!
	348	!! ** Purpose : move arrays from 1d to 2d and the reverse
	349	!!-----------------------------------------------------------------------
[8486]	350	INTEGER, INTENT(in) :: kl ! index of the ice category
	351	INTEGER, INTENT(in) :: kn ! 1= from 2D to 1D ; 2= from 1D to 2D
[8422]	352	!
[8486]	353	INTEGER :: jk ! dummy loop indices
[8422]	354	!!-----------------------------------------------------------------------
	355	!
	356	SELECT CASE( kn )
[8486]	357	! !---------------------!
	358	CASE( 1 ) !== from 2D to 1D ==!
	359	! !---------------------!
[8422]	360	CALL tab_2d_1d( nidx, idxice(1:nidx), at_i_1d(1:nidx), at_i )
[8486]	361	CALL tab_2d_1d( nidx, idxice(1:nidx), a_i_1d (1:nidx), a_i (:,:,kl) )
	362	CALL tab_2d_1d( nidx, idxice(1:nidx), ht_i_1d(1:nidx), ht_i(:,:,kl) )
	363	CALL tab_2d_1d( nidx, idxice(1:nidx), ht_s_1d(1:nidx), ht_s(:,:,kl) )
	364	CALL tab_2d_1d( nidx, idxice(1:nidx), t_su_1d(1:nidx), t_su(:,:,kl) )
	365	CALL tab_2d_1d( nidx, idxice(1:nidx), sm_i_1d(1:nidx), sm_i(:,:,kl) )
[8422]	366	DO jk = 1, nlay_s
[8486]	367	CALL tab_2d_1d( nidx, idxice(1:nidx), t_s_1d(1:nidx,jk), t_s(:,:,jk,kl) )
	368	CALL tab_2d_1d( nidx, idxice(1:nidx), e_s_1d(1:nidx,jk), e_s(:,:,jk,kl) )
[8422]	369	END DO
	370	DO jk = 1, nlay_i
[8486]	371	CALL tab_2d_1d( nidx, idxice(1:nidx), t_i_1d(1:nidx,jk), t_i(:,:,jk,kl) )
	372	CALL tab_2d_1d( nidx, idxice(1:nidx), e_i_1d(1:nidx,jk), e_i(:,:,jk,kl) )
	373	CALL tab_2d_1d( nidx, idxice(1:nidx), s_i_1d(1:nidx,jk), s_i(:,:,jk,kl) )
[8422]	374	END DO
	375	!
	376	CALL tab_2d_1d( nidx, idxice(1:nidx), qprec_ice_1d(1:nidx), qprec_ice )
[8486]	377	CALL tab_2d_1d( nidx, idxice(1:nidx), qsr_ice_1d (1:nidx), qsr_ice (:,:,kl) )
[8422]	378	CALL tab_2d_1d( nidx, idxice(1:nidx), fr1_i0_1d (1:nidx), fr1_i0 )
	379	CALL tab_2d_1d( nidx, idxice(1:nidx), fr2_i0_1d (1:nidx), fr2_i0 )
[8486]	380	CALL tab_2d_1d( nidx, idxice(1:nidx), qns_ice_1d (1:nidx), qns_ice (:,:,kl) )
	381	CALL tab_2d_1d( nidx, idxice(1:nidx), ftr_ice_1d (1:nidx), ftr_ice (:,:,kl) )
	382	CALL tab_2d_1d( nidx, idxice(1:nidx), evap_ice_1d (1:nidx), evap_ice(:,:,kl) )
	383	CALL tab_2d_1d( nidx, idxice(1:nidx), dqns_ice_1d (1:nidx), dqns_ice(:,:,kl) )
[8422]	384	CALL tab_2d_1d( nidx, idxice(1:nidx), t_bo_1d (1:nidx), t_bo )
	385	CALL tab_2d_1d( nidx, idxice(1:nidx), sprecip_1d (1:nidx), sprecip )
	386	CALL tab_2d_1d( nidx, idxice(1:nidx), fhtur_1d (1:nidx), fhtur )
	387	CALL tab_2d_1d( nidx, idxice(1:nidx), fhld_1d (1:nidx), fhld )
	388	!
	389	CALL tab_2d_1d( nidx, idxice(1:nidx), wfx_snw_sni_1d(1:nidx), wfx_snw_sni )
	390	CALL tab_2d_1d( nidx, idxice(1:nidx), wfx_snw_sum_1d(1:nidx), wfx_snw_sum )
	391	CALL tab_2d_1d( nidx, idxice(1:nidx), wfx_sub_1d (1:nidx), wfx_sub )
	392	CALL tab_2d_1d( nidx, idxice(1:nidx), wfx_snw_sub_1d(1:nidx), wfx_snw_sub )
	393	CALL tab_2d_1d( nidx, idxice(1:nidx), wfx_ice_sub_1d(1:nidx), wfx_ice_sub )
	394	CALL tab_2d_1d( nidx, idxice(1:nidx), wfx_err_sub_1d(1:nidx), wfx_err_sub )
	395	!
	396	CALL tab_2d_1d( nidx, idxice(1:nidx), wfx_bog_1d (1:nidx), wfx_bog )
	397	CALL tab_2d_1d( nidx, idxice(1:nidx), wfx_bom_1d (1:nidx), wfx_bom )
	398	CALL tab_2d_1d( nidx, idxice(1:nidx), wfx_sum_1d (1:nidx), wfx_sum )
	399	CALL tab_2d_1d( nidx, idxice(1:nidx), wfx_sni_1d (1:nidx), wfx_sni )
	400	CALL tab_2d_1d( nidx, idxice(1:nidx), wfx_res_1d (1:nidx), wfx_res )
	401	CALL tab_2d_1d( nidx, idxice(1:nidx), wfx_spr_1d (1:nidx), wfx_spr )
	402	CALL tab_2d_1d( nidx, idxice(1:nidx), wfx_lam_1d (1:nidx), wfx_lam )
	403	!
	404	CALL tab_2d_1d( nidx, idxice(1:nidx), sfx_bog_1d (1:nidx), sfx_bog )
	405	CALL tab_2d_1d( nidx, idxice(1:nidx), sfx_bom_1d (1:nidx), sfx_bom )
	406	CALL tab_2d_1d( nidx, idxice(1:nidx), sfx_sum_1d (1:nidx), sfx_sum )
	407	CALL tab_2d_1d( nidx, idxice(1:nidx), sfx_sni_1d (1:nidx), sfx_sni )
	408	CALL tab_2d_1d( nidx, idxice(1:nidx), sfx_bri_1d (1:nidx), sfx_bri )
	409	CALL tab_2d_1d( nidx, idxice(1:nidx), sfx_res_1d (1:nidx), sfx_res )
	410	CALL tab_2d_1d( nidx, idxice(1:nidx), sfx_sub_1d (1:nidx), sfx_sub )
	411	CALL tab_2d_1d( nidx, idxice(1:nidx), sfx_lam_1d (1:nidx), sfx_lam )
	412	!
	413	CALL tab_2d_1d( nidx, idxice(1:nidx), hfx_thd_1d (1:nidx), hfx_thd )
	414	CALL tab_2d_1d( nidx, idxice(1:nidx), hfx_spr_1d (1:nidx), hfx_spr )
	415	CALL tab_2d_1d( nidx, idxice(1:nidx), hfx_sum_1d (1:nidx), hfx_sum )
	416	CALL tab_2d_1d( nidx, idxice(1:nidx), hfx_bom_1d (1:nidx), hfx_bom )
	417	CALL tab_2d_1d( nidx, idxice(1:nidx), hfx_bog_1d (1:nidx), hfx_bog )
	418	CALL tab_2d_1d( nidx, idxice(1:nidx), hfx_dif_1d (1:nidx), hfx_dif )
	419	CALL tab_2d_1d( nidx, idxice(1:nidx), hfx_opw_1d (1:nidx), hfx_opw )
	420	CALL tab_2d_1d( nidx, idxice(1:nidx), hfx_snw_1d (1:nidx), hfx_snw )
	421	CALL tab_2d_1d( nidx, idxice(1:nidx), hfx_sub_1d (1:nidx), hfx_sub )
	422	CALL tab_2d_1d( nidx, idxice(1:nidx), hfx_res_1d (1:nidx), hfx_res )
	423	CALL tab_2d_1d( nidx, idxice(1:nidx), hfx_err_dif_1d(1:nidx), hfx_err_dif )
	424	CALL tab_2d_1d( nidx, idxice(1:nidx), hfx_err_rem_1d(1:nidx), hfx_err_rem )
	425	CALL tab_2d_1d( nidx, idxice(1:nidx), hfx_out_1d (1:nidx), hfx_out )
	426	!
	427	! SIMIP diagnostics
	428	CALL tab_2d_1d( nidx, idxice(1:nidx), diag_fc_bo_1d(1:nidx), diag_fc_bo )
	429	CALL tab_2d_1d( nidx, idxice(1:nidx), diag_fc_su_1d(1:nidx), diag_fc_su )
	430	! ocean surface fields
	431	CALL tab_2d_1d( nidx, idxice(1:nidx), sst_1d(1:nidx), sst_m )
	432	CALL tab_2d_1d( nidx, idxice(1:nidx), sss_1d(1:nidx), sss_m )
	433
	434	! --- Change units of e_i, e_s from J/m2 to J/m3 --- !
	435	DO jk = 1, nlay_i
	436	WHERE( ht_i_1d(1:nidx)>0._wp ) e_i_1d(1:nidx,jk) = e_i_1d(1:nidx,jk) / (ht_i_1d(1:nidx) * a_i_1d(1:nidx)) * nlay_i
[8486]	437	END DO
[8422]	438	DO jk = 1, nlay_s
	439	WHERE( ht_s_1d(1:nidx)>0._wp ) e_s_1d(1:nidx,jk) = e_s_1d(1:nidx,jk) / (ht_s_1d(1:nidx) * a_i_1d(1:nidx)) * nlay_s
[8486]	440	END DO
[8422]	441	!
[8486]	442	! !---------------------!
	443	CASE( 2 ) !== from 1D to 2D ==!
	444	! !---------------------!
[8422]	445	! --- Change units of e_i, e_s from J/m3 to J/m2 --- !
	446	DO jk = 1, nlay_i
	447	e_i_1d(1:nidx,jk) = e_i_1d(1:nidx,jk) * ht_i_1d(1:nidx) * a_i_1d(1:nidx) * r1_nlay_i
[8486]	448	END DO
[8422]	449	DO jk = 1, nlay_s
	450	e_s_1d(1:nidx,jk) = e_s_1d(1:nidx,jk) * ht_s_1d(1:nidx) * a_i_1d(1:nidx) * r1_nlay_s
[8486]	451	END DO
[8422]	452	!
[8506]	453	! Change thickness to volume (replaces routine ice_var_eqv2glo)
[8422]	454	v_i_1d(1:nidx) = ht_i_1d(1:nidx) * a_i_1d(1:nidx)
	455	v_s_1d(1:nidx) = ht_s_1d(1:nidx) * a_i_1d(1:nidx)
	456	smv_i_1d(1:nidx) = sm_i_1d(1:nidx) * v_i_1d(1:nidx)
	457
	458	CALL tab_1d_2d( nidx, idxice(1:nidx), at_i_1d(1:nidx), at_i )
[8486]	459	CALL tab_1d_2d( nidx, idxice(1:nidx), a_i_1d (1:nidx), a_i (:,:,kl) )
	460	CALL tab_1d_2d( nidx, idxice(1:nidx), ht_i_1d(1:nidx), ht_i(:,:,kl) )
	461	CALL tab_1d_2d( nidx, idxice(1:nidx), ht_s_1d(1:nidx), ht_s(:,:,kl) )
	462	CALL tab_1d_2d( nidx, idxice(1:nidx), t_su_1d(1:nidx), t_su(:,:,kl) )
	463	CALL tab_1d_2d( nidx, idxice(1:nidx), sm_i_1d(1:nidx), sm_i(:,:,kl) )
[8422]	464	DO jk = 1, nlay_s
[8486]	465	CALL tab_1d_2d( nidx, idxice(1:nidx), t_s_1d(1:nidx,jk), t_s(:,:,jk,kl) )
	466	CALL tab_1d_2d( nidx, idxice(1:nidx), e_s_1d(1:nidx,jk), e_s(:,:,jk,kl) )
[8422]	467	END DO
	468	DO jk = 1, nlay_i
[8486]	469	CALL tab_1d_2d( nidx, idxice(1:nidx), t_i_1d(1:nidx,jk), t_i(:,:,jk,kl) )
	470	CALL tab_1d_2d( nidx, idxice(1:nidx), e_i_1d(1:nidx,jk), e_i(:,:,jk,kl) )
	471	CALL tab_1d_2d( nidx, idxice(1:nidx), s_i_1d(1:nidx,jk), s_i(:,:,jk,kl) )
[8422]	472	END DO
	473	!
[8486]	474	CALL tab_1d_2d( nidx, idxice(1:nidx), wfx_snw_sni_1d(1:nidx), wfx_snw_sni )
	475	CALL tab_1d_2d( nidx, idxice(1:nidx), wfx_snw_sum_1d(1:nidx), wfx_snw_sum )
	476	CALL tab_1d_2d( nidx, idxice(1:nidx), wfx_sub_1d (1:nidx), wfx_sub )
	477	CALL tab_1d_2d( nidx, idxice(1:nidx), wfx_snw_sub_1d(1:nidx), wfx_snw_sub )
	478	CALL tab_1d_2d( nidx, idxice(1:nidx), wfx_ice_sub_1d(1:nidx), wfx_ice_sub )
	479	CALL tab_1d_2d( nidx, idxice(1:nidx), wfx_err_sub_1d(1:nidx), wfx_err_sub )
[8422]	480	!
[8486]	481	CALL tab_1d_2d( nidx, idxice(1:nidx), wfx_bog_1d (1:nidx), wfx_bog )
	482	CALL tab_1d_2d( nidx, idxice(1:nidx), wfx_bom_1d (1:nidx), wfx_bom )
	483	CALL tab_1d_2d( nidx, idxice(1:nidx), wfx_sum_1d (1:nidx), wfx_sum )
	484	CALL tab_1d_2d( nidx, idxice(1:nidx), wfx_sni_1d (1:nidx), wfx_sni )
	485	CALL tab_1d_2d( nidx, idxice(1:nidx), wfx_res_1d (1:nidx), wfx_res )
	486	CALL tab_1d_2d( nidx, idxice(1:nidx), wfx_spr_1d (1:nidx), wfx_spr )
	487	CALL tab_1d_2d( nidx, idxice(1:nidx), wfx_lam_1d (1:nidx), wfx_lam )
[8422]	488	!
[8486]	489	CALL tab_1d_2d( nidx, idxice(1:nidx), sfx_bog_1d (1:nidx), sfx_bog )
	490	CALL tab_1d_2d( nidx, idxice(1:nidx), sfx_bom_1d (1:nidx), sfx_bom )
	491	CALL tab_1d_2d( nidx, idxice(1:nidx), sfx_sum_1d (1:nidx), sfx_sum )
	492	CALL tab_1d_2d( nidx, idxice(1:nidx), sfx_sni_1d (1:nidx), sfx_sni )
	493	CALL tab_1d_2d( nidx, idxice(1:nidx), sfx_bri_1d (1:nidx), sfx_bri )
	494	CALL tab_1d_2d( nidx, idxice(1:nidx), sfx_res_1d (1:nidx), sfx_res )
	495	CALL tab_1d_2d( nidx, idxice(1:nidx), sfx_sub_1d (1:nidx), sfx_sub )
	496	CALL tab_1d_2d( nidx, idxice(1:nidx), sfx_lam_1d (1:nidx), sfx_lam )
[8422]	497	!
[8486]	498	CALL tab_1d_2d( nidx, idxice(1:nidx), hfx_thd_1d (1:nidx), hfx_thd )
	499	CALL tab_1d_2d( nidx, idxice(1:nidx), hfx_spr_1d (1:nidx), hfx_spr )
	500	CALL tab_1d_2d( nidx, idxice(1:nidx), hfx_sum_1d (1:nidx), hfx_sum )
	501	CALL tab_1d_2d( nidx, idxice(1:nidx), hfx_bom_1d (1:nidx), hfx_bom )
	502	CALL tab_1d_2d( nidx, idxice(1:nidx), hfx_bog_1d (1:nidx), hfx_bog )
	503	CALL tab_1d_2d( nidx, idxice(1:nidx), hfx_dif_1d (1:nidx), hfx_dif )
	504	CALL tab_1d_2d( nidx, idxice(1:nidx), hfx_opw_1d (1:nidx), hfx_opw )
	505	CALL tab_1d_2d( nidx, idxice(1:nidx), hfx_snw_1d (1:nidx), hfx_snw )
	506	CALL tab_1d_2d( nidx, idxice(1:nidx), hfx_sub_1d (1:nidx), hfx_sub )
	507	CALL tab_1d_2d( nidx, idxice(1:nidx), hfx_res_1d (1:nidx), hfx_res )
	508	CALL tab_1d_2d( nidx, idxice(1:nidx), hfx_err_dif_1d(1:nidx), hfx_err_dif )
	509	CALL tab_1d_2d( nidx, idxice(1:nidx), hfx_err_rem_1d(1:nidx), hfx_err_rem )
	510	CALL tab_1d_2d( nidx, idxice(1:nidx), hfx_out_1d (1:nidx), hfx_out )
[8422]	511	!
[8486]	512	CALL tab_1d_2d( nidx, idxice(1:nidx), qns_ice_1d(1:nidx), qns_ice(:,:,kl) )
	513	CALL tab_1d_2d( nidx, idxice(1:nidx), ftr_ice_1d(1:nidx), ftr_ice(:,:,kl) )
[8422]	514	!
	515	! SIMIP diagnostics
[8486]	516	CALL tab_1d_2d( nidx, idxice(1:nidx), t_si_1d (1:nidx), t_si(:,:,kl) )
	517	CALL tab_1d_2d( nidx, idxice(1:nidx), diag_fc_bo_1d(1:nidx), diag_fc_bo )
	518	CALL tab_1d_2d( nidx, idxice(1:nidx), diag_fc_su_1d(1:nidx), diag_fc_su )
[8422]	519	! extensive variables
[8486]	520	CALL tab_1d_2d( nidx, idxice(1:nidx), v_i_1d (1:nidx), v_i (:,:,kl) )
	521	CALL tab_1d_2d( nidx, idxice(1:nidx), v_s_1d (1:nidx), v_s (:,:,kl) )
	522	CALL tab_1d_2d( nidx, idxice(1:nidx), smv_i_1d(1:nidx), smv_i(:,:,kl) )
	523	!
[8422]	524	END SELECT
	525	!
	526	END SUBROUTINE ice_thd_1d2d
	527
	528
	529	SUBROUTINE ice_thd_init
	530	!!-----------------------------------------------------------------------
	531	!! * ROUTINE ice_thd_init *
	532	!!
[8531]	533	!! ** Purpose : Physical constants and parameters associated with
	534	!! ice thermodynamics
[8422]	535	!!
[8531]	536	!! ** Method : Read the namthd namelist and check the parameters
	537	!! called at the first timestep (nit000)
[8422]	538	!!
[8531]	539	!! ** input : Namelist namthd
[8422]	540	!!-------------------------------------------------------------------
[8486]	541	INTEGER :: ios ! Local integer output status for namelist read
	542	!!
[8531]	543	NAMELIST/namthd/ ln_icedH, ln_icedA, ln_icedO, ln_icedS
[8422]	544	!!-------------------------------------------------------------------
	545	!
[8531]	546	REWIND( numnam_ice_ref ) ! Namelist namthd in reference namelist : Ice thermodynamics
	547	READ ( numnam_ice_ref, namthd, IOSTAT = ios, ERR = 901)
	548	901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namthd in reference namelist', lwp )
[8422]	549
[8531]	550	REWIND( numnam_ice_cfg ) ! Namelist namthd in configuration namelist : Ice thermodynamics
	551	READ ( numnam_ice_cfg, namthd, IOSTAT = ios, ERR = 902 )
	552	902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namthd in configuration namelist', lwp )
	553	IF(lwm) WRITE ( numoni, namthd )
[8422]	554	!
	555	!
	556	IF(lwp) THEN ! control print
[8531]	557	WRITE(numout,*) 'ice_thd_init: Ice Thermodynamics'
	558	WRITE(numout,*) '~~~~~~~~~~~~'
	559	WRITE(numout,*) ' Namelist namthd:'
	560	WRITE(numout,*) ' activate ice thick change from top/bot (T) or not (F) ln_icedH = ', ln_icedH
	561	WRITE(numout,*) ' activate lateral melting (T) or not (F) ln_icedA = ', ln_icedA
	562	WRITE(numout,*) ' activate ice growth in open-water (T) or not (F) ln_icedO = ', ln_icedO
	563	WRITE(numout,*) ' activate gravity drainage and flushing (T) or not (F) ln_icedS = ', ln_icedS
	564	ENDIF
[8422]	565	!
[8531]	566	CALL ice_thd_zdf_init ! set ice heat diffusion parameters
	567	IF( ln_icedA ) CALL ice_thd_da_init ! set ice lateral melting parameters
	568	IF( ln_icedO ) CALL ice_thd_do_init ! set ice growth in open water parameters
	569	CALL ice_thd_sal_init ! set ice salinity parameters
	570	!
	571	IF( ln_icedS .AND. nn_icesal == 1 ) THEN
	572	ln_icedS = .FALSE.
	573	CALL ctl_warn('ln_icedS is set to false since constant ice salinity is chosen (nn_icesal=1)')
[8514]	574	ENDIF
[8422]	575	!
	576	END SUBROUTINE ice_thd_init
	577
	578	#else
	579	!!----------------------------------------------------------------------
	580	!! Default option Dummy module NO LIM3 sea-ice model
	581	!!----------------------------------------------------------------------
	582	#endif
	583
	584	!!======================================================================
	585	END MODULE icethd

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

Download in other formats: