Context Navigation

← Previous Revision
Latest Revision
Next Revision →
Normal
Revision Log

agrif_ice_interp.F90 @ 15554

Last change on this file since 15554 was 15548, checked in by gsamson, 3 years ago
update branch to the head of the trunk (r15547); ticket #2632
Property svn:keywords set to `Id`
File size: 20.5 KB

Rev	Line
[9596]	1	MODULE agrif_ice_interp
[7309]	2	!!=====================================================================================
[9596]	3	!! * MODULE agrif_ice_interp *
[7309]	4	!! Nesting module : interp surface ice boundary condition from a parent grid
	5	!!=====================================================================================
[9656]	6	!! History : 2.0 ! 04-2008 (F. Dupont) initial version
[7309]	7	!! 3.4 ! 09-2012 (R. Benshila, C. Herbaut) update and EVP
[9656]	8	!! 4.0 ! 2018 (C. Rousset) SI3 compatibility
[7309]	9	!!----------------------------------------------------------------------
[9570]	10	#if defined key_agrif && defined key_si3
[7309]	11	!!----------------------------------------------------------------------
[9656]	12	!! 'key_si3' SI3 sea-ice model
	13	!! 'key_agrif' AGRIF library
[7309]	14	!!----------------------------------------------------------------------
[9610]	15	!! agrif_interp_ice : interpolation of ice at "after" sea-ice time step
[13216]	16	!! interp_u_ice : atomic routine to interpolate u_ice
	17	!! interp_v_ice : atomic routine to interpolate v_ice
	18	!! interp_tra_ice : atomic routine to interpolate ice properties
[7309]	19	!!----------------------------------------------------------------------
	20	USE par_oce
	21	USE dom_oce
	22	USE sbc_oce
	23	USE ice
	24	USE agrif_ice
[13216]	25	USE agrif_oce
[9454]	26	USE phycst , ONLY: rt0
[14086]	27	USE icevar
	28	USE sbc_ice, ONLY : tn_ice
[15548]	29	USE lbclnk
	30
[7309]	31	IMPLICIT NONE
	32	PRIVATE
	33
[9610]	34	PUBLIC agrif_interp_ice ! called by agrif_user.F90
[14086]	35	PUBLIC agrif_istate_ice ! called by icerst.F90
[7309]	36
	37	!!----------------------------------------------------------------------
[10067]	38	!! NEMO/NST 4.0 , NEMO Consortium (2018)
[10069]	39	!! $Id$
[10068]	40	!! Software governed by the CeCILL license (see ./LICENSE)
[7309]	41	!!----------------------------------------------------------------------
	42
	43	CONTAINS
	44
[14086]	45	SUBROUTINE agrif_istate_ice
	46	!!-----------------------------------------------------------------------
	47	!! * ROUTINE agrif_istate_ice *
	48	!!
	49	!! ** Method : Set initial ice fields from parent grid
	50	!!
	51	!!-----------------------------------------------------------------------
	52	IF(lwp) WRITE(numout,*) ' '
	53	IF(lwp) WRITE(numout,*) 'Agrif_istate_ice : interp child ice initial state from parent'
	54	IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~~~'
	55	IF(lwp) WRITE(numout,*) ' '
	56
	57	! Set a_i, v_i, v_s, sv_i, oa_i, a_ip, v_ip, t_su, e_s, e_i:
	58	Agrif_SpecialValue = -9999.
	59	Agrif_UseSpecialValue = .TRUE.
	60	CALL Agrif_init_variable(tra_iceini_id,procname=interp_tra_ice)
	61	!
[15548]	62	CALL lbc_lnk( 'agrif_istate_ice', a_i,'T',1._wp, v_i,'T',1._wp, &
	63	& v_s,'T',1._wp, sv_i,'T',1._wp, oa_i,'T',1._wp, &
	64	& a_ip,'T',1._wp, v_ip,'T',1._wp, v_il,'T',1._wp )
	65	CALL lbc_lnk( 'agrif_istate_ice', t_su,'T',1._wp )
	66	CALL lbc_lnk( 'agrif_istate_ice', e_s,'T',1._wp )
	67	CALL lbc_lnk( 'agrif_istate_ice', e_i,'T',1._wp )
	68	!
