- Timestamp:
- 2018-07-29T11:23:51+02:00 (6 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2018/dev_r9838_ENHANCE04_RK3/src/OCE/DYN/dynspg_ts.F90
r9939 r10009 130 130 !! 131 131 !! ** Action : 132 !! -Update the filtered free surface at step "n+1" : ssh a132 !! -Update the filtered free surface at step "n+1" : ssh(Naa) 133 133 !! -Update filtered barotropic velocities at step "n+1" : ua_b, va_b 134 134 !! -Compute barotropic advective fluxes at step "n" : un_adv, vn_adv … … 440 440 DO jj = 2, jpjm1 441 441 DO ji = 2, jpim1 442 ll_tmp1 = MIN( ssh n(ji,jj) , sshn(ji+1,jj) ) >&443 & MAX( -ht_0(ji,jj) , -ht_0(ji+1,jj) ) .AND.&444 & MAX( ssh n(ji,jj) + ht_0(ji,jj) , sshn(ji+1,jj) + ht_0(ji+1,jj) ) &445 & > rn_wdmin1 + rn_wdmin2446 ll_tmp2 = ( ABS( sshn(ji+1,jj) - sshn(ji ,jj)) > 1.E-12 ).AND.(&447 & MAX( sshn(ji,jj) , sshn(ji+1,jj) ) >&448 & MAX( -ht_0(ji,jj) , -ht_0(ji+1,jj) ) + rn_wdmin1 + rn_wdmin2 )442 ll_tmp1 = MIN( ssh(ji,jj,Nnn) , ssh(ji+1,jj,Nnn) ) > & 443 & MAX( - ht_0(ji,jj) , - ht_0(ji+1,jj) ) .AND. & 444 & MAX( ssh(ji,jj,Nnn) + ht_0(ji,jj) , ssh(ji+1,jj,Nnn) + ht_0(ji+1,jj) ) > rn_wdmin1 + rn_wdmin2 445 ! 446 ll_tmp2 = ABS( ssh(ji+1,jj,Nnn) - ssh(ji,jj,Nnn) ) > 1.E-12 .AND. & 447 & MAX( ssh(ji+1,jj,Nnn) , ssh(ji,jj,Nnn) ) > & 448 & MAX(-ht_0(ji+1,jj) , -ht_0(ji,jj) ) + rn_wdmin1 + rn_wdmin2 449 449 IF(ll_tmp1) THEN 450 450 zcpx(ji,jj) = 1.0_wp 451 451 ELSEIF(ll_tmp2) THEN 452 ! no worries about ssh n(ji+1,jj) - sshn(ji ,jj) = 0, it won't happen ! here453 zcpx(ji,jj) = ABS( (sshn(ji+1,jj) + ht_0(ji+1,jj) - sshn(ji,jj) - ht_0(ji,jj))&454 & / (sshn(ji+1,jj) - sshn(ji ,jj)))452 ! no worries about ssh(ji+1,jj,Nnn) - ssh(ji,jj,Nnn) = 0, it won't happen ! here 453 zcpx(ji,jj) = ABS( ( ssh(ji+1,jj,Nnn) + ht_0(ji+1,jj) - ssh(ji,jj,Nnn) - ht_0(ji,jj) ) & 454 & / ( ssh(ji+1,jj,Nnn) - ssh(ji,jj,Nnn) ) ) 455 455 zcpx(ji,jj) = MAX( 0._wp , MIN( zcpx(ji,jj) , 1._wp ) ) 456 456 ELSE … … 458 458 ENDIF 459 459 ! 460 ll_tmp1 = MIN( ssh n(ji,jj) , sshn(ji,jj+1) ) >&461 & MAX( -ht_0(ji,jj) , -ht_0(ji,jj+1) ) .AND.&462 & MAX( ssh n(ji,jj) + ht_0(ji,jj) , sshn(ji,jj+1) + ht_0(ji,jj+1) ) &463 & > rn_wdmin1 + rn_wdmin2464 ll_tmp2 = ( ABS( sshn(ji,jj) - sshn(ji,jj+1)) > 1.E-12 ).AND.(&465 & MAX( sshn(ji,jj) , sshn(ji,jj+1) ) >&466 & MAX( -ht_0(ji,jj) , -ht_0(ji,jj+1)) + rn_wdmin1 + rn_wdmin2 )460 ll_tmp1 = MIN( ssh(ji,jj,Nnn) , ssh(ji,jj+1,Nnn) ) > & 461 & MAX( - ht_0(ji,jj) , - ht_0(ji,jj+1) ) .AND. & 462 & MAX( ssh(ji,jj,Nnn) + ht_0(ji,jj) , ssh(ji,jj+1,Nnn) + ht_0(ji,jj+1) ) > rn_wdmin1 + rn_wdmin2 463 ! 464 ll_tmp2 = ABS( ssh(ji,jj,Nnn) - ssh(ji,jj+1,Nnn) ) > 1.E-12 .AND. & 465 & MAX( ssh(ji,jj,Nnn) , ssh(ji,jj+1,Nnn) ) > & 466 & ( MAX(-ht_0(ji,jj) ,-ht_0(ji,jj+1) ) + rn_wdmin1 + rn_wdmin2 ) 467 467 468 468 IF(ll_tmp1) THEN 469 469 zcpy(ji,jj) = 1.0_wp 470 470 ELSE IF(ll_tmp2) THEN 471 ! no worries about sshn(ji,jj+1) - sshn(ji,jj) = 0, it won't happen ! here472 zcpy(ji,jj) = ABS( ( sshn(ji,jj+1) + ht_0(ji,jj+1) - sshn(ji,jj) - ht_0(ji,jj))&473 & / ( sshn(ji,jj+1) - sshn(ji,jj )))471 ! no worries about ssh(ji,jj+1,Nnn) - ssh(ji,jj ,Nnn) = 0, it won't happen ! here 472 zcpy(ji,jj) = ABS( ( ssh(ji,jj+1,Nnn) + ht_0(ji,jj+1) - ssh(ji,jj,Nnn) - ht_0(ji,jj) ) & 473 & / ( ssh(ji,jj+1,Nnn) - ssh(ji,jj,Nnn) ) ) 474 474 zcpy(ji,jj) = MAX( 0._wp , MIN( zcpy(ji,jj) , 1.0_wp ) ) 475 475 ELSE … … 481 481 DO jj = 2, jpjm1 482 482 DO ji = 2, jpim1 483 zu_trd(ji,jj) = zu_trd(ji,jj) - grav * ( ssh n(ji+1,jj ) - sshn(ji ,jj) ) &483 zu_trd(ji,jj) = zu_trd(ji,jj) - grav * ( ssh(ji+1,jj,Nnn) - ssh(ji,jj,Nnn) ) & 484 484 & * r1_e1u(ji,jj) * zcpx(ji,jj) * wdrampu(ji,jj) !jth 485 zv_trd(ji,jj) = zv_trd(ji,jj) - grav * ( ssh n(ji ,jj+1) - sshn(ji ,jj) ) &485 zv_trd(ji,jj) = zv_trd(ji,jj) - grav * ( ssh(ji,jj+1,Nnn) - ssh(ji,jj,Nnn) ) & 486 486 & * r1_e2v(ji,jj) * zcpy(ji,jj) * wdrampv(ji,jj) !jth 487 487 END DO … … 492 492 DO jj = 2, jpjm1 493 493 DO ji = fs_2, fs_jpim1 ! vector opt. 494 zu_trd(ji,jj) = zu_trd(ji,jj) - grav * ( ssh n(ji+1,jj ) - sshn(ji ,jj) ) * r1_e1u(ji,jj)495 zv_trd(ji,jj) = zv_trd(ji,jj) - grav * ( ssh n(ji ,jj+1) - sshn(ji ,jj) ) * r1_e2v(ji,jj)494 zu_trd(ji,jj) = zu_trd(ji,jj) - grav * ( ssh(ji+1,jj,Nnn) - ssh(ji,jj,Nnn) ) * r1_e1u(ji,jj) 495 zv_trd(ji,jj) = zv_trd(ji,jj) - grav * ( ssh(ji,jj+1,Nnn) - ssh(ji,jj,Nnn) ) * r1_e2v(ji,jj) 496 496 END DO 497 497 END DO … … 665 665 ! 666 666 IF (ln_bt_fw) THEN ! FORWARD integration: start from NOW fields 667 sshn_e(:,:) = ssh n(:,:)667 sshn_e(:,:) = ssh (:,:,Nnn) 668 668 un_e (:,:) = un_b(:,:) 669 669 vn_e (:,:) = vn_b(:,:) … … 674 674 hvr_e (:,:) = r1_hv_n(:,:) 675 675 ELSE ! CENTRED integration: start from BEFORE fields 676 sshn_e(:,:) = ssh b(:,:)676 sshn_e(:,:) = ssh (:,:,Nbb) 677 677 un_e (:,:) = ub_b(:,:) 678 678 vn_e (:,:) = vb_b(:,:) … … 687 687 ! 688 688 ! Initialize sums: 689 ua_b (:,:) = 0._wp ! After barotropic velocities (or transport if flux form)690 va_b (:,:) = 0._wp691 ssh a (:,:) = 0._wp ! Sum for after averaged sea level692 un_adv(:,:) = 0._wp ! Sum for now transport issued from ts loop693 vn_adv(:,:) = 0._wp689 ua_b (:,:) = 0._wp ! After barotropic velocities (or transport if flux form) 690 va_b (:,:) = 0._wp 691 ssh (:,:,Naa) = 0._wp ! Sum for after averaged sea level 692 un_adv(:,:) = 0._wp ! Sum for now transport issued from ts loop 693 vn_adv(:,:) = 0._wp 694 694 ! 695 695 IF( ln_wd_dl ) THEN … … 1185 1185 ENDIF 1186 1186 ! ! Sum sea level 1187 ssh a(:,:) = ssha(:,:) + za1 * ssha_e(:,:)1187 ssh(:,:,Naa) = ssh(:,:,Naa) + za1 * ssha_e(:,:) 1188 1188 1189 1189 ! ! ==================== ! … … 1223 1223 END DO 1224 1224 ELSE 1225 ! At this stage, ssha has been corrected: compute new depths at velocity points 1225 ! At this stage, ssh(Naa) has been corrected: compute new depths at velocity points 1226 !!gm KE conserving expression in Vector form 1227 ! DO jj = 1, jpjm1 1228 ! DO ji = 1, jpim1 ! NO Vector Opt. 1229 ! zsshu_a(ji,jj) = r1_2 * ssumask(ji,jj) * r1_e1e2u(ji,jj) * ( e1e2t(ji ,jj) * ssh(ji ,jj,Naa) & 1230 ! & + e1e2t(ji+1,jj) * ssh(ji+1,jj,Naa) ) 1231 ! zsshv_a(ji,jj) = r1_2 * ssvmask(ji,jj) * r1_e1e2v(ji,jj) * ( e1e2t(ji,jj ) * ssh(ji,jj ,Naa) & 1232 ! & + e1e2t(ji,jj+1) * ssh(ji,jj+1,Naa) ) 1233 ! END DO 1234 ! END DO 1235 !! replace by the KE conserving expression in flux form 1226 1236 DO jj = 1, jpjm1 1227 1237 DO ji = 1, jpim1 ! NO Vector Opt. 1228 zsshu_a(ji,jj) = r1_2 * ssumask(ji,jj) * r1_e1e2u(ji,jj) * ( e1e2t(ji ,jj) * ssha(ji ,jj) & 1229 & + e1e2t(ji+1,jj) * ssha(ji+1,jj) ) 1230 zsshv_a(ji,jj) = r1_2 * ssvmask(ji,jj) * r1_e1e2v(ji,jj) * ( e1e2t(ji,jj ) * ssha(ji,jj ) & 1231 & + e1e2t(ji,jj+1) * ssha(ji,jj+1) ) 1232 END DO 1233 END DO 1238 zsshu_a(ji,jj) = r1_2 * ( ssh(ji,jj,Naa) + ssh(ji+1,jj,Naa) ) * ssumask(ji,jj) 1239 zsshv_a(ji,jj) = r1_2 * ( ssh(ji,jj,Naa) + ssh(ji,jj+1,Naa) ) * ssvmask(ji,jj) 1240 END DO 1241 END DO 1242 !!gm end 1234 1243 CALL lbc_lnk_multi( zsshu_a, 'U', 1._wp, zsshv_a, 'V', 1._wp ) ! Boundary conditions 1235 1244 ! 1236 DO jk =1,jpkm11245 DO jk = 1, jpkm1 1237 1246 ua(:,:,jk) = ua(:,:,jk) + r1_hu_n(:,:) * ( ua_b(:,:) - ub_b(:,:) * hu_b(:,:) ) * r1_Dt 1238 1247 va(:,:,jk) = va(:,:,jk) + r1_hv_n(:,:) * ( va_b(:,:) - vb_b(:,:) * hv_b(:,:) ) * r1_Dt
Note: See TracChangeset
for help on using the changeset viewer.
