Changeset 1438 for trunk/NEMO/OPA_SRC/TRA/trazdf_imp.F90
- Timestamp:
- 2009-05-11T16:34:47+02:00 (15 years ago)
- File:
-
- 1 edited
-
trunk/NEMO/OPA_SRC/TRA/trazdf_imp.F90 (modified) (13 diffs)
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMO/OPA_SRC/TRA/trazdf_imp.F90
r1156 r1438 1 1 MODULE trazdf_imp 2 !!====================================================================== ========2 !!====================================================================== 3 3 !! *** MODULE trazdf_imp *** 4 4 !! Ocean active tracers: vertical component of the tracer mixing trend 5 !!============================================================================== 6 !! History : 7 !! 6.0 ! 90-10 (B. Blanke) Original code 8 !! 7.0 ! 91-11 (G. Madec) 9 !! ! 92-06 (M. Imbard) correction on tracer trend loops 10 !! ! 96-01 (G. Madec) statement function for e3 11 !! ! 97-05 (G. Madec) vertical component of isopycnal 12 !! ! 97-07 (G. Madec) geopotential diffusion in s-coord 13 !! ! 00-08 (G. Madec) double diffusive mixing 14 !! 8.5 ! 02-08 (G. Madec) F90: Free form and module 15 !! 9.0 ! 06-11 (G. Madec) New step reorganisation 5 !!====================================================================== 6 !! History : OPA ! 1990-10 (B. Blanke) Original code 7 !! 7.0 ! 1991-11 (G. Madec) 8 !! ! 1992-06 (M. Imbard) correction on tracer trend loops 9 !! ! 1996-01 (G. Madec) statement function for e3 10 !! ! 1997-05 (G. Madec) vertical component of isopycnal 11 !! ! 1997-07 (G. Madec) geopotential diffusion in s-coord 12 !! ! 2000-08 (G. Madec) double diffusive mixing 13 !! NEMO 1.0 ! 2002-08 (G. Madec) F90: Free form and module 14 !! 2.0 ! 2006-11 (G. Madec) New step reorganisation 15 !! 3.2 ! 2009-03 (G. Madec) heat and salt content trends 16 !!---------------------------------------------------------------------- 17 16 18 !!---------------------------------------------------------------------- 17 19 !! tra_zdf_imp : Update the tracer trend with the diagonal vertical 18 20 !! part of the mixing tensor. 19 21 !!---------------------------------------------------------------------- 20 !! * Modules used21 22 USE oce ! ocean dynamics and tracers variables 22 23 USE dom_oce ! ocean space and time domain variables … … 36 37 PRIVATE 37 38 38 !! * Routine accessibility 39 PUBLIC tra_zdf_imp ! routine called by step.F90 39 PUBLIC tra_zdf_imp ! routine called by step.F90 40 40 41 41 !! * Substitutions … … 45 45 # include "vectopt_loop_substitute.h90" 46 46 !!---------------------------------------------------------------------- 47 !!---------------------------------------------------------------------- 48 !! OPA 9.0 , LOCEAN-IPSL (2005) 47 !! NEMO/OPA 3.2 , LOCEAN-IPSL (2009) 49 48 !! $Id$ 50 49 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) … … 90 89 !! 91 90 !!--------------------------------------------------------------------- 92 !! * Modules used 93 USE oce , ONLY : zwd => ua, & ! ua used as workspace 94 zws => va ! va " " 95 !! * Arguments 96 INTEGER, INTENT( in ) :: kt ! ocean time-step index 97 REAL(wp), DIMENSION(jpk), INTENT( in ) :: & 98 p2dt ! vertical profile of tracer time-step 99 100 !! * Local declarations 101 INTEGER :: ji, jj, jk ! dummy loop indices 102 REAL(wp) :: zavi, zrhs, znvvl, & ! temporary scalars 103 ze3tb, ze3tn, ze3ta, zvsfvvl ! variable vertical scale factors 104 REAL(wp), DIMENSION(jpi,jpj,jpk) :: & 105 zwi, zwt, zavsi ! workspace arrays 91 USE oce , ONLY : zwd => ua ! ua used as workspace 92 USE oce , ONLY : zws => va ! va - - 93 !! 94 INTEGER , INTENT(in) :: kt ! ocean time-step index 95 REAL(wp), DIMENSION(jpk), INTENT(in) :: p2dt ! vertical profile of tracer time-step 96 !! 97 INTEGER :: ji, jj, jk ! dummy loop indices 98 REAL(wp) :: zavi, zrhs, znvvl ! temporary scalars 99 REAL(wp) :: ze3tb, ze3tn, ze3ta ! variable vertical scale factors 100 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zwi, zwt, zavsi ! workspace arrays 106 101 !!--------------------------------------------------------------------- 107 102 … … 169 164 DO jj = 2, jpjm1 170 165 DO ji = fs_2, fs_jpim1 ! vector opt. 171 zvsfvvl = fsve3t(ji,jj,jk) * ( 1 + ssha(ji,jj) * mut(ji,jj,jk) ) 172 ze3ta = ( 1. - znvvl ) + znvvl*zvsfvvl ! after scale factor at T-point 173 ze3tn = ( 1. - znvvl )*fse3t(ji,jj,jk) + znvvl ! now scale factor at T-point 166 ze3ta = ( 1. - znvvl ) & ! after scale factor at T-point 167 & + znvvl * fse3t_a(ji,jj,jk) 168 ze3tn = znvvl & ! now scale factor at T-point 169 & + ( 1. - znvvl ) * fse3t_n(ji,jj,jk) 174 170 zwi(ji,jj,jk) = - p2dt(jk) * zwt(ji,jj,jk ) / ( ze3tn * fse3w(ji,jj,jk ) ) 175 171 zws(ji,jj,jk) = - p2dt(jk) * zwt(ji,jj,jk+1) / ( ze3tn * fse3w(ji,jj,jk+1) ) … … 182 178 DO jj = 2, jpjm1 183 179 DO ji = fs_2, fs_jpim1 ! vector opt. 184 z vsfvvl = fsve3t(ji,jj,1) * ( 1 + ssha(ji,jj) * mut(ji,jj,1) )185 ze3ta = ( 1. - znvvl ) + znvvl*zvsfvvl ! after scale factor at T-point180 ze3ta = ( 1. - znvvl ) & ! after scale factor at T-point 181 & + znvvl * fse3t_a(ji,jj,1) 186 182 zwi(ji,jj,1) = 0.e0 187 183 zwd(ji,jj,1) = ze3ta - zws(ji,jj,1) … … 227 223 DO jj = 2, jpjm1 228 224 DO ji = fs_2, fs_jpim1 229 zvsfvvl = fsve3t(ji,jj,1) * ( 1 + sshb(ji,jj) * mut(ji,jj,1) ) 230 ze3tb = ( 1. - znvvl ) + znvvl*zvsfvvl 231 ze3tn = ( 1. - znvvl ) + znvvl*fse3t (ji,jj,1) 225 ze3tb = ( 1. - znvvl ) + znvvl * fse3t_b(ji,jj,1) 226 ze3tn = ( 1. - znvvl ) + znvvl * fse3t(ji,jj,1) 232 227 ta(ji,jj,1) = ze3tb * tb(ji,jj,1) + p2dt(1) * ze3tn * ta(ji,jj,1) 233 228 END DO … … 236 231 DO jj = 2, jpjm1 237 232 DO ji = fs_2, fs_jpim1 238 zvsfvvl = fsve3t(ji,jj,jk) * ( 1 + sshb(ji,jj) * mut(ji,jj,jk) ) 239 ze3tb = ( 1. - znvvl ) + znvvl*zvsfvvl 240 ze3tn = ( 1. - znvvl ) + znvvl*fse3t (ji,jj,jk) 233 ze3tb = ( 1. - znvvl ) + znvvl * fse3t_b(ji,jj,jk) 234 ze3tn = ( 1. - znvvl ) + znvvl * fse3t (ji,jj,jk) 241 235 zrhs = ze3tb * tb(ji,jj,jk) + p2dt(jk) * ze3tn * ta(ji,jj,jk) ! zrhs=right hand side 242 ta(ji,jj,jk) = zrhs - zwi(ji,jj,jk) / zwt(ji,jj,jk-1) * ta(ji,jj,jk-1)236 ta(ji,jj,jk) = zrhs - zwi(ji,jj,jk) / zwt(ji,jj,jk-1) * ta(ji,jj,jk-1) 243 237 END DO 244 238 END DO … … 271 265 DO jj = 2, jpjm1 272 266 DO ji = fs_2, fs_jpim1 ! vector opt. 273 zvsfvvl = fsve3t(ji,jj,jk) * ( 1 + ssha(ji,jj) * mut(ji,jj,jk) ) 274 ze3ta = ( 1. - znvvl ) + znvvl*zvsfvvl ! after scale factor at T-point 275 ze3tn = ( 1. - znvvl )*fse3t(ji,jj,jk) + znvvl ! now scale factor at T-point 267 ze3ta = ( 1. - znvvl ) & ! after scale factor at T-point 268 & + znvvl * fse3t_a(ji,jj,jk) 269 ze3tn = znvvl & ! now scale factor at T-point 270 & + ( 1. - znvvl ) * fse3t_n(ji,jj,jk) 276 271 zwi(ji,jj,jk) = - p2dt(jk) * zavsi(ji,jj,jk ) / ( ze3tn * fse3w(ji,jj,jk ) ) 277 272 zws(ji,jj,jk) = - p2dt(jk) * zavsi(ji,jj,jk+1) / ( ze3tn * fse3w(ji,jj,jk+1) ) … … 284 279 DO jj = 2, jpjm1 285 280 DO ji = fs_2, fs_jpim1 ! vector opt. 286 zvsfvvl = fsve3t(ji,jj,1) * ( 1 + ssha(ji,jj) * mut(ji,jj,1) ) 287 ze3ta = ( 1. - znvvl ) + znvvl*zvsfvvl ! after scale factor at T-point 281 ze3ta = ( 1. - znvvl ) + znvvl * fse3t_a(ji,jj,1) 288 282 zwi(ji,jj,1) = 0.e0 289 283 zwd(ji,jj,1) = ze3ta - zws(ji,jj,1) … … 328 322 DO jj = 2, jpjm1 329 323 DO ji = fs_2, fs_jpim1 330 z vsfvvl = fsve3t(ji,jj,1) * ( 1 + sshb(ji,jj) * mut(ji,jj,1) )331 ze3tb = ( 1. - znvvl ) + znvvl*zvsfvvl ! before scale factor at T-point332 ze3tn = ( 1. - znvvl ) + znvvl *fse3t(ji,jj,1)! now scale factor at T-point324 ze3tb = ( 1. - znvvl ) & ! before scale factor at T-point 325 & + znvvl * fse3t_b(ji,jj,1) 326 ze3tn = ( 1. - znvvl ) + znvvl * fse3t (ji,jj,1) ! now scale factor at T-point 333 327 sa(ji,jj,1) = ze3tb * sb(ji,jj,1) + p2dt(1) * ze3tn * sa(ji,jj,1) 334 328 END DO … … 337 331 DO jj = 2, jpjm1 338 332 DO ji = fs_2, fs_jpim1 339 z vsfvvl = fsve3t(ji,jj,jk) * ( 1 + sshb(ji,jj) * mut(ji,jj,jk) )340 ze3tb = ( 1. - znvvl ) + znvvl*zvsfvvl ! before scale factor at T-point341 ze3tn = ( 1. - znvvl ) + znvvl *fse3t(ji,jj,jk)! now scale factor at T-point333 ze3tb = ( 1. - znvvl ) & ! before scale factor at T-point 334 & + znvvl * fse3t_b(ji,jj,jk) 335 ze3tn = ( 1. - znvvl ) + znvvl * fse3t (ji,jj,jk) ! now scale factor at T-point 342 336 zrhs = ze3tb * sb(ji,jj,jk) + p2dt(jk) * ze3tn * sa(ji,jj,jk) ! zrhs=right hand side 343 337 sa(ji,jj,jk) = zrhs - zwi(ji,jj,jk) / zwt(ji,jj,jk-1) *sa(ji,jj,jk-1) … … 361 355 END DO 362 356 END DO 363 357 ! 364 358 END SUBROUTINE tra_zdf_imp 365 359
Note: See TracChangeset
for help on using the changeset viewer.
