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.

agrif_oce_sponge.F90 in NEMO/branches/2020/dev_r13296_HPC-07_mocavero_mpi3/src/NST – NEMO

Context Navigation

source: NEMO/branches/2020/dev_r13296_HPC-07_mocavero_mpi3/src/NST/agrif_oce_sponge.F90 @ 13630

Last change on this file since 13630 was 13630, checked in by mocavero, 4 years ago
Add neighborhood collectives calls in the NEMO src - ticket #2496
Property svn:keywords set to `Id`
File size: 34.2 KB

Rev	Line
[3680]	1	#define SPONGE && define SPONGE_TOP
[390]	2
[9570]	3	MODULE agrif_oce_sponge
[6140]	4	!!======================================================================
[9570]	5	!! * MODULE agrif_oce_interp *
[9019]	6	!! AGRIF: sponge package for the ocean dynamics (OPA)
[6140]	7	!!======================================================================
[9019]	8	!! History : 2.0 ! 2002-06 (XXX) Original cade
	9	!! - ! 2005-11 (XXX)
	10	!! 3.2 ! 2009-04 (R. Benshila)
	11	!! 3.6 ! 2014-09 (R. Benshila)
[6140]	12	!!----------------------------------------------------------------------
[7646]	13	#if defined key_agrif
[9019]	14	!!----------------------------------------------------------------------
	15	!! 'key_agrif' AGRIF zoom
	16	!!----------------------------------------------------------------------
[636]	17	USE par_oce
	18	USE oce
	19	USE dom_oce
[9019]	20	!
[636]	21	USE in_out_manager
[782]	22	USE agrif_oce
[5656]	23	USE lbclnk ! ocean lateral boundary conditions (or mpp link)
[12377]	24	USE iom
	25	USE vremap
[390]	26
[636]	27	IMPLICIT NONE
	28	PRIVATE
[390]	29
[5656]	30	PUBLIC Agrif_Sponge, Agrif_Sponge_Tra, Agrif_Sponge_Dyn
	31	PUBLIC interptsn_sponge, interpun_sponge, interpvn_sponge
[390]	32
[12377]	33	!! * Substitutions
	34	# include "do_loop_substitute.h90"
[1156]	35	!!----------------------------------------------------------------------
[9598]	36	!! NEMO/NST 4.0 , NEMO Consortium (2018)
[1156]	37	!! $Id$
[10068]	38	!! Software governed by the CeCILL license (see ./LICENSE)
[1156]	39	!!----------------------------------------------------------------------
[5656]	40	CONTAINS
[636]	41
[782]	42	SUBROUTINE Agrif_Sponge_Tra
[9019]	43	!!----------------------------------------------------------------------
	44	!! * ROUTINE Agrif_Sponge_Tra *
	45	!!----------------------------------------------------------------------
	46	REAL(wp) :: zcoef ! local scalar
[9056]	47
[9019]	48	!!----------------------------------------------------------------------
[6140]	49	!
[390]	50	#if defined SPONGE
[9031]	51	!! Assume persistence:
[9056]	52	zcoef = REAL(Agrif_rhot()-1,wp)/REAL(Agrif_rhot())
[9031]	53
[5656]	54	CALL Agrif_Sponge
[9019]	55	Agrif_SpecialValue = 0._wp
[390]	56	Agrif_UseSpecialValue = .TRUE.
[9019]	57	tabspongedone_tsn = .FALSE.
	58	!
	59	CALL Agrif_Bc_Variable( tsn_sponge_id, calledweight=zcoef, procname=interptsn_sponge )
	60	!
[5656]	61	Agrif_UseSpecialValue = .FALSE.
[390]	62	#endif
[6140]	63	!
[12377]	64	CALL iom_put( 'agrif_spu', fspu(:,:))
	65	CALL iom_put( 'agrif_spv', fspv(:,:))
	66	!
[636]	67	END SUBROUTINE Agrif_Sponge_Tra
[390]	68
[6140]	69
[782]	70	SUBROUTINE Agrif_Sponge_dyn
[9019]	71	!!----------------------------------------------------------------------
	72	!! * ROUTINE Agrif_Sponge_dyn *
	73	!!----------------------------------------------------------------------
	74	REAL(wp) :: zcoef ! local scalar
	75	!!----------------------------------------------------------------------
	76	!
[390]	77	#if defined SPONGE
[9056]	78	zcoef = REAL(Agrif_rhot()-1,wp)/REAL(Agrif_rhot())
[9031]	79
[13286]	80	Agrif_SpecialValue = 0._wp
[782]	81	Agrif_UseSpecialValue = ln_spc_dyn
[13286]	82	use_sign_north = .TRUE.
	83	sign_north = -1._wp
[9019]	84	!
[5656]	85	tabspongedone_u = .FALSE.
	86	tabspongedone_v = .FALSE.
[9019]	87	CALL Agrif_Bc_Variable( un_sponge_id, calledweight=zcoef, procname=interpun_sponge )
	88	!
[5656]	89	tabspongedone_u = .FALSE.
	90	tabspongedone_v = .FALSE.
[9019]	91	CALL Agrif_Bc_Variable( vn_sponge_id, calledweight=zcoef, procname=interpvn_sponge )
	92	!
[390]	93	Agrif_UseSpecialValue = .FALSE.
[13286]	94	use_sign_north = .FALSE.
[390]	95	#endif
[6140]	96	!
[12377]	97	CALL iom_put( 'agrif_spt', fspt(:,:))
	98	CALL iom_put( 'agrif_spf', fspf(:,:))
	99	!
[636]	100	END SUBROUTINE Agrif_Sponge_dyn
[390]	101
[6140]	102
[3680]	103	SUBROUTINE Agrif_Sponge
[9019]	104	!!----------------------------------------------------------------------
	105	!! * ROUTINE Agrif_Sponge *
	106	!!----------------------------------------------------------------------
	107	INTEGER :: ji, jj, ind1, ind2
[12377]	108	INTEGER :: ispongearea, jspongearea
	109	REAL(wp) :: z1_ispongearea, z1_jspongearea
[9019]	110	REAL(wp), DIMENSION(jpi,jpj) :: ztabramp
[13286]	111	#if defined key_vertical
	112	REAL(wp), DIMENSION(jpi,jpj) :: ztabrampu
	113	REAL(wp), DIMENSION(jpi,jpj) :: ztabrampv
	114	#endif
[12377]	115	REAL(wp), DIMENSION(jpjmax) :: zmskwest, zmskeast
	116	REAL(wp), DIMENSION(jpimax) :: zmsknorth, zmsksouth
[9019]	117	!!----------------------------------------------------------------------
	118	!
[12377]	119	! Sponge 1d example with:
	120	! iraf = 3 ; nbghost = 3 ; nn_sponge_len = 2
	121	!
	122	!coarse : U T U T U T U
	123	!\| \| \| \| \|
	124	!fine : t u t u t u t u t u t u t u t u t u t u t
	125	!sponge val:0 0 0 1 5/6 4/6 3/6 2/6 1/6 0 0
	126	! \| ghost \| <-- sponge area -- > \|
	127	! \| points \| \|
	128	! \|--> dynamical interface
	129
[3680]	130	#if defined SPONGE \|\| defined SPONGE_TOP
[4153]	131	IF (( .NOT. spongedoneT ).OR.( .NOT. spongedoneU )) THEN
[12377]	132	!
	133	! Retrieve masks at open boundaries:
	134
[13286]	135	IF( lk_west ) THEN ! --- West --- !
[13216]	136	ztabramp(:,:) = 0._wp
[13286]	137	ind1 = nn_hls + 1 + nbghostcells ! halo + land + nbghostcells
[13216]	138	DO ji = mi0(ind1), mi1(ind1)
	139	ztabramp(ji,:) = ssumask(ji,:)
	140	END DO
[13286]	141	zmskwest( 1:jpj ) = MAXVAL(ztabramp(:,:), dim=1)
	142	zmskwest(jpj+1:jpjmax) = 0._wp
[13216]	143	ENDIF
[13286]	144	IF( lk_east ) THEN ! --- East --- !
[13216]	145	ztabramp(:,:) = 0._wp
[13286]	146	ind1 = jpiglo - ( nn_hls + nbghostcells + 1) ! halo + land + nbghostcells
[13216]	147	DO ji = mi0(ind1), mi1(ind1)
	148	ztabramp(ji,:) = ssumask(ji,:)
	149	END DO
[13286]	150	zmskeast( 1:jpj ) = MAXVAL(ztabramp(:,:), dim=1)
	151	zmskeast(jpj+1:jpjmax) = 0._wp
[13216]	152	ENDIF
[13286]	153	IF( lk_south ) THEN ! --- South --- !
[13216]	154	ztabramp(:,:) = 0._wp
[13286]	155	ind1 = nn_hls + 1 + nbghostcells ! halo + land + nbghostcells
[13216]	156	DO jj = mj0(ind1), mj1(ind1)
	157	ztabramp(:,jj) = ssvmask(:,jj)
	158	END DO
[13286]	159	zmsksouth( 1:jpi ) = MAXVAL(ztabramp(:,:), dim=2)
	160	zmsksouth(jpi+1:jpimax) = 0._wp
[13216]	161	ENDIF
[13286]	162	IF( lk_north ) THEN ! --- North --- !
[13216]	163	ztabramp(:,:) = 0._wp
[13286]	164	ind1 = jpjglo - ( nn_hls + nbghostcells + 1) ! halo + land + nbghostcells
[13216]	165	DO jj = mj0(ind1), mj1(ind1)
	166	ztabramp(:,jj) = ssvmask(:,jj)
	167	END DO
[13286]	168	zmsknorth( 1:jpi ) = MAXVAL(ztabramp(:,:), dim=2)
	169	zmsknorth(jpi+1:jpimax) = 0._wp
[13216]	170	ENDIF
	171
[12377]	172	! JC: SPONGE MASKING TO BE SORTED OUT:
	173	zmskwest(:) = 1._wp
	174	zmskeast(:) = 1._wp
[13286]	175	zmsksouth(:) = 1._wp
[12377]	176	zmsknorth(:) = 1._wp
	177	#if defined key_mpp_mpi
	178	! CALL mpp_max( 'AGRIF_sponge', zmskwest(:) , jpjmax )
	179	! CALL mpp_max( 'AGRIF_Sponge', zmskeast(:) , jpjmax )
	180	! CALL mpp_max( 'AGRIF_Sponge', zmsksouth(:), jpimax )
	181	! CALL mpp_max( 'AGRIF_Sponge', zmsknorth(:), jpimax )
	182	#endif
	183
[9019]	184	! Define ramp from boundaries towards domain interior at T-points
[4153]	185	! Store it in ztabramp
[3680]	186
[13286]	187	ispongearea = nn_sponge_len * Agrif_irhox()
	188	z1_ispongearea = 1._wp / REAL( ispongearea, wp )
	189	jspongearea = nn_sponge_len * Agrif_irhoy()
	190	z1_jspongearea = 1._wp / REAL( jspongearea, wp )
[9019]	191
[5656]	192	ztabramp(:,:) = 0._wp
[4153]	193
[12377]	194	! Trick to remove sponge in 2DV domains:
	195	IF ( nbcellsx <= 3 ) ispongearea = -1
	196	IF ( nbcellsy <= 3 ) jspongearea = -1
	197
[13286]	198	IF( lk_west ) THEN ! --- West --- !
	199	ind1 = nn_hls + 1 + nbghostcells ! halo + land + nbghostcells
	200	ind2 = nn_hls + 1 + nbghostcells + ispongearea
[13216]	201	DO ji = mi0(ind1), mi1(ind2)
	202	DO jj = 1, jpj
[13286]	203	ztabramp(ji,jj) = REAL(ind2 - mig(ji), wp) * z1_ispongearea * zmskwest(jj)
[13216]	204	END DO
[13286]	205	END DO
[13216]	206	! ghost cells:
	207	ind1 = 1
[13286]	208	ind2 = nn_hls + 1 + nbghostcells ! halo + land + nbghostcells
[13216]	209	DO ji = mi0(ind1), mi1(ind2)
	210	DO jj = 1, jpj
	211	ztabramp(ji,jj) = zmskwest(jj)
	212	END DO
[12377]	213	END DO
[13216]	214	ENDIF
[13286]	215	IF( lk_east ) THEN ! --- East --- !
	216	ind1 = jpiglo - ( nn_hls + nbghostcells ) - ispongearea
	217	ind2 = jpiglo - ( nn_hls + nbghostcells ) ! halo + land + nbghostcells - 1
