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.
dynnxt.F90 in branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/RK3_SRC/DYN – NEMO

source: branches/2017/dev_r7881_ENHANCE09_RK3/NEMOGCM/NEMO/RK3_SRC/DYN/dynnxt.F90 @ 8568

Last change on this file since 8568 was 8568, checked in by gm, 7 years ago

#1911 (ENHANCE-09): PART I.2 - _NONE option + remove zts + see associated wiki page

  • Property svn:keywords set to Id
File size: 17.6 KB
Line 
1MODULE dynnxt
2   !!=========================================================================
3   !!                       ***  MODULE  dynnxt  ***
4   !! Ocean dynamics: time stepping
5   !!=========================================================================
6   !! History :  OPA  !  1987-02  (P. Andrich, D. L Hostis)  Original code
7   !!                 !  1990-10  (C. Levy, G. Madec)
8   !!            7.0  !  1993-03  (M. Guyon)  symetrical conditions
9   !!            8.0  !  1997-02  (G. Madec & M. Imbard)  opa, release 8.0
10   !!            8.2  !  1997-04  (A. Weaver)  Euler forward step
11   !!             -   !  1997-06  (G. Madec)  lateral boudary cond., lbc routine
12   !!    NEMO    1.0  !  2002-08  (G. Madec)  F90: Free form and module
13   !!             -   !  2002-10  (C. Talandier, A-M. Treguier) Open boundary cond.
14   !!            2.0  !  2005-11  (V. Garnier) Surface pressure gradient organization
15   !!            2.3  !  2007-07  (D. Storkey) Calls to BDY routines.
16   !!            3.2  !  2009-06  (G. Madec, R.Benshila)  re-introduce the vvl option
17   !!            3.3  !  2010-09  (D. Storkey, E.O'Dea) Bug fix for BDY module
18   !!            3.3  !  2011-03  (P. Oddo) Bug fix for time-splitting+(BDY-OBC) and not VVL
19   !!            3.5  !  2013-07  (J. Chanut) Compliant with time splitting changes
20   !!            3.6  !  2014-04  (G. Madec) add the diagnostic of the time filter trends
21   !!            3.7  !  2015-11  (J. Chanut) Free surface simplification
22   !!-------------------------------------------------------------------------
23 
24   !!-------------------------------------------------------------------------
25   !!   dyn_nxt       : obtain the next (after) horizontal velocity
26   !!-------------------------------------------------------------------------
27   USE oce            ! ocean dynamics and tracers
28   USE dom_oce        ! ocean space and time domain
29   USE sbc_oce        ! Surface boundary condition: ocean fields
30   USE phycst         ! physical constants
31   USE dynadv         ! dynamics: vector invariant versus flux form
32   USE dynspg_ts      ! surface pressure gradient: split-explicit scheme
33   USE domvvl         ! variable volume
34   USE bdy_oce   , ONLY: ln_bdy
35   USE bdydta         ! ocean open boundary conditions
36   USE bdydyn         ! ocean open boundary conditions
37   USE bdyvol         ! ocean open boundary condition (bdy_vol routines)
38   USE trd_oce        ! trends: ocean variables
39   USE trddyn         ! trend manager: dynamics
40   USE trdken         ! trend manager: kinetic energy
41   !
42   USE in_out_manager ! I/O manager
43   USE iom            ! I/O manager library
44   USE lbclnk         ! lateral boundary condition (or mpp link)
45   USE lib_mpp        ! MPP library
46   USE prtctl         ! Print control
47   USE timing         ! Timing
48#if defined key_agrif
49   USE agrif_opa_interp
50#endif
51
52   IMPLICIT NONE
53   PRIVATE
54
55   PUBLIC    dyn_nxt   ! routine called by step.F90
56
57   !!----------------------------------------------------------------------
58   !! NEMO/OPA 4.0 , NEMO Consortium (2017)
59   !! $Id$
60   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
61   !!----------------------------------------------------------------------
62CONTAINS
63
64   SUBROUTINE dyn_nxt ( kt )
65      !!----------------------------------------------------------------------
66      !!                  ***  ROUTINE dyn_nxt  ***
67      !!                   
68      !! ** Purpose :   Finalize after horizontal velocity. Apply the boundary
69      !!             condition on the after velocity, achieve the time stepping
70      !!             by applying the Asselin filter on now fields and swapping
71      !!             the fields.
72      !!
73      !! ** Method  : * Ensure after velocities transport matches time splitting
74      !!             estimate (ln_dynspg_ts=T)
75      !!
76      !!              * Apply lateral boundary conditions on after velocity
77      !!             at the local domain boundaries through lbc_lnk call,
78      !!             at the one-way open boundaries (ln_bdy=T),
79      !!             at the AGRIF zoom   boundaries (lk_agrif=T)
80      !!
81      !!              * Apply the time filter applied and swap of the dynamics
82      !!             arrays to start the next time step:
83      !!                (ub,vb) = (un,vn) + atfp [ (ub,vb) + (ua,va) - 2 (un,vn) ]
84      !!                (un,vn) = (ua,va).
85      !!             Note that with flux form advection and non linear free surface,
86      !!             the time filter is applied on thickness weighted velocity.
87      !!             As a result, dyn_nxt MUST be called after tra_nxt.
88      !!
89      !! ** Action :   ub,vb   filtered before horizontal velocity of next time-step
90      !!               un,vn   now horizontal velocity of next time-step
91      !!----------------------------------------------------------------------
92      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index
93      !
94      INTEGER  ::   ji, jj, jk   ! dummy loop indices
95      INTEGER  ::   ikt          ! local integers
96      REAL(wp) ::   zue3a, zue3n, zue3b, zuf, zcoef    ! local scalars
97      REAL(wp) ::   zve3a, zve3n, zve3b, zvf, z1_2dt   !   -      -
98      REAL(wp), ALLOCATABLE, DIMENSION(:,:)   ::   zue, zve
99      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   ze3u_f, ze3v_f, zua, zva 
100      !!----------------------------------------------------------------------
101      !
102      IF( ln_timing    )   CALL timing_start('dyn_nxt')
103      IF( ln_dynspg_ts )   ALLOCATE( zue(jpi,jpj)     , zve(jpi,jpj)     )
104      IF( l_trddyn     )   ALLOCATE( zua(jpi,jpj,jpk) , zva(jpi,jpj,jpk) )
105      !
106      IF( kt == nit000 ) THEN
107         IF(lwp) WRITE(numout,*)
108         IF(lwp) WRITE(numout,*) 'dyn_nxt : time stepping'
109         IF(lwp) WRITE(numout,*) '~~~~~~~'
110      ENDIF
111
112      IF ( ln_dynspg_ts ) THEN
113         ! Ensure below that barotropic velocities match time splitting estimate
114         ! Compute actual transport and replace it with ts estimate at "after" time step
115         zue(:,:) = e3u_a(:,:,1) * ua(:,:,1) * umask(:,:,1)
116         zve(:,:) = e3v_a(:,:,1) * va(:,:,1) * vmask(:,:,1)
117         DO jk = 2, jpkm1
118            zue(:,:) = zue(:,:) + e3u_a(:,:,jk) * ua(:,:,jk) * umask(:,:,jk)
119            zve(:,:) = zve(:,:) + e3v_a(:,:,jk) * va(:,:,jk) * vmask(:,:,jk)
120         END DO
121         DO jk = 1, jpkm1
122            ua(:,:,jk) = ( ua(:,:,jk) - zue(:,:) * r1_hu_a(:,:) + ua_b(:,:) ) * umask(:,:,jk)
123            va(:,:,jk) = ( va(:,:,jk) - zve(:,:) * r1_hv_a(:,:) + va_b(:,:) ) * vmask(:,:,jk)
124         END DO
125         !
126         IF( .NOT.ln_bt_fw ) THEN
127            ! Remove advective velocity from "now velocities"
128            ! prior to asselin filtering     
129            ! In the forward case, this is done below after asselin filtering   
130            ! so that asselin contribution is removed at the same time
131            DO jk = 1, jpkm1
132               un(:,:,jk) = ( un(:,:,jk) - un_adv(:,:) + un_b(:,:) )*umask(:,:,jk)
133               vn(:,:,jk) = ( vn(:,:,jk) - vn_adv(:,:) + vn_b(:,:) )*vmask(:,:,jk)
134            END DO 
135         ENDIF
136      ENDIF
137
138      ! Update after velocity on domain lateral boundaries
139      ! --------------------------------------------------     
140# if defined key_agrif
141      CALL Agrif_dyn( kt )             !* AGRIF zoom boundaries
142# endif
143      !
144      CALL lbc_lnk( ua, 'U', -1. )     !* local domain boundaries
145      CALL lbc_lnk( va, 'V', -1. ) 
146      !
147      !                                !* BDY open boundaries
148      IF( ln_bdy .AND. ln_dynspg_exp )   CALL bdy_dyn( kt )
149      IF( ln_bdy .AND. ln_dynspg_ts  )   CALL bdy_dyn( kt, dyn3d_only=.true. )
150
151!!$   Do we need a call to bdy_vol here??
152      !
153      IF( l_trddyn ) THEN             ! prepare the atf trend computation + some diagnostics
154         z1_2dt = 1._wp / (2. * rdt)        ! Euler or leap-frog time step
155         IF( neuler == 0 .AND. kt == nit000 )   z1_2dt = 1._wp / rdt
156         !
157         !                                  ! Kinetic energy and Conversion
158         IF( ln_KE_trd  )   CALL trd_dyn( ua, va, jpdyn_ken, kt )
159         !
160         IF( ln_dyn_trd ) THEN              ! 3D output: total momentum trends
161            zua(:,:,:) = ( ua(:,:,:) - ub(:,:,:) ) * z1_2dt
162            zva(:,:,:) = ( va(:,:,:) - vb(:,:,:) ) * z1_2dt
163            CALL iom_put( "utrd_tot", zua )        ! total momentum trends, except the asselin time filter
164            CALL iom_put( "vtrd_tot", zva )
165         ENDIF
166         !
167         zua(:,:,:) = un(:,:,:)             ! save the now velocity before the asselin filter
168         zva(:,:,:) = vn(:,:,:)             ! (caution: there will be a shift by 1 timestep in the
169         !                                  !  computation of the asselin filter trends)
170      ENDIF
171
172      ! Time filter and swap of dynamics arrays
173      ! ------------------------------------------
174      IF( neuler == 0 .AND. kt == nit000 ) THEN        !* Euler at first time-step: only swap
175         DO jk = 1, jpkm1
176            un(:,:,jk) = ua(:,:,jk)                          ! un <-- ua
177            vn(:,:,jk) = va(:,:,jk)
178         END DO
179         IF(.NOT.ln_linssh ) THEN
180            DO jk = 1, jpkm1
181               e3t_b(:,:,jk) = e3t_n(:,:,jk)
182               e3u_b(:,:,jk) = e3u_n(:,:,jk)
183               e3v_b(:,:,jk) = e3v_n(:,:,jk)
184            END DO
185         ENDIF
186      ELSE                                             !* Leap-Frog : Asselin filter and swap
187         !                                ! =============!
188         IF( ln_linssh ) THEN             ! Fixed volume !
189            !                             ! =============!
190            DO jk = 1, jpkm1                             
191               DO jj = 1, jpj
192                  DO ji = 1, jpi   
193                     zuf = un(ji,jj,jk) + atfp * ( ub(ji,jj,jk) - 2._wp * un(ji,jj,jk) + ua(ji,jj,jk) )
194                     zvf = vn(ji,jj,jk) + atfp * ( vb(ji,jj,jk) - 2._wp * vn(ji,jj,jk) + va(ji,jj,jk) )
195                     !
196                     ub(ji,jj,jk) = zuf                      ! ub <-- filtered velocity
197                     vb(ji,jj,jk) = zvf
198                     un(ji,jj,jk) = ua(ji,jj,jk)             ! un <-- ua
199                     vn(ji,jj,jk) = va(ji,jj,jk)
200                  END DO
201               END DO
202            END DO
203            !                             ! ================!
204         ELSE                             ! Variable volume !
205            !                             ! ================!
206            ! Before scale factor at t-points
207            ! (used as a now filtered scale factor until the swap)
208            ! ----------------------------------------------------
209            IF( ln_dynspg_ts .AND. ln_bt_fw ) THEN    ! No asselin filtering on thicknesses if forward time splitting
210               e3t_b(:,:,1:jpkm1) = e3t_n(:,:,1:jpkm1)
211            ELSE
212               DO jk = 1, jpkm1
213                  e3t_b(:,:,jk) = e3t_n(:,:,jk) + atfp * ( e3t_b(:,:,jk) - 2._wp * e3t_n(:,:,jk) + e3t_a(:,:,jk) )
214               END DO
215               ! Add volume filter correction: compatibility with tracer advection scheme
216               ! => time filter + conservation correction (only at the first level)
217               zcoef = atfp * rdt * r1_rau0
218               IF ( .NOT. ln_isf ) THEN   ! if no ice shelf melting
219                  e3t_b(:,:,1) = e3t_b(:,:,1) - zcoef * ( emp_b(:,:) - emp(:,:) &
220                                 &                      - rnf_b(:,:) + rnf(:,:) ) * tmask(:,:,1)
221               ELSE                     ! if ice shelf melting
222                  DO jj = 1, jpj
223                     DO ji = 1, jpi
224                        ikt = mikt(ji,jj)
225                        e3t_b(ji,jj,ikt) = e3t_b(ji,jj,ikt) - zcoef * (  emp_b   (ji,jj) - emp   (ji,jj)  &
226                           &                                           - rnf_b   (ji,jj) + rnf   (ji,jj)  &
227                           &                                           + fwfisf_b(ji,jj) - fwfisf(ji,jj)  ) * tmask(ji,jj,ikt)
228                     END DO
229                  END DO
230               END IF
231            ENDIF
232            !
233            IF( ln_dynadv_vec ) THEN      ! Asselin filter applied on velocity
234               ! Before filtered scale factor at (u/v)-points
235               CALL dom_vvl_interpol( e3t_b(:,:,:), e3u_b(:,:,:), 'U' )
236               CALL dom_vvl_interpol( e3t_b(:,:,:), e3v_b(:,:,:), 'V' )
237               DO jk = 1, jpkm1
238                  DO jj = 1, jpj
239                     DO ji = 1, jpi
240                        zuf = un(ji,jj,jk) + atfp * ( ub(ji,jj,jk) - 2._wp * un(ji,jj,jk) + ua(ji,jj,jk) )
241                        zvf = vn(ji,jj,jk) + atfp * ( vb(ji,jj,jk) - 2._wp * vn(ji,jj,jk) + va(ji,jj,jk) )
242                        !
243                        ub(ji,jj,jk) = zuf                      ! ub <-- filtered velocity
244                        vb(ji,jj,jk) = zvf
245                        un(ji,jj,jk) = ua(ji,jj,jk)             ! un <-- ua
246                        vn(ji,jj,jk) = va(ji,jj,jk)
247                     END DO
248                  END DO
249               END DO
250               !
251            ELSE                          ! Asselin filter applied on thickness weighted velocity
252               !
253               ALLOCATE( ze3u_f(jpi,jpj,jpk) , ze3v_f(jpi,jpj,jpk) )
254               ! Before filtered scale factor at (u/v)-points stored in ze3u_f, ze3v_f
255               CALL dom_vvl_interpol( e3t_b(:,:,:), ze3u_f, 'U' )
256               CALL dom_vvl_interpol( e3t_b(:,:,:), ze3v_f, 'V' )
257               DO jk = 1, jpkm1
258                  DO jj = 1, jpj
259                     DO ji = 1, jpi                 
260                        zue3a = e3u_a(ji,jj,jk) * ua(ji,jj,jk)
261                        zve3a = e3v_a(ji,jj,jk) * va(ji,jj,jk)
262                        zue3n = e3u_n(ji,jj,jk) * un(ji,jj,jk)
263                        zve3n = e3v_n(ji,jj,jk) * vn(ji,jj,jk)
264                        zue3b = e3u_b(ji,jj,jk) * ub(ji,jj,jk)
265                        zve3b = e3v_b(ji,jj,jk) * vb(ji,jj,jk)
266                        !
267                        zuf = ( zue3n + atfp * ( zue3b - 2._wp * zue3n  + zue3a ) ) / ze3u_f(ji,jj,jk)
268                        zvf = ( zve3n + atfp * ( zve3b - 2._wp * zve3n  + zve3a ) ) / ze3v_f(ji,jj,jk)
269                        !
270                        ub(ji,jj,jk) = zuf                     ! ub <-- filtered velocity
271                        vb(ji,jj,jk) = zvf
272                        un(ji,jj,jk) = ua(ji,jj,jk)            ! un <-- ua
273                        vn(ji,jj,jk) = va(ji,jj,jk)
274                     END DO
275                  END DO
276               END DO
277               e3u_b(:,:,1:jpkm1) = ze3u_f(:,:,1:jpkm1)        ! e3u_b <-- filtered scale factor
278               e3v_b(:,:,1:jpkm1) = ze3v_f(:,:,1:jpkm1)
279               !
280               DEALLOCATE( ze3u_f , ze3v_f )
281            ENDIF
282            !
283         ENDIF
284         !
285         IF( ln_dynspg_ts .AND. ln_bt_fw ) THEN
286            ! Revert "before" velocities to time split estimate
287            ! Doing it here also means that asselin filter contribution is removed 
288            zue(:,:) = e3u_b(:,:,1) * ub(:,:,1) * umask(:,:,1)
289            zve(:,:) = e3v_b(:,:,1) * vb(:,:,1) * vmask(:,:,1)   
290            DO jk = 2, jpkm1
291               zue(:,:) = zue(:,:) + e3u_b(:,:,jk) * ub(:,:,jk) * umask(:,:,jk)
292               zve(:,:) = zve(:,:) + e3v_b(:,:,jk) * vb(:,:,jk) * vmask(:,:,jk)   
293            END DO
294            DO jk = 1, jpkm1
295               ub(:,:,jk) = ub(:,:,jk) - (zue(:,:) * r1_hu_n(:,:) - un_b(:,:)) * umask(:,:,jk)
296               vb(:,:,jk) = vb(:,:,jk) - (zve(:,:) * r1_hv_n(:,:) - vn_b(:,:)) * vmask(:,:,jk)
297            END DO
298         ENDIF
299         !
300      ENDIF ! neuler =/0
301      !
302      ! Set "now" and "before" barotropic velocities for next time step:
303      ! JC: Would be more clever to swap variables than to make a full vertical
304      ! integration
305      !
306      !
307      IF(.NOT.ln_linssh ) THEN
308         hu_b(:,:) = e3u_b(:,:,1) * umask(:,:,1)
309         hv_b(:,:) = e3v_b(:,:,1) * vmask(:,:,1)
310         DO jk = 2, jpkm1
311            hu_b(:,:) = hu_b(:,:) + e3u_b(:,:,jk) * umask(:,:,jk)
312            hv_b(:,:) = hv_b(:,:) + e3v_b(:,:,jk) * vmask(:,:,jk)
313         END DO
314         r1_hu_b(:,:) = ssumask(:,:) / ( hu_b(:,:) + 1._wp - ssumask(:,:) )
315         r1_hv_b(:,:) = ssvmask(:,:) / ( hv_b(:,:) + 1._wp - ssvmask(:,:) )
316      ENDIF
317      !
318      un_b(:,:) = e3u_a(:,:,1) * un(:,:,1) * umask(:,:,1)
319      ub_b(:,:) = e3u_b(:,:,1) * ub(:,:,1) * umask(:,:,1)
320      vn_b(:,:) = e3v_a(:,:,1) * vn(:,:,1) * vmask(:,:,1)
321      vb_b(:,:) = e3v_b(:,:,1) * vb(:,:,1) * vmask(:,:,1)
322      DO jk = 2, jpkm1
323         un_b(:,:) = un_b(:,:) + e3u_a(:,:,jk) * un(:,:,jk) * umask(:,:,jk)
324         ub_b(:,:) = ub_b(:,:) + e3u_b(:,:,jk) * ub(:,:,jk) * umask(:,:,jk)
325         vn_b(:,:) = vn_b(:,:) + e3v_a(:,:,jk) * vn(:,:,jk) * vmask(:,:,jk)
326         vb_b(:,:) = vb_b(:,:) + e3v_b(:,:,jk) * vb(:,:,jk) * vmask(:,:,jk)
327      END DO
328      un_b(:,:) = un_b(:,:) * r1_hu_a(:,:)
329      vn_b(:,:) = vn_b(:,:) * r1_hv_a(:,:)
330      ub_b(:,:) = ub_b(:,:) * r1_hu_b(:,:)
331      vb_b(:,:) = vb_b(:,:) * r1_hv_b(:,:)
332      !
333      IF( .NOT.ln_dynspg_ts ) THEN        ! output the barotropic currents
334         CALL iom_put(  "ubar", un_b(:,:) )
335         CALL iom_put(  "vbar", vn_b(:,:) )
336      ENDIF
337      IF( l_trddyn ) THEN                ! 3D output: asselin filter trends on momentum
338         zua(:,:,:) = ( ub(:,:,:) - zua(:,:,:) ) * z1_2dt
339         zva(:,:,:) = ( vb(:,:,:) - zva(:,:,:) ) * z1_2dt
340         CALL trd_dyn( zua, zva, jpdyn_atf, kt )
341      ENDIF
342      !
343      IF(ln_ctl)   CALL prt_ctl( tab3d_1=un, clinfo1=' nxt  - Un: ', mask1=umask,   &
344         &                       tab3d_2=vn, clinfo2=' Vn: '       , mask2=vmask )
345      !
346      IF( ln_dynspg_ts )   DEALLOCATE( zue, zve )
347      IF( l_trddyn     )   DEALLOCATE( zua, zva )
348      IF( ln_timing    )   CALL timing_stop('dyn_nxt')
349      !
350   END SUBROUTINE dyn_nxt
351
352   !!=========================================================================
353END MODULE dynnxt
Note: See TracBrowser for help on using the repository browser.