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.
zpshde_trc.F90 in trunk/NEMO/TOP_SRC/TRP – NEMO

source: trunk/NEMO/TOP_SRC/TRP/zpshde_trc.F90 @ 247

Last change on this file since 247 was 247, checked in by opalod, 19 years ago

CL : Add CVS Header and CeCILL licence information
  • Property svn:eol-style set to native
  • Property svn:executable set to *
  • Property svn:keywords set to Author Date Id Revision
File size: 8.9 KB
Line 
1MODULE zpshde_trc
2   !!==============================================================================
3   !!                       ***  MODULE zpshde_trc   ***
4   !! Ocean passive tracers:
5   !!==============================================================================
6#if defined key_passivetrc && ( defined key_partial_steps || defined key_esopa )
7   !!----------------------------------------------------------------------
8   !!   'key_partial_steps' :               z-coordinate with partial steps
9   !!----------------------------------------------------------------------
10   !!   zps_hde_trc  :  Horizontal DErivative of passive tracers at the last
11   !!                   ocean level (Z-coord. with Partial Steps)
12   !!----------------------------------------------------------------------
13   !! * Modules used
14   USE oce_trc         ! ocean dynamics and tracers variables
15   USE trc             ! ocean passive tracers variables
16   USE lbclnk          ! lateral boundary conditions (or mpp link)
17
18   IMPLICIT NONE
19   PRIVATE
20
21   !! * Routine accessibility
22   PUBLIC zps_hde_trc          ! routine called by step.F90
23
24   !! * module variables
25   INTEGER, DIMENSION(jpi,jpj) ::   &
26      mbatu, mbatv      ! bottom ocean level index at U- and V-points
27
28   !! * Substitutions
29#  include "passivetrc_substitute.h90"
30   !!----------------------------------------------------------------------
31   !!----------------------------------------------------------------------
32   !!  TOP 1.0 , LOCEAN-IPSL (2005)
33   !! $Header$
34   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt
35   !!----------------------------------------------------------------------
36CONTAINS
37
38   SUBROUTINE zps_hde_trc ( kt, ptra, pgtru, pgtrv )
39      !!----------------------------------------------------------------------
40      !!                     ***  ROUTINE zps_hde_trc  ***
41      !!                   
42      !! ** Purpose :   Compute the horizontal derivative of passive tracers
43      !!      TRA at u- and v-points with a linear interpolation for z-coordinate
44      !!      with partial steps.
45      !!
46      !! ** Method  :   In z-coord with partial steps, scale factors on last
47      !!      levels are different for each grid point, so that TRA points
48      !!      are not at the same depth as in z-coord. To have horizontal
49      !!      gradients again, we interpolate TRA at the good depth :
50      !!      Linear interpolation of TRA 
51      !!         Computation of di(trb) and dj(trb) by vertical interpolation:
52      !!          di(tra) = tra~ - tra(i,j,k) or tra(i+1,j,k) - tra~
53      !!          dj(tra) = tra~ - tra(i,j,k) or tra(i,j+1,k) - tra~
54      !!         This formulation computes the two cases:
55      !!                 CASE 1                   CASE 2 
56      !!         k-1  ___ ___________   k-1   ___ ___________
57      !!                  TRAi  TRA~             TRA~  TRAi+1
58      !!                  _____                        _____
59      !!         k        |   |TRAi+1   k         TRAi |   |
60      !!                  |   |____                ____|   |
61      !!              ___ |   |   |           ___  |   |   |
62      !!                 
63      !!      case 1->   e3w(i+1) >= e3w(i) ( and e3w(j+1) >= e3w(j) ) then
64      !!      tra~ = tra(i+1,j  ,k) + (e3w(i+1) - e3w(i)) * dk(TRAi+1)/e3w(i+1)
65      !!    ( tra~ = tra(i  ,j+1,k) + (e3w(j+1) - e3w(j)) * dk(TRAj+1)/e3w(j+1))
66      !!          or
67      !!      case 2->   e3w(i+1) <= e3w(i) ( and e3w(j+1) <= e3w(j) ) then
68      !!       tra~ = tra(i,j,k) + (e3w(i) - e3w(i+1)) * dk(TRAi)/e3w(i )
69      !!     ( tra~ = tra(i,j,k) + (e3w(j) - e3w(j+1)) * dk(TRAj)/e3w(j ) )
70      !!     
71      !!
72      !! ** Action  : - pgtru : horizontal gradient of TRA at U-points
73      !!              - pgtrv : horizontal gradient of TRA at V-points
74      !!
75      !! History :
76      !!   8.5  !  02-04  (A. Bozec)  Original code
77      !!   8.5  !  02-08  (G. Madec E. Durand)  Optimization and Free form
78      !!   9.0  !  04-03  (C. Ethe)  adapted for passive tracers
79      !!----------------------------------------------------------------------
80      !! * Arguments
81      INTEGER, INTENT( in ) ::   kt ! ocean time-step index
82      REAL(wp), DIMENSION(jpi,jpj,jpk,jptra), INTENT( in ) ::   &
83         ptra                       ! 4D tracers fields
84      REAL(wp), DIMENSION(jpi,jpj,jptra), INTENT( out ) ::   &
85         pgtru,                 &  ! horizontal grad. of TRA u- and v-points
86         pgtrv                     ! of the partial step level
87
88      !! * Local declarations
89      INTEGER ::   ji, jj,jn,     &  ! Dummy loop indices
90                   iku,ikv          ! partial step level at u- and v-points
91      REAL(wp), DIMENSION(jpi,jpj) ::   &
92         zti, ztj                   ! tempory arrays
93
94      REAL(wp), DIMENSION(jpi,jpj,jptra) ::   &
95         ztrai, ztraj               ! interpolated value of TRA
96
97      REAL(wp) ::   &
98         ze3wu, ze3wv,           &  ! temporary scalars
99         zmaxu1, zmaxu2,         &  !    "         "
100         zmaxv1, zmaxv2             !    "         "
101
102      ! Initialization (first time-step only): compute mbatu and mbatv
103      IF( kt == nittrc000 ) THEN
104         mbatu(:,:) = 0
105         mbatv(:,:) = 0
106         DO jj = 1, jpjm1
107            DO ji = 1, fs_jpim1   ! vector opt.
108               mbatu(ji,jj) = MAX( MIN( mbathy(ji,jj), mbathy(ji+1,jj  ) ) - 1, 2 )
109               mbatv(ji,jj) = MAX( MIN( mbathy(ji,jj), mbathy(ji  ,jj+1) ) - 1, 2 )
110            END DO
111         END DO
112         zti(:,:) = FLOAT( mbatu(:,:) )
113         ztj(:,:) = FLOAT( mbatv(:,:) )
114         ! lateral boundary conditions: T-point, sign unchanged
115         CALL lbc_lnk( zti , 'U', 1. )
116         CALL lbc_lnk( ztj , 'V', 1. )
117         mbatu(:,:) = MAX( INT( zti(:,:) ), 2 )
118         mbatv(:,:) = MAX( INT( ztj(:,:) ), 2 )
119      ENDIF
120     
121
122      DO jn = 1, jptra
123         ! Interpolation of passive tracers at the last ocean level
124# if defined key_vectopt_loop   &&   ! defined key_autotasking
125         jj = 1
126         DO ji = 1, jpij-jpi   ! vector opt. (forced unrolled)
127# else
128         DO jj = 1, jpjm1
129            DO ji = 1, jpim1
130# endif
131               ! last level
132               iku = mbatu(ji,jj)
133               ikv = mbatv(ji,jj)
134
135               ze3wu  = fse3w(ji+1,jj  ,iku) - fse3w(ji,jj,iku)
136               ze3wv  = fse3w(ji  ,jj+1,ikv) - fse3w(ji,jj,ikv)
137               zmaxu1 =  ze3wu / fse3w(ji+1,jj  ,iku)
138               zmaxu2 = -ze3wu / fse3w(ji  ,jj  ,iku)
139               zmaxv1 =  ze3wv / fse3w(ji  ,jj+1,ikv)
140               zmaxv2 = -ze3wv / fse3w(ji  ,jj  ,ikv)
141
142               ! i- direction
143
144               IF( ze3wu >= 0. ) THEN      ! case 1
145                  ! interpolated values of passive tracers
146                  ztrai(ji,jj,jn) = ptra(ji+1,jj,iku,jn) + zmaxu1 * ( ptra(ji+1,jj,iku-1,jn) - ptra(ji+1,jj,iku,jn) )
147                  ! gradient of passive tracers
148                  pgtru(ji,jj,jn) = umask(ji,jj,1) * ( ztrai(ji,jj,jn) - ptra(ji,jj,iku,jn) )
149               ELSE                        ! case 2
150                  ! interpolated values of passive tracers
151                  ztrai(ji,jj,jn) = ptra(ji,jj,iku,jn) + zmaxu2 * ( ptra(ji,jj,iku-1,jn) - ptra(ji,jj,iku,jn) )
152                  ! gradient of passive tracers
153                  pgtru(ji,jj,jn) = umask(ji,jj,1) * ( ptra(ji+1,jj,iku,jn) - ztrai (ji,jj,jn) )
154               ENDIF
155
156               ! j- direction
157
158               IF( ze3wv >= 0. ) THEN      ! case 1
159                  ! interpolated values of passive tracers
160                  ztraj(ji,jj,jn) = ptra(ji,jj+1,ikv,jn) + zmaxv1 * ( ptra(ji,jj+1,ikv-1,jn) - ptra(ji,jj+1,ikv,jn) )
161                  ! gradient of passive tracers
162                  pgtrv(ji,jj,jn) = vmask(ji,jj,1) * ( ztraj(ji,jj,jn) - ptra(ji,jj,ikv,jn) )
163               ELSE                        ! case 2
164                  ! interpolated values of passive tracers
165                  ztraj(ji,jj,jn) = ptra(ji,jj,ikv,jn) + zmaxv2 * ( ptra(ji,jj,ikv-1,jn) - ptra(ji,jj,ikv,jn) )
166                  ! gradient of passive tracers
167                  pgtrv(ji,jj,jn) = vmask(ji,jj,1) * ( ptra(ji,jj+1,ikv,jn) - ztraj(ji,jj,jn) )
168               ENDIF
169# if ! defined key_vectopt_loop   ||   defined key_autotasking
170            END DO
171# endif
172         END DO
173
174         ! Lateral boundary conditions on each gradient
175         CALL lbc_lnk( pgtru(:,:,jn) , 'U', -1. ) 
176         CALL lbc_lnk( pgtrv(:,:,jn) , 'V', -1. )
177
178      END DO
179
180   END SUBROUTINE zps_hde_trc
181
182#else
183   !!----------------------------------------------------------------------
184   !!   Default option                                         Empty module
185   !!----------------------------------------------------------------------
186   USE par_kind
187CONTAINS
188   SUBROUTINE zps_hde_trc ( kt, ptra, pgtru, pgtrv ) ! Empty routine
189      REAL(wp) :: kt,ptra,pgtru, pgtrv
190      WRITE(*,*) 'zps_hde_trc: You should not have seen this print! error?',   &
191         kt, ptra, pgtru, pgtrv
192   END SUBROUTINE zps_hde_trc
193#endif
194
195   !!======================================================================
196END MODULE zpshde_trc
Note: See TracBrowser for help on using the repository browser.