[13216]	218	DO ji = mi0(ind1), mi1(ind2)
	219	DO jj = 1, jpj
[13286]	220	ztabramp(ji,jj) = MAX( ztabramp(ji,jj), REAL(mig(ji) - ind1, wp) * z1_ispongearea ) * zmskeast(jj)
	221	END DO
[13216]	222	END DO
	223	! ghost cells:
[13286]	224	ind1 = jpiglo - ( nn_hls + nbghostcells ) ! halo + land + nbghostcells - 1
[13216]	225	ind2 = jpiglo
	226	DO ji = mi0(ind1), mi1(ind2)
	227	DO jj = 1, jpj
	228	ztabramp(ji,jj) = zmskeast(jj)
[13286]	229	END DO
[13216]	230	END DO
[13286]	231	ENDIF
	232	IF( lk_south ) THEN ! --- South --- !
	233	ind1 = nn_hls + 1 + nbghostcells ! halo + land + nbghostcells
	234	ind2 = nn_hls + 1 + nbghostcells + jspongearea
[13216]	235	DO jj = mj0(ind1), mj1(ind2)
	236	DO ji = 1, jpi
[13286]	237	ztabramp(ji,jj) = MAX( ztabramp(ji,jj), REAL(ind2 - mjg(jj), wp) * z1_jspongearea ) * zmsksouth(ji)
[13216]	238	END DO
[12377]	239	END DO
[13216]	240	! ghost cells:
	241	ind1 = 1
[13286]	242	ind2 = nn_hls + 1 + nbghostcells ! halo + land + nbghostcells
[13216]	243	DO jj = mj0(ind1), mj1(ind2)
	244	DO ji = 1, jpi
	245	ztabramp(ji,jj) = zmsksouth(ji)
	246	END DO
[12377]	247	END DO
[13216]	248	ENDIF
[13286]	249	IF( lk_north ) THEN ! --- North --- !
	250	ind1 = jpjglo - ( nn_hls + nbghostcells ) - jspongearea
	251	ind2 = jpjglo - ( nn_hls + nbghostcells ) ! halo + land + nbghostcells - 1
[13216]	252	DO jj = mj0(ind1), mj1(ind2)
	253	DO ji = 1, jpi
[13286]	254	ztabramp(ji,jj) = MAX( ztabramp(ji,jj), REAL(mjg(jj) - ind1, wp) * z1_jspongearea ) * zmsknorth(ji)
[13216]	255	END DO
[12377]	256	END DO
[13216]	257	! ghost cells:
[13286]	258	ind1 = jpjglo - ( nn_hls + nbghostcells ) ! halo + land + nbghostcells - 1
[13216]	259	ind2 = jpjglo
	260	DO jj = mj0(ind1), mj1(ind2)
	261	DO ji = 1, jpi
	262	ztabramp(ji,jj) = zmsknorth(ji)
	263	END DO
[12377]	264	END DO
[13216]	265	ENDIF
[13286]	266	!
[4153]	267	ENDIF
	268
[3680]	269	! Tracers
	270	IF( .NOT. spongedoneT ) THEN
[12377]	271	fspu(:,:) = 0._wp
	272	fspv(:,:) = 0._wp
[13295]	273	DO_2D( 0, 0, 0, 0 )
[12377]	274	fspu(ji,jj) = 0.5_wp * ( ztabramp(ji,jj) + ztabramp(ji+1,jj ) ) * ssumask(ji,jj)
	275	fspv(ji,jj) = 0.5_wp * ( ztabramp(ji,jj) + ztabramp(ji ,jj+1) ) * ssvmask(ji,jj)
	276	END_2D
[3680]	277	ENDIF
	278
	279	! Dynamics
	280	IF( .NOT. spongedoneU ) THEN
[12377]	281	fspt(:,:) = 0._wp
	282	fspf(:,:) = 0._wp
[13295]	283	DO_2D( 0, 0, 0, 0 )
[12377]	284	fspt(ji,jj) = ztabramp(ji,jj) * ssmask(ji,jj)
	285	fspf(ji,jj) = 0.25_wp * ( ztabramp(ji ,jj ) + ztabramp(ji ,jj+1) &
	286	& +ztabramp(ji+1,jj+1) + ztabramp(ji+1,jj ) ) &
	287	& * ssvmask(ji,jj) * ssvmask(ji,jj+1)
	288	END_2D
[13286]	289	ENDIF
	290
	291	IF( .NOT. spongedoneT .AND. .NOT. spongedoneU ) THEN
[13630]	292	#if defined key_mpi3
	293	CALL lbc_lnk_nc_multi( 'agrif_Sponge', fspu, 'U', 1._wp, fspv, 'V', 1._wp, fspt, 'T', 1._wp, fspf, 'F', 1._wp )
	294	#else
[13286]	295	CALL lbc_lnk_multi( 'agrif_Sponge', fspu, 'U', 1._wp, fspv, 'V', 1._wp, fspt, 'T', 1._wp, fspf, 'F', 1._wp )
[13630]	296	#endif
[13286]	297	spongedoneT = .TRUE.
[3680]	298	spongedoneU = .TRUE.
	299	ENDIF
[13286]	300	IF( .NOT. spongedoneT ) THEN
[13630]	301	#if defined key_mpi3
	302	CALL lbc_lnk_nc_multi( 'agrif_Sponge', fspu, 'U', 1._wp, fspv, 'V', 1._wp )
	303	#else
[13286]	304	CALL lbc_lnk_multi( 'agrif_Sponge', fspu, 'U', 1._wp, fspv, 'V', 1._wp )
[13630]	305	#endif
[13286]	306	spongedoneT = .TRUE.
	307	ENDIF
	308	IF( .NOT. spongedoneT .AND. .NOT. spongedoneU ) THEN
[13630]	309	#if defined key_mpi3
	310	CALL lbc_lnk_nc_multi( 'agrif_Sponge', fspt, 'T', 1._wp, fspf, 'F', 1._wp )
	311	#else
[13286]	312	CALL lbc_lnk_multi( 'agrif_Sponge', fspt, 'T', 1._wp, fspf, 'F', 1._wp )
[13630]	313	#endif
[13286]	314	spongedoneU = .TRUE.
	315	ENDIF
[12377]	316
	317	#if defined key_vertical
	318	! Remove vertical interpolation where not needed:
