- Timestamp:
- 2020-10-21T14:37:33+02:00 (3 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/UKMO/NEMO_4.0.2_momentum_trends/src/OCE/DYN/dynspg_ts.F90
r12658 r13652 61 61 USE iom ! IOM library 62 62 USE restart ! only for lrst_oce 63 USE trd_oce ! trends: ocean variables 64 USE trddyn ! trend manager: dynamics 63 65 64 66 USE iom ! to remove … … 150 152 REAL(wp) :: r1_2dt_b, z1_hu, z1_hv ! local scalars 151 153 REAL(wp) :: za0, za1, za2, za3 ! - - 152 REAL(wp) :: z ztmp, zldg ! - -154 REAL(wp) :: zmdi, zztmp, zldg ! - - 153 155 REAL(wp) :: zhu_bck, zhv_bck, zhdiv ! - - 154 156 REAL(wp) :: zun_save, zvn_save ! - - … … 168 170 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: ztwdmask, zuwdmask, zvwdmask ! ROMS wetting and drying masks at t,u,v points 169 171 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zuwdav2, zvwdav2 ! averages over the sub-steps of zuwdmask and zvwdmask 172 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zspgtrdu, zspgtrdv, zpvotrdu, zpvotrdv ! SPG and PVO trends (if l_trddyn) 173 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: ztautrdu, ztautrdv, zbfrtrdu, zbfrtrdv ! TAU and BFR trends (if l_trddyn) 170 174 !!---------------------------------------------------------------------- 171 175 ! … … 173 177 ! !* Allocate temporary arrays 174 178 IF( ln_wd_dl ) ALLOCATE( ztwdmask(jpi,jpj), zuwdmask(jpi,jpj), zvwdmask(jpi,jpj), zuwdav2(jpi,jpj), zvwdav2(jpi,jpj)) 179 ! 180 IF( l_trddyn ) THEN 181 ALLOCATE( zspgtrdu(jpi,jpj), zspgtrdv(jpi,jpj), zpvotrdu(jpi,jpj), zpvotrdv(jpi,jpj), & 182 & ztautrdu(jpi,jpj), ztautrdv(jpi,jpj), zbfrtrdu(jpi,jpj), zbfrtrdv(jpi,jpj) ) 183 zspgtrdu(:,:) = 0._wp 184 zspgtrdv(:,:) = 0._wp 185 zpvotrdu(:,:) = 0._wp 186 zpvotrdv(:,:) = 0._wp 187 ztautrdu(:,:) = 0._wp 188 ztautrdv(:,:) = 0._wp 189 zbfrtrdu(:,:) = 0._wp 190 zbfrtrdv(:,:) = 0._wp 191 ENDIF 192 ! 193 zu_trd(:,:) = 0._wp 194 zv_trd(:,:) = 0._wp 195 zu_spg(:,:) = 0._wp 196 zv_spg(:,:) = 0._wp 197 ! 198 zmdi=1.e+20 ! missing data indicator for masking 175 199 ! 176 200 zwdramp = r_rn_wdmin1 ! simplest ramp … … 249 273 & zu_trd, zv_trd ) ! ==>> out 250 274 ! 275 IF( l_trddyn ) THEN 276 ! send correction to baroclinic planetary vorticity trend to trd_dyn 277 CALL trd_dyn( zu_trd, zv_trd, jpdyn_pvo_corr, kt ) 278 ENDIF 279 ! 251 280 IF( .NOT.ln_linssh ) THEN !* surface pressure gradient (variable volume only) 281 ! 282 IF( l_trddyn ) THEN 283 zspgtrdu(:,:) = zu_trd(:,:) 284 zspgtrdv(:,:) = zv_trd(:,:) 285 ENDIF 252 286 ! 253 287 IF( ln_wd_il ) THEN ! W/D : limiter applied to spgspg … … 270 304 ENDIF 271 305 ! 306 IF( l_trddyn ) THEN 307 zspgtrdu(:,:) = zu_trd(:,:) - zspgtrdu(:,:) 308 zspgtrdv(:,:) = zv_trd(:,:) - zspgtrdv(:,:) 309 ! send correction to HPG trend to trd_dyn 310 CALL trd_dyn( zspgtrdu, zspgtrdv, jpdyn_hpg_corr, kt ) 311 ! reset temporary arrays for use later 312 zspgtrdu(:,:) = 0._wp 313 zspgtrdv(:,:) = 0._wp 314 ENDIF 315 ! 272 316 ENDIF 273 317 ! … … 279 323 END DO 280 324 ! 325 IF( l_trddyn ) THEN 326 zbfrtrdu(:,:) = zu_frc(:,:) 327 zbfrtrdv(:,:) = zv_frc(:,:) 328 ENDIF 281 329 ! != Add bottom stress contribution from baroclinic velocities =! 282 330 ! ! ----------------------------------------------------------- ! 283 331 CALL dyn_drg_init( zu_frc, zv_frc, zCdU_u, zCdU_v ) ! also provide the barotropic drag coefficients 332 ! 333 IF( l_trddyn ) THEN 334 ! bottom friction trend diagnostic: bottom friction due to baroclinic currents 335 zbfrtrdu(:,:) = zu_frc(:,:) - zbfrtrdu(:,:) 336 zbfrtrdv(:,:) = zv_frc(:,:) - zbfrtrdv(:,:) 337 ENDIF 284 338 ! 285 339 ! != Add atmospheric pressure forcing =! … … 308 362 ! != Add atmospheric pressure forcing =! 309 363 ! ! ---------------------------------- ! 364 IF( l_trddyn ) THEN 365 ztautrdu(:,:) = zu_frc(:,:) 366 ztautrdv(:,:) = zv_frc(:,:) 367 ENDIF 368 ! 310 369 IF( ln_bt_fw ) THEN ! Add wind forcing 311 370 DO jj = 2, jpjm1 … … 325 384 ENDIF 326 385 ! 386 IF( l_trddyn ) THEN 387 ! wind stress trend diagnostic 388 ztautrdu(:,:) = zu_frc(:,:) - ztautrdu(:,:) 389 ztautrdv(:,:) = zv_frc(:,:) - ztautrdv(:,:) 390 ENDIF 327 391 ! !----------------! 328 392 ! !== sssh_frc ==! Right-Hand-Side of the barotropic ssh equation (over the FULL domain) … … 587 651 ENDIF 588 652 ! 653 IF( l_trddyn ) THEN 654 za2 = wgtbtp2(jn) 655 zspgtrdu(:,:) = zspgtrdu(:,:) + za2 * zu_spg(:,:) * ssumask(:,:) 656 zspgtrdv(:,:) = zspgtrdv(:,:) + za2 * zv_spg(:,:) * ssvmask(:,:) 657 ENDIF 658 ! 589 659 ! Add Coriolis trend: 590 660 ! zwz array below or triads normally depend on sea level with ln_linssh=F and should be updated … … 592 662 ! Recall that zhU and zhV hold fluxes at jn+0.5 (extrapolated not backward interpolated) 593 663 CALL dyn_cor_2d( zhup2_e, zhvp2_e, ua_e, va_e, zhU, zhV, zu_trd, zv_trd ) 664 ! 665 IF( l_trddyn ) THEN 666 za2 = wgtbtp2(jn) 667 zpvotrdu(:,:) = zpvotrdu(:,:) + za2 * zu_trd(:,:) * ssumask(:,:) 668 zpvotrdv(:,:) = zpvotrdv(:,:) + za2 * zv_trd(:,:) * ssvmask(:,:) 669 ENDIF 594 670 ! 595 671 ! Add tidal astronomical forcing if defined … … 612 688 END DO 613 689 END DO 690 IF( l_trddyn ) THEN 691 za2 = wgtbtp2(jn) 692 zbfrtrdu(:,:) = zbfrtrdu(:,:) + za2 * zCdU_u(:,:) * un_e(:,:) * hur_e(:,:) 693 zbfrtrdv(:,:) = zbfrtrdv(:,:) + za2 * zCdU_v(:,:) * vn_e(:,:) * hvr_e(:,:) 694 ENDIF 614 695 ENDIF 615 696 ! … … 834 915 IF( ln_wd_dl ) DEALLOCATE( ztwdmask, zuwdmask, zvwdmask, zuwdav2, zvwdav2 ) 835 916 ! 836 CALL iom_put( "baro_u" , un_b ) ! Barotropic U Velocity 837 CALL iom_put( "baro_v" , vn_b ) ! Barotropic V Velocity 917 IF( l_trddyn ) THEN 918 CALL trd_dyn( zspgtrdu, zspgtrdv, jpdyn_spg, kt ) 919 CALL trd_dyn( zpvotrdu, zpvotrdv, jpdyn_pvo, kt ) 920 CALL trd_dyn( ztautrdu, ztautrdv, jpdyn_tau, kt ) 921 CALL trd_dyn( zbfrtrdu, zbfrtrdv, jpdyn_bfr, kt ) 922 DEALLOCATE( zspgtrdu, zspgtrdv, zpvotrdu, zpvotrdv, ztautrdu, ztautrdv, zbfrtrdu, zbfrtrdv ) 923 ENDIF 924 ! 925 CALL iom_put( "baro_u" , un_b*ssumask(:,:)+zmdi*(1.-ssumask(:,:) ) ) ! Barotropic U Velocity 926 CALL iom_put( "baro_v" , vn_b*ssvmask(:,:)+zmdi*(1.-ssvmask(:,:) ) ) ! Barotropic V Velocity 838 927 ! 839 928 END SUBROUTINE dyn_spg_ts
Note: See TracChangeset
for help on using the changeset viewer.