[14086]	69	! Set u_ice, v_ice:
	70	use_sign_north = .TRUE.
	71	sign_north = -1.
[15548]	72	! JC: setting special value to -9999. with north Fold crossing
	73	! does not work probably because of the sign change.
	74	! it's likely that the same issue could occur at boundaries
	75	! but leave it as is for the time being
	76	Agrif_SpecialValue = 0._wp
[14086]	77	CALL Agrif_init_variable(u_iceini_id ,procname=interp_u_ice)
	78	CALL Agrif_init_variable(v_iceini_id ,procname=interp_v_ice)
	79	use_sign_north = .FALSE.
	80	Agrif_UseSpecialValue = .FALSE.
[15548]	81	!
	82	CALL lbc_lnk( 'agrif_istate_ice', u_ice, 'U', -1._wp, v_ice, 'V', -1._wp )
[14125]	83	!
[14086]	84	CALL ice_var_glo2eqv
[14125]	85	!
[14086]	86	END SUBROUTINE agrif_istate_ice
	87
[9610]	88	SUBROUTINE agrif_interp_ice( cd_type, kiter, kitermax )
[7309]	89	!!-----------------------------------------------------------------------
[9656]	90	!! * ROUTINE agrif_interp_ice *
[7309]	91	!!
	92	!! ** Method : simple call to atomic routines using stored values to
	93	!! fill the boundaries depending of the position of the point and
	94	!! computing factor for time interpolation
	95	!!-----------------------------------------------------------------------
[9019]	96	CHARACTER(len=1), INTENT(in ) :: cd_type
	97	INTEGER , INTENT(in ), OPTIONAL :: kiter, kitermax
[7309]	98	!!
[9019]	99	REAL(wp) :: zbeta ! local scalar
[7309]	100	!!-----------------------------------------------------------------------
	101	!
[9482]	102	IF( Agrif_Root() .OR. nn_ice==0 ) RETURN ! do not interpolate if inside Parent Grid or if child domain does not have ice
[7309]	103	!
[9019]	104	SELECT CASE( cd_type )
[7761]	105	CASE('U','V')
[9482]	106	IF( PRESENT( kiter ) ) THEN ! interpolation at the child ice sub-time step (only for ice rheology)
[9872]	107	zbeta = ( REAL(nbstep_ice) - REAL(kitermax - kiter) / REAL(kitermax) ) / &
[7761]	108	& ( Agrif_Rhot() * REAL(Agrif_Parent(nn_fsbc)) / REAL(nn_fsbc) )
[9482]	109	ELSE ! interpolation at the child ice time step
[9872]	110	zbeta = REAL(nbstep_ice) / ( Agrif_Rhot() * REAL(Agrif_Parent(nn_fsbc)) / REAL(nn_fsbc) )
[7761]	111	ENDIF
	112	CASE('T')
[9872]	113	zbeta = REAL(nbstep_ice) / ( Agrif_Rhot() * REAL(Agrif_Parent(nn_fsbc)) / REAL(nn_fsbc) )
[7761]	114	END SELECT
[7309]	115	!
[9019]	116	Agrif_SpecialValue = -9999.
[7309]	117	Agrif_UseSpecialValue = .TRUE.
[13216]	118
	119	use_sign_north = .TRUE.
	120	sign_north = -1.
	121	if (cd_type == 'T') use_sign_north = .FALSE.
	122
[9019]	123	SELECT CASE( cd_type )
	124	CASE('U') ; CALL Agrif_Bc_variable( u_ice_id , procname=interp_u_ice , calledweight=zbeta )
	125	CASE('V') ; CALL Agrif_Bc_variable( v_ice_id , procname=interp_v_ice , calledweight=zbeta )
	126	CASE('T') ; CALL Agrif_Bc_variable( tra_ice_id, procname=interp_tra_ice, calledweight=zbeta )
[7309]	127	END SELECT
[9019]	128	Agrif_SpecialValue = 0._wp
[7309]	129	Agrif_UseSpecialValue = .FALSE.
[13216]	130
	131	use_sign_north = .FALSE.