[13295]	319	DO_2D( 0, 0, 0, 0 )
[12377]	320	IF ((fspu(ji-1,jj)==0._wp).AND.(fspu(ji,jj)==0._wp).AND. &
	321	& (fspv(ji,jj-1)==0._wp).AND.(fspv(ji,jj)==0._wp)) mbkt_parent(ji,jj) = 0
	322	!
	323	IF ((fspt(ji+1,jj)==0._wp).AND.(fspt(ji,jj)==0._wp).AND. &
	324	& (fspf(ji,jj-1)==0._wp).AND.(fspf(ji,jj)==0._wp)) mbku_parent(ji,jj) = 0
	325	!
	326	IF ((fspt(ji,jj+1)==0._wp).AND.(fspt(ji,jj)==0._wp).AND. &
	327	& (fspf(ji-1,jj)==0._wp).AND.(fspf(ji,jj)==0._wp)) mbkv_parent(ji,jj) = 0
	328	!
	329	IF ( ssmask(ji,jj) == 0._wp) mbkt_parent(ji,jj) = 0
	330	IF (ssumask(ji,jj) == 0._wp) mbku_parent(ji,jj) = 0
	331	IF (ssvmask(ji,jj) == 0._wp) mbkv_parent(ji,jj) = 0
	332	END_2D
[3680]	333	!
[13571]	334	ztabramp (:,:) = REAL( mbkt_parent(:,:), wp )
	335	ztabrampu(:,:) = REAL( mbku_parent(:,:), wp )
	336	ztabrampv(:,:) = REAL( mbkv_parent(:,:), wp )
[13630]	337	#if defined key_mpi3
	338	CALL lbc_lnk_nc_multi( 'Agrif_Sponge', ztabramp, 'T', 1._wp, ztabrampu, 'U', 1._wp, ztabrampv, 'V', 1._wp )
	339	#else
[13286]	340	CALL lbc_lnk_multi( 'Agrif_Sponge', ztabramp, 'T', 1._wp, ztabrampu, 'U', 1._wp, ztabrampv, 'V', 1._wp )
[13630]	341	#endif
[13286]	342	mbkt_parent(:,:) = NINT( ztabramp (:,:) )
	343	mbku_parent(:,:) = NINT( ztabrampu(:,:) )
	344	mbkv_parent(:,:) = NINT( ztabrampv(:,:) )
[3680]	345	#endif
[6140]	346	!
[12377]	347	#endif
	348	!
[3680]	349	END SUBROUTINE Agrif_Sponge
	350
[13286]	351
[9019]	352	SUBROUTINE interptsn_sponge( tabres, i1, i2, j1, j2, k1, k2, n1, n2, before )
	353	!!----------------------------------------------------------------------
	354	!! * ROUTINE interptsn_sponge *
	355	!!----------------------------------------------------------------------
	356	INTEGER , INTENT(in ) :: i1, i2, j1, j2, k1, k2, n1, n2
	357	REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2), INTENT(inout) :: tabres
	358	LOGICAL , INTENT(in ) :: before
[6140]	359	!
[5656]	360	INTEGER :: ji, jj, jk, jn ! dummy loop indices
	361	INTEGER :: iku, ikv
[13216]	362	REAL(wp) :: ztsa, zabe1, zabe2, zbtr, zhtot
[9031]	363	REAL(wp), DIMENSION(i1:i2,j1:j2,jpk) :: ztu, ztv
	364	REAL(wp), DIMENSION(i1:i2,j1:j2,jpk,n1:n2) ::tsbdiff
	365	! vertical interpolation:
	366	REAL(wp), DIMENSION(i1:i2,j1:j2,jpk,n1:n2) ::tabres_child
	367	REAL(wp), DIMENSION(k1:k2,n1:n2-1) :: tabin
	368	REAL(wp), DIMENSION(k1:k2) :: h_in
	369	REAL(wp), DIMENSION(1:jpk) :: h_out
	370	INTEGER :: N_in, N_out
[9019]	371	!!----------------------------------------------------------------------
[5656]	372	!
[6140]	373	IF( before ) THEN
[9031]	374	DO jn = 1, jpts
	375	DO jk=k1,k2
	376	DO jj=j1,j2
	377	DO ji=i1,i2
[12377]	378	tabres(ji,jj,jk,jn) = ts(ji,jj,jk,jn,Kbb_a)
[9031]	379	END DO
	380	END DO
	381	END DO
	382	END DO
	383
	384	# if defined key_vertical
[12377]	385	! Interpolate thicknesses
	386	! Warning: these are masked, hence extrapolated prior interpolation.
	387	DO jk=k1,k2
	388	DO jj=j1,j2
	389	DO ji=i1,i2
	390	tabres(ji,jj,jk,jpts+1) = tmask(ji,jj,jk) * e3t(ji,jj,jk,Kbb_a)
	391	END DO
	392	END DO
	393	END DO
	394
	395	! Extrapolate thicknesses in partial bottom cells:
	396	! Set them to Agrif_SpecialValue (0.). Correct bottom thicknesses are retrieved later on
	397	IF (ln_zps) THEN
	398	DO jj=j1,j2
	399	DO ji=i1,i2
	400	jk = mbkt(ji,jj)
	401	tabres(ji,jj,jk,jpts+1) = 0._wp
	402	END DO
	403	END DO
	404	END IF
	405
	406	! Save ssh at last level:
	407	IF (.NOT.ln_linssh) THEN
	408	tabres(i1:i2,j1:j2,k2,jpts+1) = ssh(i1:i2,j1:j2,Kbb_a)*tmask(i1:i2,j1:j2,1)
	409	ELSE
	410	tabres(i1:i2,j1:j2,k2,jpts+1) = 0._wp
	411	END IF
[9031]	412	# endif
	413
[5656]	414	ELSE
[6140]	415	!
[9031]	416	# if defined key_vertical
[12377]	417
	418	IF (ln_linssh) tabres(i1:i2,j1:j2,k2,n2) = 0._wp
	419
[9031]	420	DO jj=j1,j2
	421	DO ji=i1,i2
[12377]	422	tabres_child(ji,jj,:,:) = 0._wp
	423	N_in = mbkt_parent(ji,jj)
	424	zhtot = 0._wp
	425	DO jk=1,N_in !k2 = jpk of parent grid
	426	IF (jk==N_in) THEN
	427	h_in(jk) = ht0_parent(ji,jj) + tabres(ji,jj,k2,n2) - zhtot
	428	ELSE
	429	h_in(jk) = tabres(ji,jj,jk,n2)
	430	ENDIF
	431	zhtot = zhtot + h_in(jk)
