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.
traldf_bilap.F90 in branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/OPA_SRC/TRA – NEMO

source: branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_bilap.F90 @ 11101

Last change on this file since 11101 was 11101, checked in by frrh, 5 years ago

Merge changes from Met Office GMED ticket 450 to reduce unnecessary
text output from NEMO.
This output, which is typically not switchable, is rarely of interest
in normal (non-debugging) runs and simply redunantley consumes extra
file space.
Further, the presence of this text output has been shown to
significantly degrade performance of models which are run during
Met Office HPC RAID (disk) checks.
The new code introduces switches which are configurable via the
changes made in the associated Met Office MOCI ticket 399.
File size: 9.9 KB
Line 
1MODULE traldf_bilap
2   !!==============================================================================
3   !!                   ***  MODULE  traldf_bilap  ***
4   !! Ocean  tracers:  horizontal component of the lateral tracer mixing trend
5   !!==============================================================================
6   !! History :  OPA  !  1991-11  (G. Madec)  Original code
7   !!                 !  1993-03  (M. Guyon)  symetrical conditions
8   !!                 !  1995-11  (G. Madec)  suppress volumetric scale factors
9   !!                 !  1996-01  (G. Madec)  statement function for e3
10   !!                 !  1996-01  (M. Imbard)  mpp exchange
11   !!                 !  1997-07  (G. Madec)  optimization, and ahtt
12   !!            8.5  !  2002-08  (G. Madec)  F90: Free form and module
13   !!   NEMO     1.0  !  2004-08  (C. Talandier) New trends organization
14   !!             -   !  2005-11  (G. Madec)  zps or sco as default option
15   !!            3.3  !  2010-05  (C. Ethe, G. Madec)  merge TRC-TRA
16   !!==============================================================================
17
18   !!----------------------------------------------------------------------
19   !!   tra_ldf_bilap : update the tracer trend with the horizontal diffusion
20   !!                   using a iso-level biharmonic operator
21   !!----------------------------------------------------------------------
22   USE oce             ! ocean dynamics and active tracers
23   USE dom_oce         ! ocean space and time domain
24   USE ldftra_oce      ! ocean tracer   lateral physics
25   USE in_out_manager  ! I/O manager
26   USE ldfslp          ! iso-neutral slopes
27   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
28   USE diaptr          ! poleward transport diagnostics
29   USE trc_oce         ! share passive tracers/Ocean variables
30   USE lib_mpp         ! MPP library
31   USE wrk_nemo       ! Memory Allocation
32   USE timing         ! Timing
33
34   IMPLICIT NONE
35   PRIVATE
36
37   PUBLIC   tra_ldf_bilap   ! routine called by step.F90
38
39   !! * Substitutions
40#  include "domzgr_substitute.h90"
41#  include "ldftra_substitute.h90"
42#  include "ldfeiv_substitute.h90"
43#  include "vectopt_loop_substitute.h90"
44   !!----------------------------------------------------------------------
45   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
46   !! $Id$
47   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
48   !!----------------------------------------------------------------------
49CONTAINS
50 
51   SUBROUTINE tra_ldf_bilap( kt, kit000, cdtype, pgu, pgv,            &
52      &                                          pgui, pgvi,          &
53      &                                  ptb, pta, kjpt ) 
54      !!----------------------------------------------------------------------
55      !!                  ***  ROUTINE tra_ldf_bilap  ***
56      !!
57      !! ** Purpose :   Compute the before horizontal tracer diffusive
58      !!      trend and add it to the general trend of tracer equation.
59      !!
60      !! ** Method  :   4th order diffusive operator along model level surfaces
61      !!      evaluated using before fields (forward time scheme). The hor.
62      !!      diffusive trends  is given by:
63      !!      Laplacian of tb:
64      !!         zlt   = 1/(e1t*e2t*e3t) {  di-1[ e2u*e3u/e1u di(tb) ]
65      !!                                  + dj-1[ e1v*e3v/e2v dj(tb) ]  }
66      !!      Multiply by the eddy diffusivity coef. and insure lateral bc:
67      !!        zlt   = ahtt * zlt
68      !!        call to lbc_lnk
69      !!      Bilaplacian (laplacian of zlt):
70      !!         difft = 1/(e1t*e2t*e3t) {  di-1[ e2u*e3u/e1u di(zlt) ]
71      !!                                  + dj-1[ e1v*e3v/e2v dj(zlt) ]  }
72      !!
73      !!      Add this trend to the general trend
74      !!         (pta) = (pta) + ( difft )
75      !!
76      !! ** Action : - Update pta arrays with the before iso-level
77      !!               biharmonic mixing trend.
78      !!----------------------------------------------------------------------
79      USE oce     , ONLY:   ztu  => ua       , ztv  => va                           ! (ua,va) used as workspace
80      !!
81      INTEGER                              , INTENT(in   ) ::   kt         ! ocean time-step index
82      INTEGER                              , INTENT(in   ) ::   kit000          ! first time step index
83      CHARACTER(len=3)                     , INTENT(in   ) ::   cdtype     ! =TRA or TRC (tracer indicator)
84      INTEGER                              , INTENT(in   ) ::   kjpt       ! number of tracers
85      REAL(wp), DIMENSION(jpi,jpj,    kjpt), INTENT(in   ) ::   pgu , pgv  ! tracer gradient at pstep levels
86      REAL(wp), DIMENSION(jpi,jpj,    kjpt), INTENT(in   ) ::   pgui, pgvi ! tracer gradient at pstep levels
87      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb        ! before and now tracer fields
88      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta        ! tracer trend
89      !!
90      INTEGER  ::  ji, jj, jk, jn   ! dummy loop indices
91      REAL(wp) ::  zbtr, ztra       ! local scalars
92      REAL(wp), POINTER, DIMENSION(:,:) ::  zeeu, zeev, zlt
93      !!----------------------------------------------------------------------
94      !
95      IF( nn_timing == 1 )  CALL timing_start( 'tra_ldf_bilap')
96      !
97      CALL wrk_alloc( jpi, jpj, zeeu, zeev, zlt ) 
98      !
99
100      IF( kt == kit000 )  THEN
101         IF(lwp) WRITE(numout,*)
102         IF(lwp) WRITE(numout,*) 'tra_ldf_bilap : iso-level biharmonic operator on ', cdtype
103         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~'
104         IF(lwp .AND. lflush) CALL flush(numout)
105      ENDIF
106      !                                                          ! ===========
107      DO jn = 1, kjpt                                            ! tracer loop
108         !                                                       ! ===========
109         !                                               
110         DO jk = 1, jpkm1                                        ! Horizontal slab
111            !                                             
112            !                          !==  Initialization of metric arrays (for z- or s-coordinates)  ==!
113            DO jj = 1, jpjm1
114               DO ji = 1, fs_jpim1   ! vector opt.
115                  zeeu(ji,jj) = re2u_e1u(ji,jj) * fse3u_n(ji,jj,jk) * umask(ji,jj,jk)
116                  zeev(ji,jj) = re1v_e2v(ji,jj) * fse3v_n(ji,jj,jk) * vmask(ji,jj,jk)
117               END DO
118            END DO
119            !                          !==  Laplacian  ==!
120            !
121            DO jj = 1, jpjm1                 ! First derivative (gradient)
122               DO ji = 1, fs_jpim1   ! vector opt.
123                  ztu(ji,jj,jk) = zeeu(ji,jj) * ( ptb(ji+1,jj  ,jk,jn) - ptb(ji,jj,jk,jn) )
124                  ztv(ji,jj,jk) = zeev(ji,jj) * ( ptb(ji  ,jj+1,jk,jn) - ptb(ji,jj,jk,jn) )
125               END DO
126            END DO
127            !
128            IF( ln_zps ) THEN                ! set gradient at partial step level (last ocean level)
129               DO jj = 1, jpjm1
130                  DO ji = 1, jpim1
131                     IF( mbku(ji,jj) == jk )  ztu(ji,jj,jk) = zeeu(ji,jj) * pgu(ji,jj,jn)
132                     IF( mbkv(ji,jj) == jk )  ztv(ji,jj,jk) = zeev(ji,jj) * pgv(ji,jj,jn)
133                  END DO
134               END DO
135            ENDIF
136            ! (ISH)
137            IF( ln_zps .AND. ln_isfcav ) THEN ! set gradient at partial step level (first ocean level in a cavity)
138               DO jj = 1, jpjm1
139                  DO ji = 1, jpim1
140                     IF( miku(ji,jj) == MAX(jk,2) )  ztu(ji,jj,jk) = zeeu(ji,jj) * pgui(ji,jj,jn)
141                     IF( mikv(ji,jj) == MAX(jk,2) )  ztu(ji,jj,jk) = zeev(ji,jj) * pgvi(ji,jj,jn)
142                  END DO
143               END DO
144            ENDIF
145            !
146            DO jj = 2, jpjm1                 ! Second derivative (divergence) time the eddy diffusivity coefficient
147               DO ji = fs_2, fs_jpim1   ! vector opt.
148                  zbtr = 1.0 / ( e12t(ji,jj) * fse3t_n(ji,jj,jk) )
149                  zlt(ji,jj) = fsahtt(ji,jj,jk) * zbtr * (   ztu(ji,jj,jk) - ztu(ji-1,jj,jk)   &
150                     &                                     + ztv(ji,jj,jk) - ztv(ji,jj-1,jk)   )
151               END DO
152            END DO
153            CALL lbc_lnk( zlt, 'T', 1. )     ! Lateral boundary conditions (unchanged sgn)
154
155            !                          !==  Bilaplacian  ==!
156            !
157            DO jj = 1, jpjm1                 ! third derivative (gradient)
158               DO ji = 1, fs_jpim1   ! vector opt.
159                  ztu(ji,jj,jk) = zeeu(ji,jj) * ( zlt(ji+1,jj  ) - zlt(ji,jj) )
160                  ztv(ji,jj,jk) = zeev(ji,jj) * ( zlt(ji  ,jj+1) - zlt(ji,jj) )
161               END DO
162            END DO
163            DO jj = 2, jpjm1                 ! fourth derivative (divergence) and add to the general tracer trend
164               DO ji = fs_2, fs_jpim1   ! vector opt.
165                  ! horizontal diffusive trends
166                  zbtr = 1.0 / ( e12t(ji,jj) * fse3t_n(ji,jj,jk) )
167                  ztra = zbtr * (  ztu(ji,jj,jk) - ztu(ji-1,jj,jk) + ztv(ji,jj,jk) - ztv(ji,jj-1,jk)  )
168                  ! add it to the general tracer trends
169                  pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + ztra
170               END DO
171            END DO
172            !                                             
173         END DO                                           ! Horizontal slab
174         !                                               
175         ! "zonal" mean lateral diffusive heat and salt transport
176         IF( cdtype == 'TRA' .AND. ln_diaptr )   CALL dia_ptr_ohst_components( jn, 'ldf', ztv(:,:,:) )
177         !                                                ! ===========
178      END DO                                              ! tracer loop
179      !                                                   ! ===========
180      IF( nn_timing == 1 )  CALL timing_stop( 'tra_ldf_bilap')
181      !
182      CALL wrk_dealloc( jpi, jpj, zeeu, zeev, zlt ) 
183      !
184   END SUBROUTINE tra_ldf_bilap
185
186   !!==============================================================================
187END MODULE traldf_bilap
Note: See TracBrowser for help on using the repository browser.