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_update.F90 in branches/2017/dev_r7963_nemo_v3_6_AGRIF-3_AGRIFVVL/NEMOGCM/NEMO/NST_SRC – NEMO

source: branches/2017/dev_r7963_nemo_v3_6_AGRIF-3_AGRIFVVL/NEMOGCM/NEMO/NST_SRC/agrif_opa_update.F90 @ 8663

Last change on this file since 8663 was 8663, checked in by jchanut, 7 years ago

Revert fmask to free slip case at outermost child grid points + slight change in tracer update near bathymetry
  • Property svn:keywords set to Id
File size: 36.4 KB
Line 
1#define TWO_WAY        /* TWO WAY NESTING */
2#undef DECAL_FEEDBACK /* SEPARATION of INTERFACES*/
3 
4MODULE agrif_opa_update
5#if defined key_agrif  && ! defined key_offline
6   USE par_oce
7   USE oce
8   USE dom_oce
9   USE agrif_oce
10   USE in_out_manager  ! I/O manager
11   USE lib_mpp
12   USE wrk_nemo 
13   USE dynspg_oce
14   USE zdf_oce        ! vertical physics: ocean variables
15   USE domvvl         ! Need interpolation routines
16
17   IMPLICIT NONE
18   PRIVATE
19
20   PUBLIC Agrif_Update_Tra, Agrif_Update_Dyn, Update_Scales, Agrif_Update_vvl
21
22# if defined key_zdftke
23   PUBLIC Agrif_Update_Tke
24# endif
25   !!----------------------------------------------------------------------
26   !! NEMO/NST 3.6 , NEMO Consortium (2010)
27   !! $Id$
28   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
29   !!----------------------------------------------------------------------
30
31CONTAINS
32
33   SUBROUTINE Agrif_Update_Tra( )
34      !!---------------------------------------------
35      !!   *** ROUTINE Agrif_Update_Tra ***
36      !!---------------------------------------------
37      !
38      IF (Agrif_Root()) RETURN
39      !
40#if defined TWO_WAY 
41      IF (lwp.AND.lk_agrif_debug) Write(*,*) 'Update tracers  from grid Number',Agrif_Fixed(), 'nbcline', nbcline
42
43      Agrif_UseSpecialValueInUpdate = .TRUE.
44      Agrif_SpecialValueFineGrid = 0.
45      !
46      IF (MOD(nbcline,nbclineupdate) == 0) THEN
47# if ! defined DECAL_FEEDBACK
48         CALL Agrif_Update_Variable(tsn_id, procname=updateTS)
49# else
50         CALL Agrif_Update_Variable(tsn_id, locupdate=(/1,0/),procname=updateTS)
51# endif
52      ELSE
53# if ! defined DECAL_FEEDBACK
54         CALL Agrif_Update_Variable(tsn_id,locupdate=(/0,2/), procname=updateTS)
55# else
56         CALL Agrif_Update_Variable(tsn_id,locupdate=(/1,2/), procname=updateTS)
57# endif
58      ENDIF
59      !
60      Agrif_UseSpecialValueInUpdate = .FALSE.
61      !
62#endif
63      !
64   END SUBROUTINE Agrif_Update_Tra
65
66   SUBROUTINE Agrif_Update_Dyn( )
67      !!---------------------------------------------
68      !!   *** ROUTINE Agrif_Update_Dyn ***
69      !!---------------------------------------------
70      !
71      IF (Agrif_Root()) RETURN
72      !
73#if defined TWO_WAY
74      IF (lwp.AND.lk_agrif_debug) Write(*,*) 'Update momentum from grid Number',Agrif_Fixed(), 'nbcline', nbcline
75
76      Agrif_UseSpecialValueInUpdate = .FALSE.
77      Agrif_SpecialValueFineGrid = 0.
78      !     
79      IF (mod(nbcline,nbclineupdate) == 0) THEN
80# if ! defined DECAL_FEEDBACK
81         CALL Agrif_Update_Variable(un_update_id,procname = updateU)
82         CALL Agrif_Update_Variable(vn_update_id,procname = updateV)
83# else
84         CALL Agrif_Update_Variable(un_update_id,locupdate1=(/0,-1/),locupdate2=(/1,-2/),procname = updateU)
85         CALL Agrif_Update_Variable(vn_update_id,locupdate1=(/1,-2/),locupdate2=(/0,-1/),procname = updateV)
86# endif
87      ELSE
88# if ! defined DECAL_FEEDBACK
89         CALL Agrif_Update_Variable(un_update_id,locupdate=(/0,1/),procname = updateU)
90         CALL Agrif_Update_Variable(vn_update_id,locupdate=(/0,1/),procname = updateV)         
91# else
92         CALL Agrif_Update_Variable(un_update_id,locupdate1=(/0,1/),locupdate2=(/1,1/),procname = updateU)
93         CALL Agrif_Update_Variable(vn_update_id,locupdate1=(/1,1/),locupdate2=(/0,1/),procname = updateV)
94# endif
95      ENDIF
96
97# if ! defined DECAL_FEEDBACK
98      CALL Agrif_Update_Variable(e1u_id,procname = updateU2d)
99      CALL Agrif_Update_Variable(e2v_id,procname = updateV2d) 
100# else
101      CALL Agrif_Update_Variable(e1u_id,locupdate1=(/0,-1/),locupdate2=(/1,-2/),procname = updateU2d)
102      CALL Agrif_Update_Variable(e2v_id,locupdate1=(/1,-2/),locupdate2=(/0,-1/),procname = updateV2d) 
103# endif
104
105# if defined key_dynspg_ts
106      IF (ln_bt_fw) THEN
107         ! Update time integrated transports
108         IF (mod(nbcline,nbclineupdate) == 0) THEN
109#  if ! defined DECAL_FEEDBACK
110            CALL Agrif_Update_Variable(ub2b_update_id,procname = updateub2b)
111            CALL Agrif_Update_Variable(vb2b_update_id,procname = updatevb2b)
112#  else
113            CALL Agrif_Update_Variable(ub2b_update_id,locupdate1=(/0,-1/),locupdate2=(/1,-2/),procname = updateub2b)
114            CALL Agrif_Update_Variable(vb2b_update_id,locupdate1=(/1,-2/),locupdate2=(/0,-1/),procname = updatevb2b)
115#  endif
116         ELSE
117#  if ! defined DECAL_FEEDBACK
118            CALL Agrif_Update_Variable(ub2b_update_id,locupdate=(/0,1/),procname = updateub2b)
119            CALL Agrif_Update_Variable(vb2b_update_id,locupdate=(/0,1/),procname = updatevb2b)
120#  else
121            CALL Agrif_Update_Variable(ub2b_update_id,locupdate1=(/0,1/),locupdate2=(/1,1/),procname = updateub2b)
122            CALL Agrif_Update_Variable(vb2b_update_id,locupdate1=(/1,1/),locupdate2=(/0,1/),procname = updatevb2b)
123#  endif
124         ENDIF
125      END IF
126# endif
127      !
128      nbcline = nbcline + 1
129      !
130      Agrif_UseSpecialValueInUpdate = .TRUE.
131      Agrif_SpecialValueFineGrid = 0.
132# if ! defined DECAL_FEEDBACK
133      CALL Agrif_Update_Variable(sshn_id,procname = updateSSH)
134# else
135      CALL Agrif_Update_Variable(sshn_id,locupdate=(/1,0/),procname = updateSSH)
136# endif
137      Agrif_UseSpecialValueInUpdate = .FALSE.
138      !
139#endif
140      !
141   END SUBROUTINE Agrif_Update_Dyn
142
143# if defined key_zdftke
144   SUBROUTINE Agrif_Update_Tke( kt )
145      !!---------------------------------------------
146      !!   *** ROUTINE Agrif_Update_Tke ***
147      !!---------------------------------------------
148      !!
149      INTEGER, INTENT(in) :: kt
150      !       
151      IF( ( Agrif_NbStepint() .NE. 0 ) .AND. (kt /= 0) ) RETURN
152#  if defined TWO_WAY
153
154      Agrif_UseSpecialValueInUpdate = .TRUE.
155      Agrif_SpecialValueFineGrid = 0.
156
157      CALL Agrif_Update_Variable( en_id, locupdate=(/0,0/), procname=updateEN  )
158      CALL Agrif_Update_Variable(avt_id, locupdate=(/0,0/), procname=updateAVT )
159      CALL Agrif_Update_Variable(avm_id, locupdate=(/0,0/), procname=updateAVM )
160
161      Agrif_UseSpecialValueInUpdate = .FALSE.
162
163#  endif
164     
165   END SUBROUTINE Agrif_Update_Tke
166# endif /* key_zdftke */
167
168   SUBROUTINE Agrif_Update_vvl( )
169      !!---------------------------------------------
170      !!   *** ROUTINE Agrif_Update_vvl ***
171      !!---------------------------------------------
172      !
173      IF (Agrif_Root()) RETURN
174      !
175#if defined TWO_WAY 
176      !
177      IF (lwp.AND.lk_agrif_debug) Write(*,*) 'Update e3 from grid Number',Agrif_Fixed(), 'Step', Agrif_Nb_Step()
178      !
179      ! JC
180!      Agrif_UseSpecialValueInUpdate = .FALSE.
181      Agrif_UseSpecialValueInUpdate = .TRUE.
182      Agrif_SpecialValueFineGrid = 0.
183      !
184# if ! defined DECAL_FEEDBACK
185      CALL Agrif_Update_Variable(e3t_id, procname=updatee3t)
186# else
187      CALL Agrif_Update_Variable(e3t_id, locupdate=(/1,0/), procname=updatee3t)
188# endif 
189      !
190      Agrif_UseSpecialValueInUpdate = .FALSE.
191      !
192      CALL Agrif_ChildGrid_To_ParentGrid()
193      CALL dom_vvl_update_UVF
194      CALL Agrif_ParentGrid_To_ChildGrid()
195      !
196#endif
197      !
198   END SUBROUTINE Agrif_Update_vvl
199
200   SUBROUTINE dom_vvl_update_UVF
201      !!---------------------------------------------
202      !!       *** ROUTINE dom_vvl_update_UVF ***
203      !!---------------------------------------------
204#  include "domzgr_substitute.h90"
205      !!
206      INTEGER :: jk
207      REAL(wp):: zcoef
208      !!---------------------------------------------
209
210      IF (lwp.AND.lk_agrif_debug) Write(*,*) 'Finalize e3 on grid Number', &
211                  & Agrif_Fixed(), 'Step', Agrif_Nb_Step()
212
213      ! Save "old" scale factor (prior update) for subsequent asselin correction
214      ! of prognostic variables (needed to update initial state only)
215      fse3u_a(:,:,:) = fse3u_n(:,:,:)
216      fse3v_a(:,:,:) = fse3v_n(:,:,:)
217!      ua(:,:,:) = fse3u_b(:,:,:)
218!      va(:,:,:) = fse3v_b(:,:,:)
219      hu_a(:,:) = hu(:,:)
220      hv_a(:,:) = hv(:,:)
221
222      ! Vertical scale factor interpolations
223      ! ------------------------------------
224      !
225      CALL dom_vvl_interpol( fse3t_n(:,:,:), fse3u_n(:,:,:),  'U'  )
226      CALL dom_vvl_interpol( fse3t_n(:,:,:), fse3v_n(:,:,:),  'V'  )
227      CALL dom_vvl_interpol( fse3u_n(:,:,:), fse3f_n(:,:,:),  'F'  )
228
229      CALL dom_vvl_interpol( fse3u_n(:,:,:), fse3uw_n(:,:,:), 'UW' )
230      CALL dom_vvl_interpol( fse3v_n(:,:,:), fse3vw_n(:,:,:), 'VW' )
231
232      ! Update total depths:
233      hu(:,:) = 0._wp                        ! Ocean depth at U-points
234      hv(:,:) = 0._wp                        ! Ocean depth at V-points
235      DO jk = 1, jpkm1
236         hu(:,:) = hu(:,:) + fse3u_n(:,:,jk) * umask(:,:,jk)
237         hv(:,:) = hv(:,:) + fse3v_n(:,:,jk) * vmask(:,:,jk)
238      END DO
239      !                                      ! Inverse of the local depth
240      hur(:,:) = 1._wp / ( hu(:,:) + 1._wp - umask_i(:,:) ) * umask_i(:,:)
241      hvr(:,:) = 1._wp / ( hv(:,:) + 1._wp - vmask_i(:,:) ) * vmask_i(:,:)
242
243#if ! defined key_dynspg_ts
244      IF  (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN
245#else
246      IF ((.NOT.(lk_agrif_fstep.AND.(neuler==0))).AND.(.NOT.ln_bt_fw)) THEN
247#endif
248         CALL dom_vvl_interpol( fse3t_b(:,:,:), fse3u_b(:,:,:),  'U'  )
249         CALL dom_vvl_interpol( fse3t_b(:,:,:), fse3v_b(:,:,:),  'V'  )
250
251         CALL dom_vvl_interpol( fse3u_b(:,:,:), fse3uw_b(:,:,:), 'UW' )
252         CALL dom_vvl_interpol( fse3v_b(:,:,:), fse3vw_b(:,:,:), 'VW' )
253
254         hu_b(:,:) = 0._wp                        ! Ocean depth at U-points
255         hv_b(:,:) = 0._wp                        ! Ocean depth at V-points
256         DO jk = 1, jpkm1
257            hu_b(:,:) = hu_b(:,:) + fse3u_b(:,:,jk) * umask(:,:,jk)
258            hv_b(:,:) = hv_b(:,:) + fse3v_b(:,:,jk) * vmask(:,:,jk)
259         END DO
260         !                                      ! Inverse of the local depth
261         hur_b(:,:) = 1._wp / ( hu_b(:,:) + 1._wp - umask_i(:,:) ) * umask_i(:,:)
262         hvr_b(:,:) = 1._wp / ( hv_b(:,:) + 1._wp - vmask_i(:,:) ) * vmask_i(:,:)
263      ENDIF
264
265      !
266   END SUBROUTINE dom_vvl_update_UVF
267
268   SUBROUTINE updateTS( tabres, i1, i2, j1, j2, k1, k2, n1, n2, before )
269      !!---------------------------------------------
270      !!           *** ROUTINE updateT ***
271      !!---------------------------------------------
272      INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2,n1,n2
273      REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2), INTENT(inout) :: tabres
274      LOGICAL, INTENT(in) :: before
275      !!
276      INTEGER :: ji,jj,jk,jn
277      REAL(wp) :: ztb, ztnu, ztno
278      !!---------------------------------------------
279      !
280      !
281      IF (before) THEN
282         DO jn = n1,n2
283            DO jk=k1,k2
284               DO jj=j1,j2
285                  DO ji=i1,i2
286!> jc tmp
287                     tabres(ji,jj,jk,jn) = tsn(ji,jj,jk,jn)  * fse3t_n(ji,jj,jk) / e3t_0(ji,jj,jk)
288!                     tabres(ji,jj,jk,jn) = tsn(ji,jj,jk,jn)  * fse3t_n(ji,jj,jk)
289!< jc tmp
290                  END DO
291               END DO
292            END DO
293         END DO
294      ELSE
295!> jc tmp
296         DO jn = n1,n2
297            tabres(i1:i2,j1:j2,k1:k2,jn) =  tabres(i1:i2,j1:j2,k1:k2,jn) * e3t_0(i1:i2,j1:j2,k1:k2) &
298                                         & * tmask(i1:i2,j1:j2,k1:k2)
299         ENDDO
300!< jc tmp
301
302         IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN
303            ! Add asselin part
304            DO jn = n1,n2
305               DO jk=k1,k2
306                  DO jj=j1,j2
307                     DO ji=i1,i2
308                        IF( tabres(ji,jj,jk,jn) .NE. 0. ) THEN
309                           ztb  = tsb(ji,jj,jk,jn) * fse3t_b(ji,jj,jk) ! fse3t_b prior update should be used
310                           ztnu = tabres(ji,jj,jk,jn)
311                           ztno = tsn(ji,jj,jk,jn) * fse3t_a(ji,jj,jk)
312                           tsb(ji,jj,jk,jn) = ( ztb + atfp * ( ztnu - ztno) )  & 
313                                     &        * tmask(ji,jj,jk) / fse3t_b(ji,jj,jk)
314                        ENDIF
315                     ENDDO
316                  ENDDO
317               ENDDO
318            ENDDO
319         ENDIF
320
321         DO jn = n1,n2
322            DO jk=k1,k2
323               DO jj=j1,j2
324                  DO ji=i1,i2
325                     IF( tabres(ji,jj,jk,jn) .NE. 0. ) THEN
326                        tsn(ji,jj,jk,jn) = tabres(ji,jj,jk,jn) / fse3t_n(ji,jj,jk)
327                     END IF
328                  END DO
329               END DO
330            END DO
331         END DO
332         !
333         IF  ((neuler==0).AND.(Agrif_Nb_Step()==0) ) THEN
334            tsb(i1:i2,j1:j2,k1:k2,n1:n2)  = tsn(i1:i2,j1:j2,k1:k2,n1:n2)
335         ENDIF
336         !
337      ENDIF
338      !
339   END SUBROUTINE updateTS
340
341   SUBROUTINE updateu( tabres, i1, i2, j1, j2, k1, k2, before, nb, ndir )
342      !!---------------------------------------------
343      !!           *** ROUTINE updateu ***
344      !!---------------------------------------------
345#  include "domzgr_substitute.h90"
346      !!
347      INTEGER, INTENT(in) :: i1, i2, j1, j2, k1, k2
348      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: tabres
349      LOGICAL, INTENT(in) :: before
350      INTEGER, INTENT(in) :: nb , ndir
351      !!
352      LOGICAL western_side, eastern_side
353      INTEGER :: ji, jj, jk
354      REAL(wp) :: zrhoy
355      REAL(wp) :: zub, zunu, zuno
356      !!---------------------------------------------
357      !
358      IF (before) THEN
359         zrhoy = Agrif_Rhoy()
360         DO jk=k1,k2
361            DO jj=j1,j2
362               DO ji=i1,i2
363                  tabres(ji,jj,jk) = e2u(ji,jj) * un(ji,jj,jk)
364                  tabres(ji,jj,jk) = tabres(ji,jj,jk) * fse3u_n(ji,jj,jk)
365               END DO
366            END DO
367         END DO
368         tabres = zrhoy * tabres
369      ELSE
370         western_side = (nb == 1).AND.(ndir == 1)
371         eastern_side = (nb == 1).AND.(ndir == 2)
372         DO jk=k1,k2
373            DO jj=j1,j2
374               DO ji=i1,i2
375                  tabres(ji,jj,jk) = tabres(ji,jj,jk) / e2u(ji,jj) 
376                  !
377                  IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN ! Add asselin part
378                     zub  = ub(ji,jj,jk) * fse3u_b(ji,jj,jk)
379                     zuno = un(ji,jj,jk) * fse3u_a(ji,jj,jk)
380                     zunu = tabres(ji,jj,jk)
381                     ub(ji,jj,jk) = ( zub + atfp * ( zunu - zuno) ) &     
382                                    & * umask(ji,jj,jk) / fse3u_b(ji,jj,jk)
383                  ENDIF
384                  !
385                  un(ji,jj,jk) = tabres(ji,jj,jk) * umask(ji,jj,jk) / fse3u_n(ji,jj,jk)
386               END DO
387            END DO
388         END DO
389         !
390!         IF (western_side) THEN
391!            DO jk=k1,k2
392!               DO jj=j1,j2
393!                 un(i1-1,jj,jk) = un(i1-1,jj,jk) * fse3u_a(i1-1,jj,jk) / fse3u_n(i1-1,jj,jk)
394!               END DO
395!            ENDDO
396!         ENDIF
397!         IF (eastern_side) THEN
398!            DO jk=k1,k2
399!               DO jj=j1,j2
400!                 un(i2+1,jj,jk) = un(i2+1,jj,jk) * fse3u_a(i2+1,jj,jk) / fse3u_n(i2+1,jj,jk)
401!               END DO
402!            ENDDO
403!         ENDIF
404         !
405         IF  ((neuler==0).AND.(Agrif_Nb_Step()==0) ) THEN
406            ub(i1:i2,j1:j2,k1:k2)  = un(i1:i2,j1:j2,k1:k2)
407         ENDIF
408         !
409      ENDIF
410      !
411   END SUBROUTINE updateu
412
413   SUBROUTINE updatev( tabres, i1, i2, j1, j2, k1, k2, before, nb, ndir )
414      !!---------------------------------------------
415      !!           *** ROUTINE updatev ***
416      !!---------------------------------------------
417#  include "domzgr_substitute.h90"
418      !!
419      INTEGER :: i1,i2,j1,j2,k1,k2
420      INTEGER :: ji,jj,jk
421      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2) :: tabres
422      LOGICAL :: before
423      INTEGER, INTENT(in) :: nb , ndir
424      !!
425      LOGICAL :: northern_side, southern_side
426      REAL(wp) :: zrhox
427      REAL(wp) :: zvb, zvnu, zvno
428      !!---------------------------------------------     
429      !
430      IF (before) THEN
431         zrhox = Agrif_Rhox()
432         DO jk=k1,k2
433            DO jj=j1,j2
434               DO ji=i1,i2
435                  tabres(ji,jj,jk) = e1v(ji,jj) * vn(ji,jj,jk)
436                  tabres(ji,jj,jk) = tabres(ji,jj,jk) * fse3v_n(ji,jj,jk)
437               END DO
438            END DO
439         END DO
440         tabres = zrhox * tabres
441      ELSE
442         southern_side = (nb == 2).AND.(ndir == 1)
443         northern_side = (nb == 2).AND.(ndir == 2)
444         DO jk=k1,k2
445            DO jj=j1,j2
446               DO ji=i1,i2
447                  tabres(ji,jj,jk) = tabres(ji,jj,jk) / e1v(ji,jj)
448                  !
449                  IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN ! Add asselin part
450                     zvb  = vb(ji,jj,jk) * fse3v_b(ji,jj,jk)
451                     zvno = vn(ji,jj,jk) * fse3v_a(ji,jj,jk)
452                     zvnu = tabres(ji,jj,jk)
453                     vb(ji,jj,jk) = ( zvb + atfp * ( zvnu - zvno) ) &     
454                                    & * vmask(ji,jj,jk) / fse3v_b(ji,jj,jk)
455                  ENDIF
456                  !
457                  vn(ji,jj,jk) = tabres(ji,jj,jk) * vmask(ji,jj,jk) / fse3v_n(ji,jj,jk)
458               END DO
459            END DO
460         END DO
461         !
462!         IF (southern_side) THEN
463!            DO jk=k1,k2
464!               DO ji=i1,i2
465!                 vn(ji,j1-1,jk) = vn(ji,j1-1,jk) * fse3v_a(ji,j1-1,jk) / fse3v_n(ji,j1-1,jk)
466!               END DO
467!            ENDDO
468!         ENDIF
469!         IF (northern_side) THEN
470!            DO jk=k1,k2
471!               DO ji=i1,i2
472!                 vn(ji,j2+1,jk) = vn(ji,j2+1,jk) * fse3v_a(ji,j2+1,jk) / fse3v_n(ji,j2+1,jk)
473!               END DO
474!            ENDDO
475!         ENDIF
476         !
477         IF  ((neuler==0).AND.(Agrif_Nb_Step()==0) ) THEN
478            vb(i1:i2,j1:j2,k1:k2)  = vn(i1:i2,j1:j2,k1:k2)
479         ENDIF
480         !
481      ENDIF
482      !
483   END SUBROUTINE updatev
484
485   SUBROUTINE updateu2d( tabres, i1, i2, j1, j2, before, nb, ndir )
486      !!---------------------------------------------
487      !!          *** ROUTINE updateu2d ***
488      !!---------------------------------------------
489#  include "domzgr_substitute.h90"
490      !!
491      INTEGER, INTENT(in) :: i1, i2, j1, j2
492      REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: tabres
493      LOGICAL, INTENT(in) :: before
494      INTEGER, INTENT(in) :: nb , ndir
495      !!
496      LOGICAL western_side, eastern_side 
497      INTEGER :: ji, jj, jk
498      REAL(wp) :: zrhoy
499      REAL(wp) :: zcorr
500      !!---------------------------------------------
501      !
502      IF (before) THEN
503         zrhoy = Agrif_Rhoy()
504         DO jj=j1,j2
505            DO ji=i1,i2
506               tabres(ji,jj) = un_b(ji,jj) * hu(ji,jj) * e2u(ji,jj)
507            END DO
508         END DO
509         tabres = zrhoy * tabres
510      ELSE
511         western_side = (nb == 1).AND.(ndir == 1)
512         eastern_side = (nb == 1).AND.(ndir == 2)
513         DO jj=j1,j2
514            DO ji=i1,i2
515               tabres(ji,jj) =  tabres(ji,jj) / e2u(ji,jj) 
516               !   
517               ! Update "now" 3d velocities:
518               spgu(ji,jj) = 0.e0
519               DO jk=1,jpkm1
520                  spgu(ji,jj) = spgu(ji,jj) + fse3u_n(ji,jj,jk) * un(ji,jj,jk)
521               END DO
522               !
523               zcorr = (tabres(ji,jj) - spgu(ji,jj)) * hur(ji,jj)
524               DO jk=1,jpkm1             
525                  un(ji,jj,jk) = un(ji,jj,jk) + zcorr * umask(ji,jj,jk)           
526               END DO
527               !
528               ! Update barotropic velocities:
529#if ! defined key_dynspg_ts
530               IF  (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN
531#else
532               IF ((.NOT.(lk_agrif_fstep.AND.(neuler==0))).AND.(.NOT.ln_bt_fw)) THEN
533#endif
534                  zcorr = (tabres(ji,jj) - un_b(ji,jj) * hu_a(ji,jj)) * hur_b(ji,jj)
535                  ub_b(ji,jj) = ub_b(ji,jj) + atfp * zcorr * umask(ji,jj,1)
536               END IF             
537               un_b(ji,jj) = tabres(ji,jj) * hur(ji,jj) * umask(ji,jj,1)
538               !       
539               ! Correct "before" velocities to hold correct bt component:
540               spgu(ji,jj) = 0.e0
541               DO jk=1,jpkm1
542                  spgu(ji,jj) = spgu(ji,jj) + fse3u_b(ji,jj,jk) * ub(ji,jj,jk)
543               END DO
544               !
545               zcorr = ub_b(ji,jj) - spgu(ji,jj) * hur_b(ji,jj)
546               DO jk=1,jpkm1             
547                  ub(ji,jj,jk) = ub(ji,jj,jk) + zcorr * umask(ji,jj,jk)           
548               END DO
549               !
550            END DO
551         END DO
552!         IF (western_side) THEN
553!            DO jj=j1,j2
554!              un_b(i1-1,jj) = un_b(i1-1,jj) * hu_a(i1-1,jj) * hur(i1-1,jj)
555!            END DO
556!         ENDIF
557!         IF (eastern_side) THEN
558!            DO jj=j1,j2
559!              un_b(i2+1,jj) = un_b(i2+1,jj) * hu_a(i2+1,jj) * hur(i2+1,jj)
560!            ENDDO
561!         ENDIF
562         IF  ((neuler==0).AND.(Agrif_Nb_Step()==0) ) THEN
563            ub_b(i1:i2,j1:j2)  = un_b(i1:i2,j1:j2)
564         ENDIF
565      ENDIF
566      !
567   END SUBROUTINE updateu2d
568
569   SUBROUTINE updatev2d( tabres, i1, i2, j1, j2, before, nb, ndir  )
570      !!---------------------------------------------
571      !!          *** ROUTINE updatev2d ***
572      !!---------------------------------------------
573      INTEGER, INTENT(in) :: i1, i2, j1, j2
574      REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: tabres
575      LOGICAL, INTENT(in) :: before
576      INTEGER, INTENT(in) :: nb , ndir
577      !!
578      LOGICAL :: northern_side, southern_side
579      INTEGER :: ji, jj, jk
580      REAL(wp) :: zrhox
581      REAL(wp) :: zcorr
582      !!---------------------------------------------
583      !
584      IF (before) THEN
585         zrhox = Agrif_Rhox()
586         DO jj=j1,j2
587            DO ji=i1,i2
588               tabres(ji,jj) = vn_b(ji,jj) * hv(ji,jj) * e1v(ji,jj) 
589            END DO
590         END DO
591         tabres = zrhox * tabres
592      ELSE
593         southern_side = (nb == 2).AND.(ndir == 1)
594         northern_side = (nb == 2).AND.(ndir == 2)
595         DO jj=j1,j2
596            DO ji=i1,i2
597               tabres(ji,jj) =  tabres(ji,jj) / e1v(ji,jj) 
598               !   
599               ! Update "now" 3d velocities:
600               spgv(ji,jj) = 0.e0
601               DO jk=1,jpkm1
602                  spgv(ji,jj) = spgv(ji,jj) + fse3v_n(ji,jj,jk) * vn(ji,jj,jk)
603               END DO
604               !
605               zcorr = (tabres(ji,jj) - spgv(ji,jj)) * hvr(ji,jj)
606               DO jk=1,jpkm1             
607                  vn(ji,jj,jk) = vn(ji,jj,jk) + zcorr * vmask(ji,jj,jk)           
608               END DO
609               !
610               ! Update barotropic velocities:
611#if ! defined key_dynspg_ts
612               IF  (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN
613#else
614               IF ((.NOT.(lk_agrif_fstep.AND.(neuler==0))).AND.(.NOT.ln_bt_fw)) THEN
615#endif
616                  zcorr = (tabres(ji,jj) - vn_b(ji,jj)*hv_a(ji,jj)) * hvr_b(ji,jj)
617                  vb_b(ji,jj) = vb_b(ji,jj) + atfp * zcorr * vmask(ji,jj,1)
618               END IF             
619               vn_b(ji,jj) = tabres(ji,jj) * hvr(ji,jj) * vmask(ji,jj,1)
620               !       
621               ! Correct "before" velocities to hold correct bt component:
622               spgv(ji,jj) = 0.e0
623               DO jk=1,jpkm1
624                  spgv(ji,jj) = spgv(ji,jj) + fse3v_b(ji,jj,jk) * vb(ji,jj,jk)
625               END DO
626               !
627               zcorr = vb_b(ji,jj) - spgv(ji,jj) * hvr_b(ji,jj)
628               DO jk=1,jpkm1             
629                  vb(ji,jj,jk) = vb(ji,jj,jk) + zcorr * vmask(ji,jj,jk)           
630               END DO
631               !
632            END DO
633         END DO
634         !
635!         IF (southern_side) THEN
636!            DO ji=i1,i2
637!              vn_b(ji,j1-1) = vn_b(ji,j1-1) * hv_a(ji,j1-1) * hvr(ji,j1-1)
638!            END DO
639!         ENDIF
640!         IF (northern_side) THEN
641!            DO ji=i1,i2
642!              vn_b(ji,j2+1) = vn_b(ji,j2+1) * hv_a(ji,j2+1) * hvr(ji,j2+1)
643!            END DO
644!         ENDIF
645         !
646         IF  ((neuler==0).AND.(Agrif_Nb_Step()==0) ) THEN
647            vb_b(i1:i2,j1:j2)  = vn_b(i1:i2,j1:j2)
648         ENDIF
649         !
650      ENDIF
651      !
652   END SUBROUTINE updatev2d
653
654
655   SUBROUTINE updateSSH( tabres, i1, i2, j1, j2, before )
656      !!---------------------------------------------
657      !!          *** ROUTINE updateSSH ***
658      !!---------------------------------------------
659      INTEGER, INTENT(in) :: i1, i2, j1, j2
660      REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: tabres
661      LOGICAL, INTENT(in) :: before
662      !!
663      INTEGER :: ji, jj
664      !!---------------------------------------------
665      !
666      IF (before) THEN
667         DO jj=j1,j2
668            DO ji=i1,i2
669               tabres(ji,jj) = sshn(ji,jj)
670            END DO
671         END DO
672      ELSE
673#if ! defined key_dynspg_ts
674         IF  (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN
675#else
676         IF ((.NOT.(lk_agrif_fstep.AND.(neuler==0))).AND.(.NOT.ln_bt_fw)) THEN
677#endif
678            DO jj=j1,j2
679               DO ji=i1,i2
680                  sshb(ji,jj) =   sshb(ji,jj) &
681                        & + atfp * ( tabres(ji,jj) - sshn(ji,jj) ) * tmask(ji,jj,1)
682               END DO
683            END DO
684         ENDIF
685         !
686         DO jj=j1,j2
687            DO ji=i1,i2
688               sshn(ji,jj) = tabres(ji,jj) * tmask(ji,jj,1)
689            END DO
690         END DO
691         !
692         IF  ((neuler==0).AND.(Agrif_Nb_Step()==0) ) THEN
693            sshb(i1:i2,j1:j2)  = sshn(i1:i2,j1:j2)
694         ENDIF
695         !
696      ENDIF
697      !
698   END SUBROUTINE updateSSH
699
700   SUBROUTINE updateub2b( tabres, i1, i2, j1, j2, before )
701      !!---------------------------------------------
702      !!          *** ROUTINE updateub2b ***
703      !!---------------------------------------------
704      INTEGER, INTENT(in) :: i1, i2, j1, j2
705      REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: tabres
706      LOGICAL, INTENT(in) :: before
707      !!
708      INTEGER :: ji, jj
709      REAL(wp) :: zrhoy, za1
710      !!---------------------------------------------
711      !
712      IF (before) THEN
713         zrhoy = Agrif_Rhoy()
714         DO jj=j1,j2
715            DO ji=i1,i2
716               tabres(ji,jj) = ub2_i_b(ji,jj) * e2u(ji,jj)
717            END DO
718         END DO
719         tabres = zrhoy * tabres
720      ELSE
721         za1 = 1._wp / REAL(Agrif_rhot(), wp)
722         tabres(i1:i2,j1:j2) = tabres(i1:i2,j1:j2) / e2u(i1:i2,j1:j2)
723         DO jj=j1,j2
724            DO ji=i1,i2 
725               ub2_i_b(ji,jj) = ub2_i_b(ji,jj) & 
726                & + za1 * (tabres(ji,jj) - ub2_b(ji,jj))
727               ub2_b(ji,jj) = tabres(ji,jj)
728            END DO
729         END DO
730      ENDIF
731      !
732   END SUBROUTINE updateub2b
733
734   SUBROUTINE updatevb2b( tabres, i1, i2, j1, j2, before )
735      !!---------------------------------------------
736      !!          *** ROUTINE updatevb2b ***
737      !!---------------------------------------------
738      INTEGER, INTENT(in) :: i1, i2, j1, j2
739      REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: tabres
740      LOGICAL, INTENT(in) :: before
741      !!
742      INTEGER :: ji, jj
743      REAL(wp) :: zrhox, za1
744      !!---------------------------------------------
745      !
746      IF (before) THEN
747         zrhox = Agrif_Rhox()
748         DO jj=j1,j2
749            DO ji=i1,i2
750               tabres(ji,jj) = vb2_i_b(ji,jj) * e1v(ji,jj) 
751            END DO
752         END DO
753         tabres = zrhox * tabres
754      ELSE
755         za1 = 1._wp / REAL(Agrif_rhot(), wp)
756         tabres(i1:i2,j1:j2) = tabres(i1:i2,j1:j2) / e1v(i1:i2,j1:j2)
757         DO jj=j1,j2
758            DO ji=i1,i2
759               vb2_i_b(ji,jj) = vb2_i_b(ji,jj) & 
760                & + za1 * (tabres(ji,jj) - vb2_b(ji,jj))
761               vb2_b(ji,jj) = tabres(ji,jj)
762            END DO
763         END DO
764      ENDIF
765      !
766   END SUBROUTINE updatevb2b
767
768
769   SUBROUTINE update_scales( tabres, i1, i2, j1, j2, k1, k2, n1,n2, before )
770      ! currently not used
771      !!---------------------------------------------
772      !!           *** ROUTINE updateT ***
773      !!---------------------------------------------
774#  include "domzgr_substitute.h90"
775
776      INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2,n1,n2
777      REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2), INTENT(inout) :: tabres
778      LOGICAL, iNTENT(in) :: before
779
780      INTEGER :: ji,jj,jk
781      REAL(wp) :: ztemp
782
783      IF (before) THEN
784         DO jk=k1,k2
785            DO jj=j1,j2
786               DO ji=i1,i2
787                  tabres(ji,jj,jk,1) = e1t(ji,jj)*e2t(ji,jj)*tmask(ji,jj,jk)
788                  tabres(ji,jj,jk,2) = e1t(ji,jj)*tmask(ji,jj,jk)
789                  tabres(ji,jj,jk,3) = e2t(ji,jj)*tmask(ji,jj,jk)
790               END DO
791            END DO
792         END DO
793         tabres(:,:,:,1)=tabres(:,:,:,1)*Agrif_Rhox()*Agrif_Rhoy()
794         tabres(:,:,:,2)=tabres(:,:,:,2)*Agrif_Rhox()
795         tabres(:,:,:,3)=tabres(:,:,:,3)*Agrif_Rhoy()
796      ELSE
797         DO jk=k1,k2
798            DO jj=j1,j2
799               DO ji=i1,i2
800                  IF( tabres(ji,jj,jk,1) .NE. 0. ) THEN
801                     print *,'VAL = ',ji,jj,jk,tabres(ji,jj,jk,1),e1t(ji,jj)*e2t(ji,jj)*tmask(ji,jj,jk)
802                     print *,'VAL2 = ',ji,jj,jk,tabres(ji,jj,jk,2),e1t(ji,jj)*tmask(ji,jj,jk)
803                     print *,'VAL3 = ',ji,jj,jk,tabres(ji,jj,jk,3),e2t(ji,jj)*tmask(ji,jj,jk)
804                     ztemp = sqrt(tabres(ji,jj,jk,1)/(tabres(ji,jj,jk,2)*tabres(ji,jj,jk,3)))
805                     print *,'CORR = ',ztemp-1.
806                     print *,'NEW VALS = ',tabres(ji,jj,jk,2)*ztemp,tabres(ji,jj,jk,3)*ztemp, &
807                           tabres(ji,jj,jk,2)*ztemp*tabres(ji,jj,jk,3)*ztemp
808                     e1t(ji,jj) = tabres(ji,jj,jk,2)*ztemp
809                     e2t(ji,jj) = tabres(ji,jj,jk,3)*ztemp
810                  END IF
811               END DO
812            END DO
813         END DO
814      ENDIF
815      !
816   END SUBROUTINE update_scales
817
818# if defined key_zdftke
819   SUBROUTINE updateEN( ptab, i1, i2, j1, j2, k1, k2, before )
820      !!---------------------------------------------
821      !!           *** ROUTINE updateen ***
822      !!---------------------------------------------
823      INTEGER, INTENT(in) :: i1, i2, j1, j2, k1, k2
824      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: ptab
825      LOGICAL, INTENT(in) :: before
826      !!---------------------------------------------
827      !
828      IF (before) THEN
829         ptab (i1:i2,j1:j2,k1:k2) = en(i1:i2,j1:j2,k1:k2)
830      ELSE
831         en(i1:i2,j1:j2,k1:k2) = ptab (i1:i2,j1:j2,k1:k2) 
832      ENDIF
833      !
834   END SUBROUTINE updateEN
835
836
837   SUBROUTINE updateAVT( ptab, i1, i2, j1, j2, k1, k2, before )
838      !!---------------------------------------------
839      !!           *** ROUTINE updateavt ***
840      !!---------------------------------------------
841      INTEGER, INTENT(in) :: i1, i2, j1, j2, k1, k2
842      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: ptab
843      LOGICAL, INTENT(in) :: before
844      !!---------------------------------------------
845      !
846      IF (before) THEN
847         ptab (i1:i2,j1:j2,k1:k2) = avt_k(i1:i2,j1:j2,k1:k2)
848      ELSE
849         avt_k(i1:i2,j1:j2,k1:k2) = ptab (i1:i2,j1:j2,k1:k2) 
850      ENDIF
851      !
852   END SUBROUTINE updateAVT
853
854
855   SUBROUTINE updateAVM( ptab, i1, i2, j1, j2, k1, k2, before )
856      !!---------------------------------------------
857      !!           *** ROUTINE updateavm ***
858      !!---------------------------------------------
859      INTEGER, INTENT(in) :: i1, i2, j1, j2, k1, k2
860      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: ptab
861      LOGICAL, INTENT(in) :: before
862      !!---------------------------------------------
863      !
864      IF (before) THEN
865         ptab (i1:i2,j1:j2,k1:k2) = avm_k(i1:i2,j1:j2,k1:k2)
866      ELSE
867         avm_k(i1:i2,j1:j2,k1:k2) = ptab (i1:i2,j1:j2,k1:k2) 
868      ENDIF
869      !
870   END SUBROUTINE updateAVM
871
872# endif /* key_zdftke */ 
873
874   SUBROUTINE updatee3t( ptab, i1, i2, j1, j2, k1, k2, before )
875      !!---------------------------------------------
876      !!           *** ROUTINE updatee3t ***
877      !!---------------------------------------------
878      INTEGER, INTENT(in) :: i1, i2, j1, j2, k1, k2
879      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: ptab
880      LOGICAL, INTENT(in) :: before
881      INTEGER :: ji,jj,jk
882      REAL(wp) :: zcoef
883      !!---------------------------------------------
884      !
885      IF (before) THEN
886!> jc tmp:
887!         ptab(i1:i2,j1:j2,k1:k2) = fse3t_n(i1:i2,j1:j2,k1:k2)
888         ptab(i1:i2,j1:j2,k1:k2) = fse3t_n(i1:i2,j1:j2,k1:k2) / e3t_0(i1:i2,j1:j2,k1:k2) * tmask(i1:i2,j1:j2,k1:k2)
889!< jc tmp:
890      ELSE
891         !
892         ! 1) Updates at before time step:
893         ! -------------------------------
894         !
895!> jc tmp:
896         DO jk = 1, jpkm1
897            DO jj=j1,j2
898               DO ji=i1,i2
899                  IF (tmask(ji,jj,jk)==1) THEN
900                     ptab(ji,jj,jk) = ptab(ji,jj,jk) * e3t_0(ji,jj,jk)
901                  ELSE
902                     ptab(ji,jj,jk) = e3t_0(ji,jj,jk)
903                  ENDIF
904               END DO
905            END DO
906         END DO
907!!         ptab(i1:i2,j1:j2,k1:k2) = ptab(i1:i2,j1:j2,k1:k2) * e3t_0(i1:i2,j1:j2,k1:k2)
908!< jc tmp:
909
910         ! Save "old" scale factor (prior update) for subsequent asselin correction
911         ! of prognostic variables (needed to update initial state only)
912         fse3t_a(i1:i2,j1:j2,k1:k2) = fse3t_n(i1:i2,j1:j2,k1:k2)
913!         hdivb(i1:i2,j1:j2,k1:k2)   = fse3t_b(i1:i2,j1:j2,k1:k2)
914
915#if ! defined key_dynspg_ts
916         IF  (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN
917#else
918         IF ((.NOT.(lk_agrif_fstep.AND.(neuler==0))).AND.(.NOT.ln_bt_fw)) THEN
919#endif
920            DO jk = 1, jpkm1
921               DO jj=j1,j2
922                  DO ji=i1,i2
923                     fse3t_b(ji,jj,jk) =   fse3t_b(ji,jj,jk) &
924                           & + atfp * ( ptab(ji,jj,jk) - fse3t_n(ji,jj,jk) )
925                  END DO
926               END DO
927            END DO
928            !
929            fse3w_b (i1:i2,j1:j2,1) = e3w_0(i1:i2,j1:j2,1) + fse3t_b(i1:i2,j1:j2,1) - e3t_0(i1:i2,j1:j2,1)
930            fsdepw_b(i1:i2,j1:j2,1) = 0.0_wp
931            fsdept_b(i1:i2,j1:j2,1) = 0.5_wp * fse3w_b(i1:i2,j1:j2,1)
932            !
933            DO jk = 2, jpk
934               DO jj = j1,j2
935                  DO ji = i1,i2           
936                     zcoef = (tmask(ji,jj,jk) - wmask(ji,jj,jk))
937                     fse3w_b(ji,jj,jk)  = e3w_0(ji,jj,jk) + ( 1.0_wp - 0.5_wp * tmask(ji,jj,jk) ) *        & 
938                     &                                        ( fse3t_b(ji,jj,jk-1) - e3t_0(ji,jj,jk-1) )  &
939                     &                                    +            0.5_wp * tmask(ji,jj,jk)   *        &
940                     &                                        ( fse3t_b(ji,jj,jk  ) - e3t_0(ji,jj,jk  ) )
941                     fsdepw_b(ji,jj,jk) = fsdepw_b(ji,jj,jk-1) + fse3t_b(ji,jj,jk-1)
942                     fsdept_b(ji,jj,jk) =      zcoef  * ( fsdepw_b(ji,jj,jk  ) + 0.5 * fse3w_b(ji,jj,jk))  &
943                         &                + (1-zcoef) * ( fsdept_b(ji,jj,jk-1) +       fse3w_b(ji,jj,jk)) 
944                  END DO
945               END DO
946            END DO
947            !
948         ENDIF       
949         !
950         ! 2) Updates at now time step:
951         ! ----------------------------
952         !
953         ! Update vertical scale factor at T-points:
954         fse3t_n(i1:i2,j1:j2,k1:k2) = ptab(i1:i2,j1:j2,k1:k2)
955         !
956         ! Update total depth:
957         ht(i1:i2,j1:j2) = 0._wp
958         DO jk = 1, jpkm1
959            ht(i1:i2,j1:j2) = ht(i1:i2,j1:j2) + fse3t_n(i1:i2,j1:j2,jk) * tmask(i1:i2,j1:j2,jk)
960         END DO
961         !
962         ! Update vertical scale factor at W-points and depths:
963         fse3w_n (i1:i2,j1:j2,1) = e3w_0(i1:i2,j1:j2,1) + fse3t_n(i1:i2,j1:j2,1) - e3t_0(i1:i2,j1:j2,1)
964         fsdept_n(i1:i2,j1:j2,1) = 0.5_wp * fse3w_n(i1:i2,j1:j2,1)
965         fsdepw_n(i1:i2,j1:j2,1) = 0.0_wp
966         fsde3w_n(i1:i2,j1:j2,1) = fsdept_n(i1:i2,j1:j2,1) - (ht(i1:i2,j1:j2)-ht_0(i1:i2,j1:j2)) ! Last term in the rhs is ssh
967         !
968         DO jk = 2, jpk
969            DO jj = j1,j2
970               DO ji = i1,i2           
971               zcoef = (tmask(ji,jj,jk) - wmask(ji,jj,jk))
972               fse3w_n(ji,jj,jk)  = e3w_0(ji,jj,jk) + ( 1.0_wp - 0.5_wp * tmask(ji,jj,jk) ) * ( fse3t_n(ji,jj,jk-1) - e3t_0(ji,jj,jk-1) )   &
973               &                                    +            0.5_wp * tmask(ji,jj,jk)   * ( fse3t_n(ji,jj,jk  ) - e3t_0(ji,jj,jk  ) )
974               fsdepw_n(ji,jj,jk) = fsdepw_n(ji,jj,jk-1) + fse3t_n(ji,jj,jk-1)
975               fsdept_n(ji,jj,jk) =      zcoef  * ( fsdepw_n(ji,jj,jk  ) + 0.5 * fse3w_n(ji,jj,jk))  &
976                   &                + (1-zcoef) * ( fsdept_n(ji,jj,jk-1) +       fse3w_n(ji,jj,jk)) 
977               fsde3w_n(ji,jj,jk) = fsdept_n(ji,jj,jk) - (ht(ji,jj)-ht_0(ji,jj)) ! Last term in the rhs is ssh
978               END DO
979            END DO
980         END DO
981         !
982         IF  ((neuler==0).AND.(Agrif_Nb_Step()==0) ) THEN
983            fse3t_b (i1:i2,j1:j2,1:jpk)  = fse3t_n (i1:i2,j1:j2,1:jpk)
984            fse3w_b (i1:i2,j1:j2,1:jpk)  = fse3w_n (i1:i2,j1:j2,1:jpk)
985            fsdepw_b(i1:i2,j1:j2,1:jpk)  = fsdepw_n(i1:i2,j1:j2,1:jpk)
986            fsdept_b(i1:i2,j1:j2,1:jpk)  = fsdept_n(i1:i2,j1:j2,1:jpk)
987         ENDIF
988         !
989      ENDIF
990      !
991   END SUBROUTINE updatee3t
992
993#else
994CONTAINS
995   SUBROUTINE agrif_opa_update_empty
996      !!---------------------------------------------
997      !!   *** ROUTINE agrif_opa_update_empty ***
998      !!---------------------------------------------
999      WRITE(*,*)  'agrif_opa_update : You should not have seen this print! error?'
1000   END SUBROUTINE agrif_opa_update_empty
1001#endif
1002END MODULE agrif_opa_update
1003
Note: See TracBrowser for help on using the repository browser.