[9031]	432	tabin(jk,:) = tabres(ji,jj,jk,n1:n2-1)
	433	END DO
	434	N_out = 0
	435	DO jk=1,jpk ! jpk of child grid
	436	IF (tmask(ji,jj,jk) == 0) EXIT
	437	N_out = N_out + 1
[12377]	438	h_out(jk) = e3t(ji,jj,jk,Kbb_a) !Child grid scale factors. Could multiply by e1e2t here instead of division above
[13286]	439	END DO
[12377]	440
	441	! Account for small differences in free-surface
	442	IF ( sum(h_out(1:N_out)) > sum(h_in(1:N_in) )) THEN
	443	h_out(1) = h_out(1) - ( sum(h_out(1:N_out))-sum(h_in(1:N_in)) )
	444	ELSE
	445	h_in(1) = h_in(1) - (sum(h_in(1:N_in))-sum(h_out(1:N_out)) )
[9031]	446	ENDIF
[12377]	447	IF (N_in*N_out > 0) THEN
	448	CALL reconstructandremap(tabin(1:N_in,1:jpts),h_in(1:N_in),tabres_child(ji,jj,1:N_out,1:jpts),h_out(1:N_out),N_in,N_out,jpts)
	449	ENDIF
[13286]	450	END DO
	451	END DO
[9031]	452	# endif
	453
	454	DO jj=j1,j2
	455	DO ji=i1,i2
	456	DO jk=1,jpkm1
	457	# if defined key_vertical
[12377]	458	tsbdiff(ji,jj,jk,1:jpts) = (ts(ji,jj,jk,1:jpts,Kbb_a) - tabres_child(ji,jj,jk,1:jpts)) * tmask(ji,jj,jk)
[9031]	459	# else
[12377]	460	tsbdiff(ji,jj,jk,1:jpts) = (ts(ji,jj,jk,1:jpts,Kbb_a) - tabres(ji,jj,jk,1:jpts))*tmask(ji,jj,jk)
[9031]	461	# endif
[13286]	462	END DO
	463	END DO
	464	END DO
[9031]	465
[5656]	466	DO jn = 1, jpts
	467	DO jk = 1, jpkm1
[9806]	468	ztu(i1:i2,j1:j2,jk) = 0._wp
	469	DO jj = j1,j2
[5656]	470	DO ji = i1,i2-1
[13216]	471	zabe1 = rn_sponge_tra * r1_Dt * fspu(ji,jj) * umask(ji,jj,jk) * e1e2u(ji,jj) * e3u(ji,jj,jk,Kmm_a)
[9806]	472	ztu(ji,jj,jk) = zabe1 * ( tsbdiff(ji+1,jj ,jk,jn) - tsbdiff(ji,jj,jk,jn) )
	473	END DO
	474	END DO
	475	ztv(i1:i2,j1:j2,jk) = 0._wp
	476	DO ji = i1,i2
	477	DO jj = j1,j2-1
[13216]	478	zabe2 = rn_sponge_tra * r1_Dt * fspv(ji,jj) * vmask(ji,jj,jk) * e1e2v(ji,jj) * e3v(ji,jj,jk,Kmm_a)
[5656]	479	ztv(ji,jj,jk) = zabe2 * ( tsbdiff(ji ,jj+1,jk,jn) - tsbdiff(ji,jj,jk,jn) )
[6140]	480	END DO
	481	END DO
	482	!
[5656]	483	IF( ln_zps ) THEN ! set gradient at partial step level
[9806]	484	DO jj = j1,j2
	485	DO ji = i1,i2
[5656]	486	! last level
	487	iku = mbku(ji,jj)
	488	ikv = mbkv(ji,jj)
[6140]	489	IF( iku == jk ) ztu(ji,jj,jk) = 0._wp
	490	IF( ikv == jk ) ztv(ji,jj,jk) = 0._wp
[5656]	491	END DO
	492	END DO
	493	ENDIF
[6140]	494	END DO
	495	!
[5656]	496	DO jk = 1, jpkm1
	497	DO jj = j1+1,j2-1
	498	DO ji = i1+1,i2-1
	499	IF (.NOT. tabspongedone_tsn(ji,jj)) THEN
[12377]	500	zbtr = r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kmm_a)
[5656]	501	! horizontal diffusive trends
[12377]	502	ztsa = zbtr * ( ztu(ji,jj,jk) - ztu(ji-1,jj,jk) + ztv(ji,jj,jk) - ztv(ji,jj-1,jk) ) &
[13216]	503	& - rn_trelax_tra * r1_Dt * fspt(ji,jj) * tsbdiff(ji,jj,jk,jn)
[5656]	504	! add it to the general tracer trends
[12377]	505	ts(ji,jj,jk,jn,Krhs_a) = ts(ji,jj,jk,jn,Krhs_a) + ztsa
[5656]	506	ENDIF
[6140]	507	END DO
	508	END DO
	509	END DO
	510	!
	511	END DO
	512	!
[5656]	513	tabspongedone_tsn(i1+1:i2-1,j1+1:j2-1) = .TRUE.
[6140]	514	!
[5656]	515	ENDIF
[6140]	516	!
[5656]	517	END SUBROUTINE interptsn_sponge
	518
[13286]	519
[9031]	520	SUBROUTINE interpun_sponge(tabres,i1,i2,j1,j2,k1,k2,m1,m2, before)
	521	!!---------------------------------------------
	522	!! * ROUTINE interpun_sponge *
	523	!!---------------------------------------------
	524	INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2,m1,m2
	525	REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2,m1:m2), INTENT(inout) :: tabres
	526	LOGICAL, INTENT(in) :: before
[6140]	527
[13286]	528	INTEGER :: ji,jj,jk,jmax
	529	INTEGER :: ind1
[5656]	530	! sponge parameters
[13216]	531	REAL(wp) :: ze2u, ze1v, zua, zva, zbtr, zhtot
[9031]	532	REAL(wp), DIMENSION(i1:i2,j1:j2,1:jpk) :: ubdiff
	533	REAL(wp), DIMENSION(i1:i2,j1:j2,1:jpk) :: rotdiff, hdivdiff
	534	! vertical interpolation:
	535	REAL(wp), DIMENSION(i1:i2,j1:j2,1:jpk) :: tabres_child
	536	REAL(wp), DIMENSION(k1:k2) :: tabin, h_in
	537	REAL(wp), DIMENSION(1:jpk) :: h_out
