- Timestamp:
- 2011-12-11T16:00:26+01:00 (13 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_muscl2.F90
r2715 r3211 32 32 LOGICAL :: l_trd ! flag to compute trends 33 33 34 !! * Control permutation of array indices 35 # include "oce_ftrans.h90" 36 # include "dom_oce_ftrans.h90" 37 # include "trc_oce_ftrans.h90" 38 34 39 !! * Substitutions 35 40 # include "domzgr_substitute.h90" … … 62 67 USE oce , ONLY: zwx => ua , zwy => va ! (ua,va) used as 3D workspace 63 68 USE wrk_nemo, ONLY: zslpx => wrk_3d_1 , zslpy => wrk_3d_2 ! 3D workspace 69 !! DCSE_NEMO: need additional directives for renamed module variables 70 !FTRANS zwx zwy zslpx zslpy :I :I :z 71 64 72 !! 65 73 INTEGER , INTENT(in ) :: kt ! ocean time-step index … … 67 75 INTEGER , INTENT(in ) :: kjpt ! number of tracers 68 76 REAL(wp), DIMENSION( jpk ), INTENT(in ) :: p2dt ! vertical profile of tracer time-step 69 REAL(wp), DIMENSION(jpi,jpj,jpk ), INTENT(in ) :: pun, pvn, pwn ! 3 ocean velocity components 70 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in ) :: ptb, ptn ! before & now tracer fields 71 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) :: pta ! tracer trend 77 78 !! DCSE_NEMO: This style defeats ftrans 79 ! REAL(wp), DIMENSION(jpi,jpj,jpk ), INTENT(in ) :: pun, pvn, pwn ! 3 ocean velocity components 80 ! REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in ) :: ptb, ptn ! before & now tracer fields 81 ! REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) :: pta ! tracer trend 82 83 !FTRANS pun pvn pwn :I :I :z 84 !FTRANS ptb ptn :I :I :z : 85 !FTRANS pta :I :I :z : 86 REAL(wp), INTENT(in ) :: pun(jpi,jpj,jpk) ! ocean velocity component (u) 87 REAL(wp), INTENT(in ) :: pvn(jpi,jpj,jpk) ! ocean velocity component (v) 88 REAL(wp), INTENT(in ) :: pwn(jpi,jpj,jpk) ! ocean velocity component (w) 89 REAL(wp), INTENT(in ) :: ptb(jpi,jpj,jpk,kjpt) ! tracer fields (before) 90 REAL(wp), INTENT(in ) :: ptn(jpi,jpj,jpk,kjpt) ! tracer fields (now) 91 REAL(wp), INTENT(inout) :: pta(jpi,jpj,jpk,kjpt) ! tracer trend 92 72 93 !! 73 94 INTEGER :: ji, jj, jk, jn ! dummy loop indices … … 98 119 zwx(:,:,jpk) = 0.e0 ; zwy(:,:,jpk) = 0.e0 ! bottom values 99 120 ! interior values 121 #if defined key_z_first 122 DO jj = 1, jpjm1 123 DO ji = 1, jpim1 124 DO jk = 1, jpkm1 125 #else 100 126 DO jk = 1, jpkm1 101 127 DO jj = 1, jpjm1 102 128 DO ji = 1, fs_jpim1 ! vector opt. 129 #endif 103 130 zwx(ji,jj,jk) = umask(ji,jj,jk) * ( ptb(ji+1,jj,jk,jn) - ptb(ji,jj,jk,jn) ) 104 131 zwy(ji,jj,jk) = vmask(ji,jj,jk) * ( ptb(ji,jj+1,jk,jn) - ptb(ji,jj,jk,jn) ) … … 111 138 ! !-- Slopes of tracer 112 139 zslpx(:,:,jpk) = 0.e0 ; zslpy(:,:,jpk) = 0.e0 ! bottom values 140 #if defined key_z_first 141 DO jj = 2, jpj ! interior values 142 DO ji = 2, jpi 143 DO jk = 1, jpkm1 144 #else 113 145 DO jk = 1, jpkm1 ! interior values 114 146 DO jj = 2, jpj 115 147 DO ji = fs_2, jpi ! vector opt. 148 #endif 116 149 zslpx(ji,jj,jk) = ( zwx(ji,jj,jk) + zwx(ji-1,jj ,jk) ) & 117 150 & * ( 0.25 + SIGN( 0.25, zwx(ji,jj,jk) * zwx(ji-1,jj ,jk) ) ) … … 122 155 END DO 123 156 ! 157 #if defined key_z_first 158 DO jj = 2, jpj ! Slopes limitation 159 DO ji = 2, jpi 160 DO jk = 1, jpkm1 161 #else 124 162 DO jk = 1, jpkm1 ! Slopes limitation 125 163 DO jj = 2, jpj 126 164 DO ji = fs_2, jpi ! vector opt. 165 #endif 127 166 zslpx(ji,jj,jk) = SIGN( 1., zslpx(ji,jj,jk) ) * MIN( ABS( zslpx(ji ,jj,jk) ), & 128 167 & 2.*ABS( zwx (ji-1,jj,jk) ), & … … 132 171 & 2.*ABS( zwy (ji,jj ,jk) ) ) 133 172 END DO 134 END DO173 END DO 135 174 END DO ! interior values 136 175 137 176 ! !-- MUSCL horizontal advective fluxes 177 #if defined key_z_first 178 DO jj = 2, jpjm1 179 DO ji = 2, jpim1 180 DO jk = 1, jpkm1 ! interior values 181 zdt = p2dt(jk) 182 #else 138 183 DO jk = 1, jpkm1 ! interior values 139 184 zdt = p2dt(jk) 140 185 DO jj = 2, jpjm1 141 186 DO ji = fs_2, fs_jpim1 ! vector opt. 187 #endif 142 188 ! MUSCL fluxes 143 189 z0u = SIGN( 0.5, pun(ji,jj,jk) ) … … 159 205 160 206 !! centered scheme at lateral b.C. if off-shore velocity 207 #if defined key_z_first 208 DO jj = 2, jpjm1 209 DO ji = 2, jpim1 210 DO jk = 1, jpkm1 211 #else 161 212 DO jk = 1, jpkm1 162 213 DO jj = 2, jpjm1 163 214 DO ji = fs_2, fs_jpim1 ! vector opt. 215 #endif 164 216 IF( umask(ji,jj,jk) == 0. ) THEN 165 217 IF( pun(ji+1,jj,jk) > 0. .AND. ji /= jpi ) THEN … … 184 236 185 237 ! Tracer flux divergence at t-point added to the general trend 238 #if defined key_z_first 239 DO jj = 2, jpjm1 240 DO ji = 2, jpim1 241 DO jk = 1, jpkm1 242 #else 186 243 DO jk = 1, jpkm1 187 244 DO jj = 2, jpjm1 188 245 DO ji = fs_2, fs_jpim1 ! vector opt. 246 #endif 189 247 zbtr = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) ) 190 248 ! horizontal advective trends … … 194 252 pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + ztra 195 253 END DO 196 END DO254 END DO 197 255 END DO 198 256 ! ! trend diagnostics (contribution of upstream fluxes) … … 211 269 ! ----------------------------- 212 270 ! !-- first guess of the slopes 271 #if defined key_z_first 272 DO jj = 1, jpj 273 DO ji = 1, jpi 274 zwx(ji,jj,1) = 0.e0 ! surface boundary conditions 275 DO jk = 2, jpkm1 ! interior values 276 zwx(ji,jj,jk) = tmask(ji,jj,jk) * ( ptb(ji,jj,jk-1,jn) - ptb(ji,jj,jk,jn) ) 277 END DO 278 zwx(ji,jj,jpk) = 0.e0 ! bottom boundary conditions 279 END DO 280 END DO 281 #else 213 282 zwx (:,:, 1 ) = 0.e0 ; zwx (:,:,jpk) = 0.e0 ! surface & bottom boundary conditions 214 283 DO jk = 2, jpkm1 ! interior values 215 284 zwx(:,:,jk) = tmask(:,:,jk) * ( ptb(:,:,jk-1,jn) - ptb(:,:,jk,jn) ) 216 285 END DO 286 #endif 217 287 218 288 ! !-- Slopes of tracer 289 #if defined key_z_first 290 DO jj = 1, jpj 291 DO ji = 1, jpi 292 zslpx(ji,jj,1) = 0.e0 ! surface values 293 DO jk = 2, jpkm1 ! interior value 294 #else 219 295 zslpx(:,:,1) = 0.e0 ! surface values 220 296 DO jk = 2, jpkm1 ! interior value 221 297 DO jj = 1, jpj 222 298 DO ji = 1, jpi 299 #endif 223 300 zslpx(ji,jj,jk) = ( zwx(ji,jj,jk) + zwx(ji,jj,jk+1) ) & 224 301 & * ( 0.25 + SIGN( 0.25, zwx(ji,jj,jk) * zwx(ji,jj,jk+1) ) ) … … 227 304 END DO 228 305 ! !-- Slopes limitation 306 #if defined key_z_first 307 DO jj = 1, jpj 308 DO ji = 1, jpi 309 DO jk = 2, jpkm1 ! interior values 310 #else 229 311 DO jk = 2, jpkm1 ! interior values 230 312 DO jj = 1, jpj 231 313 DO ji = 1, jpi 314 #endif 232 315 zslpx(ji,jj,jk) = SIGN( 1., zslpx(ji,jj,jk) ) * MIN( ABS( zslpx(ji,jj,jk ) ), & 233 316 & 2.*ABS( zwx (ji,jj,jk+1) ), & … … 242 325 ENDIF 243 326 ! 327 #if defined key_z_first 328 DO jj = 2, jpjm1 ! interior values 329 DO ji = 2, jpim1 330 DO jk = 1, jpkm1 331 zdt = p2dt(jk) 332 #else 244 333 DO jk = 1, jpkm1 ! interior values 245 334 zdt = p2dt(jk) 246 335 DO jj = 2, jpjm1 247 336 DO ji = fs_2, fs_jpim1 ! vector opt. 337 #endif 248 338 zbtr = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3w(ji,jj,jk+1) ) 249 339 z0w = SIGN( 0.5, pwn(ji,jj,jk+1) ) … … 257 347 END DO 258 348 ! 259 DO jk = 2, jpkm1 ! centered near the bottom 260 DO jj = 2, jpjm1 261 DO ji = fs_2, fs_jpim1 ! vector opt. 349 #if defined key_z_first 350 DO jj = 2, jpjm1 351 DO ji = 2, jpim1 352 DO jk = 2, jpkm1 ! centered near the bottom 353 #else 354 DO jk = 2, jpkm1 ! centered near the bottom 355 DO jj = 2, jpjm1 356 DO ji = fs_2, fs_jpim1 ! vector opt. 357 #endif 262 358 IF( tmask(ji,jj,jk+1) == 0. ) THEN 263 359 IF( pwn(ji,jj,jk) > 0. ) THEN … … 269 365 END DO 270 366 ! 367 #if defined key_z_first 368 DO jj = 2, jpjm1 ! Compute & add the vertical advective trend 369 DO ji = 2, jpim1 370 DO jk = 1, jpkm1 371 #else 271 372 DO jk = 1, jpkm1 ! Compute & add the vertical advective trend 272 373 DO jj = 2, jpjm1 273 374 DO ji = fs_2, fs_jpim1 ! vector opt. 375 #endif 274 376 zbtr = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) ) 275 377 ! vertical advective trends
Note: See TracChangeset
for help on using the changeset viewer.
