Changeset 10293
- Timestamp:
- 2018-11-09T16:47:05+01:00 (6 years ago)
- Location:
- NEMO/branches/2018/dev_r10164_HPC09_ESIWACE_PREP_MERGE/src/OCE
- Files:
-
- 2 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2018/dev_r10164_HPC09_ESIWACE_PREP_MERGE/src/OCE/DYN/dynvor.F90
r10170 r10293 212 212 INTEGER :: ji, jj, jk ! dummy loop indices 213 213 REAL(wp) :: zx1, zy1, zx2, zy2 ! local scalars 214 REAL(wp), DIMENSION(jpi,jpj) :: zwx, zwy, zwz, zwt ! 2D workspace 214 REAL(wp), DIMENSION(jpi,jpj) :: zwx, zwy, zwt ! 2D workspace 215 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zwz ! 3D workspace 215 216 !!---------------------------------------------------------------------- 216 217 ! … … 221 222 ENDIF 222 223 ! 224 ! 225 SELECT CASE( kvor ) !== volume weighted vorticity considered ==! 226 CASE ( np_RVO ) !* relative vorticity 227 DO jk = 1, jpkm1 ! Horizontal slab 228 DO jj = 1, jpjm1 229 DO ji = 1, jpim1 230 zwz(ji,jj,jk) = ( e2v(ji+1,jj) * pv(ji+1,jj,jk) - e2v(ji,jj) * pv(ji,jj,jk) & 231 & - e1u(ji,jj+1) * pu(ji,jj+1,jk) + e1u(ji,jj) * pu(ji,jj,jk) ) * r1_e1e2f(ji,jj) 232 END DO 233 END DO 234 IF( ln_dynvor_msk ) THEN ! mask/unmask relative vorticity 235 DO jj = 1, jpjm1 236 DO ji = 1, jpim1 237 zwz(ji,jj,jk) = zwz(ji,jj,jk) * fmask(ji,jj,jk) 238 END DO 239 END DO 240 ENDIF 241 END DO 242 243 CALL lbc_lnk( 'dynvor', zwz, 'F', 1. ) 244 245 CASE ( np_CRV ) !* Coriolis + relative vorticity 246 DO jk = 1, jpkm1 ! Horizontal slab 247 DO jj = 1, jpjm1 248 DO ji = 1, jpim1 ! relative vorticity 249 zwz(ji,jj,jk) = ( e2v(ji+1,jj) * pv(ji+1,jj,jk) - e2v(ji,jj) * pv(ji,jj,jk) & 250 & - e1u(ji,jj+1) * pu(ji,jj+1,jk) + e1u(ji,jj) * pu(ji,jj,jk) ) * r1_e1e2f(ji,jj) 251 END DO 252 END DO 253 IF( ln_dynvor_msk ) THEN ! mask/unmask relative vorticity 254 DO jj = 1, jpjm1 255 DO ji = 1, jpim1 256 zwz(ji,jj,jk) = zwz(ji,jj,jk) * fmask(ji,jj,jk) 257 END DO 258 END DO 259 ENDIF 260 END DO 261 262 CALL lbc_lnk( 'dynvor', zwz, 'F', 1. ) 263 264 END SELECT 265 223 266 ! ! =============== 224 267 DO jk = 1, jpkm1 ! Horizontal slab 225 !! ===============226 ! 268 ! ! =============== 269 227 270 SELECT CASE( kvor ) !== volume weighted vorticity considered ==! 228 271 CASE ( np_COR ) !* Coriolis (planetary vorticity) 229 272 zwt(:,:) = ff_t(:,:) * e1e2t(:,:)*e3t_n(:,:,jk) 230 273 CASE ( np_RVO ) !* relative vorticity 231 DO jj = 1, jpjm1232 DO ji = 1, jpim1233 zwz(ji,jj) = ( e2v(ji+1,jj) * pv(ji+1,jj,jk) - e2v(ji,jj) * pv(ji,jj,jk) &234 & - e1u(ji,jj+1) * pu(ji,jj+1,jk) + e1u(ji,jj) * pu(ji,jj,jk) ) * r1_e1e2f(ji,jj)235 END DO236 END DO237 IF( ln_dynvor_msk ) THEN ! mask/unmask relative vorticity238 DO jj = 1, jpjm1239 DO ji = 1, jpim1240 zwz(ji,jj) = zwz(ji,jj) * fmask(ji,jj,jk)241 END DO242 END DO243 ENDIF244 CALL lbc_lnk( 'dynvor', zwz, 'F', 1. )245 274 DO jj = 2, jpj 246 275 DO ji = 2, jpi ! vector opt. 247 zwt(ji,jj) = r1_4 * ( zwz(ji-1,jj ) + zwz(ji,jj) &248 & + zwz(ji-1,jj-1 ) + zwz(ji,jj-1)) * e1e2t(ji,jj)*e3t_n(ji,jj,jk)276 zwt(ji,jj) = r1_4 * ( zwz(ji-1,jj ,jk) + zwz(ji,jj ,jk) & 277 & + zwz(ji-1,jj-1,jk) + zwz(ji,jj-1,jk) ) * e1e2t(ji,jj)*e3t_n(ji,jj,jk) 249 278 END DO 250 279 END DO … … 257 286 END DO 258 287 CASE ( np_CRV ) !* Coriolis + relative vorticity 259 DO jj = 1, jpjm1260 DO ji = 1, jpim1 ! relative vorticity261 zwz(ji,jj) = ( e2v(ji+1,jj) * pv(ji+1,jj,jk) - e2v(ji,jj) * pv(ji,jj,jk) &262 & - e1u(ji,jj+1) * pu(ji,jj+1,jk) + e1u(ji,jj) * pu(ji,jj,jk) ) * r1_e1e2f(ji,jj)263 END DO264 END DO265 IF( ln_dynvor_msk ) THEN ! mask/unmask relative vorticity266 DO jj = 1, jpjm1267 DO ji = 1, jpim1268 zwz(ji,jj) = zwz(ji,jj) * fmask(ji,jj,jk)269 END DO270 END DO271 ENDIF272 CALL lbc_lnk( 'dynvor', zwz, 'F', 1. )273 288 DO jj = 2, jpj 274 289 DO ji = 2, jpi ! vector opt. 275 zwt(ji,jj) = ( ff_t(ji,jj) + r1_4 * ( zwz(ji-1,jj ) + zwz(ji,jj) &276 & + zwz(ji-1,jj-1 ) + zwz(ji,jj-1) ) ) * e1e2t(ji,jj)*e3t_n(ji,jj,jk)290 zwt(ji,jj) = ( ff_t(ji,jj) + r1_4 * ( zwz(ji-1,jj ,jk) + zwz(ji,jj ,jk) & 291 & + zwz(ji-1,jj-1,jk) + zwz(ji,jj-1,jk) ) ) * e1e2t(ji,jj)*e3t_n(ji,jj,jk) 277 292 END DO 278 293 END DO … … 548 563 REAL(wp) :: zua, zva ! local scalars 549 564 REAL(wp) :: zmsk, ze3f ! local scalars 550 REAL(wp), DIMENSION(jpi,jpj) :: zwx , zwy , zwz , z1_e3f 551 REAL(wp), DIMENSION(jpi,jpj) :: ztnw, ztne, ztsw, ztse 565 REAL(wp), DIMENSION(jpi,jpj) :: zwx , zwy , z1_e3f 566 REAL(wp), DIMENSION(jpi,jpj) :: ztnw, ztne, ztsw, ztse 567 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zwz 552 568 !!---------------------------------------------------------------------- 553 569 ! … … 591 607 DO jj = 1, jpjm1 592 608 DO ji = 1, fs_jpim1 ! vector opt. 593 zwz(ji,jj ) = ff_f(ji,jj) * z1_e3f(ji,jj)609 zwz(ji,jj,jk) = ff_f(ji,jj) * z1_e3f(ji,jj) 594 610 END DO 595 611 END DO … … 597 613 DO jj = 1, jpjm1 598 614 DO ji = 1, fs_jpim1 ! vector opt. 599 zwz(ji,jj ) = ( e2v(ji+1,jj ) * pvn(ji+1,jj,jk) - e2v(ji,jj) * pvn(ji,jj,jk) &600 & - e1u(ji ,jj+1) * pun(ji,jj+1,jk) + e1u(ji,jj) * pun(ji,jj,jk) ) * r1_e1e2f(ji,jj)*z1_e3f(ji,jj)615 zwz(ji,jj,jk) = ( e2v(ji+1,jj ) * pvn(ji+1,jj,jk) - e2v(ji,jj) * pvn(ji,jj,jk) & 616 & - e1u(ji ,jj+1) * pun(ji,jj+1,jk) + e1u(ji,jj) * pun(ji,jj,jk) ) * r1_e1e2f(ji,jj)*z1_e3f(ji,jj) 601 617 END DO 602 618 END DO … … 604 620 DO jj = 1, jpjm1 605 621 DO ji = 1, fs_jpim1 ! vector opt. 606 zwz(ji,jj ) = ( ( pvn(ji+1,jj,jk) + pvn(ji,jj,jk) ) * di_e2v_2e1e2f(ji,jj) &607 & - ( pun(ji,jj+1,jk) + pun(ji,jj,jk) ) * dj_e1u_2e1e2f(ji,jj) ) * z1_e3f(ji,jj)622 zwz(ji,jj,jk) = ( ( pvn(ji+1,jj,jk) + pvn(ji,jj,jk) ) * di_e2v_2e1e2f(ji,jj) & 623 & - ( pun(ji,jj+1,jk) + pun(ji,jj,jk) ) * dj_e1u_2e1e2f(ji,jj) ) * z1_e3f(ji,jj) 608 624 END DO 609 625 END DO … … 611 627 DO jj = 1, jpjm1 612 628 DO ji = 1, fs_jpim1 ! vector opt. 613 zwz(ji,jj ) = ( ff_f(ji,jj) + ( e2v(ji+1,jj ) * pvn(ji+1,jj,jk) - e2v(ji,jj) * pvn(ji,jj,jk) &614 & - e1u(ji ,jj+1) * pun(ji,jj+1,jk) + e1u(ji,jj) * pun(ji,jj,jk) ) &615 & * r1_e1e2f(ji,jj) ) * z1_e3f(ji,jj)629 zwz(ji,jj,jk) = ( ff_f(ji,jj) + ( e2v(ji+1,jj ) * pvn(ji+1,jj,jk) - e2v(ji,jj) * pvn(ji,jj,jk) & 630 & - e1u(ji ,jj+1) * pun(ji,jj+1,jk) + e1u(ji,jj) * pun(ji,jj,jk) ) & 631 & * r1_e1e2f(ji,jj) ) * z1_e3f(ji,jj) 616 632 END DO 617 633 END DO … … 619 635 DO jj = 1, jpjm1 620 636 DO ji = 1, fs_jpim1 ! vector opt. 621 zwz(ji,jj ) = ( ff_f(ji,jj) + ( pvn(ji+1,jj ,jk) + pvn(ji,jj,jk) ) * di_e2v_2e1e2f(ji,jj) &622 & - ( pun(ji ,jj+1,jk) + pun(ji,jj,jk) ) * dj_e1u_2e1e2f(ji,jj) ) * z1_e3f(ji,jj)637 zwz(ji,jj,jk) = ( ff_f(ji,jj) + ( pvn(ji+1,jj ,jk) + pvn(ji,jj,jk) ) * di_e2v_2e1e2f(ji,jj) & 638 & - ( pun(ji ,jj+1,jk) + pun(ji,jj,jk) ) * dj_e1u_2e1e2f(ji,jj) ) * z1_e3f(ji,jj) 623 639 END DO 624 640 END DO … … 630 646 DO jj = 1, jpjm1 631 647 DO ji = 1, fs_jpim1 ! vector opt. 632 zwz(ji,jj ) = zwz(ji,jj) * fmask(ji,jj,jk)648 zwz(ji,jj,jk) = zwz(ji,jj,jk) * fmask(ji,jj,jk) 633 649 END DO 634 650 END DO 635 651 ENDIF 636 ! 637 CALL lbc_lnk( 'dynvor', zwz, 'F', 1. ) 652 END DO ! End of slab 653 ! 654 CALL lbc_lnk( 'dynvor', zwz, 'F', 1. ) 655 656 DO jk = 1, jpkm1 ! Horizontal slab 638 657 ! 639 658 ! !== horizontal fluxes ==! … … 645 664 ztne(1,:) = 0 ; ztnw(1,:) = 0 ; ztse(1,:) = 0 ; ztsw(1,:) = 0 646 665 DO ji = 2, jpi ! split in 2 parts due to vector opt. 647 ztne(ji,jj) = zwz(ji-1,jj ) + zwz(ji ,jj ) + zwz(ji ,jj-1)648 ztnw(ji,jj) = zwz(ji-1,jj-1 ) + zwz(ji-1,jj ) + zwz(ji ,jj)649 ztse(ji,jj) = zwz(ji ,jj ) + zwz(ji ,jj-1) + zwz(ji-1,jj-1)650 ztsw(ji,jj) = zwz(ji ,jj-1 ) + zwz(ji-1,jj-1) + zwz(ji-1,jj)666 ztne(ji,jj) = zwz(ji-1,jj ,jk) + zwz(ji ,jj ,jk) + zwz(ji ,jj-1,jk) 667 ztnw(ji,jj) = zwz(ji-1,jj-1,jk) + zwz(ji-1,jj ,jk) + zwz(ji ,jj ,jk) 668 ztse(ji,jj) = zwz(ji ,jj ,jk) + zwz(ji ,jj-1,jk) + zwz(ji-1,jj-1,jk) 669 ztsw(ji,jj) = zwz(ji ,jj-1,jk) + zwz(ji-1,jj-1,jk) + zwz(ji-1,jj ,jk) 651 670 END DO 652 671 DO jj = 3, jpj 653 672 DO ji = fs_2, jpi ! vector opt. ok because we start at jj = 3 654 ztne(ji,jj) = zwz(ji-1,jj ) + zwz(ji ,jj ) + zwz(ji ,jj-1)655 ztnw(ji,jj) = zwz(ji-1,jj-1 ) + zwz(ji-1,jj ) + zwz(ji ,jj)656 ztse(ji,jj) = zwz(ji ,jj ) + zwz(ji ,jj-1) + zwz(ji-1,jj-1)657 ztsw(ji,jj) = zwz(ji ,jj-1 ) + zwz(ji-1,jj-1) + zwz(ji-1,jj)673 ztne(ji,jj) = zwz(ji-1,jj ,jk) + zwz(ji ,jj ,jk) + zwz(ji ,jj-1,jk) 674 ztnw(ji,jj) = zwz(ji-1,jj-1,jk) + zwz(ji-1,jj ,jk) + zwz(ji ,jj ,jk) 675 ztse(ji,jj) = zwz(ji ,jj ,jk) + zwz(ji ,jj-1,jk) + zwz(ji-1,jj-1,jk) 676 ztsw(ji,jj) = zwz(ji ,jj-1,jk) + zwz(ji-1,jj-1,jk) + zwz(ji-1,jj ,jk) 658 677 END DO 659 678 END DO … … 701 720 REAL(wp) :: zua, zva ! local scalars 702 721 REAL(wp) :: zmsk, z1_e3t ! local scalars 703 REAL(wp), DIMENSION(jpi,jpj) :: zwx , zwy , zwz 704 REAL(wp), DIMENSION(jpi,jpj) :: ztnw, ztne, ztsw, ztse 722 REAL(wp), DIMENSION(jpi,jpj) :: zwx , zwy 723 REAL(wp), DIMENSION(jpi,jpj) :: ztnw, ztne, ztsw, ztse 724 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zwz 705 725 !!---------------------------------------------------------------------- 706 726 ! … … 720 740 DO jj = 1, jpjm1 721 741 DO ji = 1, fs_jpim1 ! vector opt. 722 zwz(ji,jj ) = ff_f(ji,jj)742 zwz(ji,jj,jk) = ff_f(ji,jj) 723 743 END DO 724 744 END DO … … 726 746 DO jj = 1, jpjm1 727 747 DO ji = 1, fs_jpim1 ! vector opt. 728 zwz(ji,jj ) = ( e2v(ji+1,jj ) * pvn(ji+1,jj ,jk) - e2v(ji,jj) * pvn(ji,jj,jk) &729 & - e1u(ji ,jj+1) * pun(ji ,jj+1,jk) + e1u(ji,jj) * pun(ji,jj,jk) ) &730 & * r1_e1e2f(ji,jj)748 zwz(ji,jj,jk) = ( e2v(ji+1,jj ) * pvn(ji+1,jj ,jk) - e2v(ji,jj) * pvn(ji,jj,jk) & 749 & - e1u(ji ,jj+1) * pun(ji ,jj+1,jk) + e1u(ji,jj) * pun(ji,jj,jk) ) & 750 & * r1_e1e2f(ji,jj) 731 751 END DO 732 752 END DO … … 734 754 DO jj = 1, jpjm1 735 755 DO ji = 1, fs_jpim1 ! vector opt. 736 zwz(ji,jj ) = ( pvn(ji+1,jj ,jk) + pvn(ji,jj,jk) ) * di_e2v_2e1e2f(ji,jj) &737 & - ( pun(ji ,jj+1,jk) + pun(ji,jj,jk) ) * dj_e1u_2e1e2f(ji,jj)756 zwz(ji,jj,jk) = ( pvn(ji+1,jj ,jk) + pvn(ji,jj,jk) ) * di_e2v_2e1e2f(ji,jj) & 757 & - ( pun(ji ,jj+1,jk) + pun(ji,jj,jk) ) * dj_e1u_2e1e2f(ji,jj) 738 758 END DO 739 759 END DO … … 741 761 DO jj = 1, jpjm1 742 762 DO ji = 1, fs_jpim1 ! vector opt. 743 zwz(ji,jj ) = ( ff_f(ji,jj) + ( e2v(ji+1,jj ) * pvn(ji+1,jj ,jk) - e2v(ji,jj) * pvn(ji,jj,jk) &744 & - e1u(ji ,jj+1) * pun(ji ,jj+1,jk) + e1u(ji,jj) * pun(ji,jj,jk) ) &745 & * r1_e1e2f(ji,jj) )763 zwz(ji,jj,jk) = ( ff_f(ji,jj) + ( e2v(ji+1,jj ) * pvn(ji+1,jj ,jk) - e2v(ji,jj) * pvn(ji,jj,jk) & 764 & - e1u(ji ,jj+1) * pun(ji ,jj+1,jk) + e1u(ji,jj) * pun(ji,jj,jk) ) & 765 & * r1_e1e2f(ji,jj) ) 746 766 END DO 747 767 END DO … … 749 769 DO jj = 1, jpjm1 750 770 DO ji = 1, fs_jpim1 ! vector opt. 751 zwz(ji,jj ) = ff_f(ji,jj) + ( pvn(ji+1,jj ,jk) + pvn(ji,jj,jk) ) * di_e2v_2e1e2f(ji,jj) &752 & - ( pun(ji ,jj+1,jk) + pun(ji,jj,jk) ) * dj_e1u_2e1e2f(ji,jj)771 zwz(ji,jj,jk) = ff_f(ji,jj) + ( pvn(ji+1,jj ,jk) + pvn(ji,jj,jk) ) * di_e2v_2e1e2f(ji,jj) & 772 & - ( pun(ji ,jj+1,jk) + pun(ji,jj,jk) ) * dj_e1u_2e1e2f(ji,jj) 753 773 END DO 754 774 END DO … … 760 780 DO jj = 1, jpjm1 761 781 DO ji = 1, fs_jpim1 ! vector opt. 762 zwz(ji,jj ) = zwz(ji,jj) * fmask(ji,jj,jk)782 zwz(ji,jj,jk) = zwz(ji,jj,jk) * fmask(ji,jj,jk) 763 783 END DO 764 784 END DO 765 785 ENDIF 766 ! 767 CALL lbc_lnk( 'dynvor', zwz, 'F', 1. ) 768 ! 769 ! !== horizontal fluxes ==! 786 END DO 787 ! 788 CALL lbc_lnk( 'dynvor', zwz, 'F', 1. ) 789 ! 790 DO jk = 1, jpkm1 ! Horizontal slab 791 792 ! !== horizontal fluxes ==! 770 793 zwx(:,:) = e2u(:,:) * e3u_n(:,:,jk) * pun(:,:,jk) 771 794 zwy(:,:) = e1v(:,:) * e3v_n(:,:,jk) * pvn(:,:,jk) … … 776 799 DO ji = 2, jpi ! split in 2 parts due to vector opt. 777 800 z1_e3t = 1._wp / e3t_n(ji,jj,jk) 778 ztne(ji,jj) = ( zwz(ji-1,jj ) + zwz(ji ,jj ) + zwz(ji ,jj-1) ) * z1_e3t779 ztnw(ji,jj) = ( zwz(ji-1,jj-1 ) + zwz(ji-1,jj ) + zwz(ji ,jj) ) * z1_e3t780 ztse(ji,jj) = ( zwz(ji ,jj ) + zwz(ji ,jj-1) + zwz(ji-1,jj-1) ) * z1_e3t781 ztsw(ji,jj) = ( zwz(ji ,jj-1 ) + zwz(ji-1,jj-1) + zwz(ji-1,jj) ) * z1_e3t801 ztne(ji,jj) = ( zwz(ji-1,jj ,jk) + zwz(ji ,jj ,jk) + zwz(ji ,jj-1,jk) ) * z1_e3t 802 ztnw(ji,jj) = ( zwz(ji-1,jj-1,jk) + zwz(ji-1,jj ,jk) + zwz(ji ,jj ,jk) ) * z1_e3t 803 ztse(ji,jj) = ( zwz(ji ,jj ,jk) + zwz(ji ,jj-1,jk) + zwz(ji-1,jj-1,jk) ) * z1_e3t 804 ztsw(ji,jj) = ( zwz(ji ,jj-1,jk) + zwz(ji-1,jj-1,jk) + zwz(ji-1,jj ,jk) ) * z1_e3t 782 805 END DO 783 806 DO jj = 3, jpj 784 807 DO ji = fs_2, jpi ! vector opt. ok because we start at jj = 3 785 808 z1_e3t = 1._wp / e3t_n(ji,jj,jk) 786 ztne(ji,jj) = ( zwz(ji-1,jj ) + zwz(ji ,jj ) + zwz(ji ,jj-1) ) * z1_e3t787 ztnw(ji,jj) = ( zwz(ji-1,jj-1 ) + zwz(ji-1,jj ) + zwz(ji ,jj) ) * z1_e3t788 ztse(ji,jj) = ( zwz(ji ,jj ) + zwz(ji ,jj-1) + zwz(ji-1,jj-1) ) * z1_e3t789 ztsw(ji,jj) = ( zwz(ji ,jj-1 ) + zwz(ji-1,jj-1) + zwz(ji-1,jj) ) * z1_e3t809 ztne(ji,jj) = ( zwz(ji-1,jj ,jk) + zwz(ji ,jj ,jk) + zwz(ji ,jj-1,jk) ) * z1_e3t 810 ztnw(ji,jj) = ( zwz(ji-1,jj-1,jk) + zwz(ji-1,jj ,jk) + zwz(ji ,jj ,jk) ) * z1_e3t 811 ztse(ji,jj) = ( zwz(ji ,jj ,jk) + zwz(ji ,jj-1,jk) + zwz(ji-1,jj-1,jk) ) * z1_e3t 812 ztsw(ji,jj) = ( zwz(ji ,jj-1,jk) + zwz(ji-1,jj-1,jk) + zwz(ji-1,jj ,jk) ) * z1_e3t 790 813 END DO 791 814 END DO -
NEMO/branches/2018/dev_r10164_HPC09_ESIWACE_PREP_MERGE/src/OCE/TRA/traadv_fct.F90
r10170 r10293 169 169 END DO 170 170 END DO 171 CALL lbc_lnk( 'traadv_fct', zwi, 'T', 1. ) ! Lateral boundary conditions on zwi (unchanged sign)172 171 ! 173 172 IF( l_trd .OR. l_hst ) THEN ! trend diagnostics (contribution of upstream fluxes) … … 279 278 ENDIF 280 279 ! 281 CALL lbc_lnk_multi( 'traadv_fct', zw x, 'U', -1. , zwy, 'V', -1., zwz, 'W', 1. )280 CALL lbc_lnk_multi( 'traadv_fct', zwi, 'T', 1., zwx, 'U', -1. , zwy, 'V', -1., zwz, 'W', 1. ) 282 281 ! 283 282 ! !== monotonicity algorithm ==!
Note: See TracChangeset
for help on using the changeset viewer.