[12377]	538	INTEGER ::N_in, N_out
[9031]	539	!!---------------------------------------------
[5656]	540	!
[6140]	541	IF( before ) THEN
[12377]	542	DO jk=k1,k2
[9031]	543	DO jj=j1,j2
	544	DO ji=i1,i2
[12377]	545	tabres(ji,jj,jk,m1) = uu(ji,jj,jk,Kbb_a)
[9031]	546	# if defined key_vertical
[12377]	547	tabres(ji,jj,jk,m2) = e3u(ji,jj,jk,Kbb_a)*umask(ji,jj,jk)
[9031]	548	# endif
	549	END DO
	550	END DO
	551	END DO
	552
[12377]	553	# if defined key_vertical
	554	! Extrapolate thicknesses in partial bottom cells:
	555	! Set them to Agrif_SpecialValue (0.). Correct bottom thicknesses are retrieved later on
	556	IF (ln_zps) THEN
	557	DO jj=j1,j2
	558	DO ji=i1,i2
	559	jk = mbku(ji,jj)
	560	tabres(ji,jj,jk,m2) = 0._wp
	561	END DO
	562	END DO
	563	END IF
	564	! Save ssh at last level:
	565	tabres(i1:i2,j1:j2,k2,m2) = 0._wp
	566	IF (.NOT.ln_linssh) THEN
	567	! This vertical sum below should be replaced by the sea-level at U-points (optimization):
	568	DO jk=1,jpk
	569	tabres(i1:i2,j1:j2,k2,m2) = tabres(i1:i2,j1:j2,k2,m2) + e3u(i1:i2,j1:j2,jk,Kbb_a) * umask(i1:i2,j1:j2,jk)
	570	END DO
	571	tabres(i1:i2,j1:j2,k2,m2) = tabres(i1:i2,j1:j2,k2,m2) - hu_0(i1:i2,j1:j2)
	572	END IF
	573	# endif
	574
[5656]	575	ELSE
[9031]	576
	577	# if defined key_vertical
[12377]	578	IF (ln_linssh) tabres(i1:i2,j1:j2,k2,m2) = 0._wp
	579
[9031]	580	DO jj=j1,j2
	581	DO ji=i1,i2
[12377]	582	tabres_child(ji,jj,:) = 0._wp
	583	N_in = mbku_parent(ji,jj)
	584	zhtot = 0._wp
	585	DO jk=1,N_in
	586	IF (jk==N_in) THEN
	587	h_in(jk) = hu0_parent(ji,jj) + tabres(ji,jj,k2,m2) - zhtot
	588	ELSE
	589	h_in(jk) = tabres(ji,jj,jk,m2)
	590	ENDIF
	591	zhtot = zhtot + h_in(jk)
[9031]	592	tabin(jk) = tabres(ji,jj,jk,m1)
[13286]	593	END DO
[12377]	594	!
	595	N_out = 0
	596	DO jk=1,jpk
	597	IF (umask(ji,jj,jk) == 0) EXIT
	598	N_out = N_out + 1
	599	h_out(N_out) = e3u(ji,jj,jk,Kbb_a)
[13286]	600	END DO
[12377]	601
	602	! Account for small differences in free-surface
	603	IF ( sum(h_out(1:N_out)) > sum(h_in(1:N_in) )) THEN
	604	h_out(1) = h_out(1) - ( sum(h_out(1:N_out))-sum(h_in(1:N_in)) )
	605	ELSE
	606	h_in(1) = h_in(1) - (sum(h_in(1:N_in))-sum(h_out(1:N_out)) )
	607	ENDIF
	608
	609	IF (N_in * N_out > 0) THEN
	610	CALL reconstructandremap(tabin(1:N_in),h_in(1:N_in),tabres_child(ji,jj,1:N_out),h_out(1:N_out),N_in,N_out,1)
	611	ENDIF
[13286]	612	END DO
	613	END DO
[9031]	614
[12377]	615	ubdiff(i1:i2,j1:j2,:) = (uu(i1:i2,j1:j2,:,Kbb_a) - tabres_child(i1:i2,j1:j2,:))*umask(i1:i2,j1:j2,:)
[9031]	616	#else
[12377]	617	ubdiff(i1:i2,j1:j2,:) = (uu(i1:i2,j1:j2,:,Kbb_a) - tabres(i1:i2,j1:j2,:,1))*umask(i1:i2,j1:j2,:)
[9031]	618	#endif
[6140]	619	!
[5656]	620	DO jk = 1, jpkm1 ! Horizontal slab
	621	! ! ===============
	622
	623	! ! --------
	624	! Horizontal divergence ! div
	625	! ! --------
	626	DO jj = j1,j2
	627	DO ji = i1+1,i2 ! vector opt.
[13216]	628	zbtr = rn_sponge_dyn * r1_Dt * fspt(ji,jj) / e3t(ji,jj,jk,Kbb_a)
[12377]	629	hdivdiff(ji,jj,jk) = ( e2u(ji ,jj)e3u(ji ,jj,jk,Kbb_a) ubdiff(ji ,jj,jk) &
	630	& -e2u(ji-1,jj)e3u(ji-1,jj,jk,Kbb_a) ubdiff(ji-1,jj,jk) ) * zbtr
[5656]	631	END DO
	632	END DO
	633
	634	DO jj = j1,j2-1
	635	DO ji = i1,i2 ! vector opt.
[13216]	636	zbtr = rn_sponge_dyn * r1_Dt * fspf(ji,jj) * e3f(ji,jj,jk)
[9019]	637	rotdiff(ji,jj,jk) = ( -e1u(ji,jj+1) * ubdiff(ji,jj+1,jk) &
	638	& +e1u(ji,jj ) * ubdiff(ji,jj ,jk) ) * fmask(ji,jj,jk) * zbtr
[5656]	639	END DO
	640	END DO
[6140]	641	END DO
[5656]	642	!
	643	DO jj = j1+1, j2-1
	644	DO ji = i1+1, i2-1 ! vector opt.
	645
	646	IF (.NOT. tabspongedone_u(ji,jj)) THEN
	647	DO jk = 1, jpkm1 ! Horizontal slab
	648	ze2u = rotdiff (ji,jj,jk)
	649	ze1v = hdivdiff(ji,jj,jk)
	650	! horizontal diffusive trends
