Changeset 5845 for branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_triad.F90
- Timestamp:
- 2015-10-31T08:40:45+01:00 (8 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_triad.F90
r5836 r5845 37 37 38 38 !! * Substitutions 39 # include "domzgr_substitute.h90"40 39 # include "vectopt_loop_substitute.h90" 41 40 !!---------------------------------------------------------------------- … … 142 141 DO jj = 1, jpjm1 143 142 DO ji = 1, fs_jpim1 144 ze3wr = 1._wp / fse3w(ji+ip,jj,jk+kp)145 zbu = e1e2u(ji,jj) * fse3u(ji,jj,jk)143 ze3wr = 1._wp / e3w_n(ji+ip,jj,jk+kp) 144 zbu = e1e2u(ji,jj) * e3u_n(ji,jj,jk) 146 145 zah = 0.25_wp * pahu(ji,jj,jk) 147 146 zslope_skew = triadi_g(ji+ip,jj,jk,1-ip,kp) 148 147 ! Subtract s-coordinate slope at t-points to give slope rel to s-surfaces (do this by *adding* gradient of depth) 149 zslope2 = zslope_skew + ( fsdept(ji+1,jj,jk) - fsdept(ji,jj,jk) ) * r1_e1u(ji,jj) * umask(ji,jj,jk+kp)148 zslope2 = zslope_skew + ( gdept_n(ji+1,jj,jk) - gdept_n(ji,jj,jk) ) * r1_e1u(ji,jj) * umask(ji,jj,jk+kp) 150 149 zslope2 = zslope2 *zslope2 151 150 ah_wslp2(ji+ip,jj,jk+kp) = ah_wslp2(ji+ip,jj,jk+kp) + zah * zbu * ze3wr * r1_e1e2t(ji+ip,jj) * zslope2 … … 166 165 DO jj = 1, jpjm1 167 166 DO ji = 1, fs_jpim1 168 ze3wr = 1.0_wp / fse3w(ji,jj+jp,jk+kp)169 zbv = e1e2v(ji,jj) * fse3v(ji,jj,jk)167 ze3wr = 1.0_wp / e3w_n(ji,jj+jp,jk+kp) 168 zbv = e1e2v(ji,jj) * e3v_n(ji,jj,jk) 170 169 zah = 0.25_wp * pahv(ji,jj,jk) 171 170 zslope_skew = triadj_g(ji,jj+jp,jk,1-jp,kp) 172 171 ! Subtract s-coordinate slope at t-points to give slope rel to s surfaces 173 172 ! (do this by *adding* gradient of depth) 174 zslope2 = zslope_skew + ( fsdept(ji,jj+1,jk) - fsdept(ji,jj,jk) ) * r1_e2v(ji,jj) * vmask(ji,jj,jk+kp)173 zslope2 = zslope_skew + ( gdept_n(ji,jj+1,jk) - gdept_n(ji,jj,jk) ) * r1_e2v(ji,jj) * vmask(ji,jj,jk+kp) 175 174 zslope2 = zslope2 * zslope2 176 175 ah_wslp2(ji,jj+jp,jk+kp) = ah_wslp2(ji,jj+jp,jk+kp) + zah * zbv * ze3wr * r1_e1e2t(ji,jj+jp) * zslope2 … … 193 192 DO ji = 1, fs_jpim1 194 193 akz(ji,jj,jk) = 16._wp * ah_wslp2(ji,jj,jk) & 195 & * ( akz(ji,jj,jk) + ah_wslp2(ji,jj,jk) / ( fse3w(ji,jj,jk) * fse3w(ji,jj,jk) ) )194 & * ( akz(ji,jj,jk) + ah_wslp2(ji,jj,jk) / ( e3w_n(ji,jj,jk) * e3w_n(ji,jj,jk) ) ) 196 195 END DO 197 196 END DO … … 201 200 DO jj = 1, jpjm1 202 201 DO ji = 1, fs_jpim1 203 ze3w_2 = fse3w(ji,jj,jk) * fse3w(ji,jj,jk)202 ze3w_2 = e3w_n(ji,jj,jk) * e3w_n(ji,jj,jk) 204 203 zcoef0 = z2dt * ( akz(ji,jj,jk) + ah_wslp2(ji,jj,jk) / ze3w_2 ) 205 204 akz(ji,jj,jk) = MAX( zcoef0 - 0.5_wp , 0._wp ) * ze3w_2 * z1_2dt … … 274 273 ze1ur = r1_e1u(ji,jj) 275 274 zdxt = zdit(ji,jj,jk) * ze1ur 276 ze3wr = 1._wp / fse3w(ji+ip,jj,jk+kp)275 ze3wr = 1._wp / e3w_n(ji+ip,jj,jk+kp) 277 276 zdzt = zdkt3d(ji+ip,jj,kp) * ze3wr 278 277 zslope_skew = triadi_g(ji+ip,jj,jk,1-ip,kp) 279 278 zslope_iso = triadi (ji+ip,jj,jk,1-ip,kp) 280 279 281 zbu = 0.25_wp * e1e2u(ji,jj) * fse3u(ji,jj,jk)280 zbu = 0.25_wp * e1e2u(ji,jj) * e3u_n(ji,jj,jk) 282 281 ! ln_botmix_triad is .T. don't mask zah for bottom half cells !!gm ????? ahu is masked.... 283 282 zah = pahu(ji,jj,jk) … … 297 296 ze2vr = r1_e2v(ji,jj) 298 297 zdyt = zdjt(ji,jj,jk) * ze2vr 299 ze3wr = 1._wp / fse3w(ji,jj+jp,jk+kp)298 ze3wr = 1._wp / e3w_n(ji,jj+jp,jk+kp) 300 299 zdzt = zdkt3d(ji,jj+jp,kp) * ze3wr 301 300 zslope_skew = triadj_g(ji,jj+jp,jk,1-jp,kp) 302 301 zslope_iso = triadj(ji,jj+jp,jk,1-jp,kp) 303 zbv = 0.25_wp * e1e2v(ji,jj) * fse3v(ji,jj,jk)302 zbv = 0.25_wp * e1e2v(ji,jj) * e3v_n(ji,jj,jk) 304 303 ! ln_botmix_triad is .T. don't mask zah for bottom half cells !!gm ????? ahv is masked... 305 304 zah = pahv(ji,jj,jk) … … 321 320 ze1ur = r1_e1u(ji,jj) 322 321 zdxt = zdit(ji,jj,jk) * ze1ur 323 ze3wr = 1._wp / fse3w(ji+ip,jj,jk+kp)322 ze3wr = 1._wp / e3w_n(ji+ip,jj,jk+kp) 324 323 zdzt = zdkt3d(ji+ip,jj,kp) * ze3wr 325 324 zslope_skew = triadi_g(ji+ip,jj,jk,1-ip,kp) 326 325 zslope_iso = triadi(ji+ip,jj,jk,1-ip,kp) 327 326 328 zbu = 0.25_wp * e1e2u(ji,jj) * fse3u(ji,jj,jk)327 zbu = 0.25_wp * e1e2u(ji,jj) * e3u_n(ji,jj,jk) 329 328 ! ln_botmix_triad is .F. mask zah for bottom half cells 330 329 zah = pahu(ji,jj,jk) * umask(ji,jj,jk+kp) ! pahu(ji+ip,jj,jk) ===>> ???? 331 330 zah_slp = zah * zslope_iso 332 IF( ln_ldfeiv ) zaei_slp = aeiu(ji,jj,jk) * zslope_skew ! fsaeit(ji+ip,jj,jk)*zslope_skew331 IF( ln_ldfeiv ) zaei_slp = aeiu(ji,jj,jk) * zslope_skew ! aeit(ji+ip,jj,jk)*zslope_skew 333 332 zftu(ji ,jj,jk ) = zftu(ji ,jj,jk ) - ( zah * zdxt + (zah_slp - zaei_slp) * zdzt ) * zbu * ze1ur 334 333 ztfw(ji+ip,jj,jk+kp) = ztfw(ji+ip,jj,jk+kp) - (zah_slp + zaei_slp) * zdxt * zbu * ze3wr … … 344 343 ze2vr = r1_e2v(ji,jj) 345 344 zdyt = zdjt(ji,jj,jk) * ze2vr 346 ze3wr = 1._wp / fse3w(ji,jj+jp,jk+kp)345 ze3wr = 1._wp / e3w_n(ji,jj+jp,jk+kp) 347 346 zdzt = zdkt3d(ji,jj+jp,kp) * ze3wr 348 347 zslope_skew = triadj_g(ji,jj+jp,jk,1-jp,kp) 349 348 zslope_iso = triadj(ji,jj+jp,jk,1-jp,kp) 350 zbv = 0.25_wp * e1e2v(ji,jj) * fse3v(ji,jj,jk)349 zbv = 0.25_wp * e1e2v(ji,jj) * e3v_n(ji,jj,jk) 351 350 ! ln_botmix_triad is .F. mask zah for bottom half cells 352 351 zah = pahv(ji,jj,jk) * vmask(ji,jj,jk+kp) ! pahv(ji,jj+jp,jk) ???? 353 352 zah_slp = zah * zslope_iso 354 IF( ln_ldfeiv ) zaei_slp = aeiv(ji,jj,jk) * zslope_skew ! fsaeit(ji,jj+jp,jk)*zslope_skew353 IF( ln_ldfeiv ) zaei_slp = aeiv(ji,jj,jk) * zslope_skew ! aeit(ji,jj+jp,jk)*zslope_skew 355 354 zftv(ji,jj,jk) = zftv(ji,jj,jk) - ( zah * zdyt + (zah_slp - zaei_slp) * zdzt ) * zbv * ze2vr 356 355 ztfw(ji,jj+jp,jk+kp) = ztfw(ji,jj+jp,jk+kp) - (zah_slp + zaei_slp) * zdyt * zbv * ze3wr … … 365 364 pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + zsign * ( zftu(ji-1,jj,jk) - zftu(ji,jj,jk) & 366 365 & + zftv(ji,jj-1,jk) - zftv(ji,jj,jk) ) & 367 & / ( e1e2t(ji,jj) * fse3t(ji,jj,jk) )366 & / ( e1e2t(ji,jj) * e3t_n(ji,jj,jk) ) 368 367 END DO 369 368 END DO … … 376 375 DO jj = 1, jpjm1 377 376 DO ji = fs_2, fs_jpim1 378 ztfw(ji,jj,jk) = ztfw(ji,jj,jk) - e1e2t(ji,jj) / fse3w(ji,jj,jk) * tmask(ji,jj,jk) &377 ztfw(ji,jj,jk) = ztfw(ji,jj,jk) - e1e2t(ji,jj) / e3w_n(ji,jj,jk) * tmask(ji,jj,jk) & 379 378 & * ( ah_wslp2(ji,jj,jk) - akz(ji,jj,jk) ) & 380 379 & * ( ptb(ji,jj,jk-1,jn) - ptb(ji,jj,jk,jn) ) … … 388 387 DO jj = 1, jpjm1 389 388 DO ji = fs_2, fs_jpim1 390 ztfw(ji,jj,jk) = ztfw(ji,jj,jk) - e1e2t(ji,jj) / fse3w(ji,jj,jk) * tmask(ji,jj,jk) &389 ztfw(ji,jj,jk) = ztfw(ji,jj,jk) - e1e2t(ji,jj) / e3w_n(ji,jj,jk) * tmask(ji,jj,jk) & 391 390 & * ah_wslp2(ji,jj,jk) * ( ptb(ji,jj,jk-1,jn) - ptb(ji,jj,jk,jn) ) 392 391 END DO … … 397 396 DO jj = 1, jpjm1 398 397 DO ji = fs_2, fs_jpim1 399 ztfw(ji,jj,jk) = ztfw(ji,jj,jk) - e1e2t(ji,jj) / fse3w(ji,jj,jk) * tmask(ji,jj,jk) &398 ztfw(ji,jj,jk) = ztfw(ji,jj,jk) - e1e2t(ji,jj) / e3w_n(ji,jj,jk) * tmask(ji,jj,jk) & 400 399 & * ( ah_wslp2(ji,jj,jk) * ( ptb (ji,jj,jk-1,jn) - ptb (ji,jj,jk,jn) ) & 401 400 & + akz (ji,jj,jk) * ( ptbb(ji,jj,jk-1,jn) - ptbb(ji,jj,jk,jn) ) ) … … 410 409 DO ji = fs_2, fs_jpim1 ! vector opt. 411 410 pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + zsign * ( ztfw(ji,jj,jk+1) - ztfw(ji,jj,jk) ) & 412 & / ( e1e2t(ji,jj) * fse3t(ji,jj,jk) )411 & / ( e1e2t(ji,jj) * e3t_n(ji,jj,jk) ) 413 412 END DO 414 413 END DO
Note: See TracChangeset
for help on using the changeset viewer.
