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.
tranxt.F90 in NEMO/branches/UKMO/dev_r10037_GPU/src/OCE/TRA – NEMO

source: NEMO/branches/UKMO/dev_r10037_GPU/src/OCE/TRA/tranxt.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: 19.2 KB
Line 
1MODULE tranxt
2   !!======================================================================
3   !!                       ***  MODULE  tranxt  ***
4   !! Ocean active tracers:  time stepping on temperature and salinity
5   !!======================================================================
6   !! History :  OPA  !  1991-11  (G. Madec)  Original code
7   !!            7.0  !  1993-03  (M. Guyon)  symetrical conditions
8   !!            8.0  !  1996-02  (G. Madec & M. Imbard)  opa release 8.0
9   !!             -   !  1996-04  (A. Weaver)  Euler forward step
10   !!            8.2  !  1999-02  (G. Madec, N. Grima)  semi-implicit pressure grad.
11   !!  NEMO      1.0  !  2002-08  (G. Madec)  F90: Free form and module
12   !!             -   !  2002-11  (C. Talandier, A-M Treguier) Open boundaries
13   !!             -   !  2005-04  (C. Deltel) Add Asselin trend in the ML budget
14   !!            2.0  !  2006-02  (L. Debreu, C. Mazauric) Agrif implementation
15   !!            3.0  !  2008-06  (G. Madec)  time stepping always done in trazdf
16   !!            3.1  !  2009-02  (G. Madec, R. Benshila)  re-introduce the vvl option
17   !!            3.3  !  2010-04  (M. Leclair, G. Madec)  semi-implicit hpg with asselin filter + modified LF-RA
18   !!             -   !  2010-05  (C. Ethe, G. Madec)  merge TRC-TRA
19   !!----------------------------------------------------------------------
20
21   !!----------------------------------------------------------------------
22   !!   tra_nxt       : time stepping on tracers
23   !!   tra_nxt_fix   : time stepping on tracers : fixed    volume case
24   !!   tra_nxt_vvl   : time stepping on tracers : variable volume case
25   !!----------------------------------------------------------------------
26   USE oce             ! ocean dynamics and tracers variables
27   USE dom_oce         ! ocean space and time domain variables
28   USE sbc_oce         ! surface boundary condition: ocean
29   USE sbcrnf          ! river runoffs
30   USE sbcisf          ! ice shelf melting
31   USE zdf_oce         ! ocean vertical mixing
32   USE domvvl          ! variable volume
33   USE trd_oce         ! trends: ocean variables
34   USE trdtra          ! trends manager: tracers
35   USE traqsr          ! penetrative solar radiation (needed for nksr)
36   USE phycst          ! physical constant
37   USE ldftra          ! lateral physics : tracers
38   USE ldfslp          ! lateral physics : slopes
39   USE bdy_oce  , ONLY : ln_bdy
40   USE bdytra          ! open boundary condition (bdy_tra routine)
41   !
42   USE in_out_manager  ! I/O manager
43   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
44   USE prtctl          ! Print control
45   USE timing          ! Timing
46#if defined key_agrif
47   USE agrif_oce_interp
48#endif
49
50   IMPLICIT NONE
51   PRIVATE
52
53   PUBLIC   tra_nxt       ! routine called by step.F90
54   PUBLIC   tra_nxt_fix   ! to be used in trcnxt
55   PUBLIC   tra_nxt_vvl   ! to be used in trcnxt
56
57   !! * Substitutions
58#  include "vectopt_loop_substitute.h90"
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 tra_nxt( kt )
67      !!----------------------------------------------------------------------
68      !!                   ***  ROUTINE tranxt  ***
69      !!
70      !! ** Purpose :   Apply the boundary condition on the after temperature 
71      !!             and salinity fields, achieved the time stepping by adding
72      !!             the Asselin filter on now fields and swapping the fields.
73      !!
74      !! ** Method  :   At this stage of the computation, ta and sa are the
75      !!             after temperature and salinity as the time stepping has
76      !!             been performed in trazdf_imp or trazdf_exp module.
77      !!
78      !!              - Apply lateral boundary conditions on (ta,sa)
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      !!              - Update lateral boundary conditions on AGRIF children
84      !!             domains (lk_agrif=T)
85      !!
86      !! ** Action  : - tsb & tsn ready for the next time step
87      !!----------------------------------------------------------------------
88      USE scoce, ONLY : ztrdt => scr1, ztrds => scr2 
89      INTEGER, INTENT(in) ::   kt    ! ocean time-step index
90      !!
91      INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices
92      REAL(wp) ::   zfact            ! local scalars
93      !!----------------------------------------------------------------------
94      !
95      IF( ln_timing )   CALL timing_start( 'tra_nxt')
96      !
97      IF( kt == nit000 ) THEN
98         IF(lwp) WRITE(numout,*)
99         IF(lwp) WRITE(numout,*) 'tra_nxt : achieve the time stepping by Asselin filter and array swap'
100         IF(lwp) WRITE(numout,*) '~~~~~~~'
101      ENDIF
102
103      ! Update after tracer on domain lateral boundaries
104      !
105#if defined key_agrif
106      CALL Agrif_tra                     ! AGRIF zoom boundaries
107#endif
108      !                                              ! local domain boundaries  (T-point, unchanged sign)
109      CALL lbc_lnk_multi( tsa(:,:,:,jp_tem), 'T', 1., tsa(:,:,:,jp_sal), 'T', 1. )
110      !
111      IF( ln_bdy )   CALL bdy_tra( kt )  ! BDY open boundaries
112 
113      ! set time step size (Euler/Leapfrog)
114      IF( neuler == 0 .AND. kt == nit000 ) THEN   ;   r2dt =        rdt   ! at nit000             (Euler)
115      ELSEIF( kt <= nit000 + 1 )           THEN   ;   r2dt = 2._wp* rdt   ! at nit000 or nit000+1 (Leapfrog)
116      ENDIF
117
118      ! trends computation initialisation
119      IF( l_trdtra )   THEN                   
120         ztrdt(:,:,jpk) = 0._wp
121         ztrds(:,:,jpk) = 0._wp
122         IF( ln_traldf_iso ) THEN              ! diagnose the "pure" Kz diffusive trend
123            CALL trd_tra( kt, 'TRA', jp_tem, jptra_zdfp, ztrdt )
124            CALL trd_tra( kt, 'TRA', jp_sal, jptra_zdfp, ztrds )
125         ENDIF
126         ! total trend for the non-time-filtered variables.
127         zfact = 1.0 / rdt
128         ! G Nurser 23 Mar 2017. Recalculate trend as Delta(e3t*T)/e3tn; e3tn cancel from tsn terms
129         DO jk = 1, jpkm1
130            ztrdt(:,:,jk) = ( tsa(:,:,jk,jp_tem)*e3t_a(:,:,jk) / e3t_n(:,:,jk) - tsn(:,:,jk,jp_tem)) * zfact
131            ztrds(:,:,jk) = ( tsa(:,:,jk,jp_sal)*e3t_a(:,:,jk) / e3t_n(:,:,jk) - tsn(:,:,jk,jp_sal)) * zfact
132         END DO
133         CALL trd_tra( kt, 'TRA', jp_tem, jptra_tot, ztrdt )
134         CALL trd_tra( kt, 'TRA', jp_sal, jptra_tot, ztrds )
135         IF( ln_linssh ) THEN       ! linear sea surface height only
136            ! Store now fields before applying the Asselin filter
137            ! in order to calculate Asselin filter trend later.
138            ztrdt(:,:,:) = tsn(:,:,:,jp_tem) 
139            ztrds(:,:,:) = tsn(:,:,:,jp_sal)
140         ENDIF
141      ENDIF
142
143      IF( neuler == 0 .AND. kt == nit000 ) THEN       ! Euler time-stepping at first time-step (only swap)
144         DO jn = 1, jpts
145            DO jk = 1, jpkm1
146               tsn(:,:,jk,jn) = tsa(:,:,jk,jn)   
147            END DO
148         END DO
149         IF (l_trdtra .AND. .NOT. ln_linssh ) THEN   ! Zero Asselin filter contribution must be explicitly written out since for vvl
150            !                                        ! Asselin filter is output by tra_nxt_vvl that is not called on this time step
151            ztrdt(:,:,:) = 0._wp
152            ztrds(:,:,:) = 0._wp
153            CALL trd_tra( kt, 'TRA', jp_tem, jptra_atf, ztrdt )
154            CALL trd_tra( kt, 'TRA', jp_sal, jptra_atf, ztrds )
155         END IF
156         !
157      ELSE                                            ! Leap-Frog + Asselin filter time stepping
158         !
159         IF( ln_linssh ) THEN   ;   CALL tra_nxt_fix( kt, nit000,      'TRA', tsb, tsn, tsa, jpts )  ! linear free surface
160         ELSE                   ;   CALL tra_nxt_vvl( kt, nit000, rdt, 'TRA', tsb, tsn, tsa,   &
161           &                                                                sbc_tsc, sbc_tsc_b, jpts )  ! non-linear free surface
162         ENDIF
163         !
164         CALL lbc_lnk_multi( tsb(:,:,:,jp_tem), 'T', 1., tsb(:,:,:,jp_sal), 'T', 1., &
165                  &          tsn(:,:,:,jp_tem), 'T', 1., tsn(:,:,:,jp_sal), 'T', 1., &
166                  &          tsa(:,:,:,jp_tem), 'T', 1., tsa(:,:,:,jp_sal), 'T', 1.  )
167         !
168      ENDIF     
169      !
170      IF( l_trdtra .AND. ln_linssh ) THEN      ! trend of the Asselin filter (tb filtered - tb)/dt     
171         zfact = 1._wp / r2dt             
172         DO jk = 1, jpkm1
173            ztrdt(:,:,jk) = ( tsb(:,:,jk,jp_tem) - ztrdt(:,:,jk) ) * zfact
174            ztrds(:,:,jk) = ( tsb(:,:,jk,jp_sal) - ztrds(:,:,jk) ) * zfact
175         END DO
176         CALL trd_tra( kt, 'TRA', jp_tem, jptra_atf, ztrdt )
177         CALL trd_tra( kt, 'TRA', jp_sal, jptra_atf, ztrds )
178      END IF
179      !
180      !                        ! control print
181      IF(ln_ctl)   CALL prt_ctl( tab3d_1=tsn(:,:,:,jp_tem), clinfo1=' nxt  - Tn: ', mask1=tmask,   &
182         &                       tab3d_2=tsn(:,:,:,jp_sal), clinfo2=       ' Sn: ', mask2=tmask )
183      !
184      IF( ln_timing )   CALL timing_stop('tra_nxt')
185      !
186   END SUBROUTINE tra_nxt
187
188
189   SUBROUTINE tra_nxt_fix( kt, kit000, cdtype, ptb, ptn, pta, kjpt )
190      !!----------------------------------------------------------------------
191      !!                   ***  ROUTINE tra_nxt_fix  ***
192      !!
193      !! ** Purpose :   fixed volume: apply the Asselin time filter and
194      !!                swap the tracer fields.
195      !!
196      !! ** Method  : - Apply a Asselin time filter on now fields.
197      !!              - swap tracer fields to prepare the next time_step.
198      !!
199      !! ** Action  : - tsb & tsn ready for the next time step
200      !!----------------------------------------------------------------------
201      INTEGER                              , INTENT(in   ) ::  kt        ! ocean time-step index
202      INTEGER                              , INTENT(in   ) ::  kit000    ! first time step index
203      CHARACTER(len=3)                     , INTENT(in   ) ::  cdtype    ! =TRA or TRC (tracer indicator)
204      INTEGER                              , INTENT(in   ) ::  kjpt      ! number of tracers
205      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::  ptb       ! before tracer fields
206      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::  ptn       ! now tracer fields
207      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::  pta       ! tracer trend
208      !
209      INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices
210      REAL(wp) ::   ztn, ztd         ! local scalars
211      !!----------------------------------------------------------------------
212      !
213      IF( kt == kit000 )  THEN
214         IF(lwp) WRITE(numout,*)
215         IF(lwp) WRITE(numout,*) 'tra_nxt_fix : time stepping', cdtype
216         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'
217      ENDIF
218      !
219      DO jn = 1, kjpt
220         !
221         DO jk = 1, jpkm1
222            DO jj = 2, jpjm1
223               DO ji = fs_2, fs_jpim1
224                  ztn = ptn(ji,jj,jk,jn)                                   
225                  ztd = pta(ji,jj,jk,jn) - 2._wp * ztn + ptb(ji,jj,jk,jn)  ! time laplacian on tracers
226                  !
227                  ptb(ji,jj,jk,jn) = ztn + atfp * ztd                      ! ptb <-- filtered ptn
228                  ptn(ji,jj,jk,jn) = pta(ji,jj,jk,jn)                      ! ptn <-- pta
229               END DO
230           END DO
231         END DO
232         !
233      END DO
234      !
235   END SUBROUTINE tra_nxt_fix
236
237
238   SUBROUTINE tra_nxt_vvl( kt, kit000, p2dt, cdtype, ptb, ptn, pta, psbc_tc, psbc_tc_b, kjpt )
239      !!----------------------------------------------------------------------
240      !!                   ***  ROUTINE tra_nxt_vvl  ***
241      !!
242      !! ** Purpose :   Time varying volume: apply the Asselin time filter 
243      !!                and swap the tracer fields.
244      !!
245      !! ** Method  : - Apply a thickness weighted Asselin time filter on now fields.
246      !!              - swap tracer fields to prepare the next time_step.
247      !!             tb  = ( e3t_n*tn + atfp*[ e3t_b*tb - 2 e3t_n*tn + e3t_a*ta ] )
248      !!                  /( e3t_n    + atfp*[ e3t_b    - 2 e3t_n    + e3t_a    ] )
249      !!             tn  = ta
250      !!
251      !! ** Action  : - tsb & tsn ready for the next time step
252      !!----------------------------------------------------------------------
253      INTEGER                              , INTENT(in   ) ::  kt        ! ocean time-step index
254      INTEGER                              , INTENT(in   ) ::  kit000    ! first time step index
255      REAL(wp)                             , INTENT(in   ) ::  p2dt      ! time-step
256      CHARACTER(len=3)                     , INTENT(in   ) ::  cdtype    ! =TRA or TRC (tracer indicator)
257      INTEGER                              , INTENT(in   ) ::  kjpt      ! number of tracers
258      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::  ptb       ! before tracer fields
259      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::  ptn       ! now tracer fields
260      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::  pta       ! tracer trend
261      REAL(wp), DIMENSION(jpi,jpj    ,kjpt), INTENT(in   ) ::  psbc_tc   ! surface tracer content
262      REAL(wp), DIMENSION(jpi,jpj    ,kjpt), INTENT(in   ) ::  psbc_tc_b ! before surface tracer content
263      !
264      LOGICAL  ::   ll_traqsr, ll_rnf, ll_isf   ! local logical
265      INTEGER  ::   ji, jj, jk, jn              ! dummy loop indices
266      REAL(wp) ::   zfact, zfact1, ztc_a , ztc_n , ztc_b , ztc_f , ztc_d    ! local scalar
267      REAL(wp) ::   zfact2, ze3t_b, ze3t_n, ze3t_a, ze3t_f, ze3t_d   !   -      -
268      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) ::   ztrd_atf
269      !!----------------------------------------------------------------------
270      !
271      IF( kt == kit000 )  THEN
272         IF(lwp) WRITE(numout,*)
273         IF(lwp) WRITE(numout,*) 'tra_nxt_vvl : time stepping', cdtype
274         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'
275      ENDIF
276      !
277      IF( cdtype == 'TRA' )  THEN   
278         ll_traqsr  = ln_traqsr        ! active  tracers case  and  solar penetration
279         ll_rnf     = ln_rnf           ! active  tracers case  and  river runoffs
280         ll_isf     = ln_isf           ! active  tracers case  and  ice shelf melting
281      ELSE                          ! passive tracers case
282         ll_traqsr  = .FALSE.          ! NO solar penetration
283         ll_rnf     = .FALSE.          ! NO river runoffs ????          !!gm BUG ? 
284         ll_isf     = .FALSE.          ! NO ice shelf melting/freezing  !!gm BUG ??
285      ENDIF
286      !
287      IF( ( l_trdtra .AND. cdtype == 'TRA' ) .OR. ( l_trdtrc .AND. cdtype == 'TRC' ) )   THEN
288         ALLOCATE( ztrd_atf(jpi,jpj,jpk,kjpt) )
289         ztrd_atf(:,:,:,:) = 0.0_wp
290      ENDIF
291      zfact = 1._wp / p2dt
292      zfact1 = atfp * p2dt
293      zfact2 = zfact1 * r1_rau0
294      DO jn = 1, kjpt     
295         DO jk = 1, jpkm1
296            DO jj = 2, jpjm1
297               DO ji = fs_2, fs_jpim1
298                  ze3t_b = e3t_b(ji,jj,jk)
299                  ze3t_n = e3t_n(ji,jj,jk)
300                  ze3t_a = e3t_a(ji,jj,jk)
301                  !                                         ! tracer content at Before, now and after
302                  ztc_b  = ptb(ji,jj,jk,jn) * ze3t_b
303                  ztc_n  = ptn(ji,jj,jk,jn) * ze3t_n
304                  ztc_a  = pta(ji,jj,jk,jn) * ze3t_a
305                  !
306                  ze3t_d = ze3t_a - 2. * ze3t_n + ze3t_b
307                  ztc_d  = ztc_a  - 2. * ztc_n  + ztc_b
308                  !
309                  ze3t_f = ze3t_n + atfp * ze3t_d
310                  ztc_f  = ztc_n  + atfp * ztc_d
311                  !
312                  IF( jk == mikt(ji,jj) ) THEN           ! first level
313                     ze3t_f = ze3t_f - zfact2 * ( (emp_b(ji,jj)    - emp(ji,jj)   )  &
314                            &                   + (fwfisf_b(ji,jj) - fwfisf(ji,jj))  )
315                     ztc_f  = ztc_f  - zfact1 * ( psbc_tc(ji,jj,jn) - psbc_tc_b(ji,jj,jn) )
316                  ENDIF
317                  IF( ln_rnf_depth ) THEN
318                     ! Rivers are not just at the surface must go down to nk_rnf(ji,jj)
319                     IF( mikt(ji,jj) <=jk .and. jk <= nk_rnf(ji,jj)  ) THEN
320                        ze3t_f = ze3t_f - zfact2 * ( - (rnf_b(ji,jj) - rnf(ji,jj)   )  ) &
321                    &                            * ( e3t_n(ji,jj,jk) / h_rnf(ji,jj) ) 
322                     ENDIF
323                  ELSE
324                     IF( jk == mikt(ji,jj) ) THEN           ! first level
325                        ze3t_f = ze3t_f - zfact2 * ( - (rnf_b(ji,jj)    - rnf(ji,jj)   ) ) 
326                     ENDIF
327                  ENDIF
328
329                  !
330                  ! solar penetration (temperature only)
331                  IF( ll_traqsr .AND. jn == jp_tem .AND. jk <= nksr )                            & 
332                     &     ztc_f  = ztc_f  - zfact1 * ( qsr_hc(ji,jj,jk) - qsr_hc_b(ji,jj,jk) ) 
333                     !
334                  ! river runoff
335                  IF( ll_rnf .AND. jk <= nk_rnf(ji,jj) )                                          &
336                     &     ztc_f  = ztc_f  - zfact1 * ( rnf_tsc(ji,jj,jn) - rnf_tsc_b(ji,jj,jn) ) & 
337                     &                              * e3t_n(ji,jj,jk) / h_rnf(ji,jj)
338                     !
339                  ! ice shelf
340                  IF( ll_isf ) THEN
341                     ! level fully include in the Losch_2008 ice shelf boundary layer
342                     IF ( jk >= misfkt(ji,jj) .AND. jk < misfkb(ji,jj) )                          &
343                        ztc_f  = ztc_f  - zfact1 * ( risf_tsc(ji,jj,jn) - risf_tsc_b(ji,jj,jn) )  &
344                               &                 * e3t_n(ji,jj,jk) * r1_hisf_tbl (ji,jj)
345                     ! level partially include in Losch_2008 ice shelf boundary layer
346                     IF ( jk == misfkb(ji,jj) )                                                   &
347                        ztc_f  = ztc_f  - zfact1 * ( risf_tsc(ji,jj,jn) - risf_tsc_b(ji,jj,jn) )  &
348                               &                 * e3t_n(ji,jj,jk) * r1_hisf_tbl (ji,jj) * ralpha(ji,jj)
349                  END IF
350                  !
351                  ze3t_f = 1.e0 / ze3t_f
352                  ptb(ji,jj,jk,jn) = ztc_f * ze3t_f       ! ptb <-- ptn filtered
353                  ptn(ji,jj,jk,jn) = pta(ji,jj,jk,jn)     ! ptn <-- pta
354                  !
355                  IF( ( l_trdtra .and. cdtype == 'TRA' ) .OR. ( l_trdtrc .and. cdtype == 'TRC' ) ) THEN
356                     ztrd_atf(ji,jj,jk,jn) = (ztc_f - ztc_n) * zfact/ze3t_n
357                  ENDIF
358                  !
359               END DO
360            END DO
361         END DO
362         !
363      END DO
364      !
365      IF( ( l_trdtra .AND. cdtype == 'TRA' ) .OR. ( l_trdtrc .AND. cdtype == 'TRC' ) )   THEN
366         IF( l_trdtra .AND. cdtype == 'TRA' ) THEN
367            CALL trd_tra( kt, cdtype, jp_tem, jptra_atf, ztrd_atf(:,:,:,jp_tem) )
368            CALL trd_tra( kt, cdtype, jp_sal, jptra_atf, ztrd_atf(:,:,:,jp_sal) )
369         ENDIF
370         IF( l_trdtrc .AND. cdtype == 'TRC' ) THEN
371            DO jn = 1, kjpt
372               CALL trd_tra( kt, cdtype, jn, jptra_atf, ztrd_atf(:,:,:,jn) )
373            END DO
374         ENDIF
375         DEALLOCATE( ztrd_atf )
376      ENDIF
377      !
378   END SUBROUTINE tra_nxt_vvl
379
380   !!======================================================================
381END MODULE tranxt
Note: See TracBrowser for help on using the repository browser.