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.

sbcice_lim_2.F90 in branches/2016/dev_CNRS_2016/NEMOGCM/NEMO/OPA_SRC/SBC – NEMO

Context Navigation

source: branches/2016/dev_CNRS_2016/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_lim_2.F90 @ 7280

Last change on this file since 7280 was 7280, checked in by flavoni, 7 years ago
merge CNRS2016 with aerobulk branch
Property svn:keywords set to `Id`
File size: 13.5 KB

Rev	Line
[888]	1	MODULE sbcice_lim_2
	2	!!======================================================================
	3	!! * MODULE sbcice_lim_2 *
[2528]	4	!! Surface module : update surface ocean boundary condition over ice covered area using LIM sea-ice model
	5	!! Sea-Ice model : LIM-2 Sea ice model time-stepping
[888]	6	!!======================================================================
[1218]	7	!! History : 1.0 ! 06-2006 (G. Madec) from icestp_2.F90
	8	!! 3.0 ! 08-2008 (S. Masson, E. .... ) coupled interface
[2528]	9	!! 3.3 ! 05-2009 (G.Garric) addition of the lim2_evp case
[888]	10	!!----------------------------------------------------------------------
	11	#if defined key_lim2
	12	!!----------------------------------------------------------------------
[2528]	13	!! 'key_lim2' : LIM-2 sea-ice model
[888]	14	!!----------------------------------------------------------------------
[2528]	15	!! sbc_ice_lim_2 : sea-ice model time-stepping and update ocean sbc over ice-covered area
[888]	16	!!----------------------------------------------------------------------
[2528]	17	USE oce ! ocean dynamics and tracers
	18	USE dom_oce ! ocean space and time domain
[888]	19	USE ice_2
[1270]	20	USE par_ice_2
[888]	21	USE iceini_2
	22	USE dom_ice_2
	23
[2528]	24	USE sbc_oce ! Surface boundary condition: ocean fields
	25	USE sbc_ice ! Surface boundary condition: ice fields
[7280]	26	USE sbcblk ! Surface boundary condition: bulk
[2528]	27	USE sbccpl ! Surface boundary condition: coupled interface
[888]	28	USE albedo
	29
[2528]	30	USE phycst ! Define parameters for the routines
	31	USE eosbn2 ! equation of state
[888]	32	USE limdyn_2
	33	USE limtrp_2
	34	USE limdmp_2
	35	USE limthd_2
[2528]	36	USE limsbc_2 ! sea surface boundary condition
[888]	37	USE limdia_2
	38	USE limwri_2
	39	USE limrst_2
	40
[2528]	41	USE c1d ! 1D vertical configuration
[888]	42
[2528]	43	USE lbclnk ! lateral boundary condition - MPP link
	44	USE lib_mpp ! MPP library
[3294]	45	USE wrk_nemo ! work arrays
[2528]	46	USE iom ! I/O manager library
	47	USE in_out_manager ! I/O manager
	48	USE prtctl ! Print control
	49
[3680]	50	# if defined key_agrif
	51	USE agrif_ice
	52	USE agrif_lim2_update
	53	# endif
	54
[4769]	55	#if defined key_bdy
	56	USE bdyice_lim ! unstructured open boundary data (bdy_ice_lim routine)
	57	#endif
	58
[888]	59	IMPLICIT NONE
	60	PRIVATE
	61
	62	PUBLIC sbc_ice_lim_2 ! routine called by sbcmod.F90
	63
	64	!! * Substitutions
	65	# include "vectopt_loop_substitute.h90"
	66	!!----------------------------------------------------------------------
[2528]	67	!! NEMO/OPA 3.3 , NEMO Consortium (2010)
[1146]	68	!! $Id$
[2528]	69	!! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
[888]	70	!!----------------------------------------------------------------------
	71	CONTAINS
	72
[1218]	73	SUBROUTINE sbc_ice_lim_2( kt, ksbc )
[888]	74	!!---------------------------------------------------------------------
	75	!! * ROUTINE sbc_ice_lim_2 *
	76	!!
	77	!! ** Purpose : update the ocean surface boundary condition via the
	78	!! Louvain la Neuve Sea Ice Model time stepping
	79	!!
	80	!! ** Method : ice model time stepping
	81	!! - call the ice dynamics routine
	82	!! - call the ice advection/diffusion routine
	83	!! - call the ice thermodynamics routine
	84	!! - call the routine that computes mass and
	85	!! heat fluxes at the ice/ocean interface
	86	!! - save the outputs
	87	!! - save the outputs for restart when necessary
	88	!!
	89	!! ** Action : - time evolution of the LIM sea-ice model
	90	!! - update all sbc variables below sea-ice:
