Changeset 2528 for trunk/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_ts.F90
- Timestamp:
- 2010-12-27T18:33:53+01:00 (13 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_ts.F90
- Property svn:eol-style deleted
- Property svn:executable deleted
r2470 r2528 7 7 !! - ! 2008-01 (R. Benshila) change averaging method 8 8 !! 3.2 ! 2009-07 (R. Benshila, G. Madec) Complete revisit associated to vvl reactivation 9 !! 3.3 ! 2010-09 (D. Storkey, E. O'Dea) update for BDY for Shelf configurations 9 10 !!--------------------------------------------------------------------- 10 11 #if defined key_dynspg_ts || defined key_esopa … … 50 51 REAL(wp), DIMENSION(jpi,jpj) :: ftsw, ftse ! (only used with een vorticity scheme) 51 52 52 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: un_b, vn_b ! averaged velocity 53 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: un_b, vn_b ! now averaged velocity 54 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: ub_b, vb_b ! before averaged velocity 55 53 56 54 57 !! * Substitutions … … 56 59 # include "vectopt_loop_substitute.h90" 57 60 !!------------------------------------------------------------------------- 58 !! NEMO/OPA 3. 2 , LOCEAN-IPSL (2009)61 !! NEMO/OPA 3.3 , NEMO Consortium (2010) 59 62 !! $Id$ 60 !! Software is governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)63 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 61 64 !!------------------------------------------------------------------------- 62 65 … … 81 84 !! momentum and continuity integration. Barotropic former 82 85 !! variables are time averaging over the full barotropic cycle 83 !! (= 2 * baroclinic time step) and saved in zuX_b84 !! and zvX_b (X specifying after, now or before).86 !! (= 2 * baroclinic time step) and saved in uX_b 87 !! and vX_b (X specifying after, now or before). 85 88 !! -3- The new general trend becomes : 86 !! ua = ua - sum_k(ua)/H + ( u a_e - sum_k(ub))89 !! ua = ua - sum_k(ua)/H + ( un_b - ub_b ) 87 90 !! 88 91 !! ** Action : - Update (ua,va) with the surf. pressure gradient trend … … 93 96 !! 94 97 INTEGER :: ji, jj, jk, jn ! dummy loop indices 95 INTEGER :: icycle ! temporary integers 96 INTEGER :: ikbu, ikbv, ikbum1, ikbvm1 ! - - 98 INTEGER :: icycle ! temporary scalar 97 99 98 100 REAL(wp) :: zraur, zcoef, z2dt_e, z2dt_b ! temporary scalars … … 108 110 REAL(wp), DIMENSION(jpi,jpj) :: zsshun_e, zsshvn_e ! 2D workspace 109 111 !! 110 REAL(wp), DIMENSION(jpi,jpj) :: zcu, zwx, zua, zun , zub! 2D workspace111 REAL(wp), DIMENSION(jpi,jpj) :: zcv, zwy, zva, zvn , zvb! - -112 REAL(wp), DIMENSION(jpi,jpj) :: zcu, zwx, zua, zun ! 2D workspace 113 REAL(wp), DIMENSION(jpi,jpj) :: zcv, zwy, zva, zvn ! - - 112 114 REAL(wp), DIMENSION(jpi,jpj) :: zun_e, zub_e, zu_sum ! 2D workspace 113 115 REAL(wp), DIMENSION(jpi,jpj) :: zvn_e, zvb_e, zv_sum ! - - … … 160 162 ! !* e3*d/dt(Ua), e3*Ub, e3*Vn (Vertically integrated) 161 163 ! ! -------------------------- 162 zua(:,:) = 0.e0 ; zun(:,:) = 0.e0 ; zub(:,:) = 0.e0163 zva(:,:) = 0.e0 ; zvn(:,:) = 0.e0 ; zvb(:,:) = 0.e0164 zua(:,:) = 0.e0 ; zun(:,:) = 0.e0 165 zva(:,:) = 0.e0 ; zvn(:,:) = 0.e0 164 166 ! 165 167 DO jk = 1, jpkm1 … … 177 179 zun(ji,jj) = zun(ji,jj) + fse3u (ji,jj,jk) * un(ji,jj,jk) 178 180 zvn(ji,jj) = zvn(ji,jj) + fse3v (ji,jj,jk) * vn(ji,jj,jk) 179 ! ! before velocity180 zub(ji,jj) = zub(ji,jj) + fse3u_b(ji,jj,jk) * ub(ji,jj,jk)181 zvb(ji,jj) = zvb(ji,jj) + fse3v_b(ji,jj,jk) * vb(ji,jj,jk)182 181 END DO 183 182 END DO … … 265 264 DO ji = 2, jpim1 266 265 # endif 267 ikbu = MIN( mbathy(ji+1,jj), mbathy(ji,jj) )268 ikbv = MIN( mbathy(ji,jj+1), mbathy(ji,jj) )269 ikbum1 = MAX( ikbu-1, 1 )270 ikbvm1 = MAX( ikbv-1, 1 )271 272 !273 266 ! Apply stability criteria for bottom friction 274 !RBbug for vvl and external mode we may need to 275 ! use varying fse3276 zbfru (ji,jj) = MAX( bfrua(ji,jj), fse3u(ji,jj,ikbum1)*zcoef)277 zbfrv (ji,jj) = MAX( bfrva(ji,jj), fse3v(ji,jj,ikbvm1)*zcoef)267 !RBbug for vvl and external mode we may need to use varying fse3 268 !!gm Rq: the bottom e3 present the smallest variation, the use of e3u_0 is not a big approx. 269 zbfru(ji,jj) = MAX( bfrua(ji,jj) , fse3u(ji,jj,mbku(ji,jj)) * zcoef ) 270 zbfrv(ji,jj) = MAX( bfrva(ji,jj) , fse3v(ji,jj,mbkv(ji,jj)) * zcoef ) 278 271 END DO 279 272 END DO … … 282 275 DO jj = 2, jpjm1 283 276 DO ji = fs_2, fs_jpim1 ! vector opt. 284 zua(ji,jj) = zua(ji,jj) - zbfru(ji,jj) * zub(ji,jj) &277 zua(ji,jj) = zua(ji,jj) - zbfru(ji,jj) * ub_b(ji,jj) & 285 278 & / ( hu_0(ji,jj) + sshu_b(ji,jj) + 1.e0 - umask(ji,jj,1) ) 286 zva(ji,jj) = zva(ji,jj) - zbfrv(ji,jj) * zvb(ji,jj) &279 zva(ji,jj) = zva(ji,jj) - zbfrv(ji,jj) * vb_b(ji,jj) & 287 280 & / ( hv_0(ji,jj) + sshv_b(ji,jj) + 1.e0 - vmask(ji,jj,1) ) 288 281 END DO … … 291 284 DO jj = 2, jpjm1 292 285 DO ji = fs_2, fs_jpim1 ! vector opt. 293 zua(ji,jj) = zua(ji,jj) - zbfru(ji,jj) * zub(ji,jj) * hur(ji,jj)294 zva(ji,jj) = zva(ji,jj) - zbfrv(ji,jj) * zvb(ji,jj) * hvr(ji,jj)286 zua(ji,jj) = zua(ji,jj) - zbfru(ji,jj) * ub_b(ji,jj) * hur(ji,jj) 287 zva(ji,jj) = zva(ji,jj) - zbfrv(ji,jj) * vb_b(ji,jj) * hvr(ji,jj) 295 288 END DO 296 289 END DO … … 302 295 zva(:,:) = zva(:,:) * hvr(:,:) 303 296 ! 304 IF( lk_vvl ) THEN305 zub(:,:) = zub(:,:) * umask(:,:,1) / ( hu_0(:,:) + sshu_b(:,:) + 1.e0 - umask(:,:,1) )306 zvb(:,:) = zvb(:,:) * vmask(:,:,1) / ( hv_0(:,:) + sshv_b(:,:) + 1.e0 - vmask(:,:,1) )307 ELSE308 zub(:,:) = zub(:,:) * hur(:,:)309 zvb(:,:) = zvb(:,:) * hvr(:,:)310 ENDIF311 297 312 298 ! ----------------------------------------------------------------------- … … 354 340 ! !* Update the forcing (OBC, BDY and tides) 355 341 ! ! ------------------ 356 IF( lk_obc ) CALL obc_dta_bt( kt, jn )357 IF( lk_bdy .OR. ln_bdy_tides ) CALL bdy_dta_bt( kt, jn+1)342 IF( lk_obc ) CALL obc_dta_bt ( kt, jn ) 343 IF( lk_bdy ) CALL bdy_dta_fla( kt, jn+1, icycle ) 358 344 359 345 ! !* after ssh_e … … 382 368 DO jj = 2, jpjm1 ! leap-frog on ssh_e 383 369 DO ji = fs_2, fs_jpim1 ! vector opt. 384 ssha_e(ji,jj) = ( zsshb_e(ji,jj) - z2dt_e * ( zraur * emp(ji,jj) + zhdiv(ji,jj) ) ) * tmask(ji,jj,1)370 ssha_e(ji,jj) = ( zsshb_e(ji,jj) - z2dt_e * ( zraur * ( emp(ji,jj)-rnf(ji,jj) ) + zhdiv(ji,jj) ) ) * tmask(ji,jj,1) 385 371 END DO 386 372 END DO … … 478 464 ! ! - Correct the velocity 479 465 480 IF( lk_obc 481 IF( lk_bdy .OR. ln_ bdy_tides ) CALL bdy_dyn_fla( sshn_e )466 IF( lk_obc ) CALL obc_fla_ts 467 IF( lk_bdy .OR. ln_tides ) CALL bdy_dyn_fla( sshn_e ) 482 468 ! 483 469 CALL lbc_lnk( ua_e , 'U', -1. ) ! local domain boundaries … … 545 531 ! !* Time average ==> after barotropic u, v, ssh 546 532 zcoef = 1.e0 / ( 2 * nn_baro + 1 ) 547 un_b (:,:) = zcoef * zu_sum (:,:) 548 vn_b (:,:) = zcoef * zv_sum (:,:) 549 sshn_b(:,:) = zcoef * zssh_sum(:,:) 533 zu_sum(:,:) = zcoef * zu_sum (:,:) 534 zv_sum(:,:) = zcoef * zv_sum (:,:) 550 535 ! 551 536 ! !* update the general momentum trend 552 537 DO jk=1,jpkm1 553 ua(:,:,jk) = ua(:,:,jk) + ( un_b(:,:) - zub(:,:) ) / z2dt_b554 va(:,:,jk) = va(:,:,jk) + ( vn_b(:,:) - zvb(:,:) ) / z2dt_b538 ua(:,:,jk) = ua(:,:,jk) + ( zu_sum(:,:) - ub_b(:,:) ) / z2dt_b 539 va(:,:,jk) = va(:,:,jk) + ( zv_sum(:,:) - vb_b(:,:) ) / z2dt_b 555 540 END DO 541 ub_b (:,:) = un_b(:,:) 542 vb_b (:,:) = vn_b(:,:) 543 un_b (:,:) = zu_sum(:,:) 544 vn_b (:,:) = zv_sum(:,:) 545 sshn_b(:,:) = zcoef * zssh_sum(:,:) 556 546 ! 557 547 ! !* write time-spliting arrays in the restart … … 598 588 vn_b (:,:) = vn_b(:,:) * hvr(:,:) 599 589 ENDIF 590 591 ! Vertically integrated velocity (before) 592 IF (neuler/=0) THEN 593 ub_b (:,:) = 0.e0 594 vb_b (:,:) = 0.e0 595 596 ! vertical sum 597 IF( lk_vopt_loop ) THEN ! vector opt., forced unroll 598 DO jk = 1, jpkm1 599 DO ji = 1, jpij 600 ub_b(ji,1) = ub_b(ji,1) + fse3u_b(ji,1,jk) * ub(ji,1,jk) 601 vb_b(ji,1) = vb_b(ji,1) + fse3v_b(ji,1,jk) * vb(ji,1,jk) 602 END DO 603 END DO 604 ELSE ! No vector opt. 605 DO jk = 1, jpkm1 606 ub_b(:,:) = ub_b(:,:) + fse3u_b(:,:,jk) * ub(:,:,jk) 607 vb_b(:,:) = vb_b(:,:) + fse3v_b(:,:,jk) * vb(:,:,jk) 608 END DO 609 ENDIF 610 611 IF( lk_vvl ) THEN 612 ub_b (:,:) = ub_b(:,:) * umask(:,:,1) / ( hu_0(:,:) + sshu_b(:,:) + 1.e0 - umask(:,:,1) ) 613 vb_b (:,:) = vb_b(:,:) * vmask(:,:,1) / ( hv_0(:,:) + sshv_b(:,:) + 1.e0 - vmask(:,:,1) ) 614 ELSE 615 ub_b(:,:) = ub_b(:,:) * hur(:,:) 616 vb_b(:,:) = vb_b(:,:) * hvr(:,:) 617 ENDIF 618 ELSE ! neuler==0 619 ub_b (:,:) = un_b (:,:) 620 vb_b (:,:) = vn_b (:,:) 621 ENDIF 622 600 623 IF( iom_varid( numror, 'sshn_b', ldstop = .FALSE. ) > 0 ) THEN 601 624 CALL iom_get( numror, jpdom_autoglo, 'sshn_b' , sshn_b (:,:) ) ! filtered extrenal ssh
Note: See TracChangeset
for help on using the changeset viewer.
