Changeset 11240
- Timestamp:
- 2019-07-10T11:08:58+02:00 (4 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2019/dev_r10984_HPC-13_IRRMANN_BDY_optimization/src/OCE/DYN/dynspg_ts.F90
r11234 r11240 149 149 LOGICAL :: ll_fw_start ! =T : forward integration 150 150 LOGICAL :: ll_init ! =T : special startup of 2d equations 151 LOGICAL :: ll_tmp1, ll_tmp2 ! local logical variables used in W/D 152 INTEGER :: ikbu, iktu, noffset ! local integers 153 INTEGER :: ikbv, iktv ! - - 154 REAL(wp) :: r1_2dt_b, z2dt_bf ! local scalars 155 REAL(wp) :: zx1, zx2, zhura , z1_hu ! - - 156 REAL(wp) :: zy1, zy2, zhvra , z1_hv ! - - 151 INTEGER :: noffset ! local integers : time offset for bdy update 152 REAL(wp) :: r1_2dt_b, z1_hu, z1_hv ! local scalars 157 153 REAL(wp) :: za0, za1, za2, za3 ! - - 158 REAL(wp) :: zmdi, zztmp, zldg , z1_ht! - -159 REAL(wp) :: zhu_bck, zhv_bck 154 REAL(wp) :: zmdi, zztmp, zldg ! - - 155 REAL(wp) :: zhu_bck, zhv_bck, zhdiv ! - - 160 156 REAL(wp) :: zun_save, zvn_save ! - - 161 REAL(wp), DIMENSION(jpi,jpj) :: zsshp2_e 162 REAL(wp), DIMENSION(jpi,jpj) :: zwx, zu_trd, zu_frc, zu_spg, zssh_frc 163 REAL(wp), DIMENSION(jpi,jpj) :: zwy, zv_trd, zv_frc, zv_spg, zhdiv 164 REAL(wp), DIMENSION(jpi,jpj) :: zsshu_a, zhup2_e, zhust_e, zhtp2_e 165 REAL(wp), DIMENSION(jpi,jpj) :: zsshv_a, zhvp2_e, zhvst_e 157 REAL(wp), DIMENSION(jpi,jpj) :: zu_trd, zu_frc, zu_spg, zssh_frc 158 REAL(wp), DIMENSION(jpi,jpj) :: zv_trd, zv_frc, zv_spg 159 REAL(wp), DIMENSION(jpi,jpj) :: zsshu_a, zhup2_e, zhtp2_e 160 REAL(wp), DIMENSION(jpi,jpj) :: zsshv_a, zhvp2_e, zsshp2_e 166 161 REAL(wp), DIMENSION(jpi,jpj) :: zCdU_u, zCdU_v ! top/bottom stress at u- & v-points 167 162 REAL(wp), DIMENSION(jpi,jpj) :: zhU, zhV ! fluxes … … 462 457 IF( ln_wd_dl ) CALL wad_tmsk( zsshp2_e, ztwdmask ) 463 458 ! 464 DO jj = 2, jpjm1 ! Sea Surface Height at u- & v-points 465 DO ji = 2, fs_jpim1 ! Vector opt. 466 zwx(ji,jj) = r1_2 * ssumask(ji,jj) * r1_e1e2u(ji,jj) & 467 & * ( e1e2t(ji ,jj) * zsshp2_e(ji ,jj) & 468 & + e1e2t(ji+1,jj) * zsshp2_e(ji+1,jj) ) 469 zwy(ji,jj) = r1_2 * ssvmask(ji,jj) * r1_e1e2v(ji,jj) & 470 & * ( e1e2t(ji,jj ) * zsshp2_e(ji,jj ) & 471 & + e1e2t(ji,jj+1) * zsshp2_e(ji,jj+1) ) 472 END DO 473 END DO 474 CALL lbc_lnk_multi( 'dynspg_ts', zwx, 'U', 1._wp, zwy, 'V', 1._wp ) 459 ! ! ocean t-depth at mid-step 460 zhtp2_e(:,:) = ht_0(:,:) + zsshp2_e(:,:) 475 461 ! 476 zhup2_e(:,:) = hu_0(:,:) + zwx(:,:) ! Ocean depth at U- and V-points 477 zhvp2_e(:,:) = hv_0(:,:) + zwy(:,:) 478 zhtp2_e(:,:) = ht_0(:,:) + zsshp2_e(:,:) 462 ! ! ocean u- and v-depth at mid-step (separate DO-loops remove the need of a lbc_lnk) 463 DO jj = 1, jpj 464 DO ji = 1, jpim1 ! not jpi-column 465 zhup2_e(ji,jj) = hu_0(ji,jj) + r1_2 * r1_e1e2u(ji,jj) & 466 & * ( e1e2t(ji ,jj) * zsshp2_e(ji ,jj) & 467 & + e1e2t(ji+1,jj) * zsshp2_e(ji+1,jj) ) * ssumask(ji,jj) 468 END DO 469 END DO 470 DO jj = 1, jpj ! not jpj-row 471 DO ji = 1, jpim1 472 zhvp2_e(ji,jj) = hv_0(ji,jj) + r1_2 * r1_e1e2v(ji,jj) & 473 & * ( e1e2t(ji,jj ) * zsshp2_e(ji,jj ) & 474 & + e1e2t(ji,jj+1) * zsshp2_e(ji,jj+1) ) * ssvmask(ji,jj) 475 END DO 476 END DO 479 477 ! 480 478 ENDIF … … 486 484 IF( ln_bdy .AND. ln_vol ) CALL bdy_vol2d( kt, jn, ua_e, va_e, zhup2_e, zhvp2_e ) 487 485 ! 488 zhU(:,:) = e2u(:,:) * ua_e(:,:) * zhup2_e(:,:) ! fluxes at jn+0.5 489 zhV(:,:) = e1v(:,:) * va_e(:,:) * zhvp2_e(:,:) 486 ! ! resulting flux at mid-step (not over the full domain) 487 zhU(1:jpim1,1:jpj ) = e2u(1:jpim1,1:jpj ) * ua_e(1:jpim1,1:jpj ) * zhup2_e(1:jpim1,1:jpj ) ! not jpi-column 488 zhV(1:jpi ,1:jpjm1) = e1v(1:jpi ,1:jpjm1) * va_e(1:jpi ,1:jpjm1) * zhvp2_e(1:jpi ,1:jpjm1) ! not jpj-row 490 489 ! 491 490 #if defined key_agrif … … 518 517 ENDIF 519 518 #endif 520 IF( ln_wd_il ) CALL wad_lmt_bt(zhU, zhV, sshn_e, zssh_frc, rdtbt) 519 IF( ln_wd_il ) CALL wad_lmt_bt(zhU, zhV, sshn_e, zssh_frc, rdtbt) !!gm wad_lmt_bt use of lbc_lnk on zhU, zhV 521 520 522 521 IF( ln_wd_dl ) THEN ! un_e and vn_e are set to zero at faces where 523 522 ! ! the direction of the flow is from dry cells 524 CALL wad_Umsk( ztwdmask, zhU, zhV, un_e, vn_e, zuwdmask, zvwdmask ) 523 CALL wad_Umsk( ztwdmask, zhU, zhV, un_e, vn_e, zuwdmask, zvwdmask ) ! not jpi colomn for U, not jpj row for V 525 524 ! 526 525 ENDIF 527 526 ! sum over sub-time-steps to decide which baroclinic velocities to set to zero (zuwdav2 is only used when ln_wd_dl_bc=True) 528 527 IF ( ln_wd_dl_bc ) THEN 529 zuwdav2(:,:) = zuwdav2(:,:) + za2 * zuwdmask(:,:) 530 zvwdav2(:,:) = zvwdav2(:,:) + za2 * zvwdmask(:,:) 531 END IF 532 533 ! Sum over sub-time-steps to compute advective velocities 534 ! 535 za2 = wgtbtp2(jn) 536 un_adv(:,:) = un_adv(:,:) + za2 * zhU(:,:) * r1_e2u(:,:) 537 vn_adv(:,:) = vn_adv(:,:) + za2 * zhV(:,:) * r1_e1v(:,:) 538 539 ! Set next sea level: 540 DO jj = 2, jpjm1 541 DO ji = fs_2, fs_jpim1 ! vector opt. 542 zhdiv(ji,jj) = ( zhU(ji,jj) - zhU(ji-1,jj) & 543 & + zhV(ji,jj) - zhV(ji,jj-1) ) * r1_e1e2t(ji,jj) 544 END DO 545 END DO 528 zuwdav2(1:jpim1,1:jpj ) = zuwdav2(1:jpim1,1:jpj ) + za2 * zuwdmask(1:jpim1,1:jpj ) ! not jpi-column 529 zvwdav2(1:jpi ,1:jpjm1) = zvwdav2(1:jpi ,1:jpjm1) + za2 * zvwdmask(1:jpi ,1:jpjm1) ! not jpj-row 530 END IF 531 ! 532 ! 546 533 ! Compute Sea Level at step jit+1 547 534 !-- m+1 m m+1/2 --! 548 535 !-- ssh = ssh - delta_t' * [ frc + div( flux ) ] --! 549 536 !-------------------------------------------------------------------------! 550 ssha_e(:,:) = ( sshn_e(:,:) - rdtbt * ( zssh_frc(:,:) + zhdiv(:,:) ) ) * ssmask(:,:) 551 552 CALL lbc_lnk( 'dynspg_ts', ssha_e, 'T', 1._wp ) 553 537 DO jj = 2, jpjm1 ! INNER domain 538 DO ji = 2, jpim1 539 zhdiv = ( zhU(ji,jj) - zhU(ji-1,jj) + zhV(ji,jj) - zhV(ji,jj-1) ) * r1_e1e2t(ji,jj) 540 ssha_e(ji,jj) = ( sshn_e(ji,jj) - rdtbt * ( zssh_frc(ji,jj) + zhdiv ) ) * ssmask(ji,jj) 541 END DO 542 END DO 543 ! 544 CALL lbc_lnk_multi( 'dynspg_ts', ssha_e, 'T', 1._wp, zhU, 'U', 1._wp, zhV, 'V', 1._wp ) 545 ! 546 ! ! Sum over sub-time-steps to compute advective velocities 547 za2 = wgtbtp2(jn) ! zhU, zhV hold fluxes extrapolated at jn+0.5 548 un_adv(:,:) = un_adv(:,:) + za2 * zhU(:,:) * r1_e2u(:,:) 549 vn_adv(:,:) = vn_adv(:,:) + za2 * zhV(:,:) * r1_e1v(:,:) 550 ! 554 551 ! Duplicate sea level across open boundaries (this is only cosmetic if linssh=T) 555 552 IF( ln_bdy ) CALL bdy_ssh( ssha_e ) … … 652 649 ELSE !* Flux form 653 650 DO jj = 2, jpjm1 654 DO ji = fs_2, fs_jpim1 ! vector opt.651 DO ji = 2, jpim1 655 652 ! ! backward extrapolated depth used in spg terms at jn+1/2 656 653 zhu_bck = hu_0(ji,jj) + r1_2*r1_e1e2u(ji,jj) * ( e1e2t(ji ,jj) * zsshp2_e(ji ,jj) & … … 1133 1130 REAL(wp), DIMENSION(jpi,jpj) :: zhf 1134 1131 !!---------------------------------------------------------------------- 1135 !1136 1132 ! 1137 1133 SELECT CASE( nvor_scheme )
Note: See TracChangeset
for help on using the changeset viewer.
