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

Last change on this file since 1441 was 1300, checked in by rblod, 15 years ago

Correct a bug in TOP update part

  • Property svn:eol-style set to native
  • Property svn:keywords set to Id
File size: 17.8 KB
RevLine 
[636]1MODULE agrif_opa_interp
[1300]2#if defined key_agrif && ! defined key_off_tra
[636]3   USE par_oce
4   USE oce
5   USE dom_oce     
6   USE sol_oce
[782]7   USE agrif_oce
[390]8
[636]9   IMPLICIT NONE
10   PRIVATE
11   
12   PUBLIC Agrif_tra, Agrif_dyn, interpu, interpv
[390]13
[1156]14   !!----------------------------------------------------------------------
15   !!   OPA 9.0 , LOCEAN-IPSL (2006)
16   !! $Id$
17   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
18   !!----------------------------------------------------------------------
19
[636]20   CONTAINS
21   
[782]22   SUBROUTINE Agrif_tra
[636]23      !!---------------------------------------------
24      !!   *** ROUTINE Agrif_Tra ***
25      !!---------------------------------------------
[390]26#  include "domzgr_substitute.h90" 
27#  include "vectopt_loop_substitute.h90"
[636]28     
[390]29      INTEGER :: ji,jj,jk
[636]30      REAL(wp) :: zrhox
[390]31      REAL(wp) :: alpha1, alpha2, alpha3, alpha4
32      REAL(wp) :: alpha5, alpha6, alpha7
[636]33      REAL(wp), DIMENSION(jpi,jpj,jpk) :: zta, zsa
34      !
35      IF(Agrif_Root()) RETURN
[390]36
[636]37      Agrif_SpecialValue=0.
38      Agrif_UseSpecialValue = .TRUE.
39      zta = 0.e0
40      zsa = 0.e0
[390]41
[636]42      CALL Agrif_Bc_variable(zta,tn)
43      CALL Agrif_Bc_variable(zsa,sn)
44      Agrif_UseSpecialValue = .FALSE.
[390]45
[636]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
[390]80      ENDIF
81
[636]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
[390]104      ENDIF
105
[636]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
[390]124      ENDIF
125
[636]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      !!---------------------------------------------
[390]152      USE phycst
153      USE in_out_manager
154
155#  include "domzgr_substitute.h90"
[636]156     
157      INTEGER, INTENT(in) :: kt
158
159      REAL(wp) :: timeref
[390]160      REAL(wp) :: z2dt, znugdt
[636]161      REAL(wp) :: zrhox, rhoy
162      REAL(wp), DIMENSION(jpi,jpj) :: zua2d, zva2d
[390]163      REAL(wp), DIMENSION(jpi,jpj) :: spgu1,spgv1
[636]164      REAL(wp), DIMENSION(jpi,jpj,jpk) :: zua, zva
165      INTEGER :: ji,jj,jk
[390]166
167      IF (Agrif_Root()) RETURN
168
[636]169      zrhox = Agrif_Rhox()
[390]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
[636]181      Agrif_SpecialValue=0.
[782]182      Agrif_UseSpecialValue = ln_spc_dyn
183
[636]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.
[390]190
[636]191      Agrif_SpecialValue=0.
[782]192      Agrif_UseSpecialValue = ln_spc_dyn
[636]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.
[390]196
197
[636]198      IF((nbondi == -1).OR.(nbondi == 2)) THEN
[390]199
[636]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)))
[469]207#if ! defined key_zco
[636]208               ua(1:2,jj,jk) = ua(1:2,jj,jk) / fse3u(1:2,jj,jk)
[390]209#endif
[636]210            END DO
211         END DO
[390]212
[636]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
[390]218
[636]219         spgu(2,:)=0.
[390]220
[636]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
[390]226
[636]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
[390]232
[636]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
[390]239
[636]240         spgu1(2,:)=0.
[390]241
[636]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
[390]247
[636]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
[390]253
[636]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
[390]259
[636]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)
[469]263#if ! defined key_zco
[636]264               va(2,jj,jk) = va(2,jj,jk) / fse3v(2,jj,jk)
[390]265#endif           
[636]266            END DO
267         END DO
[390]268
[636]269         sshn(2,:)=sshn(3,:)
270         sshb(2,:)=sshb(3,:)
[390]271
[636]272      ENDIF
[390]273
[636]274      IF((nbondi == 1).OR.(nbondi == 2)) THEN
[390]275
[636]276         DO jj=1,jpj
277            laplacu(nlci-2,jj) = timeref * (zua2d(nlci-2,jj)/(rhoy*e2u(nlci-2,jj)))
278         END DO
[390]279
[636]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
[469]284#if ! defined key_zco
[636]285               ua(nlci-2:nlci-1,jj,jk) = ua(nlci-2:nlci-1,jj,jk) / fse3u(nlci-2:nlci-1,jj,jk)
[390]286#endif
287
[636]288            END DO
289         END DO
[390]290
[636]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
[390]296
297
[636]298         spgu(nlci-2,:)=0.
[390]299
[636]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
[390]305
[636]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
[390]311
[636]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))
[390]315
[636]316               ua(nlci-2,jj,jk) = ua(nlci-2,jj,jk) * umask(nlci-2,jj,jk)
[390]317
[636]318            END DO
319         END DO
[390]320
[636]321         spgu1(nlci-2,:)=0.
[390]322
[636]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
[390]328
[636]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
[390]334
[636]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
[390]340
[636]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)
[469]344#if ! defined key_zco
[636]345               va(nlci-1,jj,jk) = va(nlci-1,jj,jk) / fse3v(nlci-1,jj,jk)
[390]346#endif
[636]347            END DO
348         END DO
[390]349
[636]350         sshn(nlci-1,:)=sshn(nlci-2,:)
351         sshb(nlci-1,:)=sshb(nlci-2,:)       
352      ENDIF
[390]353
[636]354      IF((nbondj == -1).OR.(nbondj == 2)) THEN
[390]355
[636]356         DO ji=1,jpi
357            laplacv(ji,2) = timeref * (zva2d(ji,2)/(zrhox*e1v(ji,2)))
358         END DO
[390]359
[636]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)))
[469]363#if ! defined key_zco
[636]364               va(ji,1:2,jk) = va(ji,1:2,jk) / fse3v(ji,1:2,jk)
[390]365#endif
[636]366            END DO
367         END DO
[390]368
[636]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
[390]374
[636]375         spgv(:,2)=0.
[390]376
[636]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
[390]382
[636]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
[390]388
[636]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
[390]395
[636]396         spgv1(:,2)=0.
[390]397
[636]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
[390]403
[636]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
[390]409
[636]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
[390]415
[636]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) 
[469]419#if ! defined key_zco
[636]420               ua(ji,2,jk) = ua(ji,2,jk) / fse3u(ji,2,jk)
[390]421#endif               
[636]422            END DO
423         END DO
[390]424
[636]425         sshn(:,2)=sshn(:,3)
426         sshb(:,2)=sshb(:,3)
427      ENDIF
[390]428
[636]429      IF((nbondj == 1).OR.(nbondj == 2)) THEN
[390]430
[636]431         DO ji=1,jpi
432            laplacv(ji,nlcj-2) = timeref * (zva2d(ji,nlcj-2)/(zrhox*e1v(ji,nlcj-2)))
433         END DO
[390]434
[636]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)))
[469]438#if ! defined key_zco
[636]439               va(ji,nlcj-2:nlcj-1,jk) = va(ji,nlcj-2:nlcj-1,jk) / fse3v(ji,nlcj-2:nlcj-1,jk)
[390]440#endif
[636]441            END DO
442         END DO
[390]443
[636]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
[390]449
450
[636]451         spgv(:,nlcj-2)=0.
[390]452
[636]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
[390]458
[636]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
[390]464
[636]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
[390]471
[636]472         spgv1(:,nlcj-2)=0.
[390]473
[636]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
[390]479
[636]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
[390]485
[636]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
[390]491
[636]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)
[469]495#if ! defined key_zco
[636]496               ua(ji,nlcj-1,jk) = ua(ji,nlcj-1,jk) / fse3u(ji,nlcj-1,jk)
[390]497#endif         
[636]498            END DO
499         END DO
[390]500
[636]501         sshn(:,nlcj-1)=sshn(:,nlcj-2)
502         sshb(:,nlcj-1)=sshb(:,nlcj-2)               
503      ENDIF
[390]504
[636]505   END SUBROUTINE Agrif_dyn
[390]506
[636]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)
[469]522#if ! defined key_zco
[636]523               tabres(ji,jj,jk) = tabres(ji,jj,jk) * fse3u(ji,jj,jk)
[390]524#endif
[636]525            END DO
526         END DO
527      END DO
528   END SUBROUTINE interpu
[390]529
[636]530   SUBROUTINE interpu2d(tabres,i1,i2,j1,j2)
531      !!---------------------------------------------
532      !!   *** ROUTINE interpu2d ***
533      !!---------------------------------------------
[390]534
[636]535      INTEGER, INTENT(in) :: i1,i2,j1,j2
536      REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: tabres
[390]537
[636]538      INTEGER :: ji,jj
[390]539
[636]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)
[469]564#if ! defined key_zco
[636]565               tabres(ji,jj,jk) = tabres(ji,jj,jk) * fse3v(ji,jj,jk)
[390]566#endif           
[636]567            END DO
568         END DO
569      END DO
[390]570
[636]571   END SUBROUTINE interpv
[390]572
[636]573   SUBROUTINE interpv2d(tabres,i1,i2,j1,j2)
574      !!---------------------------------------------
575      !!   *** ROUTINE interpv2d ***
576      !!---------------------------------------------
[390]577
[636]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
[390]592#else
[636]593CONTAINS
[390]594
[636]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
[390]601#endif
[636]602END MODULE agrif_opa_interp
Note: See TracBrowser for help on using the repository browser.