[12377]	651	zua = - ( ze2u - rotdiff (ji,jj-1,jk) ) / ( e2u(ji,jj) * e3u(ji,jj,jk,Kmm_a) ) &
	652	& + ( hdivdiff(ji+1,jj,jk) - ze1v ) * r1_e1u(ji,jj) &
[13216]	653	& - rn_trelax_dyn * r1_Dt * fspu(ji,jj) * ubdiff(ji,jj,jk)
[5656]	654
	655	! add it to the general momentum trends
[12377]	656	uu(ji,jj,jk,Krhs_a) = uu(ji,jj,jk,Krhs_a) + zua
[5656]	657	END DO
	658	ENDIF
	659
	660	END DO
	661	END DO
	662
	663	tabspongedone_u(i1+1:i2-1,j1+1:j2-1) = .TRUE.
	664
	665	jmax = j2-1
[13286]	666	ind1 = jpjglo - ( nn_hls + nbghostcells + 2 ) ! North
	667	DO jj = mj0(ind1), mj1(ind1)
	668	jmax = MIN(jmax,jj)
	669	END DO
[5656]	670
	671	DO jj = j1+1, jmax
	672	DO ji = i1+1, i2 ! vector opt.
	673
	674	IF (.NOT. tabspongedone_v(ji,jj)) THEN
	675	DO jk = 1, jpkm1 ! Horizontal slab
	676	ze2u = rotdiff (ji,jj,jk)
	677	ze1v = hdivdiff(ji,jj,jk)
	678
	679	! horizontal diffusive trends
[12377]	680	zva = + ( ze2u - rotdiff (ji-1,jj,jk) ) / ( e1v(ji,jj) * e3v(ji,jj,jk,Kmm_a) ) &
[9019]	681	+ ( hdivdiff(ji,jj+1,jk) - ze1v ) * r1_e2v(ji,jj)
[5656]	682
	683	! add it to the general momentum trends
[12377]	684	vv(ji,jj,jk,Krhs_a) = vv(ji,jj,jk,Krhs_a) + zva
[5656]	685	END DO
	686	ENDIF
[6140]	687	!
[5656]	688	END DO
	689	END DO
[6140]	690	!
[5656]	691	tabspongedone_v(i1+1:i2,j1+1:jmax) = .TRUE.
[6140]	692	!
[5656]	693	ENDIF
[6140]	694	!
[5656]	695	END SUBROUTINE interpun_sponge
	696
[13286]	697
	698	SUBROUTINE interpvn_sponge(tabres,i1,i2,j1,j2,k1,k2,m1,m2, before)
[9031]	699	!!---------------------------------------------
	700	!! * ROUTINE interpvn_sponge *
	701	!!---------------------------------------------
	702	INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2,m1,m2
	703	REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2,m1:m2), INTENT(inout) :: tabres
	704	LOGICAL, INTENT(in) :: before
[6140]	705	!
[9031]	706	INTEGER :: ji, jj, jk, imax
[13286]	707	INTEGER :: ind1
[13216]	708	REAL(wp) :: ze2u, ze1v, zua, zva, zbtr, zhtot
[9031]	709	REAL(wp), DIMENSION(i1:i2,j1:j2,1:jpk) :: vbdiff
	710	REAL(wp), DIMENSION(i1:i2,j1:j2,1:jpk) :: rotdiff, hdivdiff
	711	! vertical interpolation:
	712	REAL(wp), DIMENSION(i1:i2,j1:j2,1:jpk) :: tabres_child
	713	REAL(wp), DIMENSION(k1:k2) :: tabin, h_in
	714	REAL(wp), DIMENSION(1:jpk) :: h_out
	715	INTEGER :: N_in, N_out
	716	!!---------------------------------------------
	717
[6140]	718	IF( before ) THEN
[12377]	719	DO jk=k1,k2
[9031]	720	DO jj=j1,j2
	721	DO ji=i1,i2
[12377]	722	tabres(ji,jj,jk,m1) = vv(ji,jj,jk,Kbb_a)
[9031]	723	# if defined key_vertical
[12377]	724	tabres(ji,jj,jk,m2) = vmask(ji,jj,jk) * e3v(ji,jj,jk,Kbb_a)
[9031]	725	# endif
	726	END DO
	727	END DO
	728	END DO
[12377]	729
	730	# if defined key_vertical
	731	! Extrapolate thicknesses in partial bottom cells:
	732	! Set them to Agrif_SpecialValue (0.). Correct bottom thicknesses are retrieved later on
	733	IF (ln_zps) THEN
	734	DO jj=j1,j2
	735	DO ji=i1,i2
	736	jk = mbkv(ji,jj)
	737	tabres(ji,jj,jk,m2) = 0._wp
	738	END DO
	739	END DO
	740	END IF
	741	! Save ssh at last level:
	742	tabres(i1:i2,j1:j2,k2,m2) = 0._wp
	743	IF (.NOT.ln_linssh) THEN
	744	! This vertical sum below should be replaced by the sea-level at V-points (optimization):
	745	DO jk=1,jpk
	746	tabres(i1:i2,j1:j2,k2,m2) = tabres(i1:i2,j1:j2,k2,m2) + e3v(i1:i2,j1:j2,jk,Kbb_a) * vmask(i1:i2,j1:j2,jk)
	747	END DO
	748	tabres(i1:i2,j1:j2,k2,m2) = tabres(i1:i2,j1:j2,k2,m2) - hv_0(i1:i2,j1:j2)
	749	END IF
	750	# endif
	751
[5656]	752	ELSE
[9031]	753
	754	# if defined key_vertical
[12377]	755	IF (ln_linssh) tabres(i1:i2,j1:j2,k2,m2) = 0._wp
[9031]	756	DO jj=j1,j2
	757	DO ji=i1,i2
[12377]	758	tabres_child(ji,jj,:) = 0._wp
	759	N_in = mbkv_parent(ji,jj)
	760	zhtot = 0._wp
	761	DO jk=1,N_in
	762	IF (jk==N_in) THEN
	763	h_in(jk) = hv0_parent(ji,jj) + tabres(ji,jj,k2,m2) - zhtot
	764	ELSE
	765	h_in(jk) = tabres(ji,jj,jk,m2)
	766	ENDIF
	767	zhtot = zhtot + h_in(jk)
