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_opa_interp.F90 in trunk/NEMO/NST_SRC – NEMO

Context Navigation

source: trunk/NEMO/NST_SRC/agrif_opa_interp.F90 @ 1879

Last change on this file since 1879 was 1605, checked in by ctlod, 15 years ago
Doctor naming of OPA namelist variables, see ticket: #526
Property svn:eol-style set to `native` Property svn:keywords set to `Id`
File size: 19.8 KB

Rev	Line
[636]	1	MODULE agrif_opa_interp
[1605]	2	!!======================================================================
	3	!! * MODULE agrif_opa_interp *
	4	!! AGRIF: interpolation package
	5	!!======================================================================
	6	!! History : 2.0 ! 2002-06 (XXX) Original cade
	7	!! - ! 2005-11 (XXX)
	8	!! 3.2 ! 2009-04 (R. Benshila)
	9	!!----------------------------------------------------------------------
[1300]	10	#if defined key_agrif && ! defined key_off_tra
[1605]	11	!!----------------------------------------------------------------------
	12	!! 'key_agrif' AGRIF zoom
	13	!! NOT 'key_off_tra' NO off-line tracers
	14	!!----------------------------------------------------------------------
	15	!! Agrif_tra :
	16	!! Agrif_dyn :
	17	!! interpu :
	18	!! interpv :
	19	!!----------------------------------------------------------------------
[636]	20	USE par_oce
	21	USE oce
	22	USE dom_oce
	23	USE sol_oce
[782]	24	USE agrif_oce
[1605]	25	USE phycst
	26	USE in_out_manager
[390]	27
[636]	28	IMPLICIT NONE
	29	PRIVATE
	30
[1605]	31	PUBLIC Agrif_tra, Agrif_dyn, interpu, interpv
[390]	32
[1605]	33	# include "domzgr_substitute.h90"
	34	# include "vectopt_loop_substitute.h90"
[1156]	35	!!----------------------------------------------------------------------
[1605]	36	!! NEMO/OPA 3.2 , LOCEAN-IPSL (2009)
[1156]	37	!! $Id$
	38	!! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
	39	!!----------------------------------------------------------------------
	40
[636]	41	CONTAINS
	42
[782]	43	SUBROUTINE Agrif_tra
[1605]	44	!!----------------------------------------------------------------------
	45	!! * ROUTINE Agrif_Tra *
	46	!!----------------------------------------------------------------------
	47	INTEGER :: ji, jj, jk ! dummy loop indices
	48	REAL(wp) :: zrhox , alpha1, alpha2, alpha3
	49	REAL(wp) :: alpha4, alpha5, alpha6, alpha7
	50	REAL(wp), DIMENSION(jpi,jpj,jpk) :: zta, zsa ! 3D workspace
	51	!!----------------------------------------------------------------------
[636]	52	!
[1605]	53	IF( Agrif_Root() ) RETURN
[390]	54
[1605]	55	Agrif_SpecialValue = 0.e0
[636]	56	Agrif_UseSpecialValue = .TRUE.
[1605]	57	zta(:,:,:) = 0.e0
	58	zsa(:,:,:) = 0.e0
[390]	59
[1605]	60	CALL Agrif_Bc_variable( zta, tn )
	61	CALL Agrif_Bc_variable( zsa, sn )
[636]	62	Agrif_UseSpecialValue = .FALSE.
[390]	63
[636]	64	zrhox = Agrif_Rhox()
	65
[1605]	66	alpha1 = ( zrhox - 1. ) * 0.5
	67	alpha2 = 1. - alpha1
[636]	68
[1605]	69	alpha3 = ( zrhox - 1. ) / ( zrhox + 1. )
	70	alpha4 = 1. - alpha3
[636]	71
[1605]	72	alpha6 = 2. * ( zrhox - 1. ) / ( zrhox + 1. )
	73	alpha7 = - ( zrhox - 1. ) / ( zrhox + 3. )
[636]	74	alpha5 = 1. - alpha6 - alpha7
	75
[1605]	76	IF( nbondi == 1 .OR. nbondi == 2 ) THEN
[636]	77
	78	ta(nlci,:,:) = alpha1 * zta(nlci,:,:) + alpha2 * zta(nlci-1,:,:)
	79	sa(nlci,:,:) = alpha1 * zsa(nlci,:,:) + alpha2 * zsa(nlci-1,:,:)
	80
[1605]	81	DO jk = 1, jpkm1
	82	DO jj = 1, jpj
	83	IF( umask(nlci-2,jj,jk) == 0.e0 ) THEN
[636]	84	ta(nlci-1,jj,jk) = ta(nlci,jj,jk) * tmask(nlci-1,jj,jk)
	85	sa(nlci-1,jj,jk) = sa(nlci,jj,jk) * tmask(nlci-1,jj,jk)
	86	ELSE
	87	ta(nlci-1,jj,jk)=(alpha4ta(nlci,jj,jk)+alpha3ta(nlci-2,jj,jk))*tmask(nlci-1,jj,jk)
	88	sa(nlci-1,jj,jk)=(alpha4sa(nlci,jj,jk)+alpha3sa(nlci-2,jj,jk))*tmask(nlci-1,jj,jk)
[1605]	89	IF( un(nlci-2,jj,jk) > 0.e0 ) THEN
[636]	90	ta(nlci-1,jj,jk)=( alpha6ta(nlci-2,jj,jk)+alpha5ta(nlci,jj,jk) &
[1605]	91	& + alpha7ta(nlci-3,jj,jk) ) tmask(nlci-1,jj,jk)
[636]	92	sa(nlci-1,jj,jk)=( alpha6sa(nlci-2,jj,jk)+alpha5sa(nlci,jj,jk) &
[1605]	93	& + alpha7sa(nlci-3,jj,jk) ) tmask(nlci-1,jj,jk)
[636]	94	ENDIF
	95	ENDIF
	96	END DO
	97	END DO
[390]	98	ENDIF
	99
[1605]	100	IF( nbondj == 1 .OR. nbondj == 2 ) THEN
[636]	101
	102	ta(:,nlcj,:) = alpha1 * zta(:,nlcj,:) + alpha2 * zta(:,nlcj-1,:)
	103	sa(:,nlcj,:) = alpha1 * zsa(:,nlcj,:) + alpha2 * zsa(:,nlcj-1,:)
	104
[1605]	105	DO jk = 1, jpkm1
	106	DO ji = 1, jpi
	107	IF( vmask(ji,nlcj-2,jk) == 0.e0 ) THEN
[636]	108	ta(ji,nlcj-1,jk) = ta(ji,nlcj,jk) * tmask(ji,nlcj-1,jk)
	109	sa(ji,nlcj-1,jk) = sa(ji,nlcj,jk) * tmask(ji,nlcj-1,jk)
	110	ELSE
	111	ta(ji,nlcj-1,jk)=(alpha4ta(ji,nlcj,jk)+alpha3ta(ji,nlcj-2,jk))*tmask(ji,nlcj-1,jk)
	112	sa(ji,nlcj-1,jk)=(alpha4sa(ji,nlcj,jk)+alpha3sa(ji,nlcj-2,jk))*tmask(ji,nlcj-1,jk)
[1605]	113	IF (vn(ji,nlcj-2,jk) > 0.e0 ) THEN
[636]	114	ta(ji,nlcj-1,jk)=( alpha6ta(ji,nlcj-2,jk)+alpha5ta(ji,nlcj,jk) &
[1605]	115	& + alpha7ta(ji,nlcj-3,jk) ) tmask(ji,nlcj-1,jk)
[636]	116	sa(ji,nlcj-1,jk)=( alpha6sa(ji,nlcj-2,jk)+alpha5sa(ji,nlcj,jk) &
[1605]	117	& + alpha7sa(ji,nlcj-3,jk))tmask(ji,nlcj-1,jk)
[636]	118	ENDIF
	119	ENDIF
	120	END DO
	121	END DO
[390]	122	ENDIF
	123
[1605]	124	IF( nbondi == -1 .OR. nbondi == 2 ) THEN
[636]	125	ta(1,:,:) = alpha1 * zta(1,:,:) + alpha2 * zta(2,:,:)
	126	sa(1,:,:) = alpha1 * zsa(1,:,:) + alpha2 * zsa(2,:,:)
[1605]	127	DO jk = 1, jpkm1
	128	DO jj = 1, jpj
	129	IF( umask(2,jj,jk) == 0.e0 ) THEN
[636]	130	ta(2,jj,jk) = ta(1,jj,jk) * tmask(2,jj,jk)
	131	sa(2,jj,jk) = sa(1,jj,jk) * tmask(2,jj,jk)
	132	ELSE
	133	ta(2,jj,jk)=(alpha4ta(1,jj,jk)+alpha3ta(3,jj,jk))*tmask(2,jj,jk)
	134	sa(2,jj,jk)=(alpha4sa(1,jj,jk)+alpha3sa(3,jj,jk))*tmask(2,jj,jk)
[1605]	135	IF( un(2,jj,jk) < 0.e0 ) THEN
[636]	136	ta(2,jj,jk)=(alpha6ta(3,jj,jk)+alpha5ta(1,jj,jk)+alpha7ta(4,jj,jk))tmask(2,jj,jk)
	137	sa(2,jj,jk)=(alpha6sa(3,jj,jk)+alpha5sa(1,jj,jk)+alpha7sa(4,jj,jk))tmask(2,jj,jk)
	138	ENDIF
	139	ENDIF
	140	END DO
	141	END DO
[390]	142	ENDIF
	143
[1605]	144	IF( nbondj == -1 .OR. nbondj == 2 ) THEN
[636]	145	ta(:,1,:) = alpha1 * zta(:,1,:) + alpha2 * zta(:,2,:)
	146	sa(:,1,:) = alpha1 * zsa(:,1,:) + alpha2 * zsa(:,2,:)
	147	DO jk=1,jpk
	148	DO ji=1,jpi
[1605]	149	IF( vmask(ji,2,jk) == 0.e0 ) THEN
[636]	150	ta(ji,2,jk)=ta(ji,1,jk) * tmask(ji,2,jk)
	151	sa(ji,2,jk)=sa(ji,1,jk) * tmask(ji,2,jk)
	152	ELSE
	153	ta(ji,2,jk)=(alpha4ta(ji,1,jk)+alpha3ta(ji,3,jk))*tmask(ji,2,jk)
	154	sa(ji,2,jk)=(alpha4sa(ji,1,jk)+alpha3sa(ji,3,jk))*tmask(ji,2,jk)
[1605]	155	IF( vn(ji,2,jk) < 0.e0 ) THEN
[636]	156	ta(ji,2,jk)=(alpha6ta(ji,3,jk)+alpha5ta(ji,1,jk)+alpha7ta(ji,4,jk))tmask(ji,2,jk)
	157	sa(ji,2,jk)=(alpha6sa(ji,3,jk)+alpha5sa(ji,1,jk)+alpha7sa(ji,4,jk))tmask(ji,2,jk)
	158	ENDIF
	159	ENDIF
	160	END DO
	161	END DO
	162	ENDIF
[1605]	163	!
[636]	164	END SUBROUTINE Agrif_tra
	165
[1605]	166
[636]	167	SUBROUTINE Agrif_dyn( kt )
[1605]	168	!!----------------------------------------------------------------------
	169	!! * ROUTINE Agrif_DYN *
	170	!!----------------------------------------------------------------------
	171	INTEGER, INTENT(in) :: kt
	172	!!
	173	INTEGER :: ji,jj,jk
[636]	174	REAL(wp) :: timeref
[390]	175	REAL(wp) :: z2dt, znugdt
[636]	176	REAL(wp) :: zrhox, rhoy
	177	REAL(wp), DIMENSION(jpi,jpj) :: zua2d, zva2d
[390]	178	REAL(wp), DIMENSION(jpi,jpj) :: spgu1,spgv1
[636]	179	REAL(wp), DIMENSION(jpi,jpj,jpk) :: zua, zva
[1605]	180	!!----------------------------------------------------------------------
[390]	181
[1605]	182	IF( Agrif_Root() ) RETURN
[390]	183
[636]	184	zrhox = Agrif_Rhox()
[390]	185	rhoy = Agrif_Rhoy()
	186
	187	timeref = 1.
	188
	189	! time step: leap-frog
	190	z2dt = 2. * rdt
	191	! time step: Euler if restart from rest
	192	IF( neuler == 0 .AND. kt == nit000 ) z2dt = rdt
	193	! coefficients
[1605]	194	znugdt = grav * z2dt
[390]	195
[636]	196	Agrif_SpecialValue=0.
[782]	197	Agrif_UseSpecialValue = ln_spc_dyn
	198
[636]	199	zua = 0.
	200	zva = 0.
	201	CALL Agrif_Bc_variable(zua,un,procname=interpu)
	202	CALL Agrif_Bc_variable(zva,vn,procname=interpv)
	203	zua2d = 0.
	204	zva2d = 0.
[390]	205
[636]	206	Agrif_SpecialValue=0.
[782]	207	Agrif_UseSpecialValue = ln_spc_dyn
[636]	208	CALL Agrif_Bc_variable(zua2d,e1u,calledweight=1.,procname=interpu2d)
	209	CALL Agrif_Bc_variable(zva2d,e2v,calledweight=1.,procname=interpv2d)
	210	Agrif_UseSpecialValue = .FALSE.
[390]	211
	212
[636]	213	IF((nbondi == -1).OR.(nbondi == 2)) THEN
[390]	214
[636]	215	DO jj=1,jpj
	216	laplacu(2,jj) = timeref * (zua2d(2,jj)/(rhoye2u(2,jj)))umask(2,jj,1)
	217	END DO
	218
	219	DO jk=1,jpkm1
	220	DO jj=1,jpj
	221	ua(1:2,jj,jk) = (zua(1:2,jj,jk)/(rhoy*e2u(1:2,jj)))
[469]	222	#if ! defined key_zco
[636]	223	ua(1:2,jj,jk) = ua(1:2,jj,jk) / fse3u(1:2,jj,jk)
[390]	224	#endif
[636]	225	END DO
	226	END DO
[390]	227
[636]	228	DO jk=1,jpkm1
	229	DO jj=1,jpj
	230	ua(2,jj,jk) = (ua(2,jj,jk) - z2dt * znugdt * laplacu(2,jj))*umask(2,jj,jk)
	231	END DO
	232	END DO
[390]	233
[636]	234	spgu(2,:)=0.
[390]	235
[636]	236	DO jk=1,jpkm1
	237	DO jj=1,jpj
	238	spgu(2,jj)=spgu(2,jj)+fse3u(2,jj,jk)*ua(2,jj,jk)
	239	END DO
	240	END DO
[390]	241
[636]	242	DO jj=1,jpj
	243	IF (umask(2,jj,1).NE.0.) THEN
	244	spgu(2,jj)=spgu(2,jj)/hu(2,jj)
	245	ENDIF
	246	END DO
[390]	247
[636]	248	DO jk=1,jpkm1
	249	DO jj=1,jpj
	250	ua(2,jj,jk) = 0.25(ua(1,jj,jk)+2.ua(2,jj,jk)+ua(3,jj,jk))
	251	ua(2,jj,jk) = ua(2,jj,jk) * umask(2,jj,jk)
	252	END DO
	253	END DO
[390]	254
[636]	255	spgu1(2,:)=0.
[390]	256
[636]	257	DO jk=1,jpkm1
	258	DO jj=1,jpj
	259	spgu1(2,jj)=spgu1(2,jj)+fse3u(2,jj,jk)*ua(2,jj,jk)
	260	END DO
	261	END DO
[390]	262
[636]	263	DO jj=1,jpj
	264	IF (umask(2,jj,1).NE.0.) THEN
	265	spgu1(2,jj)=spgu1(2,jj)/hu(2,jj)
	266	ENDIF
	267	END DO
[390]	268
[636]	269	DO jk=1,jpkm1
	270	DO jj=1,jpj
	271	ua(2,jj,jk) = (ua(2,jj,jk)+spgu(2,jj)-spgu1(2,jj))*umask(2,jj,jk)
	272	END DO
	273	END DO
[390]	274
[636]	275	DO jk=1,jpkm1
	276	DO jj=1,jpj
	277	va(2,jj,jk) = (zva(2,jj,jk)/(zrhoxe1v(2,jj)))vmask(2,jj,jk)
[469]	278	#if ! defined key_zco
[636]	279	va(2,jj,jk) = va(2,jj,jk) / fse3v(2,jj,jk)
[390]	280	#endif
[636]	281	END DO
	282	END DO
[390]	283
[636]	284	sshn(2,:)=sshn(3,:)
	285	sshb(2,:)=sshb(3,:)
[390]	286
[636]	287	ENDIF
[390]	288
[636]	289	IF((nbondi == 1).OR.(nbondi == 2)) THEN
[390]	290
[636]	291	DO jj=1,jpj
	292	laplacu(nlci-2,jj) = timeref * (zua2d(nlci-2,jj)/(rhoy*e2u(nlci-2,jj)))
	293	END DO
[390]	294
[636]	295	DO jk=1,jpkm1
	296	DO jj=1,jpj
	297	ua(nlci-2:nlci-1,jj,jk) = (zua(nlci-2:nlci-1,jj,jk)/(rhoy*e2u(nlci-2:nlci-1,jj)))
	298
[469]	299	#if ! defined key_zco
[636]	300	ua(nlci-2:nlci-1,jj,jk) = ua(nlci-2:nlci-1,jj,jk) / fse3u(nlci-2:nlci-1,jj,jk)
[390]	301	#endif
	302
[636]	303	END DO
	304	END DO
[390]	305
[636]	306	DO jk=1,jpkm1
	307	DO jj=1,jpj
	308	ua(nlci-2,jj,jk) = (ua(nlci-2,jj,jk)- z2dt * znugdt * laplacu(nlci-2,jj))*umask(nlci-2,jj,jk)
	309	END DO
	310	END DO
[390]	311
	312
[636]	313	spgu(nlci-2,:)=0.
[390]	314
[636]	315	do jk=1,jpkm1
	316	do jj=1,jpj
	317	spgu(nlci-2,jj)=spgu(nlci-2,jj)+fse3u(nlci-2,jj,jk)*ua(nlci-2,jj,jk)
	318	enddo
	319	enddo
[390]	320
[636]	321	DO jj=1,jpj
	322	IF (umask(nlci-2,jj,1).NE.0.) THEN
	323	spgu(nlci-2,jj)=spgu(nlci-2,jj)/hu(nlci-2,jj)
	324	ENDIF
	325	END DO
[390]	326
[636]	327	DO jk=1,jpkm1
	328	DO jj=1,jpj
	329	ua(nlci-2,jj,jk) = 0.25(ua(nlci-3,jj,jk)+2.ua(nlci-2,jj,jk)+ua(nlci-1,jj,jk))
[390]	330
[636]	331	ua(nlci-2,jj,jk) = ua(nlci-2,jj,jk) * umask(nlci-2,jj,jk)
[390]	332
[636]	333	END DO
	334	END DO
[390]	335
[636]	336	spgu1(nlci-2,:)=0.
[390]	337
[636]	338	DO jk=1,jpkm1
	339	DO jj=1,jpj
	340	spgu1(nlci-2,jj)=spgu1(nlci-2,jj)+fse3u(nlci-2,jj,jk)ua(nlci-2,jj,jk)umask(nlci-2,jj,jk)
	341	END DO
	342	END DO
[390]	343
[636]	344	DO jj=1,jpj
	345	IF (umask(nlci-2,jj,1).NE.0.) THEN
	346	spgu1(nlci-2,jj)=spgu1(nlci-2,jj)/hu(nlci-2,jj)
	347	ENDIF
	348	END DO
[390]	349
[636]	350	DO jk=1,jpkm1
	351	DO jj=1,jpj
	352	ua(nlci-2,jj,jk) = (ua(nlci-2,jj,jk)+spgu(nlci-2,jj)-spgu1(nlci-2,jj))*umask(nlci-2,jj,jk)
	353	END DO
	354	END DO
[390]	355
[636]	356	DO jk=1,jpkm1
	357	DO jj=1,jpj-1
	358	va(nlci-1,jj,jk) = (zva(nlci-1,jj,jk)/(zrhoxe1v(nlci-1,jj)))vmask(nlci-1,jj,jk)
[469]	359	#if ! defined key_zco
[636]	360	va(nlci-1,jj,jk) = va(nlci-1,jj,jk) / fse3v(nlci-1,jj,jk)
[390]	361	#endif
[636]	362	END DO
	363	END DO
[390]	364
[636]	365	sshn(nlci-1,:)=sshn(nlci-2,:)
	366	sshb(nlci-1,:)=sshb(nlci-2,:)
	367	ENDIF
[390]	368
[636]	369	IF((nbondj == -1).OR.(nbondj == 2)) THEN
[390]	370
[636]	371	DO ji=1,jpi
	372	laplacv(ji,2) = timeref * (zva2d(ji,2)/(zrhox*e1v(ji,2)))
	373	END DO
[390]	374
[636]	375	DO jk=1,jpkm1
	376	DO ji=1,jpi
	377	va(ji,1:2,jk) = (zva(ji,1:2,jk)/(zrhox*e1v(ji,1:2)))
[469]	378	#if ! defined key_zco
[636]	379	va(ji,1:2,jk) = va(ji,1:2,jk) / fse3v(ji,1:2,jk)
[390]	380	#endif
[636]	381	END DO
	382	END DO
[390]	383
[636]	384	DO jk=1,jpkm1
	385	DO ji=1,jpi
	386	va(ji,2,jk) = (va(ji,2,jk) - z2dt * znugdt * laplacv(ji,2))*vmask(ji,2,jk)
	387	END DO
	388	END DO
[390]	389
[636]	390	spgv(:,2)=0.
[390]	391
[636]	392	DO jk=1,jpkm1
	393	DO ji=1,jpi
	394	spgv(ji,2)=spgv(ji,2)+fse3v(ji,2,jk)*va(ji,2,jk)
	395	END DO
	396	END DO
[390]	397
[636]	398	DO ji=1,jpi
	399	IF (vmask(ji,2,1).NE.0.) THEN
	400	spgv(ji,2)=spgv(ji,2)/hv(ji,2)
	401	ENDIF
	402	END DO
[390]	403
[636]	404	DO jk=1,jpkm1
	405	DO ji=1,jpi
	406	va(ji,2,jk)=0.25(va(ji,1,jk)+2.va(ji,2,jk)+va(ji,3,jk))
	407	va(ji,2,jk)=va(ji,2,jk)*vmask(ji,2,jk)
	408	END DO
	409	END DO
[390]	410
[636]	411	spgv1(:,2)=0.
[390]	412
[636]	413	DO jk=1,jpkm1
	414	DO ji=1,jpi
	415	spgv1(ji,2)=spgv1(ji,2)+fse3v(ji,2,jk)va(ji,2,jk)vmask(ji,2,jk)
	416	END DO
	417	END DO
[390]	418
[636]	419	DO ji=1,jpi
	420	IF (vmask(ji,2,1).NE.0.) THEN
	421	spgv1(ji,2)=spgv1(ji,2)/hv(ji,2)
	422	ENDIF
	423	END DO
[390]	424
[636]	425	DO jk=1,jpkm1
	426	DO ji=1,jpi
	427	va(ji,2,jk) = (va(ji,2,jk)+spgv(ji,2)-spgv1(ji,2))*vmask(ji,2,jk)
	428	END DO
	429	END DO
[390]	430
[636]	431	DO jk=1,jpkm1
	432	DO ji=1,jpi
	433	ua(ji,2,jk) = (zua(ji,2,jk)/(rhoye2u(ji,2)))umask(ji,2,jk)
[469]	434	#if ! defined key_zco
[636]	435	ua(ji,2,jk) = ua(ji,2,jk) / fse3u(ji,2,jk)
[390]	436	#endif
[636]	437	END DO
	438	END DO
[390]	439
[636]	440	sshn(:,2)=sshn(:,3)
	441	sshb(:,2)=sshb(:,3)
	442	ENDIF
[390]	443
[636]	444	IF((nbondj == 1).OR.(nbondj == 2)) THEN
[390]	445
[636]	446	DO ji=1,jpi
	447	laplacv(ji,nlcj-2) = timeref * (zva2d(ji,nlcj-2)/(zrhox*e1v(ji,nlcj-2)))
	448	END DO
[390]	449
[636]	450	DO jk=1,jpkm1
	451	DO ji=1,jpi
	452	va(ji,nlcj-2:nlcj-1,jk) = (zva(ji,nlcj-2:nlcj-1,jk)/(zrhox*e1v(ji,nlcj-2:nlcj-1)))
[469]	453	#if ! defined key_zco
[636]	454	va(ji,nlcj-2:nlcj-1,jk) = va(ji,nlcj-2:nlcj-1,jk) / fse3v(ji,nlcj-2:nlcj-1,jk)
[390]	455	#endif
[636]	456	END DO
	457	END DO
[390]	458
[636]	459	DO jk=1,jpkm1
	460	DO ji=1,jpi
	461	va(ji,nlcj-2,jk) = (va(ji,nlcj-2,jk)-z2dt * znugdt * laplacv(ji,nlcj-2))*vmask(ji,nlcj-2,jk)
	462	END DO
	463	END DO
[390]	464
	465
[636]	466	spgv(:,nlcj-2)=0.
[390]	467
[636]	468	DO jk=1,jpkm1
	469	DO ji=1,jpi
	470	spgv(ji,nlcj-2)=spgv(ji,nlcj-2)+fse3v(ji,nlcj-2,jk)*va(ji,nlcj-2,jk)
	471	END DO
	472	END DO
[390]	473
[636]	474	DO ji=1,jpi
	475	IF (vmask(ji,nlcj-2,1).NE.0.) THEN
	476	spgv(ji,nlcj-2)=spgv(ji,nlcj-2)/hv(ji,nlcj-2)
	477	ENDIF
	478	END DO
[390]	479
[636]	480	DO jk=1,jpkm1
	481	DO ji=1,jpi
	482	va(ji,nlcj-2,jk)=0.25(va(ji,nlcj-3,jk)+2.va(ji,nlcj-2,jk)+va(ji,nlcj-1,jk))
	483	va(ji,nlcj-2,jk) = va(ji,nlcj-2,jk) * vmask(ji,nlcj-2,jk)
	484	END DO
	485	END DO
[390]	486
[636]	487	spgv1(:,nlcj-2)=0.
[390]	488
[636]	489	DO jk=1,jpkm1
	490	DO ji=1,jpi
	491	spgv1(ji,nlcj-2)=spgv1(ji,nlcj-2)+fse3v(ji,nlcj-2,jk)*va(ji,nlcj-2,jk)
	492	END DO
	493	END DO
[390]	494
[636]	495	DO ji=1,jpi
	496	IF (vmask(ji,nlcj-2,1).NE.0.) THEN
	497	spgv1(ji,nlcj-2)=spgv1(ji,nlcj-2)/hv(ji,nlcj-2)
	498	ENDIF
	499	END DO
[390]	500
[636]	501	DO jk=1,jpkm1
	502	DO ji=1,jpi
	503	va(ji,nlcj-2,jk) = (va(ji,nlcj-2,jk)+spgv(ji,nlcj-2)-spgv1(ji,nlcj-2))*vmask(ji,nlcj-2,jk)
	504	END DO
	505	END DO
[390]	506
[636]	507	DO jk=1,jpkm1
	508	DO ji=1,jpi
	509	ua(ji,nlcj-1,jk) = (zua(ji,nlcj-1,jk)/(rhoye2u(ji,nlcj-1)))umask(ji,nlcj-1,jk)
[469]	510	#if ! defined key_zco
[636]	511	ua(ji,nlcj-1,jk) = ua(ji,nlcj-1,jk) / fse3u(ji,nlcj-1,jk)
[390]	512	#endif
[636]	513	END DO
	514	END DO
[390]	515
[636]	516	sshn(:,nlcj-1)=sshn(:,nlcj-2)
	517	sshb(:,nlcj-1)=sshb(:,nlcj-2)
	518	ENDIF
[390]	519
[636]	520	END SUBROUTINE Agrif_dyn
[390]	521
[1605]	522
[636]	523	SUBROUTINE interpu(tabres,i1,i2,j1,j2,k1,k2)
[1605]	524	!!----------------------------------------------------------------------
	525	!! * ROUTINE interpu *
	526	!!----------------------------------------------------------------------
[636]	527	INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2
	528	REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: tabres
[1605]	529	!!
[636]	530	INTEGER :: ji,jj,jk
[1605]	531	!!----------------------------------------------------------------------
[636]	532
	533	DO jk=k1,k2
	534	DO jj=j1,j2
	535	DO ji=i1,i2
	536	tabres(ji,jj,jk) = e2u(ji,jj) * un(ji,jj,jk)
[469]	537	#if ! defined key_zco
[636]	538	tabres(ji,jj,jk) = tabres(ji,jj,jk) * fse3u(ji,jj,jk)
[390]	539	#endif
[636]	540	END DO
	541	END DO
	542	END DO
	543	END SUBROUTINE interpu
[390]	544
[1605]	545
[636]	546	SUBROUTINE interpu2d(tabres,i1,i2,j1,j2)
[1605]	547	!!----------------------------------------------------------------------
	548	!! * ROUTINE interpu2d *
	549	!!----------------------------------------------------------------------
[636]	550	INTEGER, INTENT(in) :: i1,i2,j1,j2
	551	REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: tabres
[1605]	552	!!
[636]	553	INTEGER :: ji,jj
[1605]	554	!!----------------------------------------------------------------------
[390]	555
[636]	556	DO jj=j1,j2
	557	DO ji=i1,i2
	558	tabres(ji,jj) = e2u(ji,jj) * ((gcx(ji+1,jj) - gcx(ji,jj))/e1u(ji,jj)) &
	559	* umask(ji,jj,1)
	560	END DO
	561	END DO
	562
	563	END SUBROUTINE interpu2d
	564
[1605]	565
[636]	566	SUBROUTINE interpv(tabres,i1,i2,j1,j2,k1,k2)
[1605]	567	!!----------------------------------------------------------------------
	568	!! * ROUTINE interpv *
	569	!!----------------------------------------------------------------------
[636]	570	INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2
	571	REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: tabres
[1605]	572	!!
[636]	573	INTEGER :: ji, jj, jk
[1605]	574	!!----------------------------------------------------------------------
[636]	575
	576	DO jk=k1,k2
	577	DO jj=j1,j2
	578	DO ji=i1,i2
	579	tabres(ji,jj,jk) = e1v(ji,jj) * vn(ji,jj,jk)
[469]	580	#if ! defined key_zco
[636]	581	tabres(ji,jj,jk) = tabres(ji,jj,jk) * fse3v(ji,jj,jk)
[390]	582	#endif
[636]	583	END DO
	584	END DO
	585	END DO
[390]	586
[636]	587	END SUBROUTINE interpv
[390]	588
[1605]	589
[636]	590	SUBROUTINE interpv2d(tabres,i1,i2,j1,j2)
[1605]	591	!!----------------------------------------------------------------------
	592	!! * ROUTINE interpu2d *
	593	!!----------------------------------------------------------------------
[636]	594	INTEGER, INTENT(in) :: i1,i2,j1,j2
	595	REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: tabres
[1605]	596	!!
[636]	597	INTEGER :: ji,jj
[1605]	598	!!----------------------------------------------------------------------
[636]	599
	600	DO jj=j1,j2
	601	DO ji=i1,i2
	602	tabres(ji,jj) = e1v(ji,jj) * ((gcx(ji,jj+1) - gcx(ji,jj))/e2v(ji,jj)) &
	603	* vmask(ji,jj,1)
	604	END DO
	605	END DO
	606
	607	END SUBROUTINE interpv2d
	608
[390]	609	#else
[1605]	610	!!----------------------------------------------------------------------
	611	!! Empty module no AGRIF zoom
	612	!!----------------------------------------------------------------------
[636]	613	CONTAINS
	614	SUBROUTINE Agrif_OPA_Interp_empty
	615	WRITE(,) 'agrif_opa_interp : You should not have seen this print! error?'
	616	END SUBROUTINE Agrif_OPA_Interp_empty
[390]	617	#endif
[1605]	618
	619	!!======================================================================
[636]	620	END MODULE agrif_opa_interp

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

Download in other formats: