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/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/TRA – NEMO

source: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_lap.F90 @ 4431

Last change on this file since 4431 was 3211, checked in by spickles2, 12 years ago

Stephen Pickles, 11 Dec 2011

Commit to bring the rest of the DCSE NEMO development branch
in line with the latest development version. This includes
array index re-ordering of all OPA_SRC/.
  • Property svn:keywords set to Id
File size: 8.3 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
28   IMPLICIT NONE
29   PRIVATE
30
31   PUBLIC   tra_ldf_lap   ! routine called by step.F90
32
33   REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:) ::   e1ur, e2vr   ! scale factor coefficients
34
35   !! * Control permutation of array indices
36#  include "oce_ftrans.h90"
37#  include "dom_oce_ftrans.h90"
38#  include "ldftra_oce_ftrans.h90"
39#  include "trc_oce_ftrans.h90"
40
41   !! * Substitutions
42#  include "domzgr_substitute.h90"
43#  include "ldftra_substitute.h90"
44#  include "vectopt_loop_substitute.h90"
45   !!----------------------------------------------------------------------
46   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
47   !! $Id$
48   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
49   !!----------------------------------------------------------------------
50CONTAINS
51
52   SUBROUTINE tra_ldf_lap( kt, cdtype, pgu, pgv,      &
53      &                                ptb, pta, kjpt ) 
54      !!----------------------------------------------------------------------
55      !!                  ***  ROUTINE tra_ldf_lap  ***
56      !!                   
57      !! ** Purpose :   Compute the before horizontal tracer (t & s) diffusive
58      !!      trend and add it to the general trend of tracer equation.
59      !!
60      !! ** Method  :   Second order diffusive operator evaluated using before
61      !!      fields (forward time scheme). The horizontal diffusive trends of
62      !!      the tracer is given by:
63      !!          difft = 1/(e1t*e2t*e3t) {  di-1[ aht e2u*e3u/e1u di(tb) ]
64      !!                                   + dj-1[ aht e1v*e3v/e2v dj(tb) ] }
65      !!      Add this trend to the general tracer trend pta :
66      !!          pta = pta + difft
67      !!
68      !! ** Action  : - Update pta arrays with the before iso-level
69      !!                harmonic mixing trend.
70      !!----------------------------------------------------------------------
71      USE oce, ONLY:   ztu => ua , ztv => va  ! (ua,va) used as workspace
72
73      !! DCSE_NEMO: need additional directives for renamed module variables
74!FTRANS ztu ztv :I :I :z
75
76      !
77      INTEGER                              , INTENT(in   ) ::   kt         ! ocean time-step index
78      CHARACTER(len=3)                     , INTENT(in   ) ::   cdtype     ! =TRA or TRC (tracer indicator)
79      INTEGER                              , INTENT(in   ) ::   kjpt       ! number of tracers
80      REAL(wp), DIMENSION(jpi,jpj    ,kjpt), INTENT(in   ) ::   pgu, pgv   ! tracer gradient at pstep levels
81
82      !! DCSE_NEMO: This style defeats ftrans
83!     REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb        ! before and now tracer fields
84!     REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta        ! tracer trend
85
86!FTRANS ptb pta :I :I :z :
87      REAL(wp), INTENT(in   ) ::   ptb(jpi,jpj,jpk,kjpt)        ! before and now tracer fields
88      REAL(wp), INTENT(inout) ::   pta(jpi,jpj,jpk,kjpt)        ! tracer trend
89      !
90      INTEGER  ::   ji, jj, jk, jn       ! dummy loop indices
91      INTEGER  ::   iku, ikv, ierr       ! local integers
92      REAL(wp) ::   zabe1, zabe2, zbtr   ! local scalars
93      !!----------------------------------------------------------------------
94     
95      IF( kt == nit000 )  THEN
96         IF(lwp) WRITE(numout,*)
97         IF(lwp) WRITE(numout,*) 'tra_ldf_lap : iso-level laplacian diffusion on ', cdtype
98         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~ '
99         !
100         ALLOCATE( e1ur(jpi,jpj), e2vr(jpi,jpj), STAT=ierr )
101         IF( lk_mpp    )   CALL mpp_sum( ierr )
102         IF( ierr /= 0 )   CALL ctl_stop( 'STOP', 'tra_ldf_lap : unable to allocate arrays' )
103         !
104         e1ur(:,:) = e2u(:,:) / e1u(:,:)
105         e2vr(:,:) = e1v(:,:) / e2v(:,:)
106      ENDIF
107
108      !                                                          ! =========== !
109      DO jn = 1, kjpt                                            ! tracer loop !
110         !                                                       ! =========== !   
111         DO jk = 1, jpkm1                                            ! slab loop
112            !                                           
113            ! 1. First derivative (gradient)
114            ! -------------------
115            DO jj = 1, jpjm1
116               DO ji = 1, fs_jpim1   ! vector opt.
117                  zabe1 = fsahtu(ji,jj,jk) * umask(ji,jj,jk) * e1ur(ji,jj) * fse3u(ji,jj,jk)
118                  zabe2 = fsahtv(ji,jj,jk) * vmask(ji,jj,jk) * e2vr(ji,jj) * fse3v(ji,jj,jk)
119                  ztu(ji,jj,jk) = zabe1 * ( ptb(ji+1,jj  ,jk,jn) - ptb(ji,jj,jk,jn) )
120                  ztv(ji,jj,jk) = zabe2 * ( ptb(ji  ,jj+1,jk,jn) - ptb(ji,jj,jk,jn) )
121               END DO
122            END DO
123            IF( ln_zps ) THEN      ! set gradient at partial step level
124               DO jj = 1, jpjm1
125                  DO ji = 1, fs_jpim1   ! vector opt.
126                     ! last level
127                     iku = mbku(ji,jj)
128                     ikv = mbkv(ji,jj)
129                     IF( iku == jk ) THEN
130                        zabe1 = fsahtu(ji,jj,iku) * umask(ji,jj,iku) * e1ur(ji,jj) * fse3u(ji,jj,iku)
131                        ztu(ji,jj,jk) = zabe1 * pgu(ji,jj,jn)
132                     ENDIF
133                     IF( ikv == jk ) THEN
134                        zabe2 = fsahtv(ji,jj,ikv) * vmask(ji,jj,ikv) * e2vr(ji,jj) * fse3v(ji,jj,ikv)
135                        ztv(ji,jj,jk) = zabe2 * pgv(ji,jj,jn)
136                     ENDIF
137                  END DO
138               END DO
139            ENDIF
140         
141         
142            ! 2. Second derivative (divergence) added to the general tracer trends
143            ! ---------------------------------------------------------------------
144            DO jj = 2, jpjm1
145               DO ji = fs_2, fs_jpim1   ! vector opt.
146                  zbtr = 1._wp / ( e1t(ji,jj) *e2t(ji,jj) * fse3t(ji,jj,jk) )
147                  ! horizontal diffusive trends added to the general tracer trends
148                  pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + zbtr * (  ztu(ji,jj,jk) - ztu(ji-1,jj,jk)   &
149                     &                                          + ztv(ji,jj,jk) - ztv(ji,jj-1,jk)  )
150               END DO
151            END DO
152            !
153         END DO                                             !  End of slab 
154         !
155         ! "Poleward" diffusive heat or salt transports
156         IF( cdtype == 'TRA' .AND. ln_diaptr .AND. ( MOD( kt, nn_fptr ) == 0 ) ) THEN
157            IF( jn  == jp_tem)   htr_ldf(:) = ptr_vj( ztv(:,:,:) )
158            IF( jn  == jp_sal)   str_ldf(:) = ptr_vj( ztv(:,:,:) )
159         ENDIF
160         !                                                  ! ==================
161      END DO                                                ! end of tracer loop
162      !                                                     ! ==================
163   END SUBROUTINE tra_ldf_lap
164
165   !!==============================================================================
166END MODULE traldf_lap
Note: See TracBrowser for help on using the repository browser.