[9031]	768	tabin(jk) = tabres(ji,jj,jk,m1)
[13286]	769	END DO
[12377]	770	!
	771	N_out = 0
	772	DO jk=1,jpk
	773	IF (vmask(ji,jj,jk) == 0) EXIT
	774	N_out = N_out + 1
	775	h_out(N_out) = e3v(ji,jj,jk,Kbb_a)
[13286]	776	END DO
[12377]	777
	778	! Account for small differences in free-surface
	779	IF ( sum(h_out(1:N_out)) > sum(h_in(1:N_in) )) THEN
	780	h_out(1) = h_out(1) - ( sum(h_out(1:N_out))-sum(h_in(1:N_in)) )
	781	ELSE
	782	h_in(1) = h_in(1) - ( sum(h_in(1:N_in))-sum(h_out(1:N_out)) )
	783	ENDIF
[9031]	784
[12377]	785	IF (N_in * N_out > 0) THEN
	786	CALL reconstructandremap(tabin(1:N_in),h_in(1:N_in),tabres_child(ji,jj,1:N_out),h_out(1:N_out),N_in,N_out,1)
	787	ENDIF
[13286]	788	END DO
	789	END DO
[9031]	790
[12377]	791	vbdiff(i1:i2,j1:j2,:) = (vv(i1:i2,j1:j2,:,Kbb_a) - tabres_child(i1:i2,j1:j2,:))*vmask(i1:i2,j1:j2,:)
[9031]	792	# else
[12377]	793	vbdiff(i1:i2,j1:j2,:) = (vv(i1:i2,j1:j2,:,Kbb_a) - tabres(i1:i2,j1:j2,:,1))*vmask(i1:i2,j1:j2,:)
[9031]	794	# endif
[6140]	795	!
[5656]	796	DO jk = 1, jpkm1 ! Horizontal slab
	797	! ! ===============
	798
	799	! ! --------
	800	! Horizontal divergence ! div
	801	! ! --------
	802	DO jj = j1+1,j2
	803	DO ji = i1,i2 ! vector opt.
[13216]	804	zbtr = rn_sponge_dyn * r1_Dt * fspt(ji,jj) / e3t(ji,jj,jk,Kbb_a)
[12377]	805	hdivdiff(ji,jj,jk) = ( e1v(ji,jj ) * e3v(ji,jj ,jk,Kbb_a) * vbdiff(ji,jj ,jk) &
	806	& -e1v(ji,jj-1) * e3v(ji,jj-1,jk,Kbb_a) * vbdiff(ji,jj-1,jk) ) * zbtr
[5656]	807	END DO
	808	END DO
	809	DO jj = j1,j2
	810	DO ji = i1,i2-1 ! vector opt.
[13216]	811	zbtr = rn_sponge_dyn * r1_Dt * fspf(ji,jj) * e3f(ji,jj,jk)
[5656]	812	rotdiff(ji,jj,jk) = ( e2v(ji+1,jj) * vbdiff(ji+1,jj,jk) &
[6140]	813	& -e2v(ji ,jj) * vbdiff(ji ,jj,jk) ) * fmask(ji,jj,jk) * zbtr
[5656]	814	END DO
	815	END DO
[6140]	816	END DO
[5656]	817
	818	! ! ===============
	819	!
	820
[9019]	821	imax = i2 - 1
[13286]	822	ind1 = jpiglo - ( nn_hls + nbghostcells + 2 ) ! East
	823	DO ji = mi0(ind1), mi1(ind1)
	824	imax = MIN(imax,ji)
	825	END DO
	826
[5656]	827	DO jj = j1+1, j2
	828	DO ji = i1+1, imax ! vector opt.
[6140]	829	IF( .NOT. tabspongedone_u(ji,jj) ) THEN
	830	DO jk = 1, jpkm1
[13216]	831	uu(ji,jj,jk,Krhs_a) = uu(ji,jj,jk,Krhs_a) &
[12377]	832	& - ( rotdiff (ji ,jj,jk) - rotdiff (ji,jj-1,jk)) / ( e2u(ji,jj) * e3u(ji,jj,jk,Kmm_a) ) &
[6140]	833	& + ( hdivdiff(ji+1,jj,jk) - hdivdiff(ji,jj ,jk)) * r1_e1u(ji,jj)
[5656]	834	END DO
	835	ENDIF
	836	END DO
	837	END DO
[6140]	838	!
[5656]	839	tabspongedone_u(i1+1:imax,j1+1:j2) = .TRUE.
[6140]	840	!
[5656]	841	DO jj = j1+1, j2-1
	842	DO ji = i1+1, i2-1 ! vector opt.
[6140]	843	IF( .NOT. tabspongedone_v(ji,jj) ) THEN
	844	DO jk = 1, jpkm1
[13216]	845	vv(ji,jj,jk,Krhs_a) = vv(ji,jj,jk,Krhs_a) &
[12377]	846	& + ( rotdiff (ji,jj ,jk) - rotdiff (ji-1,jj,jk) ) / ( e1v(ji,jj) * e3v(ji,jj,jk,Kmm_a) ) &
[13216]	847	& + ( hdivdiff(ji,jj+1,jk) - hdivdiff(ji ,jj,jk) ) * r1_e2v(ji,jj) &
	848	& - rn_trelax_dyn * r1_Dt * fspv(ji,jj) * vbdiff(ji,jj,jk)
[5656]	849	END DO
	850	ENDIF
	851	END DO
	852	END DO
	853	tabspongedone_v(i1+1:i2-1,j1+1:j2-1) = .TRUE.
	854	ENDIF
[6140]	855	!
[5656]	856	END SUBROUTINE interpvn_sponge
	857
[390]	858	#else
[9019]	859	!!----------------------------------------------------------------------
	860	!! Empty module no AGRIF zoom
	861	!!----------------------------------------------------------------------
[636]	862	CONTAINS
[9570]	863	SUBROUTINE agrif_oce_sponge_empty
	864	WRITE(,) 'agrif_oce_sponge : You should not have seen this print! error?'
	865	END SUBROUTINE agrif_oce_sponge_empty
[390]	866	#endif
[636]	867
[6140]	868	!!======================================================================
[9570]	869	END MODULE agrif_oce_sponge

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

Download in other formats: