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/r5936_INGV1_WAVE-coupling/NEMOGCM/NEMO/OPA_SRC/TRA – NEMO

source: branches/UKMO/r5936_INGV1_WAVE-coupling/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_lap.F90 @ 7166

Last change on this file since 7166 was 7166, checked in by jcastill, 7 years ago

Remove svn keys
File size: 8.8 KB
RevLine 
[3]1MODULE traldf_lap
2   !!==============================================================================
3   !!                       ***  MODULE  traldf_lap  ***
[5836]4   !! Ocean tracers:  lateral diffusivity trend  (laplacian and bilaplacian)
[3]5   !!==============================================================================
[5836]6   !! History :  OPA  ! 1987-06  (P. Andrich, D. L Hostis)  Original code
7   !!                 ! 1991-11  (G. Madec)
8   !!                 ! 1995-11  (G. Madec)  suppress volumetric scale factors
9   !!                 ! 1996-01  (G. Madec)  statement function for e3
10   !!            NEMO ! 2002-06  (G. Madec)  F90: Free form and module
11   !!            1.0  ! 2004-08  (C. Talandier) New trends organization
12   !!                 ! 2005-11  (G. Madec)  add zps case
13   !!            3.0  ! 2010-06  (C. Ethe, G. Madec) Merge TRA-TRC
14   !!            3.7  ! 2014-01  (G. Madec, S. Masson) re-entrant laplacian
[2528]15   !!----------------------------------------------------------------------
[3]16
17   !!----------------------------------------------------------------------
[5836]18   !!   tra_ldf_lap : update the tracer trend with the lateral diffusion : iso-level laplacian operator
19   !!   tra_ldf_blp : update the tracer trend with the lateral diffusion : iso-level bilaplacian operator
[3]20   !!----------------------------------------------------------------------
21   USE oce             ! ocean dynamics and active tracers
22   USE dom_oce         ! ocean space and time domain
[5836]23   USE ldftra          ! lateral physics: eddy diffusivity
[132]24   USE diaptr          ! poleward transport diagnostics
[2528]25   USE trc_oce         ! share passive tracers/Ocean variables
[5836]26   USE zpshde          ! partial step: hor. derivative     (zps_hde routine)
27   !
28   USE in_out_manager  ! I/O manager
29   USE lbclnk          ! ocean lateral boundary conditions (or mpp link)
30   USE lib_mpp         ! distribued memory computing library
[3294]31   USE timing          ! Timing
[5836]32   USE wrk_nemo        ! Memory allocation
[3]33
34   IMPLICIT NONE
35   PRIVATE
36
[5836]37   PUBLIC   tra_ldf_lap   ! routine called by traldf.F90
[3]38
39   !! * Substitutions
40#  include "domzgr_substitute.h90"
41#  include "vectopt_loop_substitute.h90"
42   !!----------------------------------------------------------------------
[5836]43   !! NEMO/OPA 3.7 , NEMO Consortium (2014)
[2528]44   !! $Id$
45   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
[3]46   !!----------------------------------------------------------------------
47CONTAINS
48
[5836]49   SUBROUTINE tra_ldf_lap( kt, kit000, cdtype, pahu, pahv, pgu , pgv ,   &
50      &                                                    pgui, pgvi,   &
51      &                                        ptb , pta , kjpt, kpass ) 
[3]52      !!----------------------------------------------------------------------
53      !!                  ***  ROUTINE tra_ldf_lap  ***
54      !!                   
55      !! ** Purpose :   Compute the before horizontal tracer (t & s) diffusive
56      !!      trend and add it to the general trend of tracer equation.
57      !!
58      !! ** Method  :   Second order diffusive operator evaluated using before
59      !!      fields (forward time scheme). The horizontal diffusive trends of
[2528]60      !!      the tracer is given by:
[5836]61      !!          difft = 1/(e1e2t*e3t) {  di-1[ pahu e2u*e3u/e1u di(tb) ]
62      !!                                 + dj-1[ pahv e1v*e3v/e2v dj(tb) ] }
[2528]63      !!      Add this trend to the general tracer trend pta :
64      !!          pta = pta + difft
[3]65      !!
[2528]66      !! ** Action  : - Update pta arrays with the before iso-level
[3]67      !!                harmonic mixing trend.
[2528]68      !!----------------------------------------------------------------------
69      INTEGER                              , INTENT(in   ) ::   kt         ! ocean time-step index
[5836]70      INTEGER                              , INTENT(in   ) ::   kit000     ! first time step index
[2528]71      CHARACTER(len=3)                     , INTENT(in   ) ::   cdtype     ! =TRA or TRC (tracer indicator)
72      INTEGER                              , INTENT(in   ) ::   kjpt       ! number of tracers
[5836]73      INTEGER                              , INTENT(in   ) ::   kpass      ! =1/2 first or second passage
74      REAL(wp), DIMENSION(jpi,jpj,jpk)     , INTENT(in   ) ::   pahu, pahv ! eddy diffusivity at u- and v-points  [m2/s]
[2528]75      REAL(wp), DIMENSION(jpi,jpj    ,kjpt), INTENT(in   ) ::   pgu, pgv   ! tracer gradient at pstep levels
[5836]76      REAL(wp), DIMENSION(jpi,jpj,    kjpt), INTENT(in   ) ::   pgui, pgvi ! tracer gradient at top   levels
[2528]77      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb        ! before and now tracer fields
78      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta        ! tracer trend
[2715]79      !
[5836]80      INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices
81      REAL(wp) ::   zsign            ! local scalars
82      REAL(wp), POINTER, DIMENSION(:,:,:) ::  ztu, ztv, zaheeu, zaheev
[3]83      !!----------------------------------------------------------------------
[3294]84      !
[5836]85      IF( nn_timing == 1 )   CALL timing_start('tra_ldf_lap')
[3294]86      !
[5836]87      IF( kt == nit000 .AND. lwp )  THEN
88         WRITE(numout,*)
89         WRITE(numout,*) 'tra_ldf_lap : iso-level laplacian diffusion on ', cdtype, ', pass=', kpass
90         WRITE(numout,*) '~~~~~~~~~~~ '
[3]91      ENDIF
[5836]92      !
93      CALL wrk_alloc( jpi,jpj,jpk,   ztu, ztv, zaheeu, zaheev ) 
94      !
95      !                                !==  Initialization of metric arrays used for all tracers  ==!
96      IF( kpass == 1 ) THEN   ;   zsign =  1._wp      ! bilaplacian operator require a minus sign (eddy diffusivity >0)
97      ELSE                    ;   zsign = -1._wp
98      ENDIF
99      DO jk = 1, jpkm1
100         DO jj = 1, jpjm1
101            DO ji = 1, fs_jpim1   ! vector opt.
102               zaheeu(ji,jj,jk) = zsign * pahu(ji,jj,jk) * e2_e1u(ji,jj) * fse3u_n(ji,jj,jk)   !!gm   * umask(ji,jj,jk) pah masked!
103               zaheev(ji,jj,jk) = zsign * pahv(ji,jj,jk) * e1_e2v(ji,jj) * fse3v_n(ji,jj,jk)   !!gm   * vmask(ji,jj,jk)
104            END DO
105         END DO
106      END DO
107      !
108      !                             ! =========== !
109      DO jn = 1, kjpt               ! tracer loop !
110         !                          ! =========== !   
111         !                               
112         DO jk = 1, jpkm1              !== First derivative (gradient)  ==!
[457]113            DO jj = 1, jpjm1
[5836]114               DO ji = 1, fs_jpim1
115                  ztu(ji,jj,jk) = zaheeu(ji,jj,jk) * ( ptb(ji+1,jj  ,jk,jn) - ptb(ji,jj,jk,jn) )
116                  ztv(ji,jj,jk) = zaheev(ji,jj,jk) * ( ptb(ji  ,jj+1,jk,jn) - ptb(ji,jj,jk,jn) )
[457]117               END DO
118            END DO
[5836]119         END DO 
120         IF( ln_zps ) THEN                ! set gradient at bottom/top ocean level
121            DO jj = 1, jpjm1                    ! bottom
122               DO ji = 1, fs_jpim1
123                  ztu(ji,jj,mbku(ji,jj)) = zaheeu(ji,jj,mbku(ji,jj)) * pgu(ji,jj,jn)
124                  ztv(ji,jj,mbkv(ji,jj)) = zaheev(ji,jj,mbkv(ji,jj)) * pgv(ji,jj,jn)
[5120]125               END DO
[5836]126            END DO 
127            IF( ln_isfcav ) THEN                ! top in ocean cavities only
[5120]128               DO jj = 1, jpjm1
129                  DO ji = 1, fs_jpim1   ! vector opt.
[5836]130                     IF( miku(ji,jj) > 1 )   ztu(ji,jj,miku(ji,jj)) = zaheeu(ji,jj,miku(ji,jj)) * pgui(ji,jj,jn) 
131                     IF( mikv(ji,jj) > 1 )   ztv(ji,jj,mikv(ji,jj)) = zaheev(ji,jj,mikv(ji,jj)) * pgvi(ji,jj,jn) 
[2528]132                  END DO
133               END DO
134            ENDIF
[5836]135         ENDIF
136         !
137         DO jk = 1, jpkm1              !== Second derivative (divergence) added to the general tracer trends  ==!
[2528]138            DO jj = 2, jpjm1
[5836]139               DO ji = fs_2, fs_jpim1
140                  pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + (  ztu(ji,jj,jk) - ztu(ji-1,jj,jk)     &
141                     &                                   + ztv(ji,jj,jk) - ztv(ji,jj-1,jk) )   &
142                     &                                / ( e1e2t(ji,jj) * fse3t_n(ji,jj,jk) )
[3]143               END DO
144            END DO
[5836]145         END DO 
[2528]146         !
[5836]147         !                             !== "Poleward" diffusive heat or salt transports  ==!
148         IF( ( kpass == 1 .AND. .NOT.ln_traldf_blp ) .OR.  &     !==  first pass only (  laplacian)  ==!
149             ( kpass == 2 .AND.      ln_traldf_blp ) ) THEN      !==  2nd   pass only (bilaplacian)  ==!
150            IF( cdtype == 'TRA' .AND. ln_diaptr ) THEN
151               IF( jn  == jp_tem)   htr_ldf(:) = ptr_sj( -ztv(:,:,:) )
152               IF( jn  == jp_sal)   str_ldf(:) = ptr_sj( -ztv(:,:,:) )
153            ENDIF
[457]154         ENDIF
[5836]155         !                          ! ==================
156      END DO                        ! end of tracer loop
157      !                             ! ==================
[3294]158      !
[5836]159      CALL wrk_dealloc( jpi,jpj,jpk,   ztu, ztv, zaheeu, zaheev ) 
160      !
161      IF( nn_timing == 1 )  CALL timing_stop('tra_ldf_lap')
162      !
[3]163   END SUBROUTINE tra_ldf_lap
[5836]164   
[3]165   !!==============================================================================
166END MODULE traldf_lap
Note: See TracBrowser for help on using the repository browser.