[7309]	132	!
[9610]	133	END SUBROUTINE agrif_interp_ice
[7309]	134
[9019]	135
[7309]	136	SUBROUTINE interp_u_ice( ptab, i1, i2, j1, j2, before )
	137	!!-----------------------------------------------------------------------
	138	!! * ROUTINE interp_u_ice *
	139	!!
	140	!! i1 i2 j1 j2 are the index of the boundaries parent(when before) and child (when after)
[9019]	141	!! To solve issues when parent grid is "land" masked but not all the corresponding child
	142	!! grid points, put Agrif_SpecialValue WHERE the parent grid is masked.
	143	!! The child solution will be found in the 9(?) points around
[7309]	144	!!-----------------------------------------------------------------------
[9019]	145	INTEGER , INTENT(in ) :: i1, i2, j1, j2
	146	REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: ptab
	147	LOGICAL , INTENT(in ) :: before
[7309]	148	!!
[9019]	149	REAL(wp) :: zrhoy ! local scalar
[7309]	150	!!-----------------------------------------------------------------------
	151	!
	152	IF( before ) THEN ! parent grid
[15548]	153	ptab(i1:i2,j1:j2) = e2u(i1:i2,j1:j2) * u_ice(i1:i2,j1:j2)
[9019]	154	WHERE( umask(i1:i2,j1:j2,1) == 0. ) ptab(i1:i2,j1:j2) = Agrif_SpecialValue
[7309]	155	ELSE ! child grid
	156	zrhoy = Agrif_Rhoy()
[9019]	157	u_ice(i1:i2,j1:j2) = ptab(i1:i2,j1:j2) / ( e2u(i1:i2,j1:j2) * zrhoy ) * umask(i1:i2,j1:j2,1)
[7309]	158	ENDIF
	159	!
	160	END SUBROUTINE interp_u_ice
	161
	162
	163	SUBROUTINE interp_v_ice( ptab, i1, i2, j1, j2, before )
	164	!!-----------------------------------------------------------------------
	165	!! * ROUTINE interp_v_ice *
	166	!!
	167	!! i1 i2 j1 j2 are the index of the boundaries parent(when before) and child (when after)
[9019]	168	!! To solve issues when parent grid is "land" masked but not all the corresponding child
	169	!! grid points, put Agrif_SpecialValue WHERE the parent grid is masked.
	170	!! The child solution will be found in the 9(?) points around
[7309]	171	!!-----------------------------------------------------------------------
[9019]	172	INTEGER , INTENT(in ) :: i1, i2, j1, j2
	173	REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: ptab
	174	LOGICAL , INTENT(in ) :: before
[7309]	175	!!
[9019]	176	REAL(wp) :: zrhox ! local scalar
[7309]	177	!!-----------------------------------------------------------------------
	178	!
	179	IF( before ) THEN ! parent grid
[15548]	180	ptab(i1:i2,j1:j2) = e1v(i1:i2,j1:j2) * v_ice(i1:i2,j1:j2)
[9019]	181	WHERE( vmask(i1:i2,j1:j2,1) == 0. ) ptab(i1:i2,j1:j2) = Agrif_SpecialValue
[7309]	182	ELSE ! child grid
	183	zrhox = Agrif_Rhox()
[9019]	184	v_ice(i1:i2,j1:j2) = ptab(i1:i2,j1:j2) / ( e1v(i1:i2,j1:j2) * zrhox ) * vmask(i1:i2,j1:j2,1)
[7309]	185	ENDIF
	186	!
	187	END SUBROUTINE interp_v_ice
	188
	189
	190	SUBROUTINE interp_tra_ice( ptab, i1, i2, j1, j2, k1, k2, before, nb, ndir )
	191	!!-----------------------------------------------------------------------
	192	!! * ROUTINE interp_tra_ice *
	193	!!
	194	!! i1 i2 j1 j2 are the index of the boundaries parent(when before) and child (when after)
[9019]	195	!! To solve issues when parent grid is "land" masked but not all the corresponding child
	196	!! grid points, put Agrif_SpecialValue WHERE the parent grid is masked.
	197	!! The child solution will be found in the 9(?) points around
