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.

limupdate2.F90 in branches/2015/nemo_v3_6_STABLE/NEMOGCM/NEMO/LIM_SRC_3 – NEMO

Context Navigation

source: branches/2015/nemo_v3_6_STABLE/NEMOGCM/NEMO/LIM_SRC_3/limupdate2.F90 @ 7814

Last change on this file since 7814 was 7814, checked in by clem, 7 years ago
cosmetic changes for better phasing with trunk
Property svn:keywords set to `Id`
File size: 12.7 KB

Rev	Line
[4045]	1	MODULE limupdate2
	2	!!======================================================================
	3	!! * MODULE limupdate2 *
	4	!! LIM-3 : Update of sea-ice global variables at the end of the time step
	5	!!======================================================================
	6	!! History : 3.0 ! 2006-04 (M. Vancoppenolle) Original code
[5123]	7	!! 3.5 ! 2014-06 (C. Rousset) Complete rewriting/cleaning
[4045]	8	!!----------------------------------------------------------------------
	9	#if defined key_lim3
	10	!!----------------------------------------------------------------------
	11	!! 'key_lim3' LIM3 sea-ice model
	12	!!----------------------------------------------------------------------
	13	!! lim_update2 : computes update of sea-ice global variables from trend terms
	14	!!----------------------------------------------------------------------
	15	USE sbc_oce ! Surface boundary condition: ocean fields
	16	USE sbc_ice ! Surface boundary condition: ice fields
	17	USE dom_ice
[5123]	18	USE dom_oce
[4045]	19	USE phycst ! physical constants
	20	USE ice
	21	USE thd_ice ! LIM thermodynamic sea-ice variables
	22	USE limitd_th
	23	USE limvar
[5123]	24	USE prtctl ! Print control
	25	USE lbclnk ! lateral boundary condition - MPP exchanges
	26	USE wrk_nemo ! work arrays
[4072]	27	USE timing ! Timing
[5123]	28	USE limcons ! conservation tests
	29	USE limctl
	30	USE lib_mpp ! MPP library
	31	USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)
	32	USE in_out_manager
[4045]	33
	34	IMPLICIT NONE
	35	PRIVATE
	36
	37	PUBLIC lim_update2 ! routine called by ice_step
	38
	39	!! * Substitutions
	40	# include "vectopt_loop_substitute.h90"
	41	!!----------------------------------------------------------------------
	42	!! NEMO/LIM3 4.0 , UCL - NEMO Consortium (2011)
[5215]	43	!! $Id$
[4045]	44	!! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
	45	!!----------------------------------------------------------------------
	46	CONTAINS
	47
[5123]	48	SUBROUTINE lim_update2( kt )
[4045]	49	!!-------------------------------------------------------------------
	50	!! * ROUTINE lim_update2 *
	51	!!
	52	!! ** Purpose : Computes update of sea-ice global variables at
	53	!! the end of the time step.
	54	!!
	55	!!---------------------------------------------------------------------
[5123]	56	INTEGER, INTENT(in) :: kt ! number of iteration
	57	INTEGER :: ji, jj, jk, jl ! dummy loop indices
[5134]	58	REAL(wp) :: zsal
[5123]	59	REAL(wp) :: zvi_b, zsmv_b, zei_b, zfs_b, zfw_b, zft_b
[4045]	60	!!-------------------------------------------------------------------
[4072]	61	IF( nn_timing == 1 ) CALL timing_start('limupdate2')
[4045]	62
[5123]	63	IF( kt == nit000 .AND. lwp ) THEN
[7814]	64	WRITE(numout,*)''
	65	WRITE(numout,*)' lim_update2 '
	66	WRITE(numout,*)' ~~~~~~~~~~~ '
[5123]	67	ENDIF
	68
[4688]	69	! conservation test
	70	IF( ln_limdiahsb ) CALL lim_cons_hsm(0, 'limupdate2', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b)
[4045]	71
[4688]	72	!----------------------------------------------------------------------
[5123]	73	! Constrain the thickness of the smallest category above himin
[4688]	74	!----------------------------------------------------------------------
[4869]	75	DO jj = 1, jpj
	76	DO ji = 1, jpi
[5167]	77	rswitch = MAX( 0._wp , SIGN( 1._wp, a_i(ji,jj,1) - epsi20 ) ) !0 if no ice and 1 if yes
	78	ht_i(ji,jj,1) = v_i (ji,jj,1) / MAX( a_i(ji,jj,1) , epsi20 ) * rswitch
