- Timestamp:
- 2010-12-04T16:20:50+01:00 (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/nemo_v3_3_beta/NEMOGCM/NEMO/OPA_SRC/TRA/zpshde.F90
r2287 r2450 1 1 MODULE zpshde 2 !!====================================================================== ========2 !!====================================================================== 3 3 !! *** MODULE zpshde *** 4 !! z-coordinate - partial step : Horizontal Derivative5 !!====================================================================== ========4 !! z-coordinate + partial step : Horizontal Derivative at ocean bottom level 5 !!====================================================================== 6 6 !! History : OPA ! 2002-04 (A. Bozec) Original code 7 !! 8.5! 2002-08 (G. Madec E. Durand) Optimization and Free form8 !! NEMO 1.0! 2004-03 (C. Ethe) adapted for passive tracers7 !! NEMO 1.0 ! 2002-08 (G. Madec E. Durand) Optimization and Free form 8 !! - ! 2004-03 (C. Ethe) adapted for passive tracers 9 9 !! 3.3 ! 2010-05 (C. Ethe, G. Madec) merge TRC-TRA 10 !!====================================================================== ========10 !!====================================================================== 11 11 12 12 !!---------------------------------------------------------------------- … … 14 14 !! ocean level (Z-coord. with Partial Steps) 15 15 !!---------------------------------------------------------------------- 16 USE dom_oce ! ocean space domainvariables17 USE oce ! ocean dynamics and tracersvariables16 USE oce ! ocean: dynamics and tracers variables 17 USE dom_oce ! domain: ocean variables 18 18 USE phycst ! physical constants 19 USE eosbn2 ! ocean equation of state 19 20 USE in_out_manager ! I/O manager 20 USE eosbn2 ! ocean equation of state21 21 USE lbclnk ! lateral boundary conditions (or mpp link) 22 22 … … 24 24 PRIVATE 25 25 26 PUBLIC zps_hde ! routine called by step.F90 27 PUBLIC zps_hde_init ! routine called by opa.F90 28 29 INTEGER, DIMENSION(jpi,jpj) :: mbatu, mbatv ! bottom ocean level index at U- and V-points 26 PUBLIC zps_hde ! routine called by step.F90 30 27 31 28 !! * Substitutions … … 35 32 !! NEMO/OPA 3.3 , NEMO Consortium (2010) 36 33 !! $Id$ 37 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)34 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 38 35 !!---------------------------------------------------------------------- 39 36 CONTAINS … … 44 41 !! *** ROUTINE zps_hde *** 45 42 !! 46 !! ** Purpose : Compute the horizontal derivative of T, S and r d43 !! ** Purpose : Compute the horizontal derivative of T, S and rho 47 44 !! at u- and v-points with a linear interpolation for z-coordinate 48 45 !! with partial steps. … … 78 75 !! formulation of the equation of state (eos). 79 76 !! Gradient formulation for rho : 80 !! di(rho) = rd~ - rd(i,j,k) or rd (i+1,j,k) - rd~ 81 !! 82 !! ** Action : - pgtu, pgtv: horizontal gradient of tracer at U/V-points 83 !! - pgru, pgrv: horizontal gradient of rd if present at U/V-points 84 !! and rd at V-points 77 !! di(rho) = rd~ - rd(i,j,k) or rd(i+1,j,k) - rd~ 78 !! 79 !! ** Action : - pgtu, pgtv: horizontal gradient of tracer at u- & v-points 80 !! - pgru, pgrv: horizontal gradient of rho (if present) at u- & v-points 85 81 !!---------------------------------------------------------------------- 86 82 INTEGER , INTENT(in ) :: kt ! ocean time-step index … … 92 88 !! 93 89 INTEGER :: ji, jj, jn ! Dummy loop indices 94 INTEGER :: iku, ikv ! partial step levelat u- and v-points90 INTEGER :: iku, ikv, ikum1, ikvm1 ! partial step level (ocean bottom level) at u- and v-points 95 91 REAL(wp), DIMENSION(jpi,jpj,kjpt) :: zti, ztj ! interpolated value of tracer 96 92 REAL(wp), DIMENSION(jpi,jpj) :: zri, zrj ! interpolated value of rd … … 99 95 !!---------------------------------------------------------------------- 100 96 101 102 ! Interpolation of tracers at the last ocean level 103 DO jn = 1, kjpt 97 DO jn = 1, kjpt !== Interpolation of tracers at the last ocean level ==! 104 98 ! 105 99 # if defined key_vectopt_loop … … 110 104 DO ji = 1, jpim1 111 105 # endif 112 ! last level 113 iku = mbatu(ji,jj) 114 ikv = mbatv(ji,jj) 115 ze3wu = fse3w(ji+1,jj ,iku) - fse3w(ji,jj,iku) 116 ze3wv = fse3w(ji ,jj+1,ikv) - fse3w(ji,jj,ikv) 117 106 iku = mbku(ji,jj) ; ikum1 = MAX( iku , 1 ) ! last and before last ocean level at u- & v-points 107 ikv = mbkv(ji,jj) ; ikvm1 = MAX( ikv , 1 ) ! if level first is a p-step, ik.m1=1 108 ze3wu = fse3w(ji+1,jj ,iku) - fse3w(ji,jj,iku) 109 ze3wv = fse3w(ji ,jj+1,ikv) - fse3w(ji,jj,ikv) 110 ! 118 111 ! i- direction 119 IF( ze3wu >= 0. ) THEN ! case 1112 IF( ze3wu >= 0._wp ) THEN ! case 1 120 113 zmaxu = ze3wu / fse3w(ji+1,jj,iku) 121 114 ! interpolated values of tracers 122 zti(ji,jj,jn) = pta(ji+1,jj,iku,jn) + zmaxu * ( pta(ji+1,jj,iku -1,jn) - pta(ji+1,jj,iku,jn) )115 zti(ji,jj,jn) = pta(ji+1,jj,iku,jn) + zmaxu * ( pta(ji+1,jj,ikum1,jn) - pta(ji+1,jj,iku,jn) ) 123 116 ! gradient of tracers 124 117 pgtu(ji,jj,jn) = umask(ji,jj,1) * ( zti(ji,jj,jn) - pta(ji,jj,iku,jn) ) 125 ELSE ! case 2118 ELSE ! case 2 126 119 zmaxu = -ze3wu / fse3w(ji,jj,iku) 127 120 ! interpolated values of tracers 128 zti(ji,jj,jn) = pta(ji,jj,iku,jn) + zmaxu * ( pta(ji,jj,iku -1,jn) - pta(ji,jj,iku,jn) )121 zti(ji,jj,jn) = pta(ji,jj,iku,jn) + zmaxu * ( pta(ji,jj,ikum1,jn) - pta(ji,jj,iku,jn) ) 129 122 ! gradient of tracers 130 123 pgtu(ji,jj,jn) = umask(ji,jj,1) * ( pta(ji+1,jj,iku,jn) - zti(ji,jj,jn) ) 131 124 ENDIF 132 125 ! 133 126 ! j- direction 134 IF( ze3wv >= 0. ) THEN ! case 1127 IF( ze3wv >= 0._wp ) THEN ! case 1 135 128 zmaxv = ze3wv / fse3w(ji,jj+1,ikv) 136 129 ! interpolated values of tracers 137 ztj(ji,jj,jn) = pta(ji,jj+1,ikv,jn) + zmaxv * ( pta(ji,jj+1,ikv -1,jn) - pta(ji,jj+1,ikv,jn) )130 ztj(ji,jj,jn) = pta(ji,jj+1,ikv,jn) + zmaxv * ( pta(ji,jj+1,ikvm1,jn) - pta(ji,jj+1,ikv,jn) ) 138 131 ! gradient of tracers 139 132 pgtv(ji,jj,jn) = vmask(ji,jj,1) * ( ztj(ji,jj,jn) - pta(ji,jj,ikv,jn) ) 140 ELSE ! case 2133 ELSE ! case 2 141 134 zmaxv = -ze3wv / fse3w(ji,jj,ikv) 142 135 ! interpolated values of tracers 143 ztj(ji,jj,jn) = pta(ji,jj,ikv,jn) + zmaxv * ( pta(ji,jj,ikv -1,jn) - pta(ji,jj,ikv,jn) )136 ztj(ji,jj,jn) = pta(ji,jj,ikv,jn) + zmaxv * ( pta(ji,jj,ikvm1,jn) - pta(ji,jj,ikv,jn) ) 144 137 ! gradient of tracers 145 138 pgtv(ji,jj,jn) = vmask(ji,jj,1) * ( pta(ji,jj+1,ikv,jn) - ztj(ji,jj,jn) ) … … 162 155 DO ji = 1, jpim1 163 156 # endif 164 iku = mb atu(ji,jj)165 ikv = mb atv(ji,jj)157 iku = mbku(ji,jj) 158 ikv = mbkv(ji,jj) 166 159 ze3wu = fse3w(ji+1,jj ,iku) - fse3w(ji,jj,iku) 167 160 ze3wv = fse3w(ji ,jj+1,ikv) - fse3w(ji,jj,ikv) 168 IF( ze3wu >= 0. ) THEN 169 zhi(ji,jj) = fsdept(ji ,jj,iku) 170 ELSE 171 zhi(ji,jj) = fsdept(ji+1,jj,iku) 172 ENDIF 173 IF( ze3wv >= 0. ) THEN 174 zhj(ji,jj) = fsdept(ji,jj ,ikv) 175 ELSE 176 zhj(ji,jj) = fsdept(ji,jj+1,ikv) 161 IF( ze3wu >= 0._wp ) THEN ; zhi(ji,jj) = fsdept(ji ,jj,iku) ! i-direction: case 1 162 ELSE ; zhi(ji,jj) = fsdept(ji+1,jj,iku) ! - - case 2 163 ENDIF 164 IF( ze3wv >= 0._wp ) THEN ; zhj(ji,jj) = fsdept(ji,jj ,ikv) ! j-direction: case 1 165 ELSE ; zhj(ji,jj) = fsdept(ji,jj+1,ikv) ! - - case 2 177 166 ENDIF 178 167 # if ! defined key_vectopt_loop … … 193 182 DO ji = 1, jpim1 194 183 # endif 195 iku = mb atu(ji,jj)196 ikv = mb atv(ji,jj)184 iku = mbku(ji,jj) 185 ikv = mbkv(ji,jj) 197 186 ze3wu = fse3w(ji+1,jj ,iku) - fse3w(ji,jj,iku) 198 187 ze3wv = fse3w(ji ,jj+1,ikv) - fse3w(ji,jj,ikv) 199 IF( ze3wu >= 0. ) THEN ! i-direction: case 1 200 pgru(ji,jj) = umask(ji,jj,1) * ( zri(ji,jj) - prd(ji,jj,iku) ) 201 ELSE ! i-direction: case 2 202 pgru(ji,jj) = umask(ji,jj,1) * ( prd(ji+1,jj,iku) - zri(ji,jj) ) 203 ENDIF 204 IF( ze3wv >= 0. ) THEN ! j-direction: case 1 205 pgrv(ji,jj) = vmask(ji,jj,1) * ( zrj(ji,jj) - prd(ji,jj,ikv) ) 206 ELSE ! j-direction: case 2 207 pgrv(ji,jj) = vmask(ji,jj,1) * ( prd(ji,jj+1,ikv) - zrj(ji,jj) ) 188 IF( ze3wu >= 0._wp ) THEN ; pgru(ji,jj) = umask(ji,jj,1) * ( zri(ji ,jj) - prd(ji,jj,iku) ) ! i: 1 189 ELSE ; pgru(ji,jj) = umask(ji,jj,1) * ( prd(ji+1,jj,iku) - zri(ji,jj) ) ! i: 2 190 ENDIF 191 IF( ze3wv >= 0._wp ) THEN ; pgrv(ji,jj) = vmask(ji,jj,1) * ( zrj(ji,jj ) - prd(ji,jj,ikv) ) ! j: 1 192 ELSE ; pgrv(ji,jj) = vmask(ji,jj,1) * ( prd(ji,jj+1,ikv) - zrj(ji,jj) ) ! j: 2 208 193 ENDIF 209 194 # if ! defined key_vectopt_loop … … 217 202 END SUBROUTINE zps_hde 218 203 219 220 SUBROUTINE zps_hde_init221 !!----------------------------------------------------------------------222 !! *** ROUTINE zps_hde_init ***223 !!224 !! ** Purpose : Computation of bottom ocean level index at U- and V-points225 !!226 !!----------------------------------------------------------------------227 INTEGER :: ji, jj ! Dummy loop indices228 REAL(wp), DIMENSION(jpi,jpj) :: zti, ztj ! 2D workspace229 !!----------------------------------------------------------------------230 !231 mbatu(:,:) = 0232 mbatv(:,:) = 0233 DO jj = 1, jpjm1234 DO ji = 1, fs_jpim1 ! vector opt.235 mbatu(ji,jj) = MAX( MIN( mbathy(ji,jj), mbathy(ji+1,jj ) ) - 1, 2 )236 mbatv(ji,jj) = MAX( MIN( mbathy(ji,jj), mbathy(ji ,jj+1) ) - 1, 2 )237 END DO238 END DO239 zti(:,:) = FLOAT( mbatu(:,:) )240 ztj(:,:) = FLOAT( mbatv(:,:) )241 ! lateral boundary conditions: T-point, sign unchanged242 CALL lbc_lnk( zti , 'U', 1. ) ; CALL lbc_lnk( ztj , 'V', 1. )243 mbatu(:,:) = MAX( INT( zti(:,:) ), 2 )244 mbatv(:,:) = MAX( INT( ztj(:,:) ), 2 )245 !246 END SUBROUTINE zps_hde_init247 204 !!====================================================================== 248 205 END MODULE zpshde
Note: See TracChangeset
for help on using the changeset viewer.
