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

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

Last change on this file since 706 was 699, checked in by smasson, 17 years ago

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