[7309]	198	!!-----------------------------------------------------------------------
[9019]	199	REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: ptab
	200	INTEGER , INTENT(in ) :: i1, i2, j1, j2, k1, k2
	201	LOGICAL , INTENT(in ) :: before
	202	INTEGER , INTENT(in ) :: nb, ndir
[7309]	203	!!
	204	INTEGER :: ji, jj, jk, jl, jm
	205	INTEGER :: imin, imax, jmin, jmax
[9019]	206	LOGICAL :: western_side, eastern_side, northern_side, southern_side
[7309]	207	REAL(wp) :: zrhox, z1, z2, z3, z4, z5, z6, z7
[9019]	208	REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: ztab
[7309]	209	!!-----------------------------------------------------------------------
[9019]	210	! tracers are not multiplied by grid cell here => before: * e1e2t ; after: * r1_e1e2t / rhox / rhoy
[7761]	211	! and it is ok since we conserve tracers (same as in the ocean).
[9019]	212	ALLOCATE( ztab(SIZE(a_i,1),SIZE(a_i,2),SIZE(ptab,3)) )
[13216]	213
[7309]	214	IF( before ) THEN ! parent grid
	215	jm = 1
	216	DO jl = 1, jpl
[9160]	217	ptab(i1:i2,j1:j2,jm ) = a_i (i1:i2,j1:j2,jl)
	218	ptab(i1:i2,j1:j2,jm+1) = v_i (i1:i2,j1:j2,jl)
	219	ptab(i1:i2,j1:j2,jm+2) = v_s (i1:i2,j1:j2,jl)
	220	ptab(i1:i2,j1:j2,jm+3) = sv_i(i1:i2,j1:j2,jl)
	221	ptab(i1:i2,j1:j2,jm+4) = oa_i(i1:i2,j1:j2,jl)
[9167]	222	ptab(i1:i2,j1:j2,jm+5) = a_ip(i1:i2,j1:j2,jl)
	223	ptab(i1:i2,j1:j2,jm+6) = v_ip(i1:i2,j1:j2,jl)
[13472]	224	ptab(i1:i2,j1:j2,jm+7) = v_il(i1:i2,j1:j2,jl)
	225	ptab(i1:i2,j1:j2,jm+8) = t_su(i1:i2,j1:j2,jl)
	226	jm = jm + 9
[7309]	227	DO jk = 1, nlay_s
[9160]	228	ptab(i1:i2,j1:j2,jm) = e_s(i1:i2,j1:j2,jk,jl) ; jm = jm + 1
[9019]	229	END DO
[7309]	230	DO jk = 1, nlay_i
[9160]	231	ptab(i1:i2,j1:j2,jm) = e_i(i1:i2,j1:j2,jk,jl) ; jm = jm + 1
[9019]	232	END DO
	233	END DO
[7309]	234
	235	DO jk = k1, k2
[9019]	236	WHERE( tmask(i1:i2,j1:j2,1) == 0._wp ) ptab(i1:i2,j1:j2,jk) = Agrif_SpecialValue
	237	END DO
	238	!
[7309]	239	ELSE ! child grid
[9019]	240	!
[9454]	241	! IF( nbghostcells > 1 ) THEN ! ==> The easiest interpolation is used
[9019]	242	!
	243	jm = 1
	244	DO jl = 1, jpl
	245	!
	246	DO jj = j1, j2
	247	DO ji = i1, i2
	248	a_i (ji,jj,jl) = ptab(ji,jj,jm ) * tmask(ji,jj,1)
	249	v_i (ji,jj,jl) = ptab(ji,jj,jm+1) * tmask(ji,jj,1)
	250	v_s (ji,jj,jl) = ptab(ji,jj,jm+2) * tmask(ji,jj,1)
	251	sv_i(ji,jj,jl) = ptab(ji,jj,jm+3) * tmask(ji,jj,1)
	252	oa_i(ji,jj,jl) = ptab(ji,jj,jm+4) * tmask(ji,jj,1)
[9167]	253	a_ip(ji,jj,jl) = ptab(ji,jj,jm+5) * tmask(ji,jj,1)
	254	v_ip(ji,jj,jl) = ptab(ji,jj,jm+6) * tmask(ji,jj,1)