[3625]	91	!! utau, vtau, taum, wndm, qns , qsr, emp , sfx
[888]	92	!!---------------------------------------------------------------------
	93	INTEGER, INTENT(in) :: kt ! ocean time step
[7280]	94	INTEGER, INTENT(in) :: ksbc ! type of sbc ( =4 bulk ; =5 coupled )
[888]	95	!!
	96	INTEGER :: ji, jj ! dummy loop indices
[4990]	97	REAL(wp), DIMENSION(:,:,:), POINTER :: zalb_os ! ice albedo under overcast sky
	98	REAL(wp), DIMENSION(:,:,:), POINTER :: zalb_cs ! ice albedo under clear sky
	99	REAL(wp), DIMENSION(:,:,:), POINTER :: zalb_ice ! mean ice albedo
	100	REAL(wp), DIMENSION(:,:,:), POINTER :: zsist ! ice surface temperature (K)
[5407]	101	REAL(wp), DIMENSION(:,: ), POINTER :: zutau_ice, zvtau_ice
[888]	102	!!----------------------------------------------------------------------
	103
	104	IF( kt == nit000 ) THEN
	105	IF(lwp) WRITE(numout,*)
	106	IF(lwp) WRITE(numout,*) 'sbc_ice_lim_2 : update ocean surface boudary condition'
	107	IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~ via Louvain la Neuve Ice Model (LIM) time stepping'
[2528]	108	!
[888]	109	CALL ice_init_2
[3680]	110	!
	111	# if defined key_agrif
	112	IF( .NOT. Agrif_Root() ) CALL Agrif_InitValues_cont_lim2 ! AGRIF: set the meshes
	113	# endif
[888]	114	ENDIF
	115
[2528]	116	! !----------------------!
	117	IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN ! Ice time-step only !
	118	! !----------------------!
[3680]	119	# if defined key_agrif
	120	IF( .NOT. Agrif_Root() ) lim_nbstep = MOD(lim_nbstep,Agrif_rhot()&
	121	&*Agrif_PArent(nn_fsbc)/REAL(nn_fsbc)) + 1
	122	# endif
[5407]	123
	124	CALL wrk_alloc( jpi,jpj , zutau_ice, zvtau_ice)
	125	CALL wrk_alloc( jpi,jpj,1, zalb_os, zalb_cs, zalb_ice, zsist )
	126
[2528]	127	! Bulk Formulea !
	128	!----------------!
[888]	129	! ... mean surface ocean current at ice dynamics point
[2528]	130	SELECT CASE( cp_ice_msh )
	131	CASE( 'I' ) !== B-grid ice dynamics : I-point (i.e. F-point with sea-ice indexation)
	132	DO jj = 2, jpj
	133	DO ji = 2, jpi ! NO vector opt. possible
[4990]	134	u_oce(ji,jj) = 0.5_wp * ( ssu_m(ji-1,jj ) * umask(ji-1,jj ,1) &
[5407]	135	& + ssu_m(ji-1,jj-1) * umask(ji-1,jj-1,1) ) * tmu(ji,jj)
[4990]	136	v_oce(ji,jj) = 0.5_wp * ( ssv_m(ji ,jj-1) * vmask(ji ,jj-1,1) &
[5407]	137	& + ssv_m(ji-1,jj-1) * vmask(ji-1,jj-1,1) ) * tmu(ji,jj)
[2528]	138	END DO
[888]	139	END DO
[2528]	140	CALL lbc_lnk( u_oce, 'I', -1. ) ! I-point (i.e. F-point with ice indices)
	141	CALL lbc_lnk( v_oce, 'I', -1. ) ! I-point (i.e. F-point with ice indices)
	142	!
	143	CASE( 'C' ) !== C-grid ice dynamics : U & V-points (same as ocean)
[4990]	144	u_oce(:,:) = ssu_m(:,:) * umask(:,:,1) ! mean surface ocean current at ice velocity point
	145	v_oce(:,:) = ssv_m(:,:) * vmask(:,:,1)
[2528]	146	!
	147	END SELECT
[888]	148
	149	! ... masked sea surface freezing temperature [Kelvin] (set to rt0 over land)
