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 branches/dev_001_GM/NEMO/TOP_SRC/TRP – NEMO

source: branches/dev_001_GM/NEMO/TOP_SRC/TRP/zpshde_trc.F90 @ 772

Last change on this file since 772 was 772, checked in by gm, 16 years ago

dev_001_GM - change the name of cpp key to key_top, key_lobster, key_pisces, key_kriest and the corresponding lk_

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