Context Navigation

agrif_opa_sponge.F90 @ 2382

Last change on this file since 2382 was 2342, checked in by rblod, 14 years ago
Change key_off_tra to key_offline in agrif routines
Property svn:keywords set to `Id`
File size: 13.8 KB

Rev	Line
[390]	1	#define SPONGE
	2
[636]	3	Module agrif_opa_sponge
[2342]	4	#if defined key_agrif && ! defined key_offline
[636]	5	USE par_oce
	6	USE oce
	7	USE dom_oce
	8	USE in_out_manager
[782]	9	USE agrif_oce
[390]	10
[636]	11	IMPLICIT NONE
	12	PRIVATE
[390]	13
[636]	14	PUBLIC Agrif_Sponge_Tra, Agrif_Sponge_Dyn, interptn, interpsn, interpun, interpvn
[390]	15
[1156]	16	!!----------------------------------------------------------------------
[2287]	17	!! NEMO/NST 3.3 , NEMO Consortium (2010)
[1156]	18	!! $Id$
[2287]	19	!! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
[1156]	20	!!----------------------------------------------------------------------
[390]	21
[636]	22	CONTAINS
	23
[782]	24	SUBROUTINE Agrif_Sponge_Tra
[636]	25	!!---------------------------------------------
	26	!! * ROUTINE Agrif_Sponge_Tra *
	27	!!---------------------------------------------
	28	#include "domzgr_substitute.h90"
	29
[390]	30	INTEGER :: ji,jj,jk
	31	INTEGER :: spongearea
[636]	32	REAL(wp) :: timecoeff
	33	REAL(wp) :: zta, zsa, zabe1, zabe2, zbtr
[390]	34	REAL(wp), DIMENSION(jpi,jpj) :: localviscsponge
[782]	35	REAL(wp), DIMENSION(jpi,jpj,jpk) :: tbdiff, sbdiff
[390]	36	REAL(wp), DIMENSION(jpi,jpj,jpk) :: ztu ,ztv, zsu ,zsv
[782]	37	REAL(wp), DIMENSION(jpi,jpj,jpk) :: ztab
[390]	38
	39	#if defined SPONGE
	40
[636]	41	timecoeff = REAL(Agrif_NbStepint(),wp)/Agrif_rhot()
	42
[390]	43	Agrif_SpecialValue=0.
	44	Agrif_UseSpecialValue = .TRUE.
[636]	45	ztab = 0.e0
	46	CALL Agrif_Bc_Variable(ztab, ta,calledweight=timecoeff,procname=interptn)
[390]	47	Agrif_UseSpecialValue = .FALSE.
	48
[636]	49	tbdiff(:,:,:) = tb(:,:,:) - ztab(:,:,:)
[390]	50
[636]	51	ztab = 0.e0
[390]	52	Agrif_SpecialValue=0.
	53	Agrif_UseSpecialValue = .TRUE.
[636]	54	CALL Agrif_Bc_Variable(ztab, sa,calledweight=timecoeff,procname=interpsn)
[390]	55	Agrif_UseSpecialValue = .FALSE.
	56
[636]	57	sbdiff(:,:,:) = sb(:,:,:) - ztab(:,:,:)
[390]	58
[782]	59
[390]	60	spongearea = 2 + 2 * Agrif_irhox()
	61
	62	localviscsponge = 0.
[782]	63
	64	IF (.NOT. spongedoneT) THEN
	65	spe1ur(:,:) = 0.
	66	spe2vr(:,:) = 0.
[390]	67
	68	IF ((nbondi == -1).OR.(nbondi == 2)) THEN
[636]	69	DO ji = 2, spongearea
	70	localviscsponge(ji,:) = visc_tra * (spongearea-ji)/real(spongearea-2)
	71	ENDDO
[782]	72
	73	spe1ur(2:spongearea-1,:)=0.5 * (localviscsponge(2:spongearea-1,:) + localviscsponge(3:spongearea,:)) &
	74	* e2u(2:spongearea-1,:) / e1u(2:spongearea-1,:)
	75
	76	spe2vr(2:spongearea,1:jpjm1) = 0.5 * (localviscsponge(2:spongearea,1:jpjm1) + &
	77	localviscsponge(2:spongearea,2:jpj)) &
	78	* e1v(2:spongearea,1:jpjm1) / e2v(2:spongearea,1:jpjm1)
[390]	79	ENDIF
	80
	81	IF ((nbondi == 1).OR.(nbondi == 2)) THEN
