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

Last change on this file since 1156 was 1156, checked in by rblod, 16 years ago

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