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_crs.F90 in branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/TRA – NEMO

source: branches/2015/dev_r5003_MERCATOR6_CRS/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_lap_crs.F90 @ 7806

Last change on this file since 7806 was 7806, checked in by cbricaud, 7 years ago

phaze dev_r5003_MERCATOR6_CRS branch with rev7805 of 3.6_stable branch
  • Property svn:executable set to *
File size: 8.3 KB
Line 
1MODULE traldf_lap_crs
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 , ONLY : lk_vvl, ln_zps         ! 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   USE crs
29
30   IMPLICIT NONE
31   PRIVATE
32
33   PUBLIC   tra_ldf_lap_crs   ! routine called by step.F90
34
35   REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:) ::   e1ur, e2vr   ! scale factor coefficients
36
37   !! * Substitutions
38#  include "domzgr_substitute.h90"
39#  include "ldftra_substitute.h90"
40#  include "vectopt_loop_substitute.h90"
41   !!----------------------------------------------------------------------
42   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
43   !! $Id: traldf_lap.F90 3294 2012-01-28 16:44:18Z rblod $
44   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
45   !!----------------------------------------------------------------------
46CONTAINS
47
48   SUBROUTINE tra_ldf_lap_crs( kt, kit000, cdtype, pgu, pgv,      &
49      &                                ptb, pta, kjpt ) 
50      !!----------------------------------------------------------------------
51      !!                  ***  ROUTINE tra_ldf_lap  ***
52      !!                   
53      !! ** Purpose :   Compute the before horizontal tracer (t & s) diffusive
54      !!      trend and add it to the general trend of tracer equation.
55      !!
56      !! ** Method  :   Second order diffusive operator evaluated using before
57      !!      fields (forward time scheme). The horizontal diffusive trends of
58      !!      the tracer is given by:
59      !!          difft = 1/(e1t*e2t*e3t) {  di-1[ aht e2u*e3u/e1u di(tb) ]
60      !!                                   + dj-1[ aht e1v*e3v/e2v dj(tb) ] }
61      !!      Add this trend to the general tracer trend pta :
62      !!          pta = pta + difft
63      !!
64      !! ** Action  : - Update pta arrays with the before iso-level
65      !!                harmonic mixing trend.
66      !!----------------------------------------------------------------------
67      USE oce, ONLY:   ztu => ua , ztv => va  ! (ua,va) used as workspace
68      !
69      INTEGER                              , INTENT(in   ) ::   kt         ! ocean time-step index
70      INTEGER                              , INTENT(in   ) ::   kit000          ! first time step index
71      CHARACTER(len=3)                     , INTENT(in   ) ::   cdtype     ! =TRA or TRC (tracer indicator)
72      INTEGER                              , INTENT(in   ) ::   kjpt       ! number of tracers
73      REAL(wp), DIMENSION(jpi,jpj    ,kjpt), INTENT(in   ) ::   pgu, pgv   ! tracer gradient at pstep levels
74      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb        ! before and now tracer fields
75      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta        ! tracer trend
76      !
77      INTEGER  ::   ji, jj, jk, jn       ! dummy loop indices
78      INTEGER  ::   iku, ikv, ierr       ! local integers
79      REAL(wp) ::   zabe1, zabe2, zbtr   ! local scalars
80      !!----------------------------------------------------------------------
81      !
82      CALL timing_start('tra_ldf_lap')
83      !
84      IF( kt == kit000 )  THEN
85         IF(lwp) WRITE(numout,*)
86         IF(lwp) WRITE(numout,*) 'tra_ldf_lap : iso-level laplacian diffusion on ', cdtype
87         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~ '
88         !
89         IF( .NOT. ALLOCATED( e1ur ) ) THEN
90            ! This routine may be called for both active and passive tracers.
91            ! Allocate and set saved arrays on first call only.
92            ALLOCATE( e1ur(jpi,jpj), e2vr(jpi,jpj), STAT=ierr )
93            IF( lk_mpp    )   CALL mpp_sum( ierr )
94            IF( ierr /= 0 )   CALL ctl_stop( 'STOP', 'tra_ldf_lap : unable to allocate arrays' )
95            !
96            e1ur(:,:) = 1._wp / e1u_crs(:,:)             !!cc
97            e2vr(:,:) = 1._wp / e2v_crs(:,:)             !!cc
98         ENDIF
99      ENDIF
100
101      !                                                          ! =========== !
102      DO jn = 1, kjpt                                            ! tracer loop !
103         !                                                       ! =========== !   
104         DO jk = 1, jpkm1                                            ! slab loop
105            !                                           
106            ! 1. First derivative (gradient)
107            ! -------------------
108            DO jj = 1, jpjm1
109               DO ji = 1, fs_jpim1   ! vector opt.
110       !           zabe1 = fsahtu(ji,jj,jk) * umask_crs(ji,jj,jk) * e1ur(ji,jj) * e2e3u_msk(ji,jj,jk)
111       !           zabe2 = fsahtv(ji,jj,jk) * vmask_crs(ji,jj,jk) * e2vr(ji,jj) * e1e3v_msk(ji,jj,jk)
112                   zabe1 = fsahtu(ji,jj,jk) * umask_crs(ji,jj,jk) * e1ur(ji,jj) * e2e3u_msk(ji,jj,jk)
113                   zabe2 = fsahtv(ji,jj,jk) * vmask_crs(ji,jj,jk) * e2vr(ji,jj) * e1e3v_msk(ji,jj,jk)
114                  ztu(ji,jj,jk) = zabe1 * ( ptb(ji+1,jj  ,jk,jn) - ptb(ji,jj,jk,jn) )
115                  ztv(ji,jj,jk) = zabe2 * ( ptb(ji  ,jj+1,jk,jn) - ptb(ji,jj,jk,jn) )
116               END DO
117            END DO
118
119           IF( ln_zps ) THEN      ! set gradient at partial step level
120              DO jj = 1, jpjm1
121                  DO ji = 1, fs_jpim1   ! vector opt.
122                     ! last level
123                     iku = mbku_crs(ji,jj)
124                     ikv = mbkv_crs(ji,jj)
125                     IF( iku == jk ) THEN
126                        zabe1 = fsahtu(ji,jj,iku) * umask_crs(ji,jj,iku) * e1ur(ji,jj) * fse3u_crs(ji,jj,iku)
127                        ztu(ji,jj,jk) = zabe1 * pgu(ji,jj,jn)
128                     ENDIF
129                     IF( ikv == jk ) THEN
130                        zabe2 = fsahtv(ji,jj,ikv) * vmask_crs(ji,jj,ikv) * e2vr(ji,jj) * fse3v_crs(ji,jj,ikv)
131                        ztv(ji,jj,jk) = zabe2 * pgv(ji,jj,jn)
132                     ENDIF
133                  END DO
134               END DO
135            ENDIF
136         
137         
138            ! 2. Second derivative (divergence) added to the general tracer trends
139            ! ---------------------------------------------------------------------
140            DO jj = 2, jpjm1
141               DO ji = fs_2, fs_jpim1   ! vector opt.
142                  zbtr = r1_bt_crs(ji,jj,jk) 
143                  ! horizontal diffusive trends added to the general tracer trends
144                  pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + zbtr * (  ztu(ji,jj,jk) - ztu(ji-1,jj,jk)   &
145                     &                                          + ztv(ji,jj,jk) - ztv(ji,jj-1,jk)  )
146               END DO
147            END DO
148            !
149         END DO                                             !  End of slab 
150         !
151         !                                                  ! ==================
152      END DO                                                ! end of tracer loop
153      !                                                     ! ==================
154      CALL timing_stop('tra_ldf_lap')
155      !
156   END SUBROUTINE tra_ldf_lap_crs
157
158   !!==============================================================================
159END MODULE traldf_lap_crs
Note: See TracBrowser for help on using the repository browser.