[5541]	150	CALL eos_fzp( sss_m(:,:), tfu(:,:) )
	151	tfu(:,:) = tfu(:,:) + rt0
[888]	152
[1109]	153	zsist (:,:,1) = sist (:,:) + rt0 * ( 1. - tmask(:,:,1) )
[888]	154
[4990]	155	! Ice albedo
	156
[2715]	157	CALL albedo_ice( zsist, reshape( hicif, (/jpi,jpj,1/) ), &
	158	reshape( hsnif, (/jpi,jpj,1/) ), &
[4990]	159	zalb_cs, zalb_os )
[888]	160
[4990]	161	SELECT CASE( ksbc )
[7280]	162	CASE( jp_blk , jp_purecpl ) ! BULK and COUPLED bulk formulations
[4990]	163
	164	! albedo depends on cloud fraction because of non-linear spectral effects
	165	zalb_ice(:,:,:) = ( 1. - cldf_ice ) * zalb_cs(:,:,:) + cldf_ice * zalb_os(:,:,:)
	166
	167	END SELECT
	168
[888]	169	! ... Sea-ice surface boundary conditions output from bulk formulae :
[1469]	170	! - utau_ice ! surface ice stress i-component (I-point) [N/m2]
	171	! - vtau_ice ! surface ice stress j-component (I-point) [N/m2]
[888]	172	! - qns_ice ! non solar heat flux over ice (T-point) [W/m2]
	173	! - qsr_ice ! solar heat flux over ice (T-point) [W/m2]
	174	! - qla_ice ! latent heat flux over ice (T-point) [W/m2]
	175	! - dqns_ice ! non solar heat sensistivity (T-point) [W/m2]
	176	! - dqla_ice ! latent heat sensistivity (T-point) [W/m2]
	177	! - tprecip ! total precipitation (T-point) [Kg/m2/s]
	178	! - sprecip ! solid precipitation (T-point) [Kg/m2/s]
	179	! - fr1_i0 ! 1sr fraction of qsr penetration in ice [%]
	180	! - fr2_i0 ! 2nd fraction of qsr penetration in ice [%]
	181	!
[1218]	182	SELECT CASE( ksbc )
[7280]	183	!
	184	CASE( jp_blk ) ! Bulk formulation
	185	CALL blk_ice_tau
	186	CALL blk_ice_flx( zsist, zalb_ice )
	187	!
[5407]	188	CASE( jp_purecpl ) ! Coupled formulation : atmosphere-ice stress only (fluxes provided after ice dynamics)
[1469]	189	CALL sbc_cpl_ice_tau( utau_ice , vtau_ice )
[7280]	190	!
[888]	191	END SELECT
[5407]	192
	193	IF( ln_mixcpl) THEN
	194	CALL sbc_cpl_ice_tau( zutau_ice , zvtau_ice )
	195	utau_ice(:,:) = utau_ice(:,:) * xcplmask(:,:,0) + zutau_ice(:,:) * ( 1. - xcplmask(:,:,0) )
	196	vtau_ice(:,:) = vtau_ice(:,:) * xcplmask(:,:,0) + zvtau_ice(:,:) * ( 1. - xcplmask(:,:,0) )
	197	ENDIF
[888]	198
[1482]	199	CALL iom_put( 'utau_ice', utau_ice ) ! Wind stress over ice along i-axis at I-point
	200	CALL iom_put( 'vtau_ice', vtau_ice ) ! Wind stress over ice along j-axis at I-point
	201
[888]	202	IF(ln_ctl) THEN ! print mean trends (used for debugging)
	203	CALL prt_ctl_info( 'Ice Forcings ' )
[1469]	204	CALL prt_ctl( tab2d_1=tprecip ,clinfo1=' sbc_ice_lim: precip : ', tab2d_2=sprecip , clinfo2=' Snow : ' )
	205	CALL prt_ctl( tab2d_1=utau_ice,clinfo1=' sbc_ice_lim: utau_ice: ', tab2d_2=vtau_ice, clinfo2=' vtau_ice: ' )
	206	CALL prt_ctl( tab2d_1=sst_m ,clinfo1=' sbc_ice_lim: sst : ', tab2d_2=sss_m , clinfo2=' sss : ' )