[5123]	79	IF( v_i(ji,jj,1) > 0._wp .AND. ht_i(ji,jj,1) < rn_himin ) THEN
[5202]	80	a_i (ji,jj,1) = a_i (ji,jj,1) * ht_i(ji,jj,1) / rn_himin
	81	oa_i(ji,jj,1) = oa_i(ji,jj,1) * ht_i(ji,jj,1) / rn_himin
[4869]	82	ENDIF
	83	END DO
	84	END DO
[4688]	85
	86	!-----------------------------------------------------
	87	! ice concentration should not exceed amax
	88	!-----------------------------------------------------
	89	at_i(:,:) = 0._wp
[4045]	90	DO jl = 1, jpl
	91	at_i(:,:) = a_i(:,:,jl) + at_i(:,:)
	92	END DO
[4688]	93
	94	DO jl = 1, jpl
	95	DO jj = 1, jpj
	96	DO ji = 1, jpi
[6311]	97	IF( at_i(ji,jj) > rn_amax_2d(ji,jj) .AND. a_i(ji,jj,jl) > 0._wp ) THEN
	98	a_i (ji,jj,jl) = a_i (ji,jj,jl) * ( 1._wp - ( 1._wp - rn_amax_2d(ji,jj) / at_i(ji,jj) ) )
	99	oa_i(ji,jj,jl) = oa_i(ji,jj,jl) * ( 1._wp - ( 1._wp - rn_amax_2d(ji,jj) / at_i(ji,jj) ) )
[4688]	100	ENDIF
[4045]	101	END DO
	102	END DO
	103	END DO
[4688]	104
[4045]	105	!---------------------
[5123]	106	! Ice salinity
[4045]	107	!---------------------
[5123]	108	IF ( nn_icesal == 2 ) THEN
[4045]	109	DO jl = 1, jpl
[4688]	110	DO jj = 1, jpj
	111	DO ji = 1, jpi
	112	zsal = smv_i(ji,jj,jl)
	113	! salinity stays in bounds
[5123]	114	rswitch = 1._wp - MAX( 0._wp, SIGN( 1._wp, - v_i(ji,jj,jl) ) )
[5134]	115	smv_i(ji,jj,jl) = rswitch * MAX( MIN( rn_simax * v_i(ji,jj,jl), smv_i(ji,jj,jl) ), rn_simin * v_i(ji,jj,jl) )
[4688]	116	! associated salt flux
	117	sfx_res(ji,jj) = sfx_res(ji,jj) - ( smv_i(ji,jj,jl) - zsal ) * rhoic * r1_rdtice
[5134]	118	END DO
	119	END DO
	120	END DO
[4045]	121	ENDIF
	122
[5167]	123	!----------------------------------------------------
	124	! Rebin categories with thickness out of bounds
	125	!----------------------------------------------------
	126	IF ( jpl > 1 ) CALL lim_itd_th_reb( 1, jpl )
	127
	128	!-----------------
	129	! zap small values
	130	!-----------------
	131	CALL lim_var_zapsmall
	132
[4045]	133	!------------------------------------------------------------------------------
[5123]	134	! Corrections to avoid wrong values \|
[4045]	135	!------------------------------------------------------------------------------
	136	! Ice drift
	137	!------------
	138	DO jj = 2, jpjm1
[4072]	139	DO ji = 2, jpim1
[4688]	140	IF ( at_i(ji,jj) == 0._wp ) THEN ! what to do if there is no ice
	141	IF ( at_i(ji+1,jj) == 0._wp ) u_ice(ji,jj) = 0._wp ! right side
	142	IF ( at_i(ji-1,jj) == 0._wp ) u_ice(ji-1,jj) = 0._wp ! left side
	143	IF ( at_i(ji,jj+1) == 0._wp ) v_ice(ji,jj) = 0._wp ! upper side
	144	IF ( at_i(ji,jj-1) == 0._wp ) v_ice(ji,jj-1) = 0._wp ! bottom side
[4045]	145	ENDIF
	146	END DO
	147	END DO
[4072]	148	!lateral boundary conditions
	149	CALL lbc_lnk( u_ice(:,:), 'U', -1. )
	150	CALL lbc_lnk( v_ice(:,:), 'V', -1. )
[4045]	151	!mask velocities
[5123]	152	u_ice(:,:) = u_ice(:,:) * umask(:,:,1)
	153	v_ice(:,:) = v_ice(:,:) * vmask(:,:,1)
[4045]	154
[4688]	155	! -------------------------------------------------
	156	! Diagnostics
	157	! -------------------------------------------------
