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 @ 13320

Last change on this file since 13320 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
RevLine 
[3]1MODULE traldf_bilap
2   !!==============================================================================
3   !!                   ***  MODULE  traldf_bilap  ***
[2528]4   !! Ocean  tracers:  horizontal component of the lateral tracer mixing trend
[3]5   !!==============================================================================
[2528]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   !!==============================================================================
[3]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
[74]24   USE ldftra_oce      ! ocean tracer   lateral physics
[3]25   USE in_out_manager  ! I/O manager
26   USE ldfslp          ! iso-neutral slopes
27   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
[132]28   USE diaptr          ! poleward transport diagnostics
[2528]29   USE trc_oce         ! share passive tracers/Ocean variables
[2715]30   USE lib_mpp         ! MPP library
[3294]31   USE wrk_nemo       ! Memory Allocation
32   USE timing         ! Timing
[3]33
34   IMPLICIT NONE
35   PRIVATE
36
[2528]37   PUBLIC   tra_ldf_bilap   ! routine called by step.F90
[3]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   !!----------------------------------------------------------------------
[2528]45   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
46   !! $Id$
47   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
[3]48   !!----------------------------------------------------------------------
49CONTAINS
[2528]50 
[4990]51   SUBROUTINE tra_ldf_bilap( kt, kit000, cdtype, pgu, pgv,            &
52      &                                          pgui, pgvi,          &
[2528]53      &                                  ptb, pta, kjpt ) 
[3]54      !!----------------------------------------------------------------------
55      !!                  ***  ROUTINE tra_ldf_bilap  ***
56      !!
[2528]57      !! ** Purpose :   Compute the before horizontal tracer diffusive
[3]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.
[2528]62      !!      diffusive trends  is given by:
[3]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      !!
[2528]73      !!      Add this trend to the general trend
74      !!         (pta) = (pta) + ( difft )
[3]75      !!
[2528]76      !! ** Action : - Update pta arrays with the before iso-level
[3]77      !!               biharmonic mixing trend.
[2528]78      !!----------------------------------------------------------------------
[2715]79      USE oce     , ONLY:   ztu  => ua       , ztv  => va                           ! (ua,va) used as workspace
[3]80      !!
[2528]81      INTEGER                              , INTENT(in   ) ::   kt         ! ocean time-step index
[3294]82      INTEGER                              , INTENT(in   ) ::   kit000          ! first time step index
[2528]83      CHARACTER(len=3)                     , INTENT(in   ) ::   cdtype     ! =TRA or TRC (tracer indicator)
84      INTEGER                              , INTENT(in   ) ::   kjpt       ! number of tracers
[4990]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
[2528]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
[3294]92      REAL(wp), POINTER, DIMENSION(:,:) ::  zeeu, zeev, zlt
[3]93      !!----------------------------------------------------------------------
[3294]94      !
95      IF( nn_timing == 1 )  CALL timing_start( 'tra_ldf_bilap')
96      !
97      CALL wrk_alloc( jpi, jpj, zeeu, zeev, zlt ) 
98      !
[132]99
[3294]100      IF( kt == kit000 )  THEN
[3]101         IF(lwp) WRITE(numout,*)
[2528]102         IF(lwp) WRITE(numout,*) 'tra_ldf_bilap : iso-level biharmonic operator on ', cdtype
[3]103         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~'
[11101]104         IF(lwp .AND. lflush) CALL flush(numout)
[3]105      ENDIF
[2528]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)  ==!
[457]113            DO jj = 1, jpjm1
114               DO ji = 1, fs_jpim1   ! vector opt.
[4292]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)
[457]117               END DO
118            END DO
[2528]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
[3]126            END DO
[5120]127            !
[2528]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
[457]134               END DO
[2528]135            ENDIF
[5120]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            !
[2528]146            DO jj = 2, jpjm1                 ! Second derivative (divergence) time the eddy diffusivity coefficient
147               DO ji = fs_2, fs_jpim1   ! vector opt.
[4292]148                  zbtr = 1.0 / ( e12t(ji,jj) * fse3t_n(ji,jj,jk) )
[2528]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
[3]152            END DO
[2528]153            CALL lbc_lnk( zlt, 'T', 1. )     ! Lateral boundary conditions (unchanged sgn)
[3]154
[2528]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
[3]162            END DO
[2528]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
[4292]166                  zbtr = 1.0 / ( e12t(ji,jj) * fse3t_n(ji,jj,jk) )
[2528]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
[132]170               END DO
[3]171            END DO
[2528]172            !                                             
173         END DO                                           ! Horizontal slab
174         !                                               
175         ! "zonal" mean lateral diffusive heat and salt transport
[7179]176         IF( cdtype == 'TRA' .AND. ln_diaptr )   CALL dia_ptr_ohst_components( jn, 'ldf', ztv(:,:,:) )
[2528]177         !                                                ! ===========
178      END DO                                              ! tracer loop
179      !                                                   ! ===========
[3294]180      IF( nn_timing == 1 )  CALL timing_stop( 'tra_ldf_bilap')
[2715]181      !
[3294]182      CALL wrk_dealloc( jpi, jpj, zeeu, zeev, zlt ) 
183      !
[3]184   END SUBROUTINE tra_ldf_bilap
185
186   !!==============================================================================
187END MODULE traldf_bilap
Note: See TracBrowser for help on using the repository browser.