Changeset 7753 for trunk/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_ts.F90
- Timestamp:
- 2017-03-03T12:46:59+01:00 (7 years ago)
- File:
-
- 1 edited
-
trunk/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_ts.F90 (modified) (49 diffs)
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_ts.F90
r7698 r7753 223 223 SELECT CASE( nn_een_e3f ) !* ff_f/e3 at F-point 224 224 CASE ( 0 ) ! original formulation (masked averaging of e3t divided by 4) 225 !$OMP PARALLEL DO schedule(static) private(jj, ji)226 225 DO jj = 1, jpjm1 227 226 DO ji = 1, jpim1 … … 232 231 END DO 233 232 CASE ( 1 ) ! new formulation (masked averaging of e3t divided by the sum of mask) 234 !$OMP PARALLEL DO schedule(static) private(jj, ji)235 233 DO jj = 1, jpjm1 236 234 DO ji = 1, jpim1 … … 245 243 CALL lbc_lnk( zwz, 'F', 1._wp ) 246 244 ! 247 !$OMP PARALLEL 248 !$OMP DO schedule(static) private(jj) 249 DO jj = 1, jpj 250 ftne(1,jj) = 0._wp ; ftnw(1,jj) = 0._wp ; ftse(1,jj) = 0._wp ; ftsw(1,jj) = 0._wp 251 END DO 252 !$OMP DO schedule(static) private(jj, ji) 245 ftne(1,:) = 0._wp ; ftnw(1,:) = 0._wp ; ftse(1,:) = 0._wp ; ftsw(1,:) = 0._wp 253 246 DO jj = 2, jpj 254 247 DO ji = 2, jpi … … 259 252 END DO 260 253 END DO 261 !$OMP END PARALLEL262 254 ! 263 255 ELSE !== all other schemes (ENE, ENS, MIX) 264 !$OMP PARALLEL DO schedule(static) private(jj, ji) 265 DO jj = 1, jpj 266 DO ji = 1, jpi 267 zwz(ji,jj) = 0._wp 268 zhf(ji,jj) = 0._wp 269 END DO 270 END DO 256 zwz(:,:) = 0._wp 257 zhf(:,:) = 0._wp 271 258 272 259 !!gm assume 0 in both cases (xhich is almost surely WRONG ! ) as hvatf has been removed … … 288 275 ELSE 289 276 !zhf(:,:) = hbatf(:,:) 290 !$OMP PARALLEL DO schedule(static) private(ji,jj)291 277 DO jj = 1, jpjm1 292 278 DO ji = 1, jpim1 … … 303 289 END IF 304 290 305 !$OMP PARALLEL306 !$OMP DO schedule(static) private(ji,jj)307 291 DO jj = 1, jpjm1 308 DO ji = 1, jpim1 309 zhf(ji,jj) = zhf(ji,jj) * (1._wp- umask(ji,jj,1) * umask(ji,jj+1,1)) 310 END DO 292 zhf(:,jj) = zhf(:,jj) * (1._wp- umask(:,jj,1) * umask(:,jj+1,1)) 311 293 END DO 312 294 !!gm end 313 295 314 296 DO jk = 1, jpkm1 315 !$OMP DO schedule(static) private(ji,jj)316 297 DO jj = 1, jpjm1 317 DO ji = 1, jpi 318 zhf(ji,jj) = zhf(ji,jj) + e3f_n(ji,jj,jk) * umask(ji,jj,jk) * umask(ji,jj+1,jk) 319 END DO 320 END DO 321 END DO 322 !$OMP END PARALLEL 298 zhf(:,jj) = zhf(:,jj) + e3f_n(:,jj,jk) * umask(:,jj,jk) * umask(:,jj+1,jk) 299 END DO 300 END DO 323 301 CALL lbc_lnk( zhf, 'F', 1._wp ) 324 302 ! JC: TBC. hf should be greater than 0 325 !$OMP PARALLEL326 !$OMP DO schedule(static) private(jj, ji)327 303 DO jj = 1, jpj 328 304 DO ji = 1, jpi … … 330 306 END DO 331 307 END DO 332 !$OMP DO schedule(static) private(jj, ji) 333 DO jj = 1, jpj 334 DO ji = 1, jpi 335 zwz(ji,jj) = ff_f(ji,jj) * zwz(ji,jj) 336 END DO 337 END DO 338 !$OMP END PARALLEL 308 zwz(:,:) = ff_f(:,:) * zwz(:,:) 339 309 ENDIF 340 310 ENDIF … … 354 324 ! !* e3*d/dt(Ua) (Vertically integrated) 355 325 ! ! -------------------------------------------------- 356 !$OMP PARALLEL 357 !$OMP DO schedule(static) private(jj, ji) 358 DO jj = 1, jpj 359 DO ji = 1, jpi 360 zu_frc(ji,jj) = 0._wp 361 zv_frc(ji,jj) = 0._wp 362 END DO 326 zu_frc(:,:) = 0._wp 327 zv_frc(:,:) = 0._wp 328 ! 329 DO jk = 1, jpkm1 330 zu_frc(:,:) = zu_frc(:,:) + e3u_n(:,:,jk) * ua(:,:,jk) * umask(:,:,jk) 331 zv_frc(:,:) = zv_frc(:,:) + e3v_n(:,:,jk) * va(:,:,jk) * vmask(:,:,jk) 363 332 END DO 364 333 ! 365 DO jk = 1, jpkm1 366 !$OMP DO schedule(static) private(jj,ji) 367 DO jj=1,jpj 368 DO ji=1,jpi 369 zu_frc(ji,jj) = zu_frc(ji,jj) + e3u_n(ji,jj,jk) * ua(ji,jj,jk) * umask(ji,jj,jk) 370 zv_frc(ji,jj) = zv_frc(ji,jj) + e3v_n(ji,jj,jk) * va(ji,jj,jk) * vmask(ji,jj,jk) 371 END DO 372 END DO 373 END DO 374 ! 375 !$OMP DO schedule(static) private(jj, ji) 376 DO jj = 1, jpj 377 DO ji = 1, jpi 378 zu_frc(ji,jj) = zu_frc(ji,jj) * r1_hu_n(ji,jj) 379 zv_frc(ji,jj) = zv_frc(ji,jj) * r1_hv_n(ji,jj) 380 END DO 381 END DO 334 zu_frc(:,:) = zu_frc(:,:) * r1_hu_n(:,:) 335 zv_frc(:,:) = zv_frc(:,:) * r1_hv_n(:,:) 336 ! 382 337 ! 383 338 ! !* baroclinic momentum trend (remove the vertical mean trend) 384 !$OMP DO schedule(static) private(jk,jj,ji)385 339 DO jk = 1, jpkm1 ! ----------------------------------------------------------- 386 340 DO jj = 2, jpjm1 … … 391 345 END DO 392 346 END DO 393 !$OMP END DO NOWAIT394 347 395 348 !!gm Question here when removing the Vertically integrated trends, we remove the vertically integrated NL trends on momentum.... … … 399 352 ! !* barotropic Coriolis trends (vorticity scheme dependent) 400 353 ! ! -------------------------------------------------------- 401 !$OMP DO schedule(static) private(jj, ji) 402 DO jj = 1, jpj 403 DO ji = 1, jpi 404 zwx(ji,jj) = un_b(ji,jj) * hu_n(ji,jj) * e2u(ji,jj) ! now fluxes 405 zwy(ji,jj) = vn_b(ji,jj) * hv_n(ji,jj) * e1v(ji,jj) 406 END DO 407 END DO 408 !$OMP END PARALLEL 354 zwx(:,:) = un_b(:,:) * hu_n(:,:) * e2u(:,:) ! now fluxes 355 zwy(:,:) = vn_b(:,:) * hv_n(:,:) * e1v(:,:) 409 356 ! 410 357 IF( ln_dynvor_ene .OR. ln_dynvor_mix ) THEN ! energy conserving or mixed scheme 411 !$OMP PARALLEL DO schedule(static) private(jj,ji,zy1,zy2,zx1,zx2)412 358 DO jj = 2, jpjm1 413 359 DO ji = fs_2, fs_jpim1 ! vector opt. … … 423 369 ! 424 370 ELSEIF ( ln_dynvor_ens ) THEN ! enstrophy conserving scheme 425 !$OMP PARALLEL DO schedule(static) private(jj,ji,zy1,zx1)426 371 DO jj = 2, jpjm1 427 372 DO ji = fs_2, fs_jpim1 ! vector opt. … … 436 381 ! 437 382 ELSEIF ( ln_dynvor_een ) THEN ! enstrophy and energy conserving scheme 438 !$OMP PARALLEL DO schedule(static) private(jj,ji)439 383 DO jj = 2, jpjm1 440 384 DO ji = fs_2, fs_jpim1 ! vector opt. … … 456 400 IF( .NOT.ln_linssh ) THEN ! Variable volume : remove surface pressure gradient 457 401 IF( ln_wd ) THEN ! Calculating and applying W/D gravity filters 458 !$OMP PARALLEL DO schedule(static) private(jj,ji,ll_tmp1,ll_tmp2)459 402 DO jj = 2, jpjm1 460 403 DO ji = 2, jpim1 … … 497 440 END DO 498 441 499 !$OMP PARALLEL DO schedule(static) private(jj,ji)500 442 DO jj = 2, jpjm1 501 443 DO ji = 2, jpim1 … … 509 451 ELSE 510 452 511 !$OMP PARALLEL DO schedule(static) private(jj,ji)512 453 DO jj = 2, jpjm1 513 454 DO ji = fs_2, fs_jpim1 ! vector opt. … … 520 461 ENDIF 521 462 522 !$OMP PARALLEL DO schedule(static) private(jj,ji)523 463 DO jj = 2, jpjm1 ! Remove coriolis term (and possibly spg) from barotropic trend 524 464 DO ji = fs_2, fs_jpim1 … … 530 470 ! ! Add bottom stress contribution from baroclinic velocities: 531 471 IF (ln_bt_fw) THEN 532 !$OMP PARALLEL DO schedule(static) private(jj,ji,ikbu,ikbv)533 472 DO jj = 2, jpjm1 534 473 DO ji = fs_2, fs_jpim1 ! vector opt. … … 540 479 END DO 541 480 ELSE 542 !$OMP PARALLEL DO schedule(static) private(jj,ji,ikbu,ikbv)543 481 DO jj = 2, jpjm1 544 482 DO ji = fs_2, fs_jpim1 ! vector opt. … … 553 491 ! Note that the "unclipped" bottom friction parameter is used even with explicit drag 554 492 IF( ln_wd ) THEN 555 !$OMP PARALLEL DO schedule(static) private(jj,ji) 556 DO jj = 1, jpj 557 DO ji = 1, jpi ! vector opt. 558 zu_frc(ji,jj) = zu_frc(ji,jj) + MAX(r1_hu_n(ji,jj) * bfrua(ji,jj),-1._wp / rdtbt) * zwx(ji,jj) 559 zv_frc(ji,jj) = zv_frc(ji,jj) + MAX(r1_hv_n(ji,jj) * bfrva(ji,jj),-1._wp / rdtbt) * zwy(ji,jj) 560 END DO 561 END DO 493 zu_frc(:,:) = zu_frc(:,:) + MAX(r1_hu_n(:,:) * bfrua(:,:),-1._wp / rdtbt) * zwx(:,:) 494 zv_frc(:,:) = zv_frc(:,:) + MAX(r1_hv_n(:,:) * bfrva(:,:),-1._wp / rdtbt) * zwy(:,:) 562 495 ELSE 563 !$OMP PARALLEL DO schedule(static) private(jj,ji) 564 DO jj = 1, jpj 565 DO ji = 1, jpi 566 zu_frc(ji,jj) = zu_frc(ji,jj) + r1_hu_n(ji,jj) * bfrua(ji,jj) * zwx(ji,jj) 567 zv_frc(ji,jj) = zv_frc(ji,jj) + r1_hv_n(ji,jj) * bfrva(ji,jj) * zwy(ji,jj) 568 END DO 569 END DO 496 zu_frc(:,:) = zu_frc(:,:) + r1_hu_n(:,:) * bfrua(:,:) * zwx(:,:) 497 zv_frc(:,:) = zv_frc(:,:) + r1_hv_n(:,:) * bfrva(:,:) * zwy(:,:) 570 498 END IF 571 499 ! 572 500 ! ! Add top stress contribution from baroclinic velocities: 573 501 IF( ln_bt_fw ) THEN 574 !$OMP PARALLEL DO schedule(static) private(jj,ji,iktu,iktv)575 502 DO jj = 2, jpjm1 576 503 DO ji = fs_2, fs_jpim1 ! vector opt. … … 582 509 END DO 583 510 ELSE 584 !$OMP PARALLEL DO schedule(static) private(jj,ji,iktu,iktv)585 511 DO jj = 2, jpjm1 586 512 DO ji = fs_2, fs_jpim1 ! vector opt. … … 594 520 ! 595 521 ! Note that the "unclipped" top friction parameter is used even with explicit drag 596 !$OMP PARALLEL DO schedule(static) private(jj,ji) 597 DO jj = 1, jpj 598 DO ji = 1, jpi 599 zu_frc(ji,jj) = zu_frc(ji,jj) + r1_hu_n(ji,jj) * tfrua(ji,jj) * zwx(ji,jj) 600 zv_frc(ji,jj) = zv_frc(ji,jj) + r1_hv_n(ji,jj) * tfrva(ji,jj) * zwy(ji,jj) 601 END DO 602 END DO 522 zu_frc(:,:) = zu_frc(:,:) + r1_hu_n(:,:) * tfrua(:,:) * zwx(:,:) 523 zv_frc(:,:) = zv_frc(:,:) + r1_hv_n(:,:) * tfrva(:,:) * zwy(:,:) 603 524 ! 604 525 IF (ln_bt_fw) THEN ! Add wind forcing 605 !$OMP PARALLEL DO schedule(static) private(jj,ji) 606 DO jj = 1, jpj 607 DO ji = 1, jpi 608 zu_frc(ji,jj) = zu_frc(ji,jj) + zraur * utau(ji,jj) * r1_hu_n(ji,jj) 609 zv_frc(ji,jj) = zv_frc(ji,jj) + zraur * vtau(ji,jj) * r1_hv_n(ji,jj) 610 END DO 611 END DO 526 zu_frc(:,:) = zu_frc(:,:) + zraur * utau(:,:) * r1_hu_n(:,:) 527 zv_frc(:,:) = zv_frc(:,:) + zraur * vtau(:,:) * r1_hv_n(:,:) 612 528 ELSE 613 !$OMP PARALLEL DO schedule(static) private(jj,ji) 614 DO jj = 1, jpj 615 DO ji = 1, jpi 616 zu_frc(ji,jj) = zu_frc(ji,jj) + zraur * z1_2 * ( utau_b(ji,jj) + utau(ji,jj) ) * r1_hu_n(ji,jj) 617 zv_frc(ji,jj) = zv_frc(ji,jj) + zraur * z1_2 * ( vtau_b(ji,jj) + vtau(ji,jj) ) * r1_hv_n(ji,jj) 618 END DO 619 END DO 529 zu_frc(:,:) = zu_frc(:,:) + zraur * z1_2 * ( utau_b(:,:) + utau(:,:) ) * r1_hu_n(:,:) 530 zv_frc(:,:) = zv_frc(:,:) + zraur * z1_2 * ( vtau_b(:,:) + vtau(:,:) ) * r1_hv_n(:,:) 620 531 ENDIF 621 532 ! 622 533 IF ( ln_apr_dyn ) THEN ! Add atm pressure forcing 623 534 IF (ln_bt_fw) THEN 624 !$OMP PARALLEL DO schedule(static) private(jj,ji,zu_spg,zv_spg)625 535 DO jj = 2, jpjm1 626 536 DO ji = fs_2, fs_jpim1 ! vector opt. … … 632 542 END DO 633 543 ELSE 634 !$OMP PARALLEL DO schedule(static) private(jj,ji,zu_spg,zv_spg)635 544 DO jj = 2, jpjm1 636 545 DO ji = fs_2, fs_jpim1 ! vector opt. … … 649 558 ! ! Surface net water flux and rivers 650 559 IF (ln_bt_fw) THEN 651 !$OMP PARALLEL DO schedule(static) private(jj,ji) 652 DO jj = 1, jpj 653 DO ji = 1, jpi 654 zssh_frc(ji,jj) = zraur * ( emp(ji,jj) - rnf(ji,jj) + fwfisf(ji,jj) ) 655 END DO 656 END DO 560 zssh_frc(:,:) = zraur * ( emp(:,:) - rnf(:,:) + fwfisf(:,:) ) 657 561 ELSE 658 !$OMP PARALLEL DO schedule(static) private(jj,ji) 659 DO jj = 1, jpj 660 DO ji = 1, jpi 661 zssh_frc(ji,jj) = zraur * z1_2 * ( emp(ji,jj) + emp_b(ji,jj) - rnf(ji,jj) - rnf_b(ji,jj) & 662 & + fwfisf(ji,jj) + fwfisf_b(ji,jj) ) 663 END DO 664 END DO 562 zssh_frc(:,:) = zraur * z1_2 * ( emp(:,:) + emp_b(:,:) - rnf(:,:) - rnf_b(:,:) & 563 & + fwfisf(:,:) + fwfisf_b(:,:) ) 665 564 ENDIF 666 565 ! 667 566 IF( ln_sdw ) THEN ! Stokes drift divergence added if necessary 668 !$OMP PARALLEL DO schedule(static) private(jj,ji) 669 DO jj = 1, jpj 670 DO ji = 1, jpi 671 zssh_frc(ji,jj) = zssh_frc(ji,jj) + div_sd(ji,jj) 672 END DO 673 END DO 567 zssh_frc(:,:) = zssh_frc(:,:) + div_sd(:,:) 674 568 ENDIF 675 569 ! … … 677 571 ! ! Include the IAU weighted SSH increment 678 572 IF( lk_asminc .AND. ln_sshinc .AND. ln_asmiau ) THEN 679 !$OMP PARALLEL DO schedule(static) private(jj,ji) 680 DO jj = 1, jpj 681 DO ji = 1, jpi 682 zssh_frc(ji,jj) = zssh_frc(ji,jj) - ssh_iau(ji,jj) 683 END DO 684 END DO 573 zssh_frc(:,:) = zssh_frc(:,:) - ssh_iau(:,:) 685 574 ENDIF 686 575 #endif … … 700 589 ! Initialize barotropic variables: 701 590 IF( ll_init )THEN 702 !$OMP PARALLEL DO schedule(static) private(jj,ji) 703 DO jj = 1, jpj 704 DO ji = 1, jpi 705 sshbb_e(ji,jj) = 0._wp 706 ubb_e (ji,jj) = 0._wp 707 vbb_e (ji,jj) = 0._wp 708 sshb_e (ji,jj) = 0._wp 709 ub_e (ji,jj) = 0._wp 710 vb_e (ji,jj) = 0._wp 711 END DO 712 END DO 591 sshbb_e(:,:) = 0._wp 592 ubb_e (:,:) = 0._wp 593 vbb_e (:,:) = 0._wp 594 sshb_e (:,:) = 0._wp 595 ub_e (:,:) = 0._wp 596 vb_e (:,:) = 0._wp 713 597 ENDIF 714 598 715 599 ! 716 600 IF (ln_bt_fw) THEN ! FORWARD integration: start from NOW fields 717 !$OMP PARALLEL DO schedule(static) private(jj,ji) 718 DO jj = 1, jpj 719 DO ji = 1, jpi 720 sshn_e(ji,jj) = sshn(ji,jj) 721 un_e (ji,jj) = un_b(ji,jj) 722 vn_e (ji,jj) = vn_b(ji,jj) 723 ! 724 hu_e (ji,jj) = hu_n(ji,jj) 725 hv_e (ji,jj) = hv_n(ji,jj) 726 hur_e (ji,jj) = r1_hu_n(ji,jj) 727 hvr_e (ji,jj) = r1_hv_n(ji,jj) 728 END DO 729 END DO 601 sshn_e(:,:) = sshn(:,:) 602 un_e (:,:) = un_b(:,:) 603 vn_e (:,:) = vn_b(:,:) 604 ! 605 hu_e (:,:) = hu_n(:,:) 606 hv_e (:,:) = hv_n(:,:) 607 hur_e (:,:) = r1_hu_n(:,:) 608 hvr_e (:,:) = r1_hv_n(:,:) 730 609 ELSE ! CENTRED integration: start from BEFORE fields 731 !$OMP PARALLEL DO schedule(static) private(jj,ji) 732 DO jj = 1, jpj 733 DO ji = 1, jpi 734 sshn_e(ji,jj) = sshb(ji,jj) 735 un_e (ji,jj) = ub_b(ji,jj) 736 vn_e (ji,jj) = vb_b(ji,jj) 737 ! 738 hu_e (ji,jj) = hu_b(ji,jj) 739 hv_e (ji,jj) = hv_b(ji,jj) 740 hur_e (ji,jj) = r1_hu_b(ji,jj) 741 hvr_e (ji,jj) = r1_hv_b(ji,jj) 742 END DO 743 END DO 610 sshn_e(:,:) = sshb(:,:) 611 un_e (:,:) = ub_b(:,:) 612 vn_e (:,:) = vb_b(:,:) 613 ! 614 hu_e (:,:) = hu_b(:,:) 615 hv_e (:,:) = hv_b(:,:) 616 hur_e (:,:) = r1_hu_b(:,:) 617 hvr_e (:,:) = r1_hv_b(:,:) 744 618 ENDIF 745 619 ! … … 747 621 ! 748 622 ! Initialize sums: 749 !$OMP PARALLEL DO schedule(static) private(jj,ji) 750 DO jj = 1, jpj 751 DO ji = 1, jpi 752 ua_b (ji,jj) = 0._wp ! After barotropic velocities (or transport if flux form) 753 va_b (ji,jj) = 0._wp 754 ssha (ji,jj) = 0._wp ! Sum for after averaged sea level 755 un_adv(ji,jj) = 0._wp ! Sum for now transport issued from ts loop 756 vn_adv(ji,jj) = 0._wp 757 END DO 758 END DO 623 ua_b (:,:) = 0._wp ! After barotropic velocities (or transport if flux form) 624 va_b (:,:) = 0._wp 625 ssha (:,:) = 0._wp ! Sum for after averaged sea level 626 un_adv(:,:) = 0._wp ! Sum for now transport issued from ts loop 627 vn_adv(:,:) = 0._wp 759 628 ! ! ==================== ! 760 629 DO jn = 1, icycle ! sub-time-step loop ! … … 780 649 781 650 ! Extrapolate barotropic velocities at step jit+0.5: 782 !$OMP PARALLEL DO schedule(static) private(jj,ji) 783 DO jj = 1, jpj 784 DO ji = 1, jpi 785 ua_e(ji,jj) = za1 * un_e(ji,jj) + za2 * ub_e(ji,jj) + za3 * ubb_e(ji,jj) 786 va_e(ji,jj) = za1 * vn_e(ji,jj) + za2 * vb_e(ji,jj) + za3 * vbb_e(ji,jj) 787 END DO 788 END DO 651 ua_e(:,:) = za1 * un_e(:,:) + za2 * ub_e(:,:) + za3 * ubb_e(:,:) 652 va_e(:,:) = za1 * vn_e(:,:) + za2 * vb_e(:,:) + za3 * vbb_e(:,:) 789 653 790 654 IF( .NOT.ln_linssh ) THEN !* Update ocean depth (variable volume case only) 791 655 ! ! ------------------ 792 656 ! Extrapolate Sea Level at step jit+0.5: 793 !$OMP PARALLEL 794 !$OMP DO schedule(static) private(jj,ji) 795 DO jj = 1, jpj 796 DO ji = 1, jpi 797 zsshp2_e(ji,jj) = za1 * sshn_e(ji,jj) + za2 * sshb_e(ji,jj) + za3 * sshbb_e(ji,jj) 798 END DO 799 END DO 657 zsshp2_e(:,:) = za1 * sshn_e(:,:) + za2 * sshb_e(:,:) + za3 * sshbb_e(:,:) 800 658 ! 801 !$OMP DO schedule(static) private(jj,ji)802 659 DO jj = 2, jpjm1 ! Sea Surface Height at u- & v-points 803 660 DO ji = 2, fs_jpim1 ! Vector opt. … … 810 667 END DO 811 668 END DO 812 !$OMP END PARALLEL813 669 CALL lbc_lnk_multi( zwx, 'U', 1._wp, zwy, 'V', 1._wp ) 814 670 ! 815 !$OMP PARALLEL DO schedule(static) private(jj,ji) 816 DO jj = 1, jpj 817 DO ji = 1, jpi 818 zhup2_e (ji,jj) = hu_0(ji,jj) + zwx(ji,jj) ! Ocean depth at U- and V-points 819 zhvp2_e (ji,jj) = hv_0(ji,jj) + zwy(ji,jj) 820 END DO 821 END DO 671 zhup2_e (:,:) = hu_0(:,:) + zwx(:,:) ! Ocean depth at U- and V-points 672 zhvp2_e (:,:) = hv_0(:,:) + zwy(:,:) 822 673 ELSE 823 !$OMP PARALLEL DO schedule(static) private(jj,ji) 824 DO jj = 1, jpj 825 DO ji = 1, jpi 826 zhup2_e (ji,jj) = hu_n(ji,jj) 827 zhvp2_e (ji,jj) = hv_n(ji,jj) 828 END DO 829 END DO 674 zhup2_e (:,:) = hu_n(:,:) 675 zhvp2_e (:,:) = hv_n(:,:) 830 676 ENDIF 831 677 ! !* after ssh … … 834 680 ! considering fluxes below: 835 681 ! 836 !$OMP PARALLEL DO schedule(static) private(jj,ji) 837 DO jj = 1, jpj 838 DO ji = 1, jpi 839 zwx(ji,jj) = e2u(ji,jj) * ua_e(ji,jj) * zhup2_e(ji,jj) ! fluxes at jn+0.5 840 zwy(ji,jj) = e1v(ji,jj) * va_e(ji,jj) * zhvp2_e(ji,jj) 841 END DO 842 END DO 843 682 zwx(:,:) = e2u(:,:) * ua_e(:,:) * zhup2_e(:,:) ! fluxes at jn+0.5 683 zwy(:,:) = e1v(:,:) * va_e(:,:) * zhvp2_e(:,:) 844 684 ! 845 685 #if defined key_agrif … … 872 712 ! Sum over sub-time-steps to compute advective velocities 873 713 za2 = wgtbtp2(jn) 874 !$OMP PARALLEL 875 !$OMP DO schedule(static) private(jj,ji) 876 DO jj = 1, jpj 877 DO ji = 1, jpi 878 un_adv(ji,jj) = un_adv(ji,jj) + za2 * zwx(ji,jj) * r1_e2u(ji,jj) 879 vn_adv(ji,jj) = vn_adv(ji,jj) + za2 * zwy(ji,jj) * r1_e1v(ji,jj) 880 END DO 881 END DO 882 !$OMP END DO NOWAIT 714 un_adv(:,:) = un_adv(:,:) + za2 * zwx(:,:) * r1_e2u(:,:) 715 vn_adv(:,:) = vn_adv(:,:) + za2 * zwy(:,:) * r1_e1v(:,:) 883 716 ! 884 717 ! Set next sea level: 885 !$OMP DO schedule(static) private(jj,ji)886 718 DO jj = 2, jpjm1 887 719 DO ji = fs_2, fs_jpim1 ! vector opt. … … 890 722 END DO 891 723 END DO 892 !$OMP DO schedule(static) private(jj,ji) 893 DO jj = 1, jpj 894 DO ji = 1, jpi 895 ssha_e(ji,jj) = ( sshn_e(ji,jj) - rdtbt * ( zssh_frc(ji,jj) + zhdiv(ji,jj) ) ) * ssmask(ji,jj) 896 END DO 897 END DO 898 !$OMP END PARALLEL 724 ssha_e(:,:) = ( sshn_e(:,:) - rdtbt * ( zssh_frc(:,:) + zhdiv(:,:) ) ) * ssmask(:,:) 725 899 726 CALL lbc_lnk( ssha_e, 'T', 1._wp ) 900 727 … … 907 734 ! Sea Surface Height at u-,v-points (vvl case only) 908 735 IF( .NOT.ln_linssh ) THEN 909 !$OMP PARALLEL DO schedule(static) private(jj,ji)910 736 DO jj = 2, jpjm1 911 737 DO ji = 2, jpim1 ! NO Vector Opt. … … 940 766 ENDIF 941 767 ! 942 !$OMP PARALLEL DO schedule(static) private(jj,ji) 943 DO jj = 1, jpj 944 DO ji = 1, jpi 945 zsshp2_e(ji,jj) = za0 * ssha_e(ji,jj) + za1 * sshn_e (ji,jj) & 946 & + za2 * sshb_e(ji,jj) + za3 * sshbb_e(ji,jj) 947 END DO 948 END DO 768 zsshp2_e(:,:) = za0 * ssha_e(:,:) + za1 * sshn_e (:,:) & 769 & + za2 * sshb_e(:,:) + za3 * sshbb_e(:,:) 949 770 IF( ln_wd ) THEN ! Calculating and applying W/D gravity filters 950 !$OMP PARALLEL DO schedule(static) private(jj,ji,ll_tmp1,ll_tmp2)951 771 DO jj = 2, jpjm1 952 772 DO ji = 2, jpim1 … … 993 813 IF( .NOT.ln_linssh .AND. .NOT.ln_dynadv_vec ) THEN !* Vector form 994 814 ! 995 !$OMP PARALLEL DO schedule(static) private(jj,ji,zx1,zy1)996 815 DO jj = 2, jpjm1 997 816 DO ji = 2, jpim1 … … 1007 826 END DO 1008 827 1009 IF( ln_wd ) THEN1010 !$OMP PARALLEL DO schedule(static) private(jj,ji)1011 DO jj = 1, jpj1012 DO ji = 1, jpi ! vector opt.1013 zhust_e(ji,jj) = MAX(zhust_e (ji,jj), rn_wdmin1 )1014 zhvst_e(ji,jj) = MAX(zhvst_e (ji,jj), rn_wdmin1 )1015 END DO1016 END DO1017 END IF1018 828 ENDIF 1019 829 ! … … 1026 836 ! 1027 837 IF( ln_dynvor_ene .OR. ln_dynvor_mix ) THEN !== energy conserving or mixed scheme ==! 1028 !$OMP PARALLEL DO schedule(static) private(jj,ji,zy1,zy2,zx1,zx2)1029 838 DO jj = 2, jpjm1 1030 839 DO ji = fs_2, fs_jpim1 ! vector opt. … … 1039 848 ! 1040 849 ELSEIF ( ln_dynvor_ens ) THEN !== enstrophy conserving scheme ==! 1041 !$OMP PARALLEL DO schedule(static) private(jj,ji,zx1,zy1)1042 850 DO jj = 2, jpjm1 1043 851 DO ji = fs_2, fs_jpim1 ! vector opt. … … 1052 860 ! 1053 861 ELSEIF ( ln_dynvor_een ) THEN !== energy and enstrophy conserving scheme ==! 1054 !$OMP PARALLEL DO schedule(static) private(jj,ji)1055 862 DO jj = 2, jpjm1 1056 863 DO ji = fs_2, fs_jpim1 ! vector opt. … … 1070 877 ! Add tidal astronomical forcing if defined 1071 878 IF ( ln_tide .AND. ln_tide_pot ) THEN 1072 !$OMP PARALLEL DO schedule(static) private(jj,ji,zu_spg,zv_spg)1073 879 DO jj = 2, jpjm1 1074 880 DO ji = fs_2, fs_jpim1 ! vector opt. … … 1082 888 ! 1083 889 ! Add bottom stresses: 1084 !$OMP PARALLEL DO schedule(static) private(jj,ji) 1085 DO jj = 1, jpj 1086 DO ji = 1, jpi 1087 zu_trd(ji,jj) = zu_trd(ji,jj) + bfrua(ji,jj) * un_e(ji,jj) * hur_e(ji,jj) 1088 zv_trd(ji,jj) = zv_trd(ji,jj) + bfrva(ji,jj) * vn_e(ji,jj) * hvr_e(ji,jj) 1089 ! 1090 ! Add top stresses: 1091 zu_trd(ji,jj) = zu_trd(ji,jj) + tfrua(ji,jj) * un_e(ji,jj) * hur_e(ji,jj) 1092 zv_trd(ji,jj) = zv_trd(ji,jj) + tfrva(ji,jj) * vn_e(ji,jj) * hvr_e(ji,jj) 1093 END DO 1094 END DO 1095 890 zu_trd(:,:) = zu_trd(:,:) + bfrua(:,:) * un_e(:,:) * hur_e(:,:) 891 zv_trd(:,:) = zv_trd(:,:) + bfrva(:,:) * vn_e(:,:) * hvr_e(:,:) 892 ! 893 ! Add top stresses: 894 zu_trd(:,:) = zu_trd(:,:) + tfrua(:,:) * un_e(:,:) * hur_e(:,:) 895 zv_trd(:,:) = zv_trd(:,:) + tfrva(:,:) * vn_e(:,:) * hvr_e(:,:) 1096 896 ! 1097 897 ! Surface pressure trend: 1098 898 1099 899 IF( ln_wd ) THEN 1100 !$OMP PARALLEL DO schedule(static) private(jj,ji,zu_spg,zv_spg)1101 900 DO jj = 2, jpjm1 1102 901 DO ji = 2, jpim1 … … 1109 908 END DO 1110 909 ELSE 1111 !$OMP PARALLEL DO schedule(static) private(jj,ji,zu_spg,zv_spg)1112 910 DO jj = 2, jpjm1 1113 911 DO ji = fs_2, fs_jpim1 ! vector opt. … … 1124 922 ! Set next velocities: 1125 923 IF( ln_dynadv_vec .OR. ln_linssh ) THEN !* Vector form 1126 !$OMP PARALLEL DO schedule(static) private(jj,ji)1127 924 DO jj = 2, jpjm1 1128 925 DO ji = fs_2, fs_jpim1 ! vector opt. … … 1142 939 ! 1143 940 ELSE !* Flux form 1144 !$OMP PARALLEL DO schedule(static) private(jj,ji,zhura,zhvra)1145 941 DO jj = 2, jpjm1 1146 942 DO ji = fs_2, fs_jpim1 ! vector opt. … … 1173 969 IF( .NOT.ln_linssh ) THEN !* Update ocean depth (variable volume case only) 1174 970 IF( ln_wd ) THEN 1175 !$OMP PARALLEL DO schedule(static) private(jj,ji) 1176 DO jj = 1, jpj 1177 DO ji = 1, jpi ! vector opt. 1178 hu_e (ji,jj) = MAX(hu_0(ji,jj) + zsshu_a(ji,jj), rn_wdmin1) 1179 hv_e (ji,jj) = MAX(hv_0(ji,jj) + zsshv_a(ji,jj), rn_wdmin1) 1180 END DO 1181 END DO 971 hu_e (:,:) = MAX(hu_0(:,:) + zsshu_a(:,:), rn_wdmin1) 972 hv_e (:,:) = MAX(hv_0(:,:) + zsshv_a(:,:), rn_wdmin1) 1182 973 ELSE 1183 !$OMP PARALLEL DO schedule(static) private(jj,ji) 1184 DO jj = 1, jpj 1185 DO ji = 1, jpi 1186 hu_e (ji,jj) = hu_0(ji,jj) + zsshu_a(ji,jj) 1187 hv_e (ji,jj) = hv_0(ji,jj) + zsshv_a(ji,jj) 1188 END DO 1189 END DO 974 hu_e (:,:) = hu_0(:,:) + zsshu_a(:,:) 975 hv_e (:,:) = hv_0(:,:) + zsshv_a(:,:) 1190 976 END IF 1191 !$OMP PARALLEL DO schedule(static) private(jj,ji) 1192 DO jj = 1, jpj 1193 DO ji = 1, jpi 1194 hur_e(ji,jj) = ssumask(ji,jj) / ( hu_e(ji,jj) + 1._wp - ssumask(ji,jj) ) 1195 hvr_e(ji,jj) = ssvmask(ji,jj) / ( hv_e(ji,jj) + 1._wp - ssvmask(ji,jj) ) 1196 END DO 1197 END DO 977 hur_e(:,:) = ssumask(:,:) / ( hu_e(:,:) + 1._wp - ssumask(:,:) ) 978 hvr_e(:,:) = ssvmask(:,:) / ( hv_e(:,:) + 1._wp - ssvmask(:,:) ) 1198 979 ! 1199 980 ENDIF … … 1208 989 ! !* Swap 1209 990 ! ! ---- 1210 !$OMP PARALLEL DO schedule(static) private(jj,ji) 1211 DO jj = 1, jpj 1212 DO ji = 1, jpi 1213 ubb_e (ji,jj) = ub_e (ji,jj) 1214 ub_e (ji,jj) = un_e (ji,jj) 1215 un_e (ji,jj) = ua_e (ji,jj) 1216 ! 1217 vbb_e (ji,jj) = vb_e (ji,jj) 1218 vb_e (ji,jj) = vn_e (ji,jj) 1219 vn_e (ji,jj) = va_e (ji,jj) 1220 ! 1221 sshbb_e(ji,jj) = sshb_e(ji,jj) 1222 sshb_e (ji,jj) = sshn_e(ji,jj) 1223 sshn_e (ji,jj) = ssha_e(ji,jj) 1224 END DO 1225 END DO 991 ubb_e (:,:) = ub_e (:,:) 992 ub_e (:,:) = un_e (:,:) 993 un_e (:,:) = ua_e (:,:) 994 ! 995 vbb_e (:,:) = vb_e (:,:) 996 vb_e (:,:) = vn_e (:,:) 997 vn_e (:,:) = va_e (:,:) 998 ! 999 sshbb_e(:,:) = sshb_e(:,:) 1000 sshb_e (:,:) = sshn_e(:,:) 1001 sshn_e (:,:) = ssha_e(:,:) 1226 1002 1227 1003 ! !* Sum over whole bt loop … … 1229 1005 za1 = wgtbtp1(jn) 1230 1006 IF( ln_dynadv_vec .OR. ln_linssh ) THEN ! Sum velocities 1231 !$OMP PARALLEL DO schedule(static) private(jj,ji) 1232 DO jj = 1, jpj 1233 DO ji = 1, jpi 1234 ua_b (ji,jj) = ua_b (ji,jj) + za1 * ua_e (ji,jj) 1235 va_b (ji,jj) = va_b (ji,jj) + za1 * va_e (ji,jj) 1236 END DO 1237 END DO 1007 ua_b (:,:) = ua_b (:,:) + za1 * ua_e (:,:) 1008 va_b (:,:) = va_b (:,:) + za1 * va_e (:,:) 1238 1009 ELSE ! Sum transports 1239 !$OMP PARALLEL DO schedule(static) private(jj,ji) 1240 DO jj = 1, jpj 1241 DO ji = 1, jpi 1242 ua_b (ji,jj) = ua_b (ji,jj) + za1 * ua_e (ji,jj) * hu_e (ji,jj) 1243 va_b (ji,jj) = va_b (ji,jj) + za1 * va_e (ji,jj) * hv_e (ji,jj) 1244 END DO 1245 END DO 1010 ua_b (:,:) = ua_b (:,:) + za1 * ua_e (:,:) * hu_e (:,:) 1011 va_b (:,:) = va_b (:,:) + za1 * va_e (:,:) * hv_e (:,:) 1246 1012 ENDIF 1247 1013 ! ! Sum sea level 1248 !$OMP PARALLEL DO schedule(static) private(jj,ji) 1249 DO jj = 1, jpj 1250 DO ji = 1, jpi 1251 ssha(ji,jj) = ssha(ji,jj) + za1 * ssha_e(ji,jj) 1252 END DO 1253 END DO 1014 ssha(:,:) = ssha(:,:) + za1 * ssha_e(:,:) 1254 1015 ! ! ==================== ! 1255 1016 END DO ! end loop ! … … 1260 1021 ! 1261 1022 ! Set advection velocity correction: 1262 !$OMP PARALLEL DO schedule(static) private(jj,ji) 1263 DO jj = 1, jpj 1264 DO ji = 1, jpi 1265 zwx(ji,jj) = un_adv(ji,jj) 1266 zwy(ji,jj) = vn_adv(ji,jj) 1267 END DO 1268 END DO 1023 zwx(:,:) = un_adv(:,:) 1024 zwy(:,:) = vn_adv(:,:) 1269 1025 IF( ( kt == nit000 .AND. neuler==0 ) .OR. .NOT.ln_bt_fw ) THEN 1270 !$OMP PARALLEL DO schedule(static) private(jj,ji) 1271 DO jj = 1, jpj 1272 DO ji = 1, jpi 1273 un_adv(ji,jj) = zwx(ji,jj) * r1_hu_n(ji,jj) 1274 vn_adv(ji,jj) = zwy(ji,jj) * r1_hv_n(ji,jj) 1275 END DO 1276 END DO 1026 un_adv(:,:) = zwx(:,:) * r1_hu_n(:,:) 1027 vn_adv(:,:) = zwy(:,:) * r1_hv_n(:,:) 1277 1028 ELSE 1278 !$OMP PARALLEL DO schedule(static) private(jj,ji) 1279 DO jj = 1, jpj 1280 DO ji = 1, jpi 1281 un_adv(ji,jj) = z1_2 * ( ub2_b(ji,jj) + zwx(ji,jj) ) * r1_hu_n(ji,jj) 1282 vn_adv(ji,jj) = z1_2 * ( vb2_b(ji,jj) + zwy(ji,jj) ) * r1_hv_n(ji,jj) 1283 END DO 1284 END DO 1029 un_adv(:,:) = z1_2 * ( ub2_b(:,:) + zwx(:,:) ) * r1_hu_n(:,:) 1030 vn_adv(:,:) = z1_2 * ( vb2_b(:,:) + zwy(:,:) ) * r1_hv_n(:,:) 1285 1031 END IF 1286 1032 1287 1033 IF( ln_bt_fw ) THEN ! Save integrated transport for next computation 1288 !$OMP PARALLEL DO schedule(static) private(jj,ji) 1289 DO jj = 1, jpj 1290 DO ji = 1, jpi 1291 ub2_b(ji,jj) = zwx(ji,jj) 1292 vb2_b(ji,jj) = zwy(ji,jj) 1293 END DO 1294 END DO 1034 ub2_b(:,:) = zwx(:,:) 1035 vb2_b(:,:) = zwy(:,:) 1295 1036 ENDIF 1296 1037 ! 1297 1038 ! Update barotropic trend: 1298 1039 IF( ln_dynadv_vec .OR. ln_linssh ) THEN 1299 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji)1300 1040 DO jk=1,jpkm1 1301 DO jj = 1, jpj 1302 DO ji = 1, jpi 1303 ua(ji,jj,jk) = ua(ji,jj,jk) + ( ua_b(ji,jj) - ub_b(ji,jj) ) * z1_2dt_b 1304 va(ji,jj,jk) = va(ji,jj,jk) + ( va_b(ji,jj) - vb_b(ji,jj) ) * z1_2dt_b 1305 END DO 1306 END DO 1041 ua(:,:,jk) = ua(:,:,jk) + ( ua_b(:,:) - ub_b(:,:) ) * z1_2dt_b 1042 va(:,:,jk) = va(:,:,jk) + ( va_b(:,:) - vb_b(:,:) ) * z1_2dt_b 1307 1043 END DO 1308 1044 ELSE 1309 1045 ! At this stage, ssha has been corrected: compute new depths at velocity points 1310 !$OMP PARALLEL DO schedule(static) private(jj,ji)1311 1046 DO jj = 1, jpjm1 1312 1047 DO ji = 1, jpim1 ! NO Vector Opt. … … 1321 1056 CALL lbc_lnk_multi( zsshu_a, 'U', 1._wp, zsshv_a, 'V', 1._wp ) ! Boundary conditions 1322 1057 ! 1323 !$OMP PARALLEL1324 !$OMP DO schedule(static) private(jk,jj,ji)1325 1058 DO jk=1,jpkm1 1326 DO jj = 1, jpj 1327 DO ji = 1, jpi 1328 ua(ji,jj,jk) = ua(ji,jj,jk) + r1_hu_n(ji,jj) * ( ua_b(ji,jj) - ub_b(ji,jj) * hu_b(ji,jj) ) * z1_2dt_b 1329 va(ji,jj,jk) = va(ji,jj,jk) + r1_hv_n(ji,jj) * ( va_b(ji,jj) - vb_b(ji,jj) * hv_b(ji,jj) ) * z1_2dt_b 1330 END DO 1331 END DO 1059 ua(:,:,jk) = ua(:,:,jk) + r1_hu_n(:,:) * ( ua_b(:,:) - ub_b(:,:) * hu_b(:,:) ) * z1_2dt_b 1060 va(:,:,jk) = va(:,:,jk) + r1_hv_n(:,:) * ( va_b(:,:) - vb_b(:,:) * hv_b(:,:) ) * z1_2dt_b 1332 1061 END DO 1333 !$OMP END DO NOWAIT1334 1062 ! Save barotropic velocities not transport: 1335 !$OMP DO schedule(static) private(jj,ji) 1336 DO jj = 1, jpj 1337 DO ji = 1, jpi 1338 ua_b(ji,jj) = ua_b(ji,jj) / ( hu_0(ji,jj) + zsshu_a(ji,jj) + 1._wp - ssumask(ji,jj) ) 1339 va_b(ji,jj) = va_b(ji,jj) / ( hv_0(ji,jj) + zsshv_a(ji,jj) + 1._wp - ssvmask(ji,jj) ) 1340 END DO 1341 END DO 1342 !$OMP END PARALLEL 1343 ENDIF 1344 ! 1345 !$OMP PARALLEL DO schedule(static) private(jk,jj,ji) 1063 ua_b(:,:) = ua_b(:,:) / ( hu_0(:,:) + zsshu_a(:,:) + 1._wp - ssumask(:,:) ) 1064 va_b(:,:) = va_b(:,:) / ( hv_0(:,:) + zsshv_a(:,:) + 1._wp - ssvmask(:,:) ) 1065 ENDIF 1066 ! 1346 1067 DO jk = 1, jpkm1 1347 DO jj = 1, jpj 1348 DO ji = 1, jpi 1349 ! Correct velocities: 1350 un(ji,jj,jk) = ( un(ji,jj,jk) + un_adv(ji,jj) - un_b(ji,jj) ) * umask(ji,jj,jk) 1351 vn(ji,jj,jk) = ( vn(ji,jj,jk) + vn_adv(ji,jj) - vn_b(ji,jj) ) * vmask(ji,jj,jk) 1352 ! 1353 END DO 1354 END DO 1068 ! Correct velocities: 1069 un(:,:,jk) = ( un(:,:,jk) + un_adv(:,:) - un_b(:,:) ) * umask(:,:,jk) 1070 vn(:,:,jk) = ( vn(:,:,jk) + vn_adv(:,:) - vn_b(:,:) ) * vmask(:,:,jk) 1071 ! 1355 1072 END DO 1356 1073 ! … … 1364 1081 IF( .NOT.Agrif_Root() .AND. ln_bt_fw ) THEN 1365 1082 IF( Agrif_NbStepint() == 0 ) THEN 1366 !$OMP PARALLEL DO schedule(static) private(jj,ji) 1367 DO jj = 1, jpj 1368 DO ji = 1, jpi 1369 ub2_i_b(ji,jj) = 0._wp 1370 vb2_i_b(ji,jj) = 0._wp 1371 END DO 1372 END DO 1083 ub2_i_b(:,:) = 0._wp 1084 vb2_i_b(:,:) = 0._wp 1373 1085 END IF 1374 1086 ! 1375 1087 za1 = 1._wp / REAL(Agrif_rhot(), wp) 1376 !$OMP PARALLEL DO schedule(static) private(jj,ji) 1377 DO jj = 1, jpj 1378 DO ji = 1, jpi 1379 ub2_i_b(ji,jj) = ub2_i_b(ji,jj) + za1 * ub2_b(ji,jj) 1380 vb2_i_b(ji,jj) = vb2_i_b(ji,jj) + za1 * vb2_b(ji,jj) 1381 END DO 1382 END DO 1088 ub2_i_b(:,:) = ub2_i_b(:,:) + za1 * ub2_b(:,:) 1089 vb2_i_b(:,:) = vb2_i_b(:,:) + za1 * vb2_b(:,:) 1383 1090 ENDIF 1384 1091 #endif
Note: See TracChangeset
for help on using the changeset viewer.