[13472]	255	v_il(ji,jj,jl) = ptab(ji,jj,jm+7) * tmask(ji,jj,1)
	256	t_su(ji,jj,jl) = ptab(ji,jj,jm+8) * tmask(ji,jj,1)
[9019]	257	END DO
	258	END DO
[13472]	259	jm = jm + 9
[9019]	260	!
	261	DO jk = 1, nlay_s
[9482]	262	e_s(i1:i2,j1:j2,jk,jl) = ptab(i1:i2,j1:j2,jm) * tmask(i1:i2,j1:j2,1)
[9019]	263	jm = jm + 1
	264	END DO
	265	!
	266	DO jk = 1, nlay_i
[9482]	267	e_i(i1:i2,j1:j2,jk,jl) = ptab(i1:i2,j1:j2,jm) * tmask(i1:i2,j1:j2,1)
[9019]	268	jm = jm + 1
	269	END DO
	270	!
	271	END DO
	272	!
[9454]	273	!!==> clem: this interpolation does not work because it creates negative values, due
[9482]	274	!! to negative coefficients when mixing points (for ex. z7)
[9454]	275	!!
	276	! ELSE ! ==> complex interpolation (only one ghost cell available)
	277	! !! Use a more complex interpolation since we mix solutions over a couple of grid points
	278	! !! it is advised to use it for fields modified by high order schemes (e.g. advection UM5...)
	279	! ! record ztab
	280	! jm = 1
	281	! DO jl = 1, jpl
	282	! ztab(:,:,jm ) = a_i (:,:,jl)
	283	! ztab(:,:,jm+1) = v_i (:,:,jl)
	284	! ztab(:,:,jm+2) = v_s (:,:,jl)
	285	! ztab(:,:,jm+3) = sv_i(:,:,jl)
	286	! ztab(:,:,jm+4) = oa_i(:,:,jl)
	287	! ztab(:,:,jm+5) = a_ip(:,:,jl)
	288	! ztab(:,:,jm+6) = v_ip(:,:,jl)
[13472]	289	! ztab(:,:,jm+7) = v_il(:,:,jl)
	290	! ztab(:,:,jm+8) = t_su(:,:,jl)
	291	! jm = jm + 9
[9454]	292	! DO jk = 1, nlay_s
	293	! ztab(:,:,jm) = e_s(:,:,jk,jl)
	294	! jm = jm + 1
	295	! END DO
	296	! DO jk = 1, nlay_i
	297	! ztab(:,:,jm) = e_i(:,:,jk,jl)
	298	! jm = jm + 1
	299	! END DO
	300	! !
	301	! END DO
	302	! !
	303	! ! borders of the domain
	304	! western_side = (nb == 1).AND.(ndir == 1) ; eastern_side = (nb == 1).AND.(ndir == 2)
	305	! southern_side = (nb == 2).AND.(ndir == 1) ; northern_side = (nb == 2).AND.(ndir == 2)
	306	! !
	307	! ! spatial smoothing
	308	! zrhox = Agrif_Rhox()
	309	! z1 = ( zrhox - 1. ) * 0.5
	310	! z3 = ( zrhox - 1. ) / ( zrhox + 1. )
	311	! z6 = 2. * ( zrhox - 1. ) / ( zrhox + 1. )
	312	! z7 = - ( zrhox - 1. ) / ( zrhox + 3. )
	313	! z2 = 1. - z1
	314	! z4 = 1. - z3
	315	! z5 = 1. - z6 - z7
	316	! !
	317	! ! Remove corners
	318	! imin = i1 ; imax = i2 ; jmin = j1 ; jmax = j2
	319	! IF( (nbondj == -1) .OR. (nbondj == 2) ) jmin = 3
[13286]	320	! IF( (nbondj == +1) .OR. (nbondj == 2) ) jmax = jpj-2
[9454]	321	! IF( (nbondi == -1) .OR. (nbondi == 2) ) imin = 3
[13286]	322	! IF( (nbondi == +1) .OR. (nbondi == 2) ) imax = jpi-2
[9454]	323	!
	324	! ! smoothed fields
	325	! IF( eastern_side ) THEN
