Changeset 2338 for branches/nemo_v3_3_beta
- Timestamp:
- 2010-10-29T10:45:18+02:00 (14 years ago)
- Location:
- branches/nemo_v3_3_beta/NEMOGCM/NEMO/OPA_SRC/DYN
- Files:
-
- 2 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/nemo_v3_3_beta/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg.F90
r2287 r2338 19 19 USE dynspg_ts ! surface pressure gradient (dyn_spg_ts routine) 20 20 USE dynspg_flt ! surface pressure gradient (dyn_spg_flt routine) 21 USE dynadv ! dynamics: vector invariant versus flux form 21 22 USE trdmod ! ocean dynamics trends 22 23 USE trdmod_oce ! ocean variables trends … … 167 168 ENDIF 168 169 170 ! ! Control of momentum forulation 171 IF( lk_dynspg_ts .AND. lk_vvl ) THEN 172 IF( .NOT. ln_dynadv_vec ) & 173 & CALL ctl_stop( ' Flux formulae not implemented for this free surface formulation ' ) 174 ENDIF 175 169 176 #if defined key_obc 170 177 ! ! Conservation of ocean volume (key_dynspg_flt) -
branches/nemo_v3_3_beta/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_ts.F90
r2305 r2338 51 51 REAL(wp), DIMENSION(jpi,jpj) :: ftsw, ftse ! (only used with een vorticity scheme) 52 52 53 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 54 56 55 57 !! * Substitutions … … 82 84 !! momentum and continuity integration. Barotropic former 83 85 !! variables are time averaging over the full barotropic cycle 84 !! (= 2 * baroclinic time step) and saved in zuX_b85 !! 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). 86 88 !! -3- The new general trend becomes : 87 !! ua = ua - sum_k(ua)/H + ( u a_e - sum_k(ub))89 !! ua = ua - sum_k(ua)/H + ( un_b - ub_b ) 88 90 !! 89 91 !! ** Action : - Update (ua,va) with the surf. pressure gradient trend … … 109 111 REAL(wp), DIMENSION(jpi,jpj) :: zsshun_e, zsshvn_e ! 2D workspace 110 112 !! 111 REAL(wp), DIMENSION(jpi,jpj) :: zcu, zwx, zua, zun , zub! 2D workspace112 REAL(wp), DIMENSION(jpi,jpj) :: zcv, zwy, zva, zvn , zvb! - -113 REAL(wp), DIMENSION(jpi,jpj) :: zcu, zwx, zua, zun ! 2D workspace 114 REAL(wp), DIMENSION(jpi,jpj) :: zcv, zwy, zva, zvn ! - - 113 115 REAL(wp), DIMENSION(jpi,jpj) :: zun_e, zub_e, zu_sum ! 2D workspace 114 116 REAL(wp), DIMENSION(jpi,jpj) :: zvn_e, zvb_e, zv_sum ! - - … … 161 163 ! !* e3*d/dt(Ua), e3*Ub, e3*Vn (Vertically integrated) 162 164 ! ! -------------------------- 163 zua(:,:) = 0.e0 ; zun(:,:) = 0.e0 ; zub(:,:) = 0.e0164 zva(:,:) = 0.e0 ; zvn(:,:) = 0.e0 ; zvb(:,:) = 0.e0165 zua(:,:) = 0.e0 ; zun(:,:) = 0.e0 166 zva(:,:) = 0.e0 ; zvn(:,:) = 0.e0 165 167 ! 166 168 DO jk = 1, jpkm1 … … 178 180 zun(ji,jj) = zun(ji,jj) + fse3u (ji,jj,jk) * un(ji,jj,jk) 179 181 zvn(ji,jj) = zvn(ji,jj) + fse3v (ji,jj,jk) * vn(ji,jj,jk) 180 ! ! before velocity181 zub(ji,jj) = zub(ji,jj) + fse3u_b(ji,jj,jk) * ub(ji,jj,jk)182 zvb(ji,jj) = zvb(ji,jj) + fse3v_b(ji,jj,jk) * vb(ji,jj,jk)183 182 END DO 184 183 END DO … … 280 279 DO jj = 2, jpjm1 281 280 DO ji = fs_2, fs_jpim1 ! vector opt. 282 zua(ji,jj) = zua(ji,jj) - zbfru(ji,jj) * zub(ji,jj) &281 zua(ji,jj) = zua(ji,jj) - zbfru(ji,jj) * ub_b(ji,jj) & 283 282 & / ( hu_0(ji,jj) + sshu_b(ji,jj) + 1.e0 - umask(ji,jj,1) ) 284 zva(ji,jj) = zva(ji,jj) - zbfrv(ji,jj) * zvb(ji,jj) &283 zva(ji,jj) = zva(ji,jj) - zbfrv(ji,jj) * vb_b(ji,jj) & 285 284 & / ( hv_0(ji,jj) + sshv_b(ji,jj) + 1.e0 - vmask(ji,jj,1) ) 286 285 END DO … … 289 288 DO jj = 2, jpjm1 290 289 DO ji = fs_2, fs_jpim1 ! vector opt. 291 zua(ji,jj) = zua(ji,jj) - zbfru(ji,jj) * zub(ji,jj) * hur(ji,jj)292 zva(ji,jj) = zva(ji,jj) - zbfrv(ji,jj) * zvb(ji,jj) * hvr(ji,jj)290 zua(ji,jj) = zua(ji,jj) - zbfru(ji,jj) * ub_b(ji,jj) * hur(ji,jj) 291 zva(ji,jj) = zva(ji,jj) - zbfrv(ji,jj) * vb_b(ji,jj) * hvr(ji,jj) 293 292 END DO 294 293 END DO … … 300 299 zva(:,:) = zva(:,:) * hvr(:,:) 301 300 ! 302 IF( lk_vvl ) THEN303 zub(:,:) = zub(:,:) * umask(:,:,1) / ( hu_0(:,:) + sshu_b(:,:) + 1.e0 - umask(:,:,1) )304 zvb(:,:) = zvb(:,:) * vmask(:,:,1) / ( hv_0(:,:) + sshv_b(:,:) + 1.e0 - vmask(:,:,1) )305 ELSE306 zub(:,:) = zub(:,:) * hur(:,:)307 zvb(:,:) = zvb(:,:) * hvr(:,:)308 ENDIF309 301 310 302 ! ----------------------------------------------------------------------- … … 352 344 ! !* Update the forcing (OBC, BDY and tides) 353 345 ! ! ------------------ 354 IF( lk_obc ) CALL obc_dta_bt ( kt, jn )346 IF( lk_obc ) CALL obc_dta_bt ( kt, jn ) 355 347 IF( lk_bdy ) CALL bdy_dta_fla( kt, jn+1, icycle ) 356 348 … … 476 468 ! ! - Correct the velocity 477 469 478 IF( lk_obc 479 IF( lk_bdy .OR. ln_ bdy_tides ) CALL bdy_dyn_fla( sshn_e )470 IF( lk_obc ) CALL obc_fla_ts 471 IF( lk_bdy .OR. ln_tides ) CALL bdy_dyn_fla( sshn_e ) 480 472 ! 481 473 CALL lbc_lnk( ua_e , 'U', -1. ) ! local domain boundaries … … 543 535 ! !* Time average ==> after barotropic u, v, ssh 544 536 zcoef = 1.e0 / ( 2 * nn_baro + 1 ) 545 un_b (:,:) = zcoef * zu_sum (:,:) 546 vn_b (:,:) = zcoef * zv_sum (:,:) 547 sshn_b(:,:) = zcoef * zssh_sum(:,:) 537 zu_sum(:,:) = zcoef * zu_sum (:,:) 538 zv_sum(:,:) = zcoef * zv_sum (:,:) 548 539 ! 549 540 ! !* update the general momentum trend 550 541 DO jk=1,jpkm1 551 ua(:,:,jk) = ua(:,:,jk) + ( un_b(:,:) - zub(:,:) ) / z2dt_b552 va(:,:,jk) = va(:,:,jk) + ( vn_b(:,:) - zvb(:,:) ) / z2dt_b542 ua(:,:,jk) = ua(:,:,jk) + ( zu_sum(:,:) - ub_b(:,:) ) / z2dt_b 543 va(:,:,jk) = va(:,:,jk) + ( zv_sum(:,:) - vb_b(:,:) ) / z2dt_b 553 544 END DO 545 ub_b (:,:) = un_b(:,:) 546 vb_b (:,:) = vn_b(:,:) 547 un_b (:,:) = zu_sum(:,:) 548 vn_b (:,:) = zv_sum(:,:) 549 sshn_b(:,:) = zcoef * zssh_sum(:,:) 554 550 ! 555 551 ! !* write time-spliting arrays in the restart … … 596 592 vn_b (:,:) = vn_b(:,:) * hvr(:,:) 597 593 ENDIF 594 595 ! Vertically integrated velocity (before) 596 IF (neuler/=0) THEN 597 ub_b (:,:) = 0.e0 598 vb_b (:,:) = 0.e0 599 600 ! vertical sum 601 IF( lk_vopt_loop ) THEN ! vector opt., forced unroll 602 DO jk = 1, jpkm1 603 DO ji = 1, jpij 604 ub_b(ji,1) = ub_b(ji,1) + fse3u_b(ji,1,jk) * ub(ji,1,jk) 605 vb_b(ji,1) = vb_b(ji,1) + fse3v_b(ji,1,jk) * vb(ji,1,jk) 606 END DO 607 END DO 608 ELSE ! No vector opt. 609 DO jk = 1, jpkm1 610 ub_b(:,:) = ub_b(:,:) + fse3u_b(:,:,jk) * ub(:,:,jk) 611 vb_b(:,:) = vb_b(:,:) + fse3v_b(:,:,jk) * vb(:,:,jk) 612 END DO 613 ENDIF 614 615 IF( lk_vvl ) THEN 616 ub_b (:,:) = ub_b(:,:) * umask(:,:,1) / ( hu_0(:,:) + sshu_b(:,:) + 1.e0 - umask(:,:,1) ) 617 vb_b (:,:) = vb_b(:,:) * vmask(:,:,1) / ( hv_0(:,:) + sshv_b(:,:) + 1.e0 - vmask(:,:,1) ) 618 ELSE 619 ub_b(:,:) = ub_b(:,:) * hur(:,:) 620 vb_b(:,:) = vb_b(:,:) * hvr(:,:) 621 ENDIF 622 ELSE ! neuler==0 623 ub_b (:,:) = un_b (:,:) 624 vb_b (:,:) = vn_b (:,:) 625 ENDIF 626 598 627 IF( iom_varid( numror, 'sshn_b', ldstop = .FALSE. ) > 0 ) THEN 599 628 CALL iom_get( numror, jpdom_autoglo, 'sshn_b' , sshn_b (:,:) ) ! filtered extrenal ssh
Note: See TracChangeset
for help on using the changeset viewer.