[1470]	207	CALL prt_ctl( tab2d_1=u_oce ,clinfo1=' sbc_ice_lim: u_io : ', tab2d_2=v_oce , clinfo2=' v_io : ' )
[1469]	208	CALL prt_ctl( tab2d_1=hsnif ,clinfo1=' sbc_ice_lim: hsnif 1: ', tab2d_2=hicif , clinfo2=' hicif : ' )
	209	CALL prt_ctl( tab2d_1=frld ,clinfo1=' sbc_ice_lim: frld 1: ', tab2d_2=sist , clinfo2=' sist : ' )
[888]	210	ENDIF
	211
	212	! ---------------- !
	213	! Ice model step !
	214	! ---------------- !
[2528]	215	numit = numit + nn_fsbc ! Ice model time step
[1239]	216
[2528]	217	CALL lim_rst_opn_2 ( kt ) ! Open Ice restart file
	218	IF( .NOT. lk_c1d ) THEN ! Ice dynamics & transport (except in 1D case)
	219	CALL lim_dyn_2 ( kt ) ! Ice dynamics ( rheology/dynamics )
	220	CALL lim_trp_2 ( kt ) ! Ice transport ( Advection/diffusion )
	221	IF( ln_limdmp ) CALL lim_dmp_2 ( kt ) ! Ice damping
[4769]	222	#if defined key_bdy
	223	CALL bdy_ice_lim( kt ) ! bdy ice thermo
	224	#endif
[2528]	225	END IF
	226	! ! Ice surface fluxes in coupled mode
[5407]	227	IF( ln_cpl ) THEN ! pure coupled and mixed forced-coupled configurations
[3294]	228	a_i(:,:,1)=fr_i
	229	CALL sbc_cpl_ice_flx( frld, &
[2715]	230	! optional arguments, used only in 'mixed oce-ice' case
[5385]	231	& palbi=zalb_ice, psst=sst_m, pist=zsist )
[3294]	232	sprecip(:,:) = - emp_ice(:,:) ! Ugly patch, WARNING, in coupled mode, sublimation included in snow (parsub = 0.)
	233	ENDIF
[2528]	234	CALL lim_thd_2 ( kt ) ! Ice thermodynamics
	235	CALL lim_sbc_flx_2 ( kt ) ! update surface ocean mass, heat & salt fluxes
[1481]	236
[4621]	237	IF( .NOT. lk_mpp )THEN
	238	IF( MOD( kt+nn_fsbc-1, ninfo ) == 0 .OR. ntmoy == 1 ) &
[2528]	239	& CALL lim_dia_2 ( kt ) ! Ice Diagnostics
[4621]	240	ENDIF
[1482]	241	# if ! defined key_iomput
[2528]	242	CALL lim_wri_2 ( kt ) ! Ice outputs
[1482]	243	# endif
[2528]	244	IF( lrst_ice ) CALL lim_rst_write_2( kt ) ! Ice restart file
[888]	245	!
[3680]	246	# if defined key_agrif && defined key_lim2
	247	IF( .NOT. Agrif_Root() ) CALL agrif_update_lim2( kt )
	248	# endif
	249	!
[5407]	250	CALL wrk_dealloc( jpi,jpj , zutau_ice, zvtau_ice)
	251	CALL wrk_dealloc( jpi,jpj,1, zalb_os, zalb_cs, zalb_ice, zsist )
	252	!
[2528]	253	ENDIF ! End sea-ice time step only
[888]	254	!
[2528]	255	! !--------------------------!
	256	! ! at all ocean time step !
	257	! !--------------------------!
	258	!
	259	! ! Update surface ocean stresses (only in ice-dynamic case)
	260	! ! otherwise the atm.-ocean stresses are used everywhere
	261	IF( ln_limdyn ) CALL lim_sbc_tau_2( kt, ub(:,:,1), vb(:,:,1) ) ! using before instantaneous surf. currents
	262	!
[888]	263	END SUBROUTINE sbc_ice_lim_2
	264
	265	#else
	266	!!----------------------------------------------------------------------
	267	!! Default option Dummy module NO LIM 2.0 sea-ice model
	268	!!----------------------------------------------------------------------
	269	CONTAINS
[1218]	270	SUBROUTINE sbc_ice_lim_2 ( kt, ksbc ) ! Dummy routine
[2715]	271	INTEGER, INTENT(in) :: kt, ksbc
[1218]	272	WRITE(,) 'sbc_ice_lim_2: You should not have seen this print! error?', kt, ksbc
[888]	273	END SUBROUTINE sbc_ice_lim_2
	274	#endif
	275
	276	!!======================================================================
	277	END MODULE sbcice_lim_2

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

Download in other formats: