Changeset 13237 for NEMO/trunk/src/OCE/DYN/sshwzv.F90
- Timestamp:
- 2020-07-03T11:12:53+02:00 (4 years ago)
- File:
-
- 1 edited
-
NEMO/trunk/src/OCE/DYN/sshwzv.F90 (modified) (13 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/trunk/src/OCE/DYN/sshwzv.F90
r13226 r13237 50 50 !! * Substitutions 51 51 # include "do_loop_substitute.h90" 52 # include "domzgr_substitute.h90" 53 52 54 !!---------------------------------------------------------------------- 53 55 !! NEMO/OCE 4.0 , NEMO Consortium (2018) … … 110 112 ! 111 113 #if defined key_agrif 112 Kbb_a = Kbb; Kmm_a = Kmm; Krhs_a = Kaa; CALL agrif_ssh( kt ) 114 Kbb_a = Kbb ; Kmm_a = Kmm ; Krhs_a = Kaa 115 CALL agrif_ssh( kt ) 113 116 #endif 114 117 ! … … 130 133 131 134 132 SUBROUTINE wzv( kt, Kbb, Kmm, pww, Kaa)135 SUBROUTINE wzv( kt, Kbb, Kmm, Kaa, pww ) 133 136 !!---------------------------------------------------------------------- 134 137 !! *** ROUTINE wzv *** … … 147 150 INTEGER , INTENT(in) :: kt ! time step 148 151 INTEGER , INTENT(in) :: Kbb, Kmm, Kaa ! time level indices 149 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: pww ! now vertical velocity152 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: pww ! vertical velocity at Kmm 150 153 ! 151 154 INTEGER :: ji, jj, jk ! dummy loop indices … … 166 169 ! !------------------------------! 167 170 ! 168 IF( ln_vvl_ztilde .OR. ln_vvl_layer ) THEN ! z_tilde and layer cases 171 ! !===============================! 172 IF( ln_vvl_ztilde .OR. ln_vvl_layer ) THEN !== z_tilde and layer cases ==! 173 ! !===============================! 169 174 ALLOCATE( zhdiv(jpi,jpj,jpk) ) 170 175 ! … … 181 186 DO jk = jpkm1, 1, -1 ! integrate from the bottom the hor. divergence 182 187 ! computation of w 183 pww(:,:,jk) = pww(:,:,jk+1) - ( e3t(:,:,jk,Kmm) * hdiv(:,:,jk) + zhdiv(:,:,jk) & 184 & + r1_Dt * ( e3t(:,:,jk,Kaa) - e3t(:,:,jk,Kbb) ) ) * tmask(:,:,jk) 188 pww(:,:,jk) = pww(:,:,jk+1) - ( e3t(:,:,jk,Kmm) * hdiv(:,:,jk) & 189 & + zhdiv(:,:,jk) & 190 & + r1_Dt * ( e3t(:,:,jk,Kaa) & 191 & - e3t(:,:,jk,Kbb) ) ) * tmask(:,:,jk) 185 192 END DO 186 193 ! IF( ln_vvl_layer ) pww(:,:,:) = 0.e0 187 194 DEALLOCATE( zhdiv ) 188 ELSE ! z_star and linear free surface cases 195 ! !=================================! 196 ELSEIF( ln_linssh ) THEN !== linear free surface cases ==! 197 ! !=================================! 198 DO jk = jpkm1, 1, -1 ! integrate from the bottom the hor. divergence 199 pww(:,:,jk) = pww(:,:,jk+1) - ( e3t(:,:,jk,Kmm) * hdiv(:,:,jk) ) * tmask(:,:,jk) 200 END DO 201 ! !==========================================! 202 ELSE !== Quasi-Eulerian vertical coordinate ==! ('key_qco') 203 ! !==========================================! 189 204 DO jk = jpkm1, 1, -1 ! integrate from the bottom the hor. divergence 190 ! computation of w191 205 pww(:,:,jk) = pww(:,:,jk+1) - ( e3t(:,:,jk,Kmm) * hdiv(:,:,jk) & 192 & + r1_Dt * ( e3t(:,:,jk,Kaa) - e3t(:,:,jk,Kbb) ) ) * tmask(:,:,jk) 206 & + r1_Dt * ( e3t(:,:,jk,Kaa) & 207 & - e3t(:,:,jk,Kbb) ) ) * tmask(:,:,jk) 193 208 END DO 194 209 ENDIF … … 248 263 249 264 250 SUBROUTINE ssh_atf( kt, Kbb, Kmm, Kaa, pssh )265 SUBROUTINE ssh_atf( kt, Kbb, Kmm, Kaa, pssh, pssh_f ) 251 266 !!---------------------------------------------------------------------- 252 267 !! *** ROUTINE ssh_atf *** … … 265 280 INTEGER , INTENT(in ) :: kt ! ocean time-step index 266 281 INTEGER , INTENT(in ) :: Kbb, Kmm, Kaa ! ocean time level indices 267 REAL(wp), DIMENSION(jpi,jpj,jpt), INTENT(inout) :: pssh ! SSH field 282 REAL(wp), DIMENSION(jpi,jpj,jpt) , TARGET, INTENT(inout) :: pssh ! SSH field 283 REAL(wp), DIMENSION(jpi,jpj ), OPTIONAL, TARGET, INTENT( out) :: pssh_f ! filtered SSH field 268 284 ! 269 285 REAL(wp) :: zcoef ! local scalar 286 REAL(wp), POINTER, DIMENSION(:,:) :: zssh ! pointer for filtered SSH 270 287 !!---------------------------------------------------------------------- 271 288 ! … … 279 296 ! !== Euler time-stepping: no filter, just swap ==! 280 297 IF ( .NOT.( l_1st_euler ) ) THEN ! Only do time filtering for leapfrog timesteps 298 IF( PRESENT( pssh_f ) ) THEN ; zssh => pssh_f 299 ELSE ; zssh => pssh(:,:,Kmm) 300 ENDIF 281 301 ! ! filtered "now" field 282 302 pssh(:,:,Kmm) = pssh(:,:,Kmm) + rn_atfp * ( pssh(:,:,Kbb) - 2 * pssh(:,:,Kmm) + pssh(:,:,Kaa) ) … … 300 320 END SUBROUTINE ssh_atf 301 321 322 302 323 SUBROUTINE wAimp( kt, Kmm ) 303 324 !!---------------------------------------------------------------------- … … 320 341 ! 321 342 INTEGER :: ji, jj, jk ! dummy loop indices 322 REAL(wp) :: zCu, zcff, z1_e3t 343 REAL(wp) :: zCu, zcff, z1_e3t, zdt ! local scalars 323 344 REAL(wp) , PARAMETER :: Cu_min = 0.15_wp ! local parameters 324 345 REAL(wp) , PARAMETER :: Cu_max = 0.30_wp ! local parameters … … 337 358 ! 338 359 ! Calculate Courant numbers 360 zdt = 2._wp * rn_Dt ! 2*rn_Dt and not rDt (for restartability) 339 361 IF( ln_vvl_ztilde .OR. ln_vvl_layer ) THEN 340 362 DO_3D_00_00( 1, jpkm1 ) 341 363 z1_e3t = 1._wp / e3t(ji,jj,jk,Kmm) 342 ! 2*rn_Dt and not rDt (for restartability) 343 Cu_adv(ji,jj,jk) = 2._wp * rn_Dt * ( ( MAX( ww(ji,jj,jk) , 0._wp ) - MIN( ww(ji,jj,jk+1) , 0._wp ) ) & 344 & + ( MAX( e2u(ji ,jj)*e3u(ji ,jj,jk,Kmm)*uu(ji ,jj,jk,Kmm) + un_td(ji ,jj,jk), 0._wp ) - & 345 & MIN( e2u(ji-1,jj)*e3u(ji-1,jj,jk,Kmm)*uu(ji-1,jj,jk,Kmm) + un_td(ji-1,jj,jk), 0._wp ) ) & 364 Cu_adv(ji,jj,jk) = zdt * & 365 & ( ( MAX( ww(ji,jj,jk) , 0._wp ) - MIN( ww(ji,jj,jk+1) , 0._wp ) ) & 366 & + ( MAX( e2u(ji ,jj) * e3u(ji ,jj,jk,Kmm) & 367 & * uu (ji ,jj,jk,Kmm) + un_td(ji ,jj,jk), 0._wp ) - & 368 & MIN( e2u(ji-1,jj) * e3u(ji-1,jj,jk,Kmm) & 369 & * uu (ji-1,jj,jk,Kmm) + un_td(ji-1,jj,jk), 0._wp ) ) & 346 370 & * r1_e1e2t(ji,jj) & 347 & + ( MAX( e1v(ji,jj )*e3v(ji,jj ,jk,Kmm)*vv(ji,jj ,jk,Kmm) + vn_td(ji,jj ,jk), 0._wp ) - & 348 & MIN( e1v(ji,jj-1)*e3v(ji,jj-1,jk,Kmm)*vv(ji,jj-1,jk,Kmm) + vn_td(ji,jj-1,jk), 0._wp ) ) & 371 & + ( MAX( e1v(ji,jj ) * e3v(ji,jj ,jk,Kmm) & 372 & * vv (ji,jj ,jk,Kmm) + vn_td(ji,jj ,jk), 0._wp ) - & 373 & MIN( e1v(ji,jj-1) * e3v(ji,jj-1,jk,Kmm) & 374 & * vv (ji,jj-1,jk,Kmm) + vn_td(ji,jj-1,jk), 0._wp ) ) & 349 375 & * r1_e1e2t(ji,jj) & 350 376 & ) * z1_e3t … … 353 379 DO_3D_00_00( 1, jpkm1 ) 354 380 z1_e3t = 1._wp / e3t(ji,jj,jk,Kmm) 355 ! 2*rn_Dt and not rDt (for restartability)356 Cu_adv(ji,jj,jk) = 2._wp * rn_Dt * ( ( MAX( ww(ji,jj,jk) , 0._wp ) - MIN( ww(ji,jj,jk+1) , 0._wp ) ) &381 Cu_adv(ji,jj,jk) = zdt * & 382 & ( ( MAX( ww(ji,jj,jk) , 0._wp ) - MIN( ww(ji,jj,jk+1) , 0._wp ) ) & 357 383 & + ( MAX( e2u(ji ,jj)*e3u(ji ,jj,jk,Kmm)*uu(ji ,jj,jk,Kmm), 0._wp ) - & 358 384 & MIN( e2u(ji-1,jj)*e3u(ji-1,jj,jk,Kmm)*uu(ji-1,jj,jk,Kmm), 0._wp ) ) &
Note: See TracChangeset
for help on using the changeset viewer.