[13286]	326	! ztab(jpi,j1:j2,:) = z1 * ptab(jpi,j1:j2,:) + z2 * ptab(jpi-1,j1:j2,:)
[9454]	327	! DO jj = jmin, jmax
	328	! rswitch = 0.
[13286]	329	! IF( u_ice(jpi-2,jj) > 0._wp ) rswitch = 1.
	330	! ztab(jpi-1,jj,:) = ( 1. - umask(jpi-2,jj,1) ) * ztab(jpi,jj,:) &
	331	! & + umask(jpi-2,jj,1) * &
	332	! & ( (1. - rswitch) * ( z4 * ztab(jpi ,jj,:) + z3 * ztab(jpi-2,jj,:) ) &
	333	! & + rswitch * ( z6 * ztab(jpi-2,jj,:) + z5 * ztab(jpi ,jj,:) + z7 * ztab(jpi-3,jj,:) ) )
	334	! ztab(jpi-1,jj,:) = ztab(jpi-1,jj,:) * tmask(jpi-1,jj,1)
[9454]	335	! END DO
	336	! ENDIF
	337	! !
	338	! IF( northern_side ) THEN
[13286]	339	! ztab(i1:i2,jpj,:) = z1 * ptab(i1:i2,jpj,:) + z2 * ptab(i1:i2,jpj-1,:)
[9454]	340	! DO ji = imin, imax
	341	! rswitch = 0.
[13286]	342	! IF( v_ice(ji,jpj-2) > 0._wp ) rswitch = 1.
	343	! ztab(ji,jpj-1,:) = ( 1. - vmask(ji,jpj-2,1) ) * ztab(ji,jpj,:) &
	344	! & + vmask(ji,jpj-2,1) * &
	345	! & ( (1. - rswitch) * ( z4 * ztab(ji,jpj ,:) + z3 * ztab(ji,jpj-2,:) ) &
	346	! & + rswitch * ( z6 * ztab(ji,jpj-2,:) + z5 * ztab(ji,jpj ,:) + z7 * ztab(ji,jpj-3,:) ) )
	347	! ztab(ji,jpj-1,:) = ztab(ji,jpj-1,:) * tmask(ji,jpj-1,1)
[9454]	348	! END DO
	349	! END IF
	350	! !
	351	! IF( western_side) THEN
	352	! ztab(1,j1:j2,:) = z1 * ptab(1,j1:j2,:) + z2 * ptab(2,j1:j2,:)
	353	! DO jj = jmin, jmax
	354	! rswitch = 0.
	355	! IF( u_ice(2,jj) < 0._wp ) rswitch = 1.
	356	! ztab(2,jj,:) = ( 1. - umask(2,jj,1) ) * ztab(1,jj,:) &
	357	! & + umask(2,jj,1) * &
	358	! & ( ( 1. - rswitch ) * ( z4 * ztab(1,jj,:) + z3 * ztab(3,jj,:) ) &
	359	! & + rswitch * ( z6 * ztab(3,jj,:) + z5 * ztab(1,jj,:) + z7 * ztab(4,jj,:) ) )
	360	! ztab(2,jj,:) = ztab(2,jj,:) * tmask(2,jj,1)
	361	! END DO
	362	! ENDIF
	363	! !
	364	! IF( southern_side ) THEN
	365	! ztab(i1:i2,1,:) = z1 * ptab(i1:i2,1,:) + z2 * ptab(i1:i2,2,:)
	366	! DO ji = imin, imax
	367	! rswitch = 0.
	368	! IF( v_ice(ji,2) < 0._wp ) rswitch = 1.
	369	! ztab(ji,2,:) = ( 1. - vmask(ji,2,1) ) * ztab(ji,1,:) &
	370	! & + vmask(ji,2,1) * &
	371	! & ( ( 1. - rswitch ) * ( z4 * ztab(ji,1,:) + z3 * ztab(ji,3,:) ) &
	372	! & + rswitch * ( z6 * ztab(ji,3,:) + z5 * ztab(ji,1,:) + z7 * ztab(ji,4,:) ) )
	373	! ztab(ji,2,:) = ztab(ji,2,:) * tmask(ji,2,1)
	374	! END DO
	375	! END IF
	376	! !
	377	! ! Treatment of corners
[13286]	378	! IF( (eastern_side) .AND. ((nbondj == -1).OR.(nbondj == 2)) ) ztab(jpi-1,2 ,:) = ptab(jpi-1, 2,:) ! East south
	379	! IF( (eastern_side) .AND. ((nbondj == 1).OR.(nbondj == 2)) ) ztab(jpi-1,jpj-1,:) = ptab(jpi-1,jpj-1,:) ! East north
	380	! IF( (western_side) .AND. ((nbondj == -1).OR.(nbondj == 2)) ) ztab( 2, 2,:) = ptab( 2, 2,:) ! West south
	381	! IF( (western_side) .AND. ((nbondj == 1).OR.(nbondj == 2)) ) ztab( 2,jpj-1,:) = ptab( 2,jpj-1,:) ! West north
[9454]	382	!
	383	! ! retrieve ice tracers
	384	! jm = 1
	385	! DO jl = 1, jpl
	386	! !
	387	! DO jj = j1, j2
	388	! DO ji = i1, i2
	389	! a_i (ji,jj,jl) = ztab(ji,jj,jm ) * tmask(ji,jj,1)
	390	! v_i (ji,jj,jl) = ztab(ji,jj,jm+1) * tmask(ji,jj,1)
	391	! v_s (ji,jj,jl) = ztab(ji,jj,jm+2) * tmask(ji,jj,1)
	392	! sv_i(ji,jj,jl) = ztab(ji,jj,jm+3) * tmask(ji,jj,1)
	393	! oa_i(ji,jj,jl) = ztab(ji,jj,jm+4) * tmask(ji,jj,1)
	394	! a_ip(ji,jj,jl) = ztab(ji,jj,jm+5) * tmask(ji,jj,1)
	395	! v_ip(ji,jj,jl) = ztab(ji,jj,jm+6) * tmask(ji,jj,1)
[13472]	396	! v_il(ji,jj,jl) = ztab(ji,jj,jm+7) * tmask(ji,jj,1)
	397	! t_su(ji,jj,jl) = ztab(ji,jj,jm+8) * tmask(ji,jj,1)
[9454]	398	! END DO
	399	! END DO
[13472]	400	! jm = jm + 9
[9454]	401	! !
	402	! DO jk = 1, nlay_s
	403	! e_s(i1:i2,j1:j2,jk,jl) = ztab(i1:i2,j1:j2,jm) * tmask(i1:i2,j1:j2,1)
	404	! jm = jm + 1
	405	! END DO
	406	! !
	407	! DO jk = 1, nlay_i
	408	! e_i(i1:i2,j1:j2,jk,jl) = ztab(i1:i2,j1:j2,jm) * tmask(i1:i2,j1:j2,1)
	409	! jm = jm + 1
	410	! END DO
	411	! !
	412	! END DO
	413	!
	414	! ENDIF ! nbghostcells=1
[9019]	415
[9454]	416	DO jl = 1, jpl
	417	WHERE( tmask(i1:i2,j1:j2,1) == 0._wp ) t_su(i1:i2,j1:j2,jl) = rt0 ! to avoid a division by 0 in sbcblk.F90
	418	END DO
	419	!
[7309]	420	ENDIF
	421
	422	DEALLOCATE( ztab )
	423	!
	424	END SUBROUTINE interp_tra_ice
	425
	426	#else
[9019]	427	!!----------------------------------------------------------------------
	428	!! Empty module no sea-ice
	429	!!----------------------------------------------------------------------
[7309]	430	CONTAINS
[9596]	431	SUBROUTINE agrif_ice_interp_empty
	432	WRITE(,) 'agrif_ice_interp : You should not have seen this print! error?'
	433	END SUBROUTINE agrif_ice_interp_empty
[7309]	434	#endif
[9019]	435
	436	!!======================================================================
[9596]	437	END MODULE agrif_ice_interp

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

New URL for NEMO forge! http://forge.nemo-ocean.eu

Context Navigation

source: NEMO/branches/2021/ticket2632_r14588_theta_sbcblk/src/NST/agrif_ice_interp.F90 @ 15554

Download in other formats: