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_lap.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_lap.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: 8.8 KB
Line 
1MODULE traldf_lap
2   !!==============================================================================
3   !!                       ***  MODULE  traldf_lap  ***
4   !! Ocean  tracers:  horizontal component of the lateral tracer mixing trend
5   !!==============================================================================
6   !! History :  OPA  !  87-06  (P. Andrich, D. L Hostis)  Original code
7   !!                 !  91-11  (G. Madec)
8   !!                 !  95-11  (G. Madec)  suppress volumetric scale factors
9   !!                 !  96-01  (G. Madec)  statement function for e3
10   !!            NEMO !  02-06  (G. Madec)  F90: Free form and module
11   !!            1.0  !  04-08  (C. Talandier) New trends organization
12   !!                 !  05-11  (G. Madec)  add zps case
13   !!            3.0  !  10-06  (C. Ethe, G. Madec) Merge TRA-TRC
14   !!----------------------------------------------------------------------
15
16   !!----------------------------------------------------------------------
17   !!   tra_ldf_lap  : update the tracer trend with the horizontal diffusion
18   !!                 using a iso-level harmonic (laplacien) operator.
19   !!----------------------------------------------------------------------
20   USE oce             ! ocean dynamics and active tracers
21   USE dom_oce         ! ocean space and time domain
22   USE ldftra_oce      ! ocean active tracers: lateral physics
23   USE in_out_manager  ! I/O manager
24   USE diaptr          ! poleward transport diagnostics
25   USE trc_oce         ! share passive tracers/Ocean variables
26   USE lib_mpp         ! MPP library
27   USE timing          ! Timing
28
29   IMPLICIT NONE
30   PRIVATE
31
32   PUBLIC   tra_ldf_lap   ! routine called by step.F90
33
34   !! * Substitutions
35#  include "domzgr_substitute.h90"
36#  include "ldftra_substitute.h90"
37#  include "vectopt_loop_substitute.h90"
38   !!----------------------------------------------------------------------
39   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
40   !! $Id$
41   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
42   !!----------------------------------------------------------------------
43CONTAINS
44
45   SUBROUTINE tra_ldf_lap( kt, kit000, cdtype, pgu , pgv ,    &
46      &                                        pgui, pgvi,    &
47      &                                ptb, pta, kjpt ) 
48      !!----------------------------------------------------------------------
49      !!                  ***  ROUTINE tra_ldf_lap  ***
50      !!                   
51      !! ** Purpose :   Compute the before horizontal tracer (t & s) diffusive
52      !!      trend and add it to the general trend of tracer equation.
53      !!
54      !! ** Method  :   Second order diffusive operator evaluated using before
55      !!      fields (forward time scheme). The horizontal diffusive trends of
56      !!      the tracer is given by:
57      !!          difft = 1/(e1t*e2t*e3t) {  di-1[ aht e2u*e3u/e1u di(tb) ]
58      !!                                   + dj-1[ aht e1v*e3v/e2v dj(tb) ] }
59      !!      Add this trend to the general tracer trend pta :
60      !!          pta = pta + difft
61      !!
62      !! ** Action  : - Update pta arrays with the before iso-level
63      !!                harmonic mixing trend.
64      !!----------------------------------------------------------------------
65      USE oce, ONLY:   ztu => ua , ztv => va  ! (ua,va) used as workspace
66      !
67      INTEGER                              , INTENT(in   ) ::   kt         ! ocean time-step index
68      INTEGER                              , INTENT(in   ) ::   kit000          ! first time step index
69      CHARACTER(len=3)                     , INTENT(in   ) ::   cdtype     ! =TRA or TRC (tracer indicator)
70      INTEGER                              , INTENT(in   ) ::   kjpt       ! number of tracers
71      REAL(wp), DIMENSION(jpi,jpj    ,kjpt), INTENT(in   ) ::   pgu, pgv   ! tracer gradient at pstep levels
72      REAL(wp), DIMENSION(jpi,jpj,    kjpt), INTENT(in   ) ::   pgui, pgvi ! tracer gradient at top levels
73      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb        ! before and now tracer fields
74      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta        ! tracer trend
75      !
76      INTEGER  ::   ji, jj, jk, jn       ! dummy loop indices
77      INTEGER  ::   iku, ikv, ierr       ! local integers
78      REAL(wp) ::   zabe1, zabe2, zbtr   ! local scalars
79      !!----------------------------------------------------------------------
80      !
81      IF( nn_timing == 1 ) CALL timing_start('tra_ldf_lap')
82      !
83      IF( kt == kit000 )  THEN
84         IF(lwp) WRITE(numout,*)
85         IF(lwp) WRITE(numout,*) 'tra_ldf_lap : iso-level laplacian diffusion on ', cdtype
86         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~ '
87         IF(lwp .AND. lflush) CALL flush(numout)
88      ENDIF
89
90      !                                                          ! =========== !
91      DO jn = 1, kjpt                                            ! tracer loop !
92         !                                                       ! =========== !   
93         DO jk = 1, jpkm1                                            ! slab loop
94            !                                           
95            ! 1. First derivative (gradient)
96            ! -------------------
97            DO jj = 1, jpjm1
98               DO ji = 1, fs_jpim1   ! vector opt.
99                  zabe1 = fsahtu(ji,jj,jk) * umask(ji,jj,jk) * re2u_e1u(ji,jj) * fse3u_n(ji,jj,jk)
100                  zabe2 = fsahtv(ji,jj,jk) * vmask(ji,jj,jk) * re1v_e2v(ji,jj) * fse3v_n(ji,jj,jk)
101                  ztu(ji,jj,jk) = zabe1 * ( ptb(ji+1,jj  ,jk,jn) - ptb(ji,jj,jk,jn) )
102                  ztv(ji,jj,jk) = zabe2 * ( ptb(ji  ,jj+1,jk,jn) - ptb(ji,jj,jk,jn) )
103               END DO
104            END DO
105            IF( ln_zps ) THEN      ! set gradient at partial step level for the last ocean cell
106               DO jj = 1, jpjm1
107                  DO ji = 1, fs_jpim1   ! vector opt.
108                     ! last level
109                     iku = mbku(ji,jj)
110                     ikv = mbkv(ji,jj)
111                     IF( iku == jk ) THEN
112                        zabe1 = fsahtu(ji,jj,iku) * umask(ji,jj,iku) * re2u_e1u(ji,jj) * fse3u_n(ji,jj,iku)
113                        ztu(ji,jj,jk) = zabe1 * pgu(ji,jj,jn)
114                     ENDIF
115                     IF( ikv == jk ) THEN
116                        zabe2 = fsahtv(ji,jj,ikv) * vmask(ji,jj,ikv) * re1v_e2v(ji,jj) * fse3v_n(ji,jj,ikv)
117                        ztv(ji,jj,jk) = zabe2 * pgv(ji,jj,jn)
118                     ENDIF
119                  END DO
120               END DO
121            ENDIF
122            ! (ISH)
123            IF( ln_zps .AND. ln_isfcav ) THEN      ! set gradient at partial step level for the first ocean cell
124                                                   ! into a cavity
125               DO jj = 1, jpjm1
126                  DO ji = 1, fs_jpim1   ! vector opt.
127                     ! ice shelf level level MAX(2,jk) => only where ice shelf
128                     iku = miku(ji,jj) 
129                     ikv = mikv(ji,jj) 
130                     IF( iku == MAX(2,jk) ) THEN
131                        zabe1 = fsahtu(ji,jj,iku) * umask(ji,jj,iku) * re2u_e1u(ji,jj) * fse3u_n(ji,jj,iku) 
132                        ztu(ji,jj,jk) = zabe1 * pgui(ji,jj,jn) 
133                     ENDIF
134                     IF( ikv == MAX(2,jk) ) THEN
135                        zabe2 = fsahtv(ji,jj,ikv) * vmask(ji,jj,ikv) * re1v_e2v(ji,jj) * fse3v_n(ji,jj,ikv) 
136                        ztv(ji,jj,jk) = zabe2 * pgvi(ji,jj,jn) 
137                     END IF
138                  END DO
139               END DO
140            ENDIF
141         
142         
143            ! 2. Second derivative (divergence) added to the general tracer trends
144            ! ---------------------------------------------------------------------
145            DO jj = 2, jpjm1
146               DO ji = fs_2, fs_jpim1   ! vector opt.
147                  zbtr = 1._wp / ( e12t(ji,jj) * fse3t_n(ji,jj,jk) )
148                  ! horizontal diffusive trends added to the general tracer trends
149                  pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + 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            !
154         END DO                                             !  End of slab 
155         !
156         ! "Poleward" diffusive heat or salt transports
157         IF( cdtype == 'TRA' .AND. ln_diaptr )    CALL dia_ptr_ohst_components( jn, 'ldf', ztv(:,:,:) )
158         !                                                  ! ==================
159      END DO                                                ! end of tracer loop
160      !                                                     ! ==================
161      IF( nn_timing == 1 ) CALL timing_stop('tra_ldf_lap')
162      !
163   END SUBROUTINE tra_ldf_lap
164
165   !!==============================================================================
166END MODULE traldf_lap
Note: See TracBrowser for help on using the repository browser.