[5123]	158	DO jl = 1, jpl
[5202]	159	oa_i(:,:,jl) = oa_i(:,:,jl) + a_i(:,:,jl) * rdt_ice / rday ! ice natural aging
[5123]	160	afx_thd(:,:) = afx_thd(:,:) + ( a_i(:,:,jl) - a_i_b(:,:,jl) ) * r1_rdtice
	161	END DO
	162	afx_tot = afx_thd + afx_dyn
[4688]	163
	164	DO jj = 1, jpj
	165	DO ji = 1, jpi
[5167]	166	! heat content variation (W.m-2)
	167	diag_heat(ji,jj) = diag_heat(ji,jj) - &
	168	& ( SUM( e_i(ji,jj,1:nlay_i,:) - e_i_b(ji,jj,1:nlay_i,:) ) + &
	169	& SUM( e_s(ji,jj,1:nlay_s,:) - e_s_b(ji,jj,1:nlay_s,:) ) &
	170	& ) * r1_rdtice
	171	! salt, volume
	172	diag_smvi(ji,jj) = diag_smvi(ji,jj) + SUM( smv_i(ji,jj,:) - smv_i_b(ji,jj,:) ) * rhoic * r1_rdtice
	173	diag_vice(ji,jj) = diag_vice(ji,jj) + SUM( v_i (ji,jj,:) - v_i_b (ji,jj,:) ) * rhoic * r1_rdtice
	174	diag_vsnw(ji,jj) = diag_vsnw(ji,jj) + SUM( v_s (ji,jj,:) - v_s_b (ji,jj,:) ) * rhosn * r1_rdtice
[4045]	175	END DO
	176	END DO
	177
[5167]	178	! conservation test
	179	IF( ln_limdiahsb ) CALL lim_cons_hsm(1, 'limupdate2', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b)
	180
[5410]	181	! necessary calls (at least for coupling)
[5167]	182	CALL lim_var_glo2eqv
	183	CALL lim_var_agg(2)
	184
[5123]	185	! -------------------------------------------------
	186	! control prints
	187	! -------------------------------------------------
[5128]	188	IF( ln_icectl ) CALL lim_prt( kt, iiceprt, jiceprt, 2, ' - Final state - ' ) ! control print
[4045]	189
	190	IF(ln_ctl) THEN ! Control print
	191	CALL prt_ctl_info(' ')
	192	CALL prt_ctl_info(' - Cell values : ')
	193	CALL prt_ctl_info(' ~~~~~~~~~~~~~ ')
[5123]	194	CALL prt_ctl(tab2d_1=e12t , clinfo1=' lim_update2 : cell area :')
[4045]	195	CALL prt_ctl(tab2d_1=at_i , clinfo1=' lim_update2 : at_i :')
	196	CALL prt_ctl(tab2d_1=vt_i , clinfo1=' lim_update2 : vt_i :')
	197	CALL prt_ctl(tab2d_1=vt_s , clinfo1=' lim_update2 : vt_s :')
	198	CALL prt_ctl(tab2d_1=strength , clinfo1=' lim_update2 : strength :')
	199	CALL prt_ctl(tab2d_1=u_ice , clinfo1=' lim_update2 : u_ice :', tab2d_2=v_ice , clinfo2=' v_ice :')
[4872]	200	CALL prt_ctl(tab2d_1=u_ice_b , clinfo1=' lim_update2 : u_ice_b :', tab2d_2=v_ice_b , clinfo2=' v_ice_b :')
[4045]	201
	202	DO jl = 1, jpl
	203	CALL prt_ctl_info(' ')
	204	CALL prt_ctl_info(' - Category : ', ivar1=jl)
	205	CALL prt_ctl_info(' ~~~~~~~~~~')
	206	CALL prt_ctl(tab2d_1=ht_i (:,:,jl) , clinfo1= ' lim_update2 : ht_i : ')
	207	CALL prt_ctl(tab2d_1=ht_s (:,:,jl) , clinfo1= ' lim_update2 : ht_s : ')
	208	CALL prt_ctl(tab2d_1=t_su (:,:,jl) , clinfo1= ' lim_update2 : t_su : ')
	209	CALL prt_ctl(tab2d_1=t_s (:,:,1,jl) , clinfo1= ' lim_update2 : t_snow : ')
	210	CALL prt_ctl(tab2d_1=sm_i (:,:,jl) , clinfo1= ' lim_update2 : sm_i : ')
	211	CALL prt_ctl(tab2d_1=o_i (:,:,jl) , clinfo1= ' lim_update2 : o_i : ')
	212	CALL prt_ctl(tab2d_1=a_i (:,:,jl) , clinfo1= ' lim_update2 : a_i : ')
[4872]	213	CALL prt_ctl(tab2d_1=a_i_b (:,:,jl) , clinfo1= ' lim_update2 : a_i_b : ')
[4045]	214	CALL prt_ctl(tab2d_1=v_i (:,:,jl) , clinfo1= ' lim_update2 : v_i : ')
[4872]	215	CALL prt_ctl(tab2d_1=v_i_b (:,:,jl) , clinfo1= ' lim_update2 : v_i_b : ')
[4045]	216	CALL prt_ctl(tab2d_1=v_s (:,:,jl) , clinfo1= ' lim_update2 : v_s : ')
[4872]	217	CALL prt_ctl(tab2d_1=v_s_b (:,:,jl) , clinfo1= ' lim_update2 : v_s_b : ')
[5123]	218	CALL prt_ctl(tab2d_1=e_i (:,:,1,jl) , clinfo1= ' lim_update2 : e_i1 : ')
	219	CALL prt_ctl(tab2d_1=e_i_b (:,:,1,jl) , clinfo1= ' lim_update2 : e_i1_b : ')
	220	CALL prt_ctl(tab2d_1=e_i (:,:,2,jl) , clinfo1= ' lim_update2 : e_i2 : ')
	221	CALL prt_ctl(tab2d_1=e_i_b (:,:,2,jl) , clinfo1= ' lim_update2 : e_i2_b : ')
[4045]	222	CALL prt_ctl(tab2d_1=e_s (:,:,1,jl) , clinfo1= ' lim_update2 : e_snow : ')
[4872]	223	CALL prt_ctl(tab2d_1=e_s_b (:,:,1,jl) , clinfo1= ' lim_update2 : e_snow_b : ')
[4045]	224	CALL prt_ctl(tab2d_1=smv_i (:,:,jl) , clinfo1= ' lim_update2 : smv_i : ')
[4872]	225	CALL prt_ctl(tab2d_1=smv_i_b (:,:,jl) , clinfo1= ' lim_update2 : smv_i_b : ')
[4045]	226	CALL prt_ctl(tab2d_1=oa_i (:,:,jl) , clinfo1= ' lim_update2 : oa_i : ')
[4872]	227	CALL prt_ctl(tab2d_1=oa_i_b (:,:,jl) , clinfo1= ' lim_update2 : oa_i_b : ')
[4045]	228
	229	DO jk = 1, nlay_i
	230	CALL prt_ctl_info(' - Layer : ', ivar1=jk)
	231	CALL prt_ctl(tab2d_1=t_i(:,:,jk,jl) , clinfo1= ' lim_update2 : t_i : ')
	232	END DO
	233	END DO
	234
	235	CALL prt_ctl_info(' ')
	236	CALL prt_ctl_info(' - Heat / FW fluxes : ')
	237	CALL prt_ctl_info(' ~~~~~~~~~~~~~~~~~~ ')
	238	CALL prt_ctl(tab2d_1=sst_m , clinfo1= ' lim_update2 : sst : ', tab2d_2=sss_m , clinfo2= ' sss : ')
	239
	240	CALL prt_ctl_info(' ')
	241	CALL prt_ctl_info(' - Stresses : ')
	242	CALL prt_ctl_info(' ~~~~~~~~~~ ')
	243	CALL prt_ctl(tab2d_1=utau , clinfo1= ' lim_update2 : utau : ', tab2d_2=vtau , clinfo2= ' vtau : ')
	244	CALL prt_ctl(tab2d_1=utau_ice , clinfo1= ' lim_update2 : utau_ice : ', tab2d_2=vtau_ice , clinfo2= ' vtau_ice : ')
	245	CALL prt_ctl(tab2d_1=u_oce , clinfo1= ' lim_update2 : u_oce : ', tab2d_2=v_oce , clinfo2= ' v_oce : ')
	246	ENDIF
	247
[4688]	248	IF( nn_timing == 1 ) CALL timing_stop('limupdate2')
[4045]	249
	250	END SUBROUTINE lim_update2
	251	#else
	252	!!----------------------------------------------------------------------
	253	!! Default option Empty Module No sea-ice model
	254	!!----------------------------------------------------------------------
	255	CONTAINS
	256	SUBROUTINE lim_update2 ! Empty routine
	257	END SUBROUTINE lim_update2
	258
	259	#endif
	260
	261	END MODULE limupdate2

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

Download in other formats: