- Timestamp:
- 2020-09-29T12:41:06+02:00 (4 years ago)
- Location:
- NEMO/branches/2020/r12377_ticket2386
- Files:
-
- 2 edited
-
. (modified) (1 prop)
-
src/OCE/DYN/sshwzv.F90 (modified) (15 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2020/r12377_ticket2386
- Property svn:externals
-
old new 3 3 ^/utils/build/mk@HEAD mk 4 4 ^/utils/tools@HEAD tools 5 ^/vendors/AGRIF/dev @HEADext/AGRIF5 ^/vendors/AGRIF/dev_r12970_AGRIF_CMEMS ext/AGRIF 6 6 ^/vendors/FCM@HEAD ext/FCM 7 7 ^/vendors/IOIPSL@HEAD ext/IOIPSL 8 8 9 9 # SETTE 10 ^/utils/CI/sette@ HEADsette10 ^/utils/CI/sette@13507 sette
-
- Property svn:externals
-
NEMO/branches/2020/r12377_ticket2386/src/OCE/DYN/sshwzv.F90
r12511 r13540 28 28 USE bdydyn2d ! bdy_ssh routine 29 29 #if defined key_agrif 30 USE agrif_oce 30 31 USE agrif_oce_interp 31 32 #endif … … 50 51 !! * Substitutions 51 52 # include "do_loop_substitute.h90" 53 # include "domzgr_substitute.h90" 54 52 55 !!---------------------------------------------------------------------- 53 56 !! NEMO/OCE 4.0 , NEMO Consortium (2018) … … 110 113 ! 111 114 #if defined key_agrif 112 Kbb_a = Kbb; Kmm_a = Kmm; Krhs_a = Kaa; CALL agrif_ssh( kt ) 115 Kbb_a = Kbb ; Kmm_a = Kmm ; Krhs_a = Kaa 116 CALL agrif_ssh( kt ) 113 117 #endif 114 118 ! 115 119 IF ( .NOT.ln_dynspg_ts ) THEN 116 120 IF( ln_bdy ) THEN 117 CALL lbc_lnk( 'sshwzv', pssh(:,:,Kaa), 'T', 1. ) ! Not sure that's necessary121 CALL lbc_lnk( 'sshwzv', pssh(:,:,Kaa), 'T', 1.0_wp ) ! Not sure that's necessary 118 122 CALL bdy_ssh( pssh(:,:,Kaa) ) ! Duplicate sea level across open boundaries 119 123 ENDIF … … 130 134 131 135 132 SUBROUTINE wzv( kt, Kbb, Kmm, pww, Kaa)136 SUBROUTINE wzv( kt, Kbb, Kmm, Kaa, pww ) 133 137 !!---------------------------------------------------------------------- 134 138 !! *** ROUTINE wzv *** … … 147 151 INTEGER , INTENT(in) :: kt ! time step 148 152 INTEGER , INTENT(in) :: Kbb, Kmm, Kaa ! time level indices 149 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: pww ! now vertical velocity153 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: pww ! vertical velocity at Kmm 150 154 ! 151 155 INTEGER :: ji, jj, jk ! dummy loop indices … … 166 170 ! !------------------------------! 167 171 ! 168 IF( ln_vvl_ztilde .OR. ln_vvl_layer ) THEN ! z_tilde and layer cases 172 ! !===============================! 173 IF( ln_vvl_ztilde .OR. ln_vvl_layer ) THEN !== z_tilde and layer cases ==! 174 ! !===============================! 169 175 ALLOCATE( zhdiv(jpi,jpj,jpk) ) 170 176 ! … … 172 178 ! horizontal divergence of thickness diffusion transport ( velocity multiplied by e3t) 173 179 ! - ML - note: computation already done in dom_vvl_sf_nxt. Could be optimized (not critical and clearer this way) 174 DO_2D _00_00180 DO_2D( 0, 0, 0, 0 ) 175 181 zhdiv(ji,jj,jk) = r1_e1e2t(ji,jj) * ( un_td(ji,jj,jk) - un_td(ji-1,jj,jk) + vn_td(ji,jj,jk) - vn_td(ji,jj-1,jk) ) 176 182 END_2D 177 183 END DO 178 CALL lbc_lnk('sshwzv', zhdiv, 'T', 1. ) ! - ML - Perhaps not necessary: not used for horizontal "connexions"184 CALL lbc_lnk('sshwzv', zhdiv, 'T', 1.0_wp) ! - ML - Perhaps not necessary: not used for horizontal "connexions" 179 185 ! ! Is it problematic to have a wrong vertical velocity in boundary cells? 180 186 ! ! Same question holds for hdiv. Perhaps just for security 181 187 DO jk = jpkm1, 1, -1 ! integrate from the bottom the hor. divergence 182 188 ! 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) 189 pww(:,:,jk) = pww(:,:,jk+1) - ( e3t(:,:,jk,Kmm) * hdiv(:,:,jk) & 190 & + zhdiv(:,:,jk) & 191 & + r1_Dt * ( e3t(:,:,jk,Kaa) & 192 & - e3t(:,:,jk,Kbb) ) ) * tmask(:,:,jk) 185 193 END DO 186 194 ! IF( ln_vvl_layer ) pww(:,:,:) = 0.e0 187 195 DEALLOCATE( zhdiv ) 188 ELSE ! z_star and linear free surface cases 189 DO jk = jpkm1, 1, -1 ! integrate from the bottom the hor. divergence 190 ! computation of w 196 ! !=================================! 197 ELSEIF( ln_linssh ) THEN !== linear free surface cases ==! 198 ! !=================================! 199 DO jk = jpkm1, 1, -1 ! integrate from the bottom the hor. divergence 200 pww(:,:,jk) = pww(:,:,jk+1) - ( e3t(:,:,jk,Kmm) * hdiv(:,:,jk) ) * tmask(:,:,jk) 201 END DO 202 ! !==========================================! 203 ELSE !== Quasi-Eulerian vertical coordinate ==! ('key_qco') 204 ! !==========================================! 205 DO jk = jpkm1, 1, -1 ! integrate from the bottom the hor. divergence 191 206 pww(:,:,jk) = pww(:,:,jk+1) - ( e3t(:,:,jk,Kmm) * hdiv(:,:,jk) & 192 & + r1_Dt * ( e3t(:,:,jk,Kaa) - e3t(:,:,jk,Kbb) ) ) * tmask(:,:,jk) 207 & + r1_Dt * ( e3t(:,:,jk,Kaa) & 208 & - e3t(:,:,jk,Kbb) ) ) * tmask(:,:,jk) 193 209 END DO 194 210 ENDIF … … 200 216 ENDIF 201 217 ! 202 #if defined key_agrif 203 IF( .NOT. AGRIF_Root() ) THEN 204 IF ((nbondi == 1).OR.(nbondi == 2)) pww(nlci-1 , : ,:) = 0.e0 ! east 205 IF ((nbondi == -1).OR.(nbondi == 2)) pww(2 , : ,:) = 0.e0 ! west 206 IF ((nbondj == 1).OR.(nbondj == 2)) pww(: ,nlcj-1 ,:) = 0.e0 ! north 207 IF ((nbondj == -1).OR.(nbondj == 2)) pww(: ,2 ,:) = 0.e0 ! south 218 #if defined key_agrif 219 IF( .NOT. AGRIF_Root() ) THEN 220 ! 221 ! Mask vertical velocity at first/last columns/row 222 ! inside computational domain (cosmetic) 223 DO jk = 1, jpkm1 224 IF( lk_west ) THEN ! --- West --- ! 225 DO ji = mi0(2+nn_hls), mi1(2+nn_hls) 226 DO jj = 1, jpj 227 pww(ji,jj,jk) = 0._wp 228 END DO 229 END DO 230 ENDIF 231 IF( lk_east ) THEN ! --- East --- ! 232 DO ji = mi0(jpiglo-1-nn_hls), mi1(jpiglo-1-nn_hls) 233 DO jj = 1, jpj 234 pww(ji,jj,jk) = 0._wp 235 END DO 236 END DO 237 ENDIF 238 IF( lk_south ) THEN ! --- South --- ! 239 DO jj = mj0(2+nn_hls), mj1(2+nn_hls) 240 DO ji = 1, jpi 241 pww(ji,jj,jk) = 0._wp 242 END DO 243 END DO 244 ENDIF 245 IF( lk_north ) THEN ! --- North --- ! 246 DO jj = mj0(jpjglo-1-nn_hls), mj1(jpjglo-1-nn_hls) 247 DO ji = 1, jpi 248 pww(ji,jj,jk) = 0._wp 249 END DO 250 END DO 251 ENDIF 252 ! 253 END DO 254 ! 208 255 ENDIF 209 #endif 256 #endif 210 257 ! 211 258 IF( ln_timing ) CALL timing_stop('wzv') … … 214 261 215 262 216 SUBROUTINE ssh_atf( kt, Kbb, Kmm, Kaa, pssh )263 SUBROUTINE ssh_atf( kt, Kbb, Kmm, Kaa, pssh, pssh_f ) 217 264 !!---------------------------------------------------------------------- 218 265 !! *** ROUTINE ssh_atf *** … … 231 278 INTEGER , INTENT(in ) :: kt ! ocean time-step index 232 279 INTEGER , INTENT(in ) :: Kbb, Kmm, Kaa ! ocean time level indices 233 REAL(wp), DIMENSION(jpi,jpj,jpt), INTENT(inout) :: pssh ! SSH field 280 REAL(wp), DIMENSION(jpi,jpj,jpt) , TARGET, INTENT(inout) :: pssh ! SSH field 281 REAL(wp), DIMENSION(jpi,jpj ), OPTIONAL, TARGET, INTENT( out) :: pssh_f ! filtered SSH field 234 282 ! 235 283 REAL(wp) :: zcoef ! local scalar 284 REAL(wp), POINTER, DIMENSION(:,:) :: zssh ! pointer for filtered SSH 236 285 !!---------------------------------------------------------------------- 237 286 ! … … 245 294 ! !== Euler time-stepping: no filter, just swap ==! 246 295 IF ( .NOT.( l_1st_euler ) ) THEN ! Only do time filtering for leapfrog timesteps 296 IF( PRESENT( pssh_f ) ) THEN ; zssh => pssh_f 297 ELSE ; zssh => pssh(:,:,Kmm) 298 ENDIF 247 299 ! ! filtered "now" field 248 300 pssh(:,:,Kmm) = pssh(:,:,Kmm) + rn_atfp * ( pssh(:,:,Kbb) - 2 * pssh(:,:,Kmm) + pssh(:,:,Kaa) ) … … 266 318 END SUBROUTINE ssh_atf 267 319 320 268 321 SUBROUTINE wAimp( kt, Kmm ) 269 322 !!---------------------------------------------------------------------- … … 286 339 ! 287 340 INTEGER :: ji, jj, jk ! dummy loop indices 288 REAL(wp) :: zCu, zcff, z1_e3t 341 REAL(wp) :: zCu, zcff, z1_e3t, zdt ! local scalars 289 342 REAL(wp) , PARAMETER :: Cu_min = 0.15_wp ! local parameters 290 343 REAL(wp) , PARAMETER :: Cu_max = 0.30_wp ! local parameters … … 303 356 ! 304 357 ! Calculate Courant numbers 358 zdt = 2._wp * rn_Dt ! 2*rn_Dt and not rDt (for restartability) 305 359 IF( ln_vvl_ztilde .OR. ln_vvl_layer ) THEN 306 DO_3D _00_00(1, jpkm1 )360 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 307 361 z1_e3t = 1._wp / e3t(ji,jj,jk,Kmm) 308 ! 2*rn_Dt and not rDt (for restartability) 309 Cu_adv(ji,jj,jk) = 2._wp * rn_Dt * ( ( MAX( ww(ji,jj,jk) , 0._wp ) - MIN( ww(ji,jj,jk+1) , 0._wp ) ) & 310 & + ( MAX( e2u(ji ,jj)*e3u(ji ,jj,jk,Kmm)*uu(ji ,jj,jk,Kmm) + un_td(ji ,jj,jk), 0._wp ) - & 311 & 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 ) ) & 362 Cu_adv(ji,jj,jk) = zdt * & 363 & ( ( MAX( ww(ji,jj,jk) , 0._wp ) - MIN( ww(ji,jj,jk+1) , 0._wp ) ) & 364 & + ( MAX( e2u(ji ,jj) * e3u(ji ,jj,jk,Kmm) & 365 & * uu (ji ,jj,jk,Kmm) + un_td(ji ,jj,jk), 0._wp ) - & 366 & MIN( e2u(ji-1,jj) * e3u(ji-1,jj,jk,Kmm) & 367 & * uu (ji-1,jj,jk,Kmm) + un_td(ji-1,jj,jk), 0._wp ) ) & 312 368 & * r1_e1e2t(ji,jj) & 313 & + ( MAX( e1v(ji,jj )*e3v(ji,jj ,jk,Kmm)*vv(ji,jj ,jk,Kmm) + vn_td(ji,jj ,jk), 0._wp ) - & 314 & 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 ) ) & 369 & + ( MAX( e1v(ji,jj ) * e3v(ji,jj ,jk,Kmm) & 370 & * vv (ji,jj ,jk,Kmm) + vn_td(ji,jj ,jk), 0._wp ) - & 371 & MIN( e1v(ji,jj-1) * e3v(ji,jj-1,jk,Kmm) & 372 & * vv (ji,jj-1,jk,Kmm) + vn_td(ji,jj-1,jk), 0._wp ) ) & 315 373 & * r1_e1e2t(ji,jj) & 316 374 & ) * z1_e3t 317 375 END_3D 318 376 ELSE 319 DO_3D _00_00(1, jpkm1 )377 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 320 378 z1_e3t = 1._wp / e3t(ji,jj,jk,Kmm) 321 ! 2*rn_Dt and not rDt (for restartability)322 Cu_adv(ji,jj,jk) = 2._wp * rn_Dt * ( ( MAX( ww(ji,jj,jk) , 0._wp ) - MIN( ww(ji,jj,jk+1) , 0._wp ) ) &379 Cu_adv(ji,jj,jk) = zdt * & 380 & ( ( MAX( ww(ji,jj,jk) , 0._wp ) - MIN( ww(ji,jj,jk+1) , 0._wp ) ) & 323 381 & + ( MAX( e2u(ji ,jj)*e3u(ji ,jj,jk,Kmm)*uu(ji ,jj,jk,Kmm), 0._wp ) - & 324 382 & MIN( e2u(ji-1,jj)*e3u(ji-1,jj,jk,Kmm)*uu(ji-1,jj,jk,Kmm), 0._wp ) ) & … … 330 388 END_3D 331 389 ENDIF 332 CALL lbc_lnk( 'sshwzv', Cu_adv, 'T', 1. )390 CALL lbc_lnk( 'sshwzv', Cu_adv, 'T', 1.0_wp ) 333 391 ! 334 392 CALL iom_put("Courant",Cu_adv) 335 393 ! 336 394 IF( MAXVAL( Cu_adv(:,:,:) ) > Cu_min ) THEN ! Quick check if any breaches anywhere 337 DO_3DS _11_11( jpkm1, 2, -1 )395 DO_3DS( 1, 1, 1, 1, jpkm1, 2, -1 ) ! or scan Courant criterion and partition ! w where necessary 338 396 ! 339 397 zCu = MAX( Cu_adv(ji,jj,jk) , Cu_adv(ji,jj,jk-1) )
Note: See TracChangeset
for help on using the changeset viewer.
