Changeset 7698 for trunk/NEMOGCM/NEMO/LIM_SRC_3/limadv_umx.F90
- Timestamp:
- 2017-02-18T10:02:03+01:00 (7 years ago)
- File:
-
- 1 edited
-
trunk/NEMOGCM/NEMO/LIM_SRC_3/limadv_umx.F90 (modified) (30 diffs)
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMOGCM/NEMO/LIM_SRC_3/limadv_umx.F90
r7646 r7698 75 75 ! upstream advection with initial mass fluxes & intermediate update 76 76 ! -------------------------------------------------------------------- 77 !$OMP PARALLEL 78 !$OMP DO schedule(static) private(jj,ji,zfp_ui,zfm_ui,zfp_vj,zfm_vj) 77 79 DO jj = 1, jpjm1 ! upstream tracer flux in the i and j direction 78 80 DO ji = 1, fs_jpim1 ! vector opt. … … 86 88 END DO 87 89 90 !$OMP DO schedule(static) private(jj,ji,ztra) 88 91 DO jj = 2, jpjm1 ! total intermediate advective trends 89 92 DO ji = fs_2, fs_jpim1 ! vector opt. … … 95 98 END DO 96 99 END DO 100 !$OMP END PARALLEL 97 101 CALL lbc_lnk( zt_ups, 'T', 1. ) ! Lateral boundary conditions (unchanged sign) 98 102 … … 101 105 SELECT CASE( nn_limadv_ord ) 102 106 CASE ( 20 ) ! centered second order 107 !$OMP PARALLEL DO schedule(static) private(jj,ji) 103 108 DO jj = 2, jpjm1 104 109 DO ji = fs_2, fs_jpim1 ! vector opt. … … 111 116 CALL macho( kt, nn_limadv_ord, pdt, ptc, puc, pvc, pubox, pvbox, zt_u, zt_v ) 112 117 ! 118 !$OMP PARALLEL DO schedule(static) private(jj,ji) 113 119 DO jj = 2, jpjm1 114 120 DO ji = fs_2, fs_jpim1 ! vector opt. … … 122 128 ! antidiffusive flux : high order minus low order 123 129 ! -------------------------------------------------- 130 !$OMP PARALLEL DO schedule(static) private(jj,ji) 124 131 DO jj = 2, jpjm1 125 132 DO ji = fs_2, fs_jpim1 ! vector opt. … … 136 143 ! final trend with corrected fluxes 137 144 ! ------------------------------------ 145 !$OMP PARALLEL DO schedule(static) private(jj,ji,ztra) 138 146 DO jj = 2, jpjm1 139 147 DO ji = fs_2, fs_jpim1 ! vector opt. … … 187 195 ! 188 196 ! !-- advective form update in zzt --! 197 !$OMP PARALLEL DO schedule(static) private(jj,ji) 189 198 DO jj = 2, jpjm1 190 199 DO ji = fs_2, fs_jpim1 ! vector opt. … … 205 214 ! 206 215 ! !-- advective form update in zzt --! 216 !$OMP PARALLEL DO schedule(static) private(jj,ji) 207 217 DO jj = 2, jpjm1 208 218 DO ji = fs_2, fs_jpim1 … … 253 263 ! 254 264 ! !-- Laplacian in i-direction --! 265 !$OMP PARALLEL DO schedule(static) private(jj,ji) 255 266 DO jj = 2, jpjm1 ! First derivative (gradient) 256 267 DO ji = 1, fs_jpim1 … … 265 276 ! 266 277 ! !-- BiLaplacian in i-direction --! 278 !$OMP PARALLEL DO schedule(static) private(jj,ji) 267 279 DO jj = 2, jpjm1 ! Third derivative 268 280 DO ji = 1, fs_jpim1 … … 281 293 CASE( 1 ) !== 1st order central TIM ==! (Eq. 21) 282 294 ! 295 !$OMP PARALLEL DO schedule(static) private(jj,ji) 283 296 DO jj = 1, jpj 284 297 DO ji = 1, fs_jpim1 ! vector opt. … … 290 303 CASE( 2 ) !== 2nd order central TIM ==! (Eq. 23) 291 304 ! 305 !$OMP PARALLEL DO schedule(static) private(jj,ji,zcu) 292 306 DO jj = 1, jpj 293 307 DO ji = 1, fs_jpim1 ! vector opt. … … 301 315 CASE( 3 ) !== 3rd order central TIM ==! (Eq. 24) 302 316 ! 317 !$OMP PARALLEL DO schedule(static) private(jj,ji,zcu,zdx2) 303 318 DO jj = 1, jpj 304 319 DO ji = 1, fs_jpim1 ! vector opt. … … 315 330 CASE( 4 ) !== 4th order central TIM ==! (Eq. 27) 316 331 ! 332 !$OMP PARALLEL DO schedule(static) private(jj,ji,zcu,zdx2) 317 333 DO jj = 1, jpj 318 334 DO ji = 1, fs_jpim1 ! vector opt. … … 329 345 CASE( 5 ) !== 5th order central TIM ==! (Eq. 29) 330 346 ! 347 !$OMP PARALLEL DO schedule(static) private(jj,ji,zcu,zdx2,zdx4) 331 348 DO jj = 1, jpj 332 349 DO ji = 1, fs_jpim1 ! vector opt. … … 380 397 ! 381 398 ! !-- Laplacian in j-direction --! 399 !$OMP PARALLEL 400 !$OMP DO schedule(static) private(jj,ji) 382 401 DO jj = 1, jpjm1 ! First derivative (gradient) 383 402 DO ji = fs_2, fs_jpim1 … … 385 404 END DO 386 405 END DO 406 !$OMP DO schedule(static) private(jj,ji) 387 407 DO jj = 2, jpjm1 ! Second derivative (Laplacian) 388 408 DO ji = fs_2, fs_jpim1 … … 390 410 END DO 391 411 END DO 412 !$OMP END PARALLEL 392 413 CALL lbc_lnk( ztv2, 'T', 1. ) 393 414 ! 394 415 ! !-- BiLaplacian in j-direction --! 416 !$OMP PARALLEL 417 !$OMP DO schedule(static) private(jj,ji) 395 418 DO jj = 1, jpjm1 ! First derivative 396 419 DO ji = fs_2, fs_jpim1 … … 398 421 END DO 399 422 END DO 423 !$OMP DO schedule(static) private(jj,ji) 400 424 DO jj = 2, jpjm1 ! Second derivative 401 425 DO ji = fs_2, fs_jpim1 … … 403 427 END DO 404 428 END DO 429 !$OMP END PARALLEL 405 430 CALL lbc_lnk( ztv4, 'T', 1. ) 406 431 ! … … 410 435 CASE( 1 ) !== 1st order central TIM ==! (Eq. 21) 411 436 ! 437 !$OMP PARALLEL DO schedule(static) private(jj,ji) 412 438 DO jj = 1, jpjm1 413 439 DO ji = 1, jpi … … 418 444 ! 419 445 CASE( 2 ) !== 2nd order central TIM ==! (Eq. 23) 446 !$OMP PARALLEL DO schedule(static) private(jj,ji,zcv) 420 447 DO jj = 1, jpjm1 421 448 DO ji = 1, jpi … … 429 456 CASE( 3 ) !== 3rd order central TIM ==! (Eq. 24) 430 457 ! 458 !$OMP PARALLEL DO schedule(static) private(jj,ji,zcv,zdy2) 431 459 DO jj = 1, jpjm1 432 460 DO ji = 1, jpi … … 443 471 CASE( 4 ) !== 4th order central TIM ==! (Eq. 27) 444 472 ! 473 !$OMP PARALLEL DO schedule(static) private(jj,ji,zcv,zdy2) 445 474 DO jj = 1, jpjm1 446 475 DO ji = 1, jpi … … 457 486 CASE( 5 ) !== 5th order central TIM ==! (Eq. 29) 458 487 ! 488 !$OMP PARALLEL DO schedule(static) private(jj,ji,zcv,zdy2,zdy4) 459 489 DO jj = 1, jpjm1 460 490 DO ji = 1, jpi … … 513 543 514 544 ! clem test 545 !$OMP PARALLEL DO schedule(static) private(jj,ji) 515 546 DO jj = 2, jpjm1 516 547 DO ji = fs_2, fs_jpim1 ! vector opt. … … 522 553 523 554 ! Determine ice masks for before and after tracers 524 WHERE( pbef(:,:) == 0._wp .AND. paft(:,:) == 0._wp .AND. zdiv(:,:) == 0._wp ) ; zmsk(:,:) = 0._wp 525 ELSEWHERE ; zmsk(:,:) = 1._wp * tmask(:,:,1) 526 END WHERE 555 !$OMP PARALLEL DO schedule(static) private(jj,ji) 556 DO jj = 1, jpj 557 DO ji = 1, jpi 558 IF( pbef(ji,jj) == 0._wp .AND. paft(ji,jj) == 0._wp .AND. zdiv(ji,jj) == 0._wp ) THEN 559 zmsk(ji,jj) = 0._wp 560 ELSE 561 zmsk(ji,jj) = 1._wp * tmask(ji,jj,1) 562 END IF 563 END DO 564 END DO 527 565 528 566 ! Search local extrema … … 533 571 ! zbdo(:,:) = MIN( pbef(:,:) * tmask(:,:,1) + zbig * ( 1.e0 - tmask(:,:,1) ), & 534 572 ! & paft(:,:) * tmask(:,:,1) + zbig * ( 1.e0 - tmask(:,:,1) ) ) 535 zbup(:,:) = MAX( pbef(:,:) * zmsk(:,:) - zbig * ( 1.e0 - zmsk(:,:) ), &536 & paft(:,:) * zmsk(:,:) - zbig * ( 1.e0 - zmsk(:,:) ) )537 zbdo(:,:) = MIN( pbef(:,:) * zmsk(:,:) + zbig * ( 1.e0 - zmsk(:,:) ), &538 & paft(:,:) * zmsk(:,:) + zbig * ( 1.e0 - zmsk(:,:) ) )539 573 540 574 z1_dt = 1._wp / pdt 575 576 !$OMP PARALLEL 577 !$OMP DO schedule(static) private(jj,ji) 578 DO jj = 1, jpj 579 DO ji = 1, jpi 580 zbup(ji,jj) = MAX( pbef(ji,jj) * zmsk(ji,jj) - zbig * ( 1.e0 - zmsk(ji,jj) ), & 581 & paft(ji,jj) * zmsk(ji,jj) - zbig * ( 1.e0 - zmsk(ji,jj) ) ) 582 zbdo(ji,jj) = MIN( pbef(ji,jj) * zmsk(ji,jj) + zbig * ( 1.e0 - zmsk(ji,jj) ), & 583 & paft(ji,jj) * zmsk(ji,jj) + zbig * ( 1.e0 - zmsk(ji,jj) ) ) 584 END DO 585 END DO 586 587 !$OMP DO schedule(static) private(jj,ji,zup,zdo,zpos,zneg,zbt) 541 588 DO jj = 2, jpjm1 542 589 DO ji = fs_2, fs_jpim1 ! vector opt. … … 557 604 END DO 558 605 END DO 606 !$OMP END PARALLEL 559 607 CALL lbc_lnk_multi( zbetup, 'T', 1., zbetdo, 'T', 1. ) ! lateral boundary cond. (unchanged sign) 560 608 561 609 ! monotonic flux in the i & j direction (paa & pbb) 562 610 ! ------------------------------------- 611 !$OMP PARALLEL DO schedule(static) private(jj,ji,zau,zbu,zcu,zav,zbv,zcv) 563 612 DO jj = 2, jpjm1 564 613 DO ji = fs_2, fs_jpim1 ! vector opt.
Note: See TracChangeset
for help on using the changeset viewer.
