Changeset 10425 for NEMO/trunk/src/OCE/DYN
- Timestamp:
- 2018-12-19T22:54:16+01:00 (5 years ago)
- Location:
- NEMO/trunk/src/OCE/DYN
- Files:
-
- 11 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/trunk/src/OCE/DYN/divhor.F90
r10068 r10425 104 104 IF( ln_iscpl .AND. ln_hsb ) CALL iscpl_div( hdivn ) !== ice sheet ==! (update hdivn field) 105 105 ! 106 CALL lbc_lnk( hdivn, 'T', 1. ) ! (no sign change)106 CALL lbc_lnk( 'divhor', hdivn, 'T', 1. ) ! (no sign change) 107 107 ! 108 108 IF( ln_timing ) CALL timing_stop('div_hor') -
NEMO/trunk/src/OCE/DYN/dynadv_ubs.F90
r10068 r10425 123 123 END DO 124 124 END DO 125 CALL lbc_lnk_multi( zlu_uu(:,:,:,1), 'U', 1. , zlu_uv(:,:,:,1), 'U', 1., &125 CALL lbc_lnk_multi( 'dynadv_ubs', zlu_uu(:,:,:,1), 'U', 1. , zlu_uv(:,:,:,1), 'U', 1., & 126 126 & zlu_uu(:,:,:,2), 'U', 1. , zlu_uv(:,:,:,2), 'U', 1., & 127 127 & zlv_vv(:,:,:,1), 'V', 1. , zlv_vu(:,:,:,1), 'V', 1., & -
NEMO/trunk/src/OCE/DYN/dynhpg.F90
r10068 r10425 490 490 END DO 491 491 END DO 492 CALL lbc_lnk_multi( zcpx, 'U', 1., zcpy, 'V', 1. )492 CALL lbc_lnk_multi( 'dynhpg', zcpx, 'U', 1., zcpy, 'V', 1. ) 493 493 END IF 494 494 … … 723 723 END DO 724 724 END DO 725 CALL lbc_lnk_multi( zcpx, 'U', 1., zcpy, 'V', 1. )725 CALL lbc_lnk_multi( 'dynhpg', zcpx, 'U', 1., zcpy, 'V', 1. ) 726 726 END IF 727 727 … … 883 883 END DO 884 884 END DO 885 CALL lbc_lnk_multi( rho_k, 'W', 1., rho_i, 'U', 1., rho_j, 'V', 1. )885 CALL lbc_lnk_multi( 'dynhpg', rho_k, 'W', 1., rho_i, 'U', 1., rho_j, 'V', 1. ) 886 886 887 887 ! --------------- … … 1016 1016 END DO 1017 1017 END DO 1018 CALL lbc_lnk_multi( zcpx, 'U', 1., zcpy, 'V', 1. )1018 CALL lbc_lnk_multi( 'dynhpg', zcpx, 'U', 1., zcpy, 'V', 1. ) 1019 1019 ENDIF 1020 1020 … … 1102 1102 END DO 1103 1103 1104 CALL lbc_lnk_multi ( zsshu_n, 'U', 1., zsshv_n, 'V', 1. )1104 CALL lbc_lnk_multi ('dynhpg', zsshu_n, 'U', 1., zsshv_n, 'V', 1. ) 1105 1105 1106 1106 DO jj = 2, jpjm1 -
NEMO/trunk/src/OCE/DYN/dynkeg.F90
r10068 r10425 158 158 END DO 159 159 END DO 160 CALL lbc_lnk( zhke, 'T', 1. )160 CALL lbc_lnk( 'dynkeg', zhke, 'T', 1. ) 161 161 ! 162 162 END SELECT -
NEMO/trunk/src/OCE/DYN/dynldf_iso.F90
r10068 r10425 136 136 END DO 137 137 ! Lateral boundary conditions on the slopes 138 CALL lbc_lnk_multi( uslp , 'U', -1., vslp , 'V', -1., wslpi, 'W', -1., wslpj, 'W', -1. )138 CALL lbc_lnk_multi( 'dynldf_iso', uslp , 'U', -1., vslp , 'V', -1., wslpi, 'W', -1., wslpj, 'W', -1. ) 139 139 ! 140 140 ENDIF -
NEMO/trunk/src/OCE/DYN/dynldf_lap_blp.F90
r10068 r10425 136 136 CALL dyn_ldf_lap( kt, pub, pvb, zulap, zvlap, 1 ) ! rotated laplacian applied to ptb (output in zlap) 137 137 ! 138 CALL lbc_lnk_multi( zulap, 'U', -1., zvlap, 'V', -1. ) ! Lateral boundary conditions138 CALL lbc_lnk_multi( 'dynldf_lap_blp', zulap, 'U', -1., zvlap, 'V', -1. ) ! Lateral boundary conditions 139 139 ! 140 140 CALL dyn_ldf_lap( kt, zulap, zvlap, pua, pva, 2 ) ! rotated laplacian applied to zlap (output in pta) -
NEMO/trunk/src/OCE/DYN/dynnxt.F90
r10349 r10425 144 144 # endif 145 145 ! 146 CALL lbc_lnk_multi( ua, 'U', -1., va, 'V', -1. ) !* local domain boundaries146 CALL lbc_lnk_multi( 'dynnxt', ua, 'U', -1., va, 'V', -1. ) !* local domain boundaries 147 147 ! 148 148 ! !* BDY open boundaries -
NEMO/trunk/src/OCE/DYN/dynspg_ts.F90
r10272 r10425 112 112 dyn_spg_ts_alloc = MAXVAL( ierr(:) ) 113 113 ! 114 IF( lk_mpp ) CALL mpp_sum(dyn_spg_ts_alloc )115 IF( dyn_spg_ts_alloc /= 0 ) CALL ctl_ warn('dyn_spg_ts_alloc: failed to allocate arrays')114 CALL mpp_sum( 'dynspg_ts', dyn_spg_ts_alloc ) 115 IF( dyn_spg_ts_alloc /= 0 ) CALL ctl_stop( 'STOP', 'dyn_spg_ts_alloc: failed to allocate arrays' ) 116 116 ! 117 117 END FUNCTION dyn_spg_ts_alloc … … 262 262 END DO 263 263 END SELECT 264 CALL lbc_lnk( zwz, 'F', 1._wp )264 CALL lbc_lnk( 'dynspg_ts', zwz, 'F', 1._wp ) 265 265 ! 266 266 ftne(1,:) = 0._wp ; ftnw(1,:) = 0._wp ; ftse(1,:) = 0._wp ; ftsw(1,:) = 0._wp … … 330 330 END DO 331 331 END DO 332 CALL lbc_lnk( zhf, 'F', 1._wp )332 CALL lbc_lnk( 'dynspg_ts', zhf, 'F', 1._wp ) 333 333 ! JC: TBC. hf should be greater than 0 334 334 DO jj = 1, jpj … … 711 711 DO jn = 1, icycle ! sub-time-step loop ! 712 712 ! ! ==================== ! 713 ! 714 l_full_nf_update = jn == icycle ! false: disable full North fold update (performances) for jn = 1 to icycle-1 715 ! ! ------------------ 713 716 ! !* Update the forcing (BDY and tides) 714 717 ! ! ------------------ … … 777 780 END DO 778 781 END DO 779 CALL lbc_lnk_multi( zwx, 'U', 1._wp, zwy, 'V', 1._wp )782 CALL lbc_lnk_multi( 'dynspg_ts', zwx, 'U', 1._wp, zwy, 'V', 1._wp ) 780 783 ! 781 784 zhup2_e(:,:) = hu_0(:,:) + zwx(:,:) ! Ocean depth at U- and V-points … … 872 875 ssha_e(:,:) = ( sshn_e(:,:) - rdtbt * ( zssh_frc(:,:) + zhdiv(:,:) ) ) * ssmask(:,:) 873 876 874 CALL lbc_lnk( ssha_e, 'T', 1._wp )877 CALL lbc_lnk( 'dynspg_ts', ssha_e, 'T', 1._wp ) 875 878 876 879 ! Duplicate sea level across open boundaries (this is only cosmetic if linssh=T) … … 892 895 END DO 893 896 END DO 894 CALL lbc_lnk_multi( zsshu_a, 'U', 1._wp, zsshv_a, 'V', 1._wp )897 CALL lbc_lnk_multi( 'dynspg_ts', zsshu_a, 'U', 1._wp, zsshv_a, 'V', 1._wp ) 895 898 ENDIF 896 899 ! … … 1160 1163 ENDIF 1161 1164 ! !* domain lateral boundary 1162 CALL lbc_lnk_multi( ua_e, 'U', -1._wp, va_e , 'V', -1._wp )1165 CALL lbc_lnk_multi( 'dynspg_ts', ua_e, 'U', -1._wp, va_e , 'V', -1._wp ) 1163 1166 ! 1164 1167 ! ! open boundaries … … 1246 1249 END DO 1247 1250 END DO 1248 CALL lbc_lnk_multi( zsshu_a, 'U', 1._wp, zsshv_a, 'V', 1._wp ) ! Boundary conditions1251 CALL lbc_lnk_multi( 'dynspg_ts', zsshu_a, 'U', 1._wp, zsshv_a, 'V', 1._wp ) ! Boundary conditions 1249 1252 ! 1250 1253 DO jk=1,jpkm1 … … 1481 1484 ! 1482 1485 zcmax = MAXVAL( zcu(:,:) ) 1483 IF( lk_mpp ) CALL mpp_max(zcmax )1486 CALL mpp_max( 'dynspg_ts', zcmax ) 1484 1487 1485 1488 ! Estimate number of iterations to satisfy a max courant number= rn_bt_cmax -
NEMO/trunk/src/OCE/DYN/dynvor.F90
r10068 r10425 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( 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( 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( 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( 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 … … 863 886 END DO 864 887 ! 865 CALL lbc_lnk( fmask, 'F', 1._wp ) ! Lateral boundary conditions on fmask888 CALL lbc_lnk( 'dynvor', fmask, 'F', 1._wp ) ! Lateral boundary conditions on fmask 866 889 ! 867 890 ENDIF … … 903 926 END DO 904 927 END DO 905 CALL lbc_lnk_multi( di_e2u_2, 'T', -1. , dj_e1v_2, 'T', -1. ) ! Lateral boundary conditions928 CALL lbc_lnk_multi( 'dynvor', di_e2u_2, 'T', -1. , dj_e1v_2, 'T', -1. ) ! Lateral boundary conditions 906 929 ! 907 930 CASE DEFAULT !* F-point metric term : pre-compute di(e2u)/(2*e1e2f) and dj(e1v)/(2*e1e2f) … … 913 936 END DO 914 937 END DO 915 CALL lbc_lnk_multi( di_e2v_2e1e2f, 'F', -1. , dj_e1u_2e1e2f, 'F', -1. ) ! Lateral boundary conditions938 CALL lbc_lnk_multi( 'dynvor', di_e2v_2e1e2f, 'F', -1. , dj_e1u_2e1e2f, 'F', -1. ) ! Lateral boundary conditions 916 939 END SELECT 917 940 ! -
NEMO/trunk/src/OCE/DYN/sshwzv.F90
r10364 r10425 112 112 IF ( .NOT.ln_dynspg_ts ) THEN 113 113 IF( ln_bdy ) THEN 114 CALL lbc_lnk( ssha, 'T', 1. ) ! Not sure that's necessary114 CALL lbc_lnk( 'sshwzv', ssha, 'T', 1. ) ! Not sure that's necessary 115 115 CALL bdy_ssh( ssha ) ! Duplicate sea level across open boundaries 116 116 ENDIF … … 176 176 END DO 177 177 END DO 178 CALL lbc_lnk( zhdiv, 'T', 1.) ! - ML - Perhaps not necessary: not used for horizontal "connexions"178 CALL lbc_lnk('sshwzv', zhdiv, 'T', 1.) ! - ML - Perhaps not necessary: not used for horizontal "connexions" 179 179 ! ! Is it problematic to have a wrong vertical velocity in boundary cells? 180 180 ! ! Same question holds for hdivn. Perhaps just for security -
NEMO/trunk/src/OCE/DYN/wet_dry.F90
r10069 r10425 241 241 END DO 242 242 END DO 243 CALL lbc_lnk_multi( zwdlmtu, 'U', 1., zwdlmtv, 'V', 1. )244 ! 245 IF( lk_mpp ) CALL mpp_max(jflag) !max over the global domain243 CALL lbc_lnk_multi( 'wet_dry', zwdlmtu, 'U', 1., zwdlmtv, 'V', 1. ) 244 ! 245 CALL mpp_max('wet_dry', jflag) !max over the global domain 246 246 ! 247 247 IF( jflag == 0 ) EXIT … … 257 257 ! 258 258 !!gm TO BE SUPPRESSED ? these lbc_lnk are useless since zwdlmtu and zwdlmtv are defined everywhere ! 259 CALL lbc_lnk_multi( un , 'U', -1., vn , 'V', -1. )260 CALL lbc_lnk_multi( un_b, 'U', -1., vn_b, 'V', -1. )259 CALL lbc_lnk_multi( 'wet_dry', un , 'U', -1., vn , 'V', -1. ) 260 CALL lbc_lnk_multi( 'wet_dry', un_b, 'U', -1., vn_b, 'V', -1. ) 261 261 !!gm 262 262 ! … … 370 370 END DO ! jj loop 371 371 ! 372 CALL lbc_lnk_multi( zwdlmtu, 'U', 1., zwdlmtv, 'V', 1. )373 ! 374 IF(lk_mpp) CALL mpp_max(jflag) !max over the global domain372 CALL lbc_lnk_multi( 'wet_dry', zwdlmtu, 'U', 1., zwdlmtv, 'V', 1. ) 373 ! 374 CALL mpp_max('wet_dry', jflag) !max over the global domain 375 375 ! 376 376 IF(jflag == 0) EXIT … … 382 382 ! 383 383 !!gm THIS lbc_lnk is useless since it is already done at the end of the jk1-loop 384 CALL lbc_lnk_multi( zflxu, 'U', -1., zflxv, 'V', -1. )384 CALL lbc_lnk_multi( 'wet_dry', zflxu, 'U', -1., zflxv, 'V', -1. ) 385 385 !!gm end 386 386 !
Note: See TracChangeset
for help on using the changeset viewer.