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 @ 719

Last change on this file since 719 was 719, checked in by ctlod, 17 years ago

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