[636]	82	DO ji = nlci-spongearea + 1,nlci-1
	83	localviscsponge(ji,:) = visc_tra * (ji - (nlci-spongearea+1))/real(spongearea-2)
	84	ENDDO
[782]	85
	86	spe1ur(nlci-spongearea + 1:nlci-2,:)=0.5 * (localviscsponge(nlci-spongearea + 1:nlci-2,:) + &
	87	localviscsponge(nlci-spongearea + 2:nlci-1,:)) &
	88	* e2u(nlci-spongearea + 1:nlci-2,:) / e1u(nlci-spongearea + 1:nlci-2,:)
	89
	90	spe2vr(nlci-spongearea + 1:nlci-1,1:jpjm1) = 0.5 * (localviscsponge(nlci-spongearea + 1:nlci-1,1:jpjm1) &
	91	+ localviscsponge(nlci-spongearea + 1:nlci-1,2:jpj)) &
	92	* e1v(nlci-spongearea + 1:nlci-1,1:jpjm1) / e2v(nlci-spongearea + 1:nlci-1,1:jpjm1)
[390]	93	ENDIF
	94
	95
	96	IF ((nbondj == -1).OR.(nbondj == 2)) THEN
[636]	97	DO jj = 2, spongearea
	98	localviscsponge(:,jj) = visc_tra * (spongearea-jj)/real(spongearea-2)
	99	ENDDO
[782]	100
	101	spe1ur(1:jpim1,2:spongearea)=0.5 * (localviscsponge(1:jpim1,2:spongearea) + &
	102	localviscsponge(2:jpi,2:spongearea)) &
	103	* e2u(1:jpim1,2:spongearea) / e1u(1:jpim1,2:spongearea)
	104
	105	spe2vr(:,2:spongearea-1) = 0.5 * (localviscsponge(:,2:spongearea-1) + &
	106	localviscsponge(:,3:spongearea)) &
	107	* e1v(:,2:spongearea-1) / e2v(:,2:spongearea-1)
[390]	108	ENDIF
	109
	110	IF ((nbondj == 1).OR.(nbondj == 2)) THEN
[636]	111	DO jj = nlcj-spongearea + 1,nlcj-1
	112	localviscsponge(:,jj) = visc_tra * (jj - (nlcj-spongearea+1))/real(spongearea-2)
	113	ENDDO
[782]	114
	115	spe1ur(1:jpim1,nlcj-spongearea + 1:nlcj-1)=0.5 * (localviscsponge(1:jpim1,nlcj-spongearea + 1:nlcj-1) + &
	116	localviscsponge(2:jpi,nlcj-spongearea + 1:nlcj-1)) &
	117	* e2u(1:jpim1,nlcj-spongearea + 1:nlcj-1) / e1u(1:jpim1,nlcj-spongearea + 1:nlcj-1)
	118
	119	spe2vr(:,nlcj-spongearea + 1:nlcj-2) = 0.5 * (localviscsponge(:,nlcj-spongearea + 1:nlcj-2) + &
	120	localviscsponge(:,nlcj-spongearea + 2:nlcj-1)) &
	121	* e1v(:,nlcj-spongearea + 1:nlcj-2) / e2v(:,nlcj-spongearea + 1:nlcj-2)
[390]	122	ENDIF
[782]	123
	124	spbtr2(:,:) = 1. / ( e1t(:,:) * e2t(:,:))
[390]	125
	126	spongedoneT = .TRUE.
	127	ENDIF
	128
[636]	129	DO jk = 1, jpkm1
	130	DO jj = 1, jpjm1
[390]	131	DO ji = 1, jpim1
[782]	132	zabe1 = umask(ji,jj,jk) * spe1ur(ji,jj) * fse3u(ji,jj,jk)
	133	zabe2 = vmask(ji,jj,jk) * spe2vr(ji,jj) * fse3v(ji,jj,jk)
[390]	134	ztu(ji,jj,jk) = zabe1 * ( tbdiff(ji+1,jj ,jk) - tbdiff(ji,jj,jk) )
	135	zsu(ji,jj,jk) = zabe1 * ( sbdiff(ji+1,jj ,jk) - sbdiff(ji,jj,jk) )
	136	ztv(ji,jj,jk) = zabe2 * ( tbdiff(ji ,jj+1,jk) - tbdiff(ji,jj,jk) )
	137	zsv(ji,jj,jk) = zabe2 * ( sbdiff(ji ,jj+1,jk) - sbdiff(ji,jj,jk) )
	138	ENDDO
[636]	139	ENDDO
[390]	140
	141	DO jj = 2,jpjm1
	142	DO ji = 2,jpim1
[782]	143	zbtr = spbtr2(ji,jj) / fse3t(ji,jj,jk)
[390]	144	! horizontal diffusive trends
	145	zta = zbtr * ( ztu(ji,jj,jk) - ztu(ji-1,jj,jk) &
	146	& + ztv(ji,jj,jk) - ztv(ji,jj-1,jk) )
	147	zsa = zbtr * ( zsu(ji,jj,jk) - zsu(ji-1,jj,jk) &
	148	& + zsv(ji,jj,jk) - zsv(ji,jj-1,jk) )
	149	! add it to the general tracer trends
	150	ta(ji,jj,jk) = (ta(ji,jj,jk) + zta)
	151	sa(ji,jj,jk) = (sa(ji,jj,jk) + zsa)
	152	END DO
	153	END DO
	154
[636]	155	ENDDO
[390]	156
	157	#endif
	158
[636]	159	END SUBROUTINE Agrif_Sponge_Tra
[390]	160
[782]	161	SUBROUTINE Agrif_Sponge_dyn
[636]	162	!!---------------------------------------------
	163	!! * ROUTINE Agrif_Sponge_dyn *
	164	!!---------------------------------------------
	165	#include "domzgr_substitute.h90"
[390]	166
	167	INTEGER :: ji,jj,jk
	168	INTEGER :: spongearea
[636]	169	REAL(wp) :: timecoeff
[782]	170	REAL(wp) :: ze2u, ze1v, zua, zva, zbtr
[390]	171	REAL(wp), DIMENSION(jpi,jpj) :: localviscsponge
[636]	172	REAL(wp), DIMENSION(jpi,jpj,jpk) :: ztab, ubdiff, vbdiff,rotdiff,hdivdiff
[390]	173
	174	#if defined SPONGE
	175
[636]	176	timecoeff = REAL(Agrif_NbStepint(),wp)/Agrif_rhot()
[390]	177
	178	Agrif_SpecialValue=0.
[782]	179	Agrif_UseSpecialValue = ln_spc_dyn
[636]	180	ztab = 0.e0
	181	CALL Agrif_Bc_Variable(ztab, ua,calledweight=timecoeff,procname=interpun)
[390]	182	Agrif_UseSpecialValue = .FALSE.
	183
[782]	184	ubdiff(:,:,:) = (ub(:,:,:) - ztab(:,:,:))*umask(:,:,:)
[390]	185
[636]	186	ztab = 0.e0
[390]	187	Agrif_SpecialValue=0.
[782]	188	Agrif_UseSpecialValue = ln_spc_dyn
[636]	189	CALL Agrif_Bc_Variable(ztab, va,calledweight=timecoeff,procname=interpvn)
[390]	190	Agrif_UseSpecialValue = .FALSE.
	191
[782]	192	vbdiff(:,:,:) = (vb(:,:,:) - ztab(:,:,:))*vmask(:,:,:)
[390]	193
	194	spongearea = 2 + 2 * Agrif_irhox()
	195
	196	localviscsponge = 0.
	197
[782]	198	IF (.NOT. spongedoneU) THEN
	199	spe1ur2(:,:) = 0.
	200	spe2vr2(:,:) = 0.
	201
[390]	202	IF ((nbondi == -1).OR.(nbondi == 2)) THEN
[636]	203	DO ji = 2, spongearea
	204	localviscsponge(ji,:) = visc_dyn * (spongearea-ji)/real(spongearea-2)
	205	ENDDO
[782]	206
	207	spe1ur2(2:spongearea-1,:)=0.5 * (localviscsponge(2:spongearea-1,:) + localviscsponge(3:spongearea,:))
	208
	209	spe2vr2(2:spongearea,1:jpjm1) = 0.5 * (localviscsponge(2:spongearea,1:jpjm1) + &
	210	localviscsponge(2:spongearea,2:jpj))
[390]	211	ENDIF
	212
	213	IF ((nbondi == 1).OR.(nbondi == 2)) THEN
[636]	214	DO ji = nlci-spongearea + 1,nlci-1
	215	localviscsponge(ji,:) = visc_dyn * (ji - (nlci-spongearea+1))/real(spongearea-2)
	216	ENDDO
[782]	217
	218	spe1ur2(nlci-spongearea + 1:nlci-2,:)=0.5 * (localviscsponge(nlci-spongearea + 1:nlci-2,:) + &
	219	localviscsponge(nlci-spongearea + 2:nlci-1,:))
	220
	221	spe2vr2(nlci-spongearea + 1:nlci-1,1:jpjm1) = 0.5 * (localviscsponge(nlci-spongearea + 1:nlci-1,1:jpjm1) &
	222	+ localviscsponge(nlci-spongearea + 1:nlci-1,2:jpj))
[390]	223	ENDIF
	224
[782]	225
[390]	226	IF ((nbondj == -1).OR.(nbondj == 2)) THEN
[636]	227	DO jj = 2, spongearea
	228	localviscsponge(:,jj) = visc_dyn * (spongearea-jj)/real(spongearea-2)
	229	ENDDO
[782]	230
	231	spe1ur2(1:jpim1,2:spongearea)=0.5 * (localviscsponge(1:jpim1,2:spongearea) + &
	232	localviscsponge(2:jpi,2:spongearea))
	233
	234	spe2vr2(:,2:spongearea-1) = 0.5 * (localviscsponge(:,2:spongearea-1) + &
	235	localviscsponge(:,3:spongearea))
[390]	236	ENDIF
	237
	238	IF ((nbondj == 1).OR.(nbondj == 2)) THEN
[636]	239	DO jj = nlcj-spongearea + 1,nlcj-1
	240	localviscsponge(:,jj) = visc_dyn * (jj - (nlcj-spongearea+1))/real(spongearea-2)
	241	ENDDO
[782]	242
	243	spe1ur2(1:jpim1,nlcj-spongearea + 1:nlcj-1)=0.5 * (localviscsponge(1:jpim1,nlcj-spongearea + 1:nlcj-1) + &
	244	localviscsponge(2:jpi,nlcj-spongearea + 1:nlcj-1))
	245
	246	spe2vr2(:,nlcj-spongearea + 1:nlcj-2) = 0.5 * (localviscsponge(:,nlcj-spongearea + 1:nlcj-2) + &
	247	localviscsponge(:,nlcj-spongearea + 2:nlcj-1))
[636]	248	ENDIF
[390]	249
[782]	250	spongedoneU = .TRUE.
	251
	252	spbtr3(:,:) = 1./( e1f(:,:) * e2f(:,:))
	253	ENDIF
	254
	255	IF (.NOT. spongedoneT) THEN
	256	spbtr2(:,:) = 1. / ( e1t(:,:) * e2t(:,:))
	257	ENDIF
	258
	259	DO jk=1,jpkm1
	260	ubdiff(:,:,jk) = ubdiff(:,:,jk) * spe1ur2(:,:)
	261	vbdiff(:,:,jk) = vbdiff(:,:,jk) * spe2vr2(:,:)
	262	ENDDO
	263
[390]	264	hdivdiff = 0.
	265	rotdiff = 0.
	266
	267	DO jk = 1, jpkm1 ! Horizontal slab
	268	! ! ===============
	269
	270	! ! --------
	271	! Horizontal divergence ! div
	272	! ! --------
	273	DO jj = 2, jpjm1
	274	DO ji = 2, jpim1 ! vector opt.
[782]	275	zbtr = spbtr2(ji,jj) / fse3t(ji,jj,jk)
[390]	276	hdivdiff(ji,jj,jk) = &
	277	( e2u(ji,jj)fse3u(ji,jj,jk) &
	278	ubdiff(ji,jj,jk) - e2u(ji-1,jj )* &
	279	fse3u(ji-1,jj ,jk) * ubdiff(ji-1,jj ,jk) &
[636]	280	+ e1v(ji,jj)fse3v(ji,jj,jk) &
[390]	281	vbdiff(ji,jj,jk) - e1v(ji ,jj-1)* &
[782]	282	fse3v(ji ,jj-1,jk) * vbdiff(ji ,jj-1,jk) ) * zbtr
[390]	283	END DO
	284	END DO
[636]	285
[390]	286	DO jj = 1, jpjm1
	287	DO ji = 1, jpim1 ! vector opt.
[782]	288	zbtr = spbtr3(ji,jj) * fse3f(ji,jj,jk)
	289	rotdiff(ji,jj,jk) = ( e2v(ji+1,jj ) * vbdiff(ji+1,jj ,jk) - e2v(ji,jj) * vbdiff(ji,jj,jk) &
	290	& - e1u(ji ,jj+1) * ubdiff(ji ,jj+1,jk) + e1u(ji,jj) * ubdiff(ji,jj,jk) ) &
	291	& * fmask(ji,jj,jk) * zbtr
[390]	292	END DO
	293	END DO
[636]	294
	295	ENDDO
	296
[390]	297	! ! ===============
	298	DO jk = 1, jpkm1 ! Horizontal slab
	299	! ! ===============
	300	DO jj = 2, jpjm1
	301	DO ji = 2, jpim1 ! vector opt.
[469]	302	ze2u = rotdiff (ji,jj,jk)
	303	ze1v = hdivdiff(ji,jj,jk)
[390]	304	! horizontal diffusive trends
[782]	305	zua = - ( ze2u - rotdiff (ji,jj-1,jk)) / ( e2u(ji,jj) * fse3u(ji,jj,jk) ) &
[636]	306	+ ( hdivdiff(ji+1,jj,jk) - ze1v &
	307	) / e1u(ji,jj)
[390]	308
[782]	309	zva = + ( ze2u - rotdiff (ji-1,jj,jk)) / ( e1v(ji,jj) * fse3v(ji,jj,jk) ) &
[636]	310	+ ( hdivdiff(ji,jj+1,jk) - ze1v &
	311	) / e2v(ji,jj)
[390]	312
	313	! add it to the general momentum trends
	314	ua(ji,jj,jk) = ua(ji,jj,jk) + zua
	315	va(ji,jj,jk) = va(ji,jj,jk) + zva
	316	END DO
	317	END DO
	318	! ! ===============
	319	END DO ! End of slab
	320	! ! ===============
	321
	322	#endif
	323
[636]	324	END SUBROUTINE Agrif_Sponge_dyn
[390]	325
[636]	326	SUBROUTINE interptn(tabres,i1,i2,j1,j2,k1,k2)
	327	!!---------------------------------------------
	328	!! * ROUTINE interptn *
	329	!!---------------------------------------------
[390]	330	# include "domzgr_substitute.h90"
[636]	331
	332	INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2
	333	REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: tabres
[390]	334
[636]	335	tabres(i1:i2,j1:j2,k1:k2) = tn(i1:i2,j1:j2,k1:k2)
[390]	336
[636]	337	END SUBROUTINE interptn
	338
	339	SUBROUTINE interpsn(tabres,i1,i2,j1,j2,k1,k2)
	340	!!---------------------------------------------
	341	!! * ROUTINE interpsn *
	342	!!---------------------------------------------
[390]	343	# include "domzgr_substitute.h90"
[636]	344
	345	INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2
	346	REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: tabres
[390]	347
[636]	348	tabres(i1:i2,j1:j2,k1:k2) = sn(i1:i2,j1:j2,k1:k2)
[390]	349
[636]	350	END SUBROUTINE interpsn
	351
	352	SUBROUTINE interpun(tabres,i1,i2,j1,j2,k1,k2)
	353	!!---------------------------------------------
	354	!! * ROUTINE interpun *
	355	!!---------------------------------------------
[390]	356	# include "domzgr_substitute.h90"
[636]	357
	358	INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2
	359	REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: tabres
[390]	360
[636]	361	tabres(i1:i2,j1:j2,k1:k2) = un(i1:i2,j1:j2,k1:k2)
[390]	362
[636]	363	END SUBROUTINE interpun
	364
	365	SUBROUTINE interpvn(tabres,i1,i2,j1,j2,k1,k2)
	366	!!---------------------------------------------
	367	!! * ROUTINE interpvn *
	368	!!---------------------------------------------
[390]	369	# include "domzgr_substitute.h90"
[636]	370
	371	INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2
	372	REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: tabres
[390]	373
[636]	374	tabres(i1:i2,j1:j2,k1:k2) = vn(i1:i2,j1:j2,k1:k2)
[390]	375
[636]	376	END SUBROUTINE interpvn
[390]	377
	378	#else
[636]	379	CONTAINS
	380
	381	SUBROUTINE agrif_opa_sponge_empty
	382	!!---------------------------------------------
	383	!! * ROUTINE agrif_OPA_sponge_empty *
	384	!!---------------------------------------------
	385	WRITE(,) 'agrif_opa_sponge : You should not have seen this print! error?'
	386	END SUBROUTINE agrif_opa_sponge_empty
[390]	387	#endif
[636]	388
	389	END MODULE agrif_opa_sponge

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

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

Context Navigation

source: branches/nemo_v3_3_beta/NEMOGCM/NEMO/NST_SRC/agrif_opa_sponge.F90 @ 2382

Download in other formats: