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 NEMO/branches/UKMO/dev_r10037_GPU/src/OCE/DYN – NEMO

source: NEMO/branches/UKMO/dev_r10037_GPU/src/OCE/DYN/dynnxt.F90 @ 11467

Last change on this file since 11467 was 11467, checked in by andmirek, 5 years ago

Ticket #2197 allocate arrays at the beggining of the run

File size: 18.1 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 sbcrnf         ! river runoffs
31   USE sbcisf         ! ice shelf
32   USE phycst         ! physical constants
33   USE dynadv         ! dynamics: vector invariant versus flux form
34   USE dynspg_ts      ! surface pressure gradient: split-explicit scheme
35   USE domvvl         ! variable volume
36   USE bdy_oce   , ONLY: ln_bdy
37   USE bdydta         ! ocean open boundary conditions
38   USE bdydyn         ! ocean open boundary conditions
39   USE bdyvol         ! ocean open boundary condition (bdy_vol routines)
40   USE trd_oce        ! trends: ocean variables
41   USE trddyn         ! trend manager: dynamics
42   USE trdken         ! trend manager: kinetic energy
43   !
44   USE in_out_manager ! I/O manager
45   USE iom            ! I/O manager library
46   USE lbclnk         ! lateral boundary condition (or mpp link)
47   USE lib_mpp        ! MPP library
48   USE prtctl         ! Print control
49   USE timing         ! Timing
50#if defined key_agrif
51   USE agrif_oce_interp
52#endif
53
54   IMPLICIT NONE
55   PRIVATE
56
57   PUBLIC    dyn_nxt   ! routine called by step.F90
58
59   !!----------------------------------------------------------------------
60   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
61   !! $Id$
62   !! Software governed by the CeCILL license (see ./LICENSE)
63   !!----------------------------------------------------------------------
64CONTAINS
65
66   SUBROUTINE dyn_nxt ( kt )
67      !!----------------------------------------------------------------------
68      !!                  ***  ROUTINE dyn_nxt  ***
69      !!                   
70      !! ** Purpose :   Finalize after horizontal velocity. Apply the boundary
71      !!             condition on the after velocity, achieve the time stepping
72      !!             by applying the Asselin filter on now fields and swapping
73      !!             the fields.
74      !!
75      !! ** Method  : * Ensure after velocities transport matches time splitting
76      !!             estimate (ln_dynspg_ts=T)
77      !!
78      !!              * Apply lateral boundary conditions on after velocity
79      !!             at the local domain boundaries through lbc_lnk call,
80      !!             at the one-way open boundaries (ln_bdy=T),
81      !!             at the AGRIF zoom   boundaries (lk_agrif=T)
82      !!
83      !!              * Apply the time filter applied and swap of the dynamics
84      !!             arrays to start the next time step:
85      !!                (ub,vb) = (un,vn) + atfp [ (ub,vb) + (ua,va) - 2 (un,vn) ]
86      !!                (un,vn) = (ua,va).
87      !!             Note that with flux form advection and non linear free surface,
88      !!             the time filter is applied on thickness weighted velocity.
89      !!             As a result, dyn_nxt MUST be called after tra_nxt.
90      !!
91      !! ** Action :   ub,vb   filtered before horizontal velocity of next time-step
92      !!               un,vn   now horizontal velocity of next time-step
93      !!----------------------------------------------------------------------
94      USE scoce, ONLY : zue => scr2D1, zve => scr2D2, &
95                       ze3u_f => scr1, ze3v_f => scr2, zua => scr3, zva => scr4
96      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index
97      !
98      INTEGER  ::   ji, jj, jk   ! dummy loop indices
99      INTEGER  ::   ikt          ! local integers
100      REAL(wp) ::   zue3a, zue3n, zue3b, zuf, zcoef    ! local scalars
101      REAL(wp) ::   zve3a, zve3n, zve3b, zvf, z1_2dt   !   -      -
102      !!----------------------------------------------------------------------
103      !
104      IF( ln_timing    )   CALL timing_start('dyn_nxt')
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(:,:)*r1_hu_n(:,:) + un_b(:,:) )*umask(:,:,jk)
133               vn(:,:,jk) = ( vn(:,:,jk) - vn_adv(:,:)*r1_hv_n(:,:) + 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_multi( ua, 'U', -1., va, 'V', -1. )     !* local domain boundaries
145      !
146      !                                !* BDY open boundaries
147      IF( ln_bdy .AND. ln_dynspg_exp )   CALL bdy_dyn( kt )
148      IF( ln_bdy .AND. ln_dynspg_ts  )   CALL bdy_dyn( kt, dyn3d_only=.true. )
149
150!!$   Do we need a call to bdy_vol here??
151      !
152      IF( l_trddyn ) THEN             ! prepare the atf trend computation + some diagnostics
153         z1_2dt = 1._wp / (2. * rdt)        ! Euler or leap-frog time step
154         IF( neuler == 0 .AND. kt == nit000 )   z1_2dt = 1._wp / rdt
155         !
156         !                                  ! Kinetic energy and Conversion
157         IF( ln_KE_trd  )   CALL trd_dyn( ua, va, jpdyn_ken, kt )
158         !
159         IF( ln_dyn_trd ) THEN              ! 3D output: total momentum trends
160            zua(:,:,:) = ( ua(:,:,:) - ub(:,:,:) ) * z1_2dt
161            zva(:,:,:) = ( va(:,:,:) - vb(:,:,:) ) * z1_2dt
162            CALL iom_put( "utrd_tot", zua )        ! total momentum trends, except the asselin time filter
163            CALL iom_put( "vtrd_tot", zva )
164         ENDIF
165         !
166         zua(:,:,:) = un(:,:,:)             ! save the now velocity before the asselin filter
167         zva(:,:,:) = vn(:,:,:)             ! (caution: there will be a shift by 1 timestep in the
168         !                                  !  computation of the asselin filter trends)
169      ENDIF
170
171      ! Time filter and swap of dynamics arrays
172      ! ------------------------------------------
173      IF( neuler == 0 .AND. kt == nit000 ) THEN        !* Euler at first time-step: only swap
174         DO jk = 1, jpkm1
175            un(:,:,jk) = ua(:,:,jk)                         ! un <-- ua
176            vn(:,:,jk) = va(:,:,jk)
177         END DO
178         IF( .NOT.ln_linssh ) THEN                          ! e3._b <-- e3._n
179!!gm BUG ????    I don't understand why it is not : e3._n <-- e3._a 
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               !
185               e3t_n(:,:,jk) = e3t_a(:,:,jk)
186               e3u_n(:,:,jk) = e3u_a(:,:,jk)
187               e3v_n(:,:,jk) = e3v_a(:,:,jk)
188            END DO
189!!gm BUG end
190         ENDIF
191                                                            !
192         
193      ELSE                                             !* Leap-Frog : Asselin filter and swap
194         !                                ! =============!
195         IF( ln_linssh ) THEN             ! Fixed volume !
196            !                             ! =============!
197            DO jk = 1, jpkm1                             
198               DO jj = 1, jpj
199                  DO ji = 1, jpi   
200                     zuf = un(ji,jj,jk) + atfp * ( ub(ji,jj,jk) - 2._wp * un(ji,jj,jk) + ua(ji,jj,jk) )
201                     zvf = vn(ji,jj,jk) + atfp * ( vb(ji,jj,jk) - 2._wp * vn(ji,jj,jk) + va(ji,jj,jk) )
202                     !
203                     ub(ji,jj,jk) = zuf                      ! ub <-- filtered velocity
204                     vb(ji,jj,jk) = zvf
205                     un(ji,jj,jk) = ua(ji,jj,jk)             ! un <-- ua
206                     vn(ji,jj,jk) = va(ji,jj,jk)
207                  END DO
208               END DO
209            END DO
210            !                             ! ================!
211         ELSE                             ! Variable volume !
212            !                             ! ================!
213            ! Before scale factor at t-points
214            ! (used as a now filtered scale factor until the swap)
215            ! ----------------------------------------------------
216            DO jk = 1, jpkm1
217               e3t_b(:,:,jk) = e3t_n(:,:,jk) + atfp * ( e3t_b(:,:,jk) - 2._wp * e3t_n(:,:,jk) + e3t_a(:,:,jk) )
218            END DO
219            ! Add volume filter correction: compatibility with tracer advection scheme
220            ! => time filter + conservation correction (only at the first level)
221            zcoef = atfp * rdt * r1_rau0
222
223            e3t_b(:,:,1) = e3t_b(:,:,1) - zcoef * ( emp_b(:,:) - emp(:,:) ) * tmask(:,:,1)
224
225            IF ( ln_rnf ) THEN
226               IF( ln_rnf_depth ) THEN
227                  DO jk = 1, jpkm1 ! Deal with Rivers separetely, as can be through depth too
228                     DO jj = 1, jpj
229                        DO ji = 1, jpi
230                           IF( jk <=  nk_rnf(ji,jj)  ) THEN
231                               e3t_b(ji,jj,jk) =   e3t_b(ji,jj,jk) - zcoef *  ( - rnf_b(ji,jj) + rnf(ji,jj) ) &
232                                      &          * ( e3t_n(ji,jj,jk) / h_rnf(ji,jj) ) * tmask(ji,jj,jk)
233                           ENDIF
234                        ENDDO
235                     ENDDO
236                  ENDDO
237               ELSE
238                  e3t_b(:,:,1) = e3t_b(:,:,1) - zcoef *  ( -rnf_b(:,:) + rnf(:,:))*tmask(:,:,1)
239               ENDIF
240            END IF
241
242            IF ( ln_isf ) THEN   ! if ice shelf melting
243               DO jk = 1, jpkm1 ! Deal with isf separetely, as can be through depth too
244                  DO jj = 1, jpj
245                     DO ji = 1, jpi
246                        IF( misfkt(ji,jj) <= jk .AND. jk <= misfkb(ji,jj) ) THEN
247                           e3t_b(ji,jj,jk) =   e3t_b(ji,jj,jk) - zcoef *  ( fwfisf_b(ji,jj) - fwfisf(ji,jj) ) &
248                                &          * ( e3t_n(ji,jj,jk) * r1_hisf_tbl(ji,jj) ) * tmask(ji,jj,jk)
249                        ENDIF
250                     END DO
251                  END DO
252               END DO
253            END IF
254            !
255            IF( ln_dynadv_vec ) THEN      ! Asselin filter applied on velocity
256               ! Before filtered scale factor at (u/v)-points
257               CALL dom_vvl_interpol( e3t_b(:,:,:), e3u_b(:,:,:), 'U' )
258               CALL dom_vvl_interpol( e3t_b(:,:,:), e3v_b(:,:,:), 'V' )
259               DO jk = 1, jpkm1
260                  DO jj = 1, jpj
261                     DO ji = 1, jpi
262                        zuf = un(ji,jj,jk) + atfp * ( ub(ji,jj,jk) - 2._wp * un(ji,jj,jk) + ua(ji,jj,jk) )
263                        zvf = vn(ji,jj,jk) + atfp * ( vb(ji,jj,jk) - 2._wp * vn(ji,jj,jk) + va(ji,jj,jk) )
264                        !
265                        ub(ji,jj,jk) = zuf                      ! ub <-- filtered velocity
266                        vb(ji,jj,jk) = zvf
267                        un(ji,jj,jk) = ua(ji,jj,jk)             ! un <-- ua
268                        vn(ji,jj,jk) = va(ji,jj,jk)
269                     END DO
270                  END DO
271               END DO
272               !
273            ELSE                          ! Asselin filter applied on thickness weighted velocity
274               !
275               ! Before filtered scale factor at (u/v)-points stored in ze3u_f, ze3v_f
276               CALL dom_vvl_interpol( e3t_b(:,:,:), ze3u_f, 'U' )
277               CALL dom_vvl_interpol( e3t_b(:,:,:), ze3v_f, 'V' )
278               DO jk = 1, jpkm1
279                  DO jj = 1, jpj
280                     DO ji = 1, jpi                 
281                        zue3a = e3u_a(ji,jj,jk) * ua(ji,jj,jk)
282                        zve3a = e3v_a(ji,jj,jk) * va(ji,jj,jk)
283                        zue3n = e3u_n(ji,jj,jk) * un(ji,jj,jk)
284                        zve3n = e3v_n(ji,jj,jk) * vn(ji,jj,jk)
285                        zue3b = e3u_b(ji,jj,jk) * ub(ji,jj,jk)
286                        zve3b = e3v_b(ji,jj,jk) * vb(ji,jj,jk)
287                        !
288                        zuf = ( zue3n + atfp * ( zue3b - 2._wp * zue3n  + zue3a ) ) / ze3u_f(ji,jj,jk)
289                        zvf = ( zve3n + atfp * ( zve3b - 2._wp * zve3n  + zve3a ) ) / ze3v_f(ji,jj,jk)
290                        !
291                        ub(ji,jj,jk) = zuf                     ! ub <-- filtered velocity
292                        vb(ji,jj,jk) = zvf
293                        un(ji,jj,jk) = ua(ji,jj,jk)            ! un <-- ua
294                        vn(ji,jj,jk) = va(ji,jj,jk)
295                     END DO
296                  END DO
297               END DO
298               e3u_b(:,:,1:jpkm1) = ze3u_f(:,:,1:jpkm1)        ! e3u_b <-- filtered scale factor
299               e3v_b(:,:,1:jpkm1) = ze3v_f(:,:,1:jpkm1)
300               !
301            ENDIF
302            !
303         ENDIF
304         !
305         IF( ln_dynspg_ts .AND. ln_bt_fw ) THEN
306            ! Revert "before" velocities to time split estimate
307            ! Doing it here also means that asselin filter contribution is removed 
308            zue(:,:) = e3u_b(:,:,1) * ub(:,:,1) * umask(:,:,1)
309            zve(:,:) = e3v_b(:,:,1) * vb(:,:,1) * vmask(:,:,1)   
310            DO jk = 2, jpkm1
311               zue(:,:) = zue(:,:) + e3u_b(:,:,jk) * ub(:,:,jk) * umask(:,:,jk)
312               zve(:,:) = zve(:,:) + e3v_b(:,:,jk) * vb(:,:,jk) * vmask(:,:,jk)   
313            END DO
314            DO jk = 1, jpkm1
315               ub(:,:,jk) = ub(:,:,jk) - (zue(:,:) * r1_hu_n(:,:) - un_b(:,:)) * umask(:,:,jk)
316               vb(:,:,jk) = vb(:,:,jk) - (zve(:,:) * r1_hv_n(:,:) - vn_b(:,:)) * vmask(:,:,jk)
317            END DO
318         ENDIF
319         !
320      ENDIF ! neuler =/0
321      !
322      ! Set "now" and "before" barotropic velocities for next time step:
323      ! JC: Would be more clever to swap variables than to make a full vertical
324      ! integration
325      !
326      !
327      IF(.NOT.ln_linssh ) THEN
328         hu_b(:,:) = e3u_b(:,:,1) * umask(:,:,1)
329         hv_b(:,:) = e3v_b(:,:,1) * vmask(:,:,1)
330         DO jk = 2, jpkm1
331            hu_b(:,:) = hu_b(:,:) + e3u_b(:,:,jk) * umask(:,:,jk)
332            hv_b(:,:) = hv_b(:,:) + e3v_b(:,:,jk) * vmask(:,:,jk)
333         END DO
334         r1_hu_b(:,:) = ssumask(:,:) / ( hu_b(:,:) + 1._wp - ssumask(:,:) )
335         r1_hv_b(:,:) = ssvmask(:,:) / ( hv_b(:,:) + 1._wp - ssvmask(:,:) )
336      ENDIF
337      !
338      un_b(:,:) = e3u_a(:,:,1) * un(:,:,1) * umask(:,:,1)
339      ub_b(:,:) = e3u_b(:,:,1) * ub(:,:,1) * umask(:,:,1)
340      vn_b(:,:) = e3v_a(:,:,1) * vn(:,:,1) * vmask(:,:,1)
341      vb_b(:,:) = e3v_b(:,:,1) * vb(:,:,1) * vmask(:,:,1)
342      DO jk = 2, jpkm1
343         un_b(:,:) = un_b(:,:) + e3u_a(:,:,jk) * un(:,:,jk) * umask(:,:,jk)
344         ub_b(:,:) = ub_b(:,:) + e3u_b(:,:,jk) * ub(:,:,jk) * umask(:,:,jk)
345         vn_b(:,:) = vn_b(:,:) + e3v_a(:,:,jk) * vn(:,:,jk) * vmask(:,:,jk)
346         vb_b(:,:) = vb_b(:,:) + e3v_b(:,:,jk) * vb(:,:,jk) * vmask(:,:,jk)
347      END DO
348      un_b(:,:) = un_b(:,:) * r1_hu_a(:,:)
349      vn_b(:,:) = vn_b(:,:) * r1_hv_a(:,:)
350      ub_b(:,:) = ub_b(:,:) * r1_hu_b(:,:)
351      vb_b(:,:) = vb_b(:,:) * r1_hv_b(:,:)
352      !
353      IF( .NOT.ln_dynspg_ts ) THEN        ! output the barotropic currents
354         CALL iom_put(  "ubar", un_b(:,:) )
355         CALL iom_put(  "vbar", vn_b(:,:) )
356      ENDIF
357      IF( l_trddyn ) THEN                ! 3D output: asselin filter trends on momentum
358         zua(:,:,:) = ( ub(:,:,:) - zua(:,:,:) ) * z1_2dt
359         zva(:,:,:) = ( vb(:,:,:) - zva(:,:,:) ) * z1_2dt
360         CALL trd_dyn( zua, zva, jpdyn_atf, kt )
361      ENDIF
362      !
363      IF(ln_ctl)   CALL prt_ctl( tab3d_1=un, clinfo1=' nxt  - Un: ', mask1=umask,   &
364         &                       tab3d_2=vn, clinfo2=' Vn: '       , mask2=vmask )
365      !
366      IF( ln_timing    )   CALL timing_stop('dyn_nxt')
367      !
368   END SUBROUTINE dyn_nxt
369
370   !!=========================================================================
371END MODULE dynnxt
Note: See TracBrowser for help on using the repository browser.