- Timestamp:
- 2020-11-09T16:48:35+01:00 (3 years ago)
- Location:
- NEMO/branches/2020/test_12905_xios_restart
- Files:
-
- 2 edited
-
. (modified) (1 prop)
-
src/NST/agrif_oce_sponge.F90 (modified) (38 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2020/test_12905_xios_restart
- 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/ r12931_sette_ticket2462@HEADsette10 ^/utils/CI/sette@13559 sette
-
- Property svn:externals
-
NEMO/branches/2020/test_12905_xios_restart/src/NST/agrif_oce_sponge.F90
r12489 r13751 78 78 zcoef = REAL(Agrif_rhot()-1,wp)/REAL(Agrif_rhot()) 79 79 80 Agrif_SpecialValue =0.80 Agrif_SpecialValue = 0._wp 81 81 Agrif_UseSpecialValue = ln_spc_dyn 82 use_sign_north = .TRUE. 83 sign_north = -1._wp 82 84 ! 83 85 tabspongedone_u = .FALSE. … … 90 92 ! 91 93 Agrif_UseSpecialValue = .FALSE. 94 use_sign_north = .FALSE. 92 95 #endif 93 96 ! … … 106 109 REAL(wp) :: z1_ispongearea, z1_jspongearea 107 110 REAL(wp), DIMENSION(jpi,jpj) :: ztabramp 111 #if defined key_vertical 112 REAL(wp), DIMENSION(jpi,jpj) :: ztabrampu 113 REAL(wp), DIMENSION(jpi,jpj) :: ztabrampv 114 #endif 108 115 REAL(wp), DIMENSION(jpjmax) :: zmskwest, zmskeast 109 116 REAL(wp), DIMENSION(jpimax) :: zmsknorth, zmsksouth … … 126 133 ! Retrieve masks at open boundaries: 127 134 128 ! --- West --- ! 129 ztabramp(:,:) = 0._wp 130 ind1 = 1+nbghostcells 131 DO ji = mi0(ind1), mi1(ind1) 132 ztabramp(ji,:) = ssumask(ji,:) 133 END DO 134 ! 135 zmskwest(:) = 0._wp 136 zmskwest(1:jpj) = MAXVAL(ztabramp(:,:), dim=1) 137 138 ! --- East --- ! 139 ztabramp(:,:) = 0._wp 140 ind1 = jpiglo - nbghostcells - 1 141 DO ji = mi0(ind1), mi1(ind1) 142 ztabramp(ji,:) = ssumask(ji,:) 143 END DO 144 ! 145 zmskeast(:) = 0._wp 146 zmskeast(1:jpj) = MAXVAL(ztabramp(:,:), dim=1) 147 148 ! --- South --- ! 149 ztabramp(:,:) = 0._wp 150 ind1 = 1+nbghostcells 151 DO jj = mj0(ind1), mj1(ind1) 152 ztabramp(:,jj) = ssvmask(:,jj) 153 END DO 154 ! 155 zmsksouth(:) = 0._wp 156 zmsksouth(1:jpi) = MAXVAL(ztabramp(:,:), dim=2) 157 158 ! --- North --- ! 159 ztabramp(:,:) = 0._wp 160 ind1 = jpjglo - nbghostcells - 1 161 DO jj = mj0(ind1), mj1(ind1) 162 ztabramp(:,jj) = ssvmask(:,jj) 163 END DO 164 ! 165 zmsknorth(:) = 0._wp 166 zmsknorth(1:jpi) = MAXVAL(ztabramp(:,:), dim=2) 135 IF( lk_west ) THEN ! --- West --- ! 136 ztabramp(:,:) = 0._wp 137 ind1 = nn_hls + 1 + nbghostcells ! halo + land + nbghostcells 138 DO ji = mi0(ind1), mi1(ind1) 139 ztabramp(ji,:) = ssumask(ji,:) 140 END DO 141 zmskwest( 1:jpj ) = MAXVAL(ztabramp(:,:), dim=1) 142 zmskwest(jpj+1:jpjmax) = 0._wp 143 ENDIF 144 IF( lk_east ) THEN ! --- East --- ! 145 ztabramp(:,:) = 0._wp 146 ind1 = jpiglo - ( nn_hls + nbghostcells + 1) ! halo + land + nbghostcells 147 DO ji = mi0(ind1), mi1(ind1) 148 ztabramp(ji,:) = ssumask(ji,:) 149 END DO 150 zmskeast( 1:jpj ) = MAXVAL(ztabramp(:,:), dim=1) 151 zmskeast(jpj+1:jpjmax) = 0._wp 152 ENDIF 153 IF( lk_south ) THEN ! --- South --- ! 154 ztabramp(:,:) = 0._wp 155 ind1 = nn_hls + 1 + nbghostcells ! halo + land + nbghostcells 156 DO jj = mj0(ind1), mj1(ind1) 157 ztabramp(:,jj) = ssvmask(:,jj) 158 END DO 159 zmsksouth( 1:jpi ) = MAXVAL(ztabramp(:,:), dim=2) 160 zmsksouth(jpi+1:jpimax) = 0._wp 161 ENDIF 162 IF( lk_north ) THEN ! --- North --- ! 163 ztabramp(:,:) = 0._wp 164 ind1 = jpjglo - ( nn_hls + nbghostcells + 1) ! halo + land + nbghostcells 165 DO jj = mj0(ind1), mj1(ind1) 166 ztabramp(:,jj) = ssvmask(:,jj) 167 END DO 168 zmsknorth( 1:jpi ) = MAXVAL(ztabramp(:,:), dim=2) 169 zmsknorth(jpi+1:jpimax) = 0._wp 170 ENDIF 171 167 172 ! JC: SPONGE MASKING TO BE SORTED OUT: 168 173 zmskwest(:) = 1._wp 169 174 zmskeast(:) = 1._wp 175 zmsksouth(:) = 1._wp 170 176 zmsknorth(:) = 1._wp 171 zmsksouth(:) = 1._wp172 177 #if defined key_mpp_mpi 173 178 ! CALL mpp_max( 'AGRIF_sponge', zmskwest(:) , jpjmax ) … … 180 185 ! Store it in ztabramp 181 186 182 ispongearea = nn_sponge_len * Agrif_irhox()183 z1_ispongearea = 1._wp / REAL( ispongearea )184 jspongearea = nn_sponge_len * Agrif_irhoy()185 z1_jspongearea = 1._wp / REAL( jspongearea )187 ispongearea = nn_sponge_len * Agrif_irhox() 188 z1_ispongearea = 1._wp / REAL( ispongearea, wp ) 189 jspongearea = nn_sponge_len * Agrif_irhoy() 190 z1_jspongearea = 1._wp / REAL( jspongearea, wp ) 186 191 187 192 ztabramp(:,:) = 0._wp … … 191 196 IF ( nbcellsy <= 3 ) jspongearea = -1 192 197 193 ! --- West --- ! 194 ind1 = 1+nbghostcells 195 ind2 = 1+nbghostcells + ispongearea 196 DO ji = mi0(ind1), mi1(ind2) 197 DO jj = 1, jpj 198 ztabramp(ji,jj) = REAL( ind2 - mig(ji) ) * z1_ispongearea * zmskwest(jj) 199 END DO 200 END DO 201 202 ! ghost cells: 203 ind1 = 1 204 ind2 = nbghostcells + 1 205 DO ji = mi0(ind1), mi1(ind2) 206 DO jj = 1, jpj 207 ztabramp(ji,jj) = zmskwest(jj) 208 END DO 209 END DO 210 211 ! --- East --- ! 212 ind1 = jpiglo - nbghostcells - ispongearea 213 ind2 = jpiglo - nbghostcells 214 DO ji = mi0(ind1), mi1(ind2) 215 DO jj = 1, jpj 216 ztabramp(ji,jj) = MAX( ztabramp(ji,jj), REAL( mig(ji) - ind1 ) * z1_ispongearea) * zmskeast(jj) 217 ENDDO 218 END DO 219 220 ! ghost cells: 221 ind1 = jpiglo - nbghostcells 222 ind2 = jpiglo 223 DO ji = mi0(ind1), mi1(ind2) 224 DO jj = 1, jpj 225 ztabramp(ji,jj) = zmskeast(jj) 226 ENDDO 227 END DO 228 229 ! --- South --- ! 230 ind1 = 1+nbghostcells 231 ind2 = 1+nbghostcells + jspongearea 232 DO jj = mj0(ind1), mj1(ind2) 233 DO ji = 1, jpi 234 ztabramp(ji,jj) = MAX( ztabramp(ji,jj), REAL( ind2 - mjg(jj) ) * z1_jspongearea) * zmsksouth(ji) 235 END DO 236 END DO 237 238 ! ghost cells: 239 ind1 = 1 240 ind2 = nbghostcells + 1 241 DO jj = mj0(ind1), mj1(ind2) 242 DO ji = 1, jpi 243 ztabramp(ji,jj) = zmsksouth(ji) 244 END DO 245 END DO 246 247 ! --- North --- ! 248 ind1 = jpjglo - nbghostcells - jspongearea 249 ind2 = jpjglo - nbghostcells 250 DO jj = mj0(ind1), mj1(ind2) 251 DO ji = 1, jpi 252 ztabramp(ji,jj) = MAX( ztabramp(ji,jj), REAL( mjg(jj) - ind1 ) * z1_jspongearea) * zmsknorth(ji) 253 END DO 254 END DO 255 256 ! ghost cells: 257 ind1 = jpjglo - nbghostcells 258 ind2 = jpjglo 259 DO jj = mj0(ind1), mj1(ind2) 260 DO ji = 1, jpi 261 ztabramp(ji,jj) = zmsknorth(ji) 262 END DO 263 END DO 264 198 IF( lk_west ) THEN ! --- West --- ! 199 ind1 = nn_hls + 1 + nbghostcells ! halo + land + nbghostcells 200 ind2 = nn_hls + 1 + nbghostcells + ispongearea 201 DO ji = mi0(ind1), mi1(ind2) 202 DO jj = 1, jpj 203 ztabramp(ji,jj) = REAL(ind2 - mig(ji), wp) * z1_ispongearea * zmskwest(jj) 204 END DO 205 END DO 206 ! ghost cells: 207 ind1 = 1 208 ind2 = nn_hls + 1 + nbghostcells ! halo + land + nbghostcells 209 DO ji = mi0(ind1), mi1(ind2) 210 DO jj = 1, jpj 211 ztabramp(ji,jj) = zmskwest(jj) 212 END DO 213 END DO 214 ENDIF 215 IF( lk_east ) THEN ! --- East --- ! 216 ind1 = jpiglo - ( nn_hls + nbghostcells ) - ispongearea 217 ind2 = jpiglo - ( nn_hls + nbghostcells ) ! halo + land + nbghostcells - 1 218 DO ji = mi0(ind1), mi1(ind2) 219 DO jj = 1, jpj 220 ztabramp(ji,jj) = MAX( ztabramp(ji,jj), REAL(mig(ji) - ind1, wp) * z1_ispongearea ) * zmskeast(jj) 221 END DO 222 END DO 223 ! ghost cells: 224 ind1 = jpiglo - ( nn_hls + nbghostcells ) ! halo + land + nbghostcells - 1 225 ind2 = jpiglo 226 DO ji = mi0(ind1), mi1(ind2) 227 DO jj = 1, jpj 228 ztabramp(ji,jj) = zmskeast(jj) 229 END DO 230 END DO 231 ENDIF 232 IF( lk_south ) THEN ! --- South --- ! 233 ind1 = nn_hls + 1 + nbghostcells ! halo + land + nbghostcells 234 ind2 = nn_hls + 1 + nbghostcells + jspongearea 235 DO jj = mj0(ind1), mj1(ind2) 236 DO ji = 1, jpi 237 ztabramp(ji,jj) = MAX( ztabramp(ji,jj), REAL(ind2 - mjg(jj), wp) * z1_jspongearea ) * zmsksouth(ji) 238 END DO 239 END DO 240 ! ghost cells: 241 ind1 = 1 242 ind2 = nn_hls + 1 + nbghostcells ! halo + land + nbghostcells 243 DO jj = mj0(ind1), mj1(ind2) 244 DO ji = 1, jpi 245 ztabramp(ji,jj) = zmsksouth(ji) 246 END DO 247 END DO 248 ENDIF 249 IF( lk_north ) THEN ! --- North --- ! 250 ind1 = jpjglo - ( nn_hls + nbghostcells ) - jspongearea 251 ind2 = jpjglo - ( nn_hls + nbghostcells ) ! halo + land + nbghostcells - 1 252 DO jj = mj0(ind1), mj1(ind2) 253 DO ji = 1, jpi 254 ztabramp(ji,jj) = MAX( ztabramp(ji,jj), REAL(mjg(jj) - ind1, wp) * z1_jspongearea ) * zmsknorth(ji) 255 END DO 256 END DO 257 ! ghost cells: 258 ind1 = jpjglo - ( nn_hls + nbghostcells ) ! halo + land + nbghostcells - 1 259 ind2 = jpjglo 260 DO jj = mj0(ind1), mj1(ind2) 261 DO ji = 1, jpi 262 ztabramp(ji,jj) = zmsknorth(ji) 263 END DO 264 END DO 265 ENDIF 266 ! 265 267 ENDIF 266 268 … … 269 271 fspu(:,:) = 0._wp 270 272 fspv(:,:) = 0._wp 271 DO_2D _00_00273 DO_2D( 0, 0, 0, 0 ) 272 274 fspu(ji,jj) = 0.5_wp * ( ztabramp(ji,jj) + ztabramp(ji+1,jj ) ) * ssumask(ji,jj) 273 275 fspv(ji,jj) = 0.5_wp * ( ztabramp(ji,jj) + ztabramp(ji ,jj+1) ) * ssvmask(ji,jj) 274 276 END_2D 275 CALL lbc_lnk( 'agrif_Sponge', fspu, 'U', 1. ) ! Lateral boundary conditions276 CALL lbc_lnk( 'agrif_Sponge', fspv, 'V', 1. )277 278 spongedoneT = .TRUE.279 277 ENDIF 280 278 … … 283 281 fspt(:,:) = 0._wp 284 282 fspf(:,:) = 0._wp 285 DO_2D _00_00283 DO_2D( 0, 0, 0, 0 ) 286 284 fspt(ji,jj) = ztabramp(ji,jj) * ssmask(ji,jj) 287 285 fspf(ji,jj) = 0.25_wp * ( ztabramp(ji ,jj ) + ztabramp(ji ,jj+1) & … … 289 287 & * ssvmask(ji,jj) * ssvmask(ji,jj+1) 290 288 END_2D 291 CALL lbc_lnk( 'agrif_Sponge', fspt, 'T', 1. ) ! Lateral boundary conditions 292 CALL lbc_lnk( 'agrif_Sponge', fspf, 'F', 1. ) 293 289 ENDIF 290 291 IF( .NOT. spongedoneT .AND. .NOT. spongedoneU ) THEN 292 CALL lbc_lnk_multi( 'agrif_Sponge', fspu, 'U', 1._wp, fspv, 'V', 1._wp, fspt, 'T', 1._wp, fspf, 'F', 1._wp ) 293 spongedoneT = .TRUE. 294 294 spongedoneU = .TRUE. 295 295 ENDIF 296 IF( .NOT. spongedoneT ) THEN 297 CALL lbc_lnk_multi( 'agrif_Sponge', fspu, 'U', 1._wp, fspv, 'V', 1._wp ) 298 spongedoneT = .TRUE. 299 ENDIF 300 IF( .NOT. spongedoneT .AND. .NOT. spongedoneU ) THEN 301 CALL lbc_lnk_multi( 'agrif_Sponge', fspt, 'T', 1._wp, fspf, 'F', 1._wp ) 302 spongedoneU = .TRUE. 303 ENDIF 296 304 297 305 #if defined key_vertical 298 306 ! Remove vertical interpolation where not needed: 299 DO_2D _00_00307 DO_2D( 0, 0, 0, 0 ) 300 308 IF ((fspu(ji-1,jj)==0._wp).AND.(fspu(ji,jj)==0._wp).AND. & 301 309 & (fspv(ji,jj-1)==0._wp).AND.(fspv(ji,jj)==0._wp)) mbkt_parent(ji,jj) = 0 … … 312 320 END_2D 313 321 ! 314 ztabramp(:,:) = REAL( mbkt_parent(:,:), wp ) ; CALL lbc_lnk( 'Agrif_Sponge', ztabramp, 'T', 1. ) 315 mbkt_parent(:,:) = NINT( ztabramp(:,:) ) 316 ztabramp(:,:) = REAL( mbku_parent(:,:), wp ) ; CALL lbc_lnk( 'Agrif_Sponge', ztabramp, 'U', 1. ) 317 mbku_parent(:,:) = NINT( ztabramp(:,:) ) 318 ztabramp(:,:) = REAL( mbkv_parent(:,:), wp ) ; CALL lbc_lnk( 'Agrif_Sponge', ztabramp, 'V', 1. ) 319 mbkv_parent(:,:) = NINT( ztabramp(:,:) ) 322 ztabramp (:,:) = REAL( mbkt_parent(:,:), wp ) 323 ztabrampu(:,:) = REAL( mbku_parent(:,:), wp ) 324 ztabrampv(:,:) = REAL( mbkv_parent(:,:), wp ) 325 CALL lbc_lnk_multi( 'Agrif_Sponge', ztabramp, 'T', 1._wp, ztabrampu, 'U', 1._wp, ztabrampv, 'V', 1._wp ) 326 mbkt_parent(:,:) = NINT( ztabramp (:,:) ) 327 mbku_parent(:,:) = NINT( ztabrampu(:,:) ) 328 mbkv_parent(:,:) = NINT( ztabrampv(:,:) ) 320 329 #endif 321 330 ! … … 324 333 END SUBROUTINE Agrif_Sponge 325 334 335 326 336 SUBROUTINE interptsn_sponge( tabres, i1, i2, j1, j2, k1, k2, n1, n2, before ) 327 337 !!---------------------------------------------------------------------- … … 334 344 INTEGER :: ji, jj, jk, jn ! dummy loop indices 335 345 INTEGER :: iku, ikv 336 REAL(wp) :: ztsa, zabe1, zabe2, zbtr, zhtot , ztrelax346 REAL(wp) :: ztsa, zabe1, zabe2, zbtr, zhtot 337 347 REAL(wp), DIMENSION(i1:i2,j1:j2,jpk) :: ztu, ztv 338 348 REAL(wp), DIMENSION(i1:i2,j1:j2,jpk,n1:n2) ::tsbdiff … … 411 421 N_out = N_out + 1 412 422 h_out(jk) = e3t(ji,jj,jk,Kbb_a) !Child grid scale factors. Could multiply by e1e2t here instead of division above 413 END DO423 END DO 414 424 415 425 ! Account for small differences in free-surface … … 422 432 CALL reconstructandremap(tabin(1:N_in,1:jpts),h_in(1:N_in),tabres_child(ji,jj,1:N_out,1:jpts),h_out(1:N_out),N_in,N_out,jpts) 423 433 ENDIF 424 END DO425 END DO434 END DO 435 END DO 426 436 # endif 427 437 … … 434 444 tsbdiff(ji,jj,jk,1:jpts) = (ts(ji,jj,jk,1:jpts,Kbb_a) - tabres(ji,jj,jk,1:jpts))*tmask(ji,jj,jk) 435 445 # endif 436 ENDDO 437 ENDDO 438 ENDDO 439 440 !* set relaxation time scale 441 IF( l_1st_euler .AND. lk_agrif_fstep ) THEN ; ztrelax = rn_trelax_tra / ( rn_Dt ) 442 ELSE ; ztrelax = rn_trelax_tra / (2._wp * rn_Dt ) 443 ENDIF 446 END DO 447 END DO 448 END DO 444 449 445 450 DO jn = 1, jpts … … 448 453 DO jj = j1,j2 449 454 DO ji = i1,i2-1 450 zabe1 = rn_sponge_tra * fspu(ji,jj) * umask(ji,jj,jk) * e2_e1u(ji,jj) * e3u(ji,jj,jk,Kmm_a)455 zabe1 = rn_sponge_tra * r1_Dt * fspu(ji,jj) * umask(ji,jj,jk) * e1e2u(ji,jj) * e3u(ji,jj,jk,Kmm_a) 451 456 ztu(ji,jj,jk) = zabe1 * ( tsbdiff(ji+1,jj ,jk,jn) - tsbdiff(ji,jj,jk,jn) ) 452 457 END DO … … 455 460 DO ji = i1,i2 456 461 DO jj = j1,j2-1 457 zabe2 = rn_sponge_tra * fspv(ji,jj) * vmask(ji,jj,jk) * e1_e2v(ji,jj) * e3v(ji,jj,jk,Kmm_a)462 zabe2 = rn_sponge_tra * r1_Dt * fspv(ji,jj) * vmask(ji,jj,jk) * e1e2v(ji,jj) * e3v(ji,jj,jk,Kmm_a) 458 463 ztv(ji,jj,jk) = zabe2 * ( tsbdiff(ji ,jj+1,jk,jn) - tsbdiff(ji,jj,jk,jn) ) 459 464 END DO … … 480 485 ! horizontal diffusive trends 481 486 ztsa = zbtr * ( ztu(ji,jj,jk) - ztu(ji-1,jj,jk) + ztv(ji,jj,jk) - ztv(ji,jj-1,jk) ) & 482 & - ztrelax* fspt(ji,jj) * tsbdiff(ji,jj,jk,jn)487 & - rn_trelax_tra * r1_Dt * fspt(ji,jj) * tsbdiff(ji,jj,jk,jn) 483 488 ! add it to the general tracer trends 484 489 ts(ji,jj,jk,jn,Krhs_a) = ts(ji,jj,jk,jn,Krhs_a) + ztsa … … 496 501 END SUBROUTINE interptsn_sponge 497 502 503 498 504 SUBROUTINE interpun_sponge(tabres,i1,i2,j1,j2,k1,k2,m1,m2, before) 499 505 !!--------------------------------------------- … … 504 510 LOGICAL, INTENT(in) :: before 505 511 506 INTEGER :: ji,jj,jk,jmax507 512 INTEGER :: ji,jj,jk,jmax 513 INTEGER :: ind1 508 514 ! sponge parameters 509 REAL(wp) :: ze2u, ze1v, zua, zva, zbtr, zhtot , ztrelax515 REAL(wp) :: ze2u, ze1v, zua, zva, zbtr, zhtot 510 516 REAL(wp), DIMENSION(i1:i2,j1:j2,1:jpk) :: ubdiff 511 517 REAL(wp), DIMENSION(i1:i2,j1:j2,1:jpk) :: rotdiff, hdivdiff … … 569 575 zhtot = zhtot + h_in(jk) 570 576 tabin(jk) = tabres(ji,jj,jk,m1) 571 END DO577 END DO 572 578 ! 573 579 N_out = 0 … … 576 582 N_out = N_out + 1 577 583 h_out(N_out) = e3u(ji,jj,jk,Kbb_a) 578 END DO584 END DO 579 585 580 586 ! Account for small differences in free-surface … … 588 594 CALL reconstructandremap(tabin(1:N_in),h_in(1:N_in),tabres_child(ji,jj,1:N_out),h_out(1:N_out),N_in,N_out,1) 589 595 ENDIF 590 END DO591 END DO596 END DO 597 END DO 592 598 593 599 ubdiff(i1:i2,j1:j2,:) = (uu(i1:i2,j1:j2,:,Kbb_a) - tabres_child(i1:i2,j1:j2,:))*umask(i1:i2,j1:j2,:) … … 595 601 ubdiff(i1:i2,j1:j2,:) = (uu(i1:i2,j1:j2,:,Kbb_a) - tabres(i1:i2,j1:j2,:,1))*umask(i1:i2,j1:j2,:) 596 602 #endif 597 !* set relaxation time scale598 IF( l_1st_euler .AND. lk_agrif_fstep ) THEN ; ztrelax = rn_trelax_dyn / ( rn_Dt )599 ELSE ; ztrelax = rn_trelax_dyn / (2._wp * rn_Dt )600 ENDIF601 603 ! 602 604 DO jk = 1, jpkm1 ! Horizontal slab … … 608 610 DO jj = j1,j2 609 611 DO ji = i1+1,i2 ! vector opt. 610 zbtr = r 1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kbb_a) * rn_sponge_dyn * fspt(ji,jj)612 zbtr = rn_sponge_dyn * r1_Dt * fspt(ji,jj) / e3t(ji,jj,jk,Kbb_a) 611 613 hdivdiff(ji,jj,jk) = ( e2u(ji ,jj)*e3u(ji ,jj,jk,Kbb_a) * ubdiff(ji ,jj,jk) & 612 614 & -e2u(ji-1,jj)*e3u(ji-1,jj,jk,Kbb_a) * ubdiff(ji-1,jj,jk) ) * zbtr … … 616 618 DO jj = j1,j2-1 617 619 DO ji = i1,i2 ! vector opt. 618 zbtr = r 1_e1e2f(ji,jj) * e3f(ji,jj,jk) * rn_sponge_dyn * fspf(ji,jj)620 zbtr = rn_sponge_dyn * r1_Dt * fspf(ji,jj) * e3f(ji,jj,jk) 619 621 rotdiff(ji,jj,jk) = ( -e1u(ji,jj+1) * ubdiff(ji,jj+1,jk) & 620 622 & +e1u(ji,jj ) * ubdiff(ji,jj ,jk) ) * fmask(ji,jj,jk) * zbtr … … 633 635 zua = - ( ze2u - rotdiff (ji,jj-1,jk) ) / ( e2u(ji,jj) * e3u(ji,jj,jk,Kmm_a) ) & 634 636 & + ( hdivdiff(ji+1,jj,jk) - ze1v ) * r1_e1u(ji,jj) & 635 & - ztrelax* fspu(ji,jj) * ubdiff(ji,jj,jk)637 & - rn_trelax_dyn * r1_Dt * fspu(ji,jj) * ubdiff(ji,jj,jk) 636 638 637 639 ! add it to the general momentum trends … … 646 648 647 649 jmax = j2-1 648 IF ((nbondj == 1).OR.(nbondj == 2)) jmax = MIN(jmax,nlcj-nbghostcells-2) ! North 650 ind1 = jpjglo - ( nn_hls + nbghostcells + 2 ) ! North 651 DO jj = mj0(ind1), mj1(ind1) 652 jmax = MIN(jmax,jj) 653 END DO 649 654 650 655 DO jj = j1+1, jmax … … 674 679 END SUBROUTINE interpun_sponge 675 680 676 SUBROUTINE interpvn_sponge(tabres,i1,i2,j1,j2,k1,k2,m1,m2, before,nb,ndir) 681 682 SUBROUTINE interpvn_sponge(tabres,i1,i2,j1,j2,k1,k2,m1,m2, before) 677 683 !!--------------------------------------------- 678 684 !! *** ROUTINE interpvn_sponge *** … … 681 687 REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2,m1:m2), INTENT(inout) :: tabres 682 688 LOGICAL, INTENT(in) :: before 683 INTEGER, INTENT(in) :: nb , ndir684 689 ! 685 690 INTEGER :: ji, jj, jk, imax 686 REAL(wp) :: ze2u, ze1v, zua, zva, zbtr, zhtot, ztrelax 691 INTEGER :: ind1 692 REAL(wp) :: ze2u, ze1v, zua, zva, zbtr, zhtot 687 693 REAL(wp), DIMENSION(i1:i2,j1:j2,1:jpk) :: vbdiff 688 694 REAL(wp), DIMENSION(i1:i2,j1:j2,1:jpk) :: rotdiff, hdivdiff … … 745 751 zhtot = zhtot + h_in(jk) 746 752 tabin(jk) = tabres(ji,jj,jk,m1) 747 END DO753 END DO 748 754 ! 749 755 N_out = 0 … … 752 758 N_out = N_out + 1 753 759 h_out(N_out) = e3v(ji,jj,jk,Kbb_a) 754 END DO760 END DO 755 761 756 762 ! Account for small differences in free-surface … … 764 770 CALL reconstructandremap(tabin(1:N_in),h_in(1:N_in),tabres_child(ji,jj,1:N_out),h_out(1:N_out),N_in,N_out,1) 765 771 ENDIF 766 END DO767 END DO772 END DO 773 END DO 768 774 769 775 vbdiff(i1:i2,j1:j2,:) = (vv(i1:i2,j1:j2,:,Kbb_a) - tabres_child(i1:i2,j1:j2,:))*vmask(i1:i2,j1:j2,:) … … 771 777 vbdiff(i1:i2,j1:j2,:) = (vv(i1:i2,j1:j2,:,Kbb_a) - tabres(i1:i2,j1:j2,:,1))*vmask(i1:i2,j1:j2,:) 772 778 # endif 773 !* set relaxation time scale774 IF( l_1st_euler .AND. lk_agrif_fstep ) THEN ; ztrelax = rn_trelax_dyn / ( rn_Dt )775 ELSE ; ztrelax = rn_trelax_dyn / (2._wp * rn_Dt )776 ENDIF777 779 ! 778 780 DO jk = 1, jpkm1 ! Horizontal slab … … 784 786 DO jj = j1+1,j2 785 787 DO ji = i1,i2 ! vector opt. 786 zbtr = r 1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kbb_a) * rn_sponge_dyn * fspt(ji,jj)788 zbtr = rn_sponge_dyn * r1_Dt * fspt(ji,jj) / e3t(ji,jj,jk,Kbb_a) 787 789 hdivdiff(ji,jj,jk) = ( e1v(ji,jj ) * e3v(ji,jj ,jk,Kbb_a) * vbdiff(ji,jj ,jk) & 788 790 & -e1v(ji,jj-1) * e3v(ji,jj-1,jk,Kbb_a) * vbdiff(ji,jj-1,jk) ) * zbtr … … 791 793 DO jj = j1,j2 792 794 DO ji = i1,i2-1 ! vector opt. 793 zbtr = r 1_e1e2f(ji,jj) * e3f(ji,jj,jk) * rn_sponge_dyn * fspf(ji,jj)795 zbtr = rn_sponge_dyn * r1_Dt * fspf(ji,jj) * e3f(ji,jj,jk) 794 796 rotdiff(ji,jj,jk) = ( e2v(ji+1,jj) * vbdiff(ji+1,jj,jk) & 795 797 & -e2v(ji ,jj) * vbdiff(ji ,jj,jk) ) * fmask(ji,jj,jk) * zbtr … … 802 804 803 805 imax = i2 - 1 804 IF ((nbondi == 1).OR.(nbondi == 2)) imax = MIN(imax,nlci-nbghostcells-2) ! East 805 806 ind1 = jpiglo - ( nn_hls + nbghostcells + 2 ) ! East 807 DO ji = mi0(ind1), mi1(ind1) 808 imax = MIN(imax,ji) 809 END DO 810 806 811 DO jj = j1+1, j2 807 812 DO ji = i1+1, imax ! vector opt. 808 813 IF( .NOT. tabspongedone_u(ji,jj) ) THEN 809 814 DO jk = 1, jpkm1 810 uu(ji,jj,jk,Krhs_a) = uu(ji,jj,jk,Krhs_a) 815 uu(ji,jj,jk,Krhs_a) = uu(ji,jj,jk,Krhs_a) & 811 816 & - ( rotdiff (ji ,jj,jk) - rotdiff (ji,jj-1,jk)) / ( e2u(ji,jj) * e3u(ji,jj,jk,Kmm_a) ) & 812 817 & + ( hdivdiff(ji+1,jj,jk) - hdivdiff(ji,jj ,jk)) * r1_e1u(ji,jj) … … 822 827 IF( .NOT. tabspongedone_v(ji,jj) ) THEN 823 828 DO jk = 1, jpkm1 824 vv(ji,jj,jk,Krhs_a) = vv(ji,jj,jk,Krhs_a) 829 vv(ji,jj,jk,Krhs_a) = vv(ji,jj,jk,Krhs_a) & 825 830 & + ( rotdiff (ji,jj ,jk) - rotdiff (ji-1,jj,jk) ) / ( e1v(ji,jj) * e3v(ji,jj,jk,Kmm_a) ) & 826 & + ( hdivdiff(ji,jj+1,jk) - hdivdiff(ji ,jj,jk) ) * r1_e2v(ji,jj) &827 & - ztrelax* fspv(ji,jj) * vbdiff(ji,jj,jk)831 & + ( hdivdiff(ji,jj+1,jk) - hdivdiff(ji ,jj,jk) ) * r1_e2v(ji,jj) & 832 & - rn_trelax_dyn * r1_Dt * fspv(ji,jj) * vbdiff(ji,jj,jk) 828 833 END DO 829 834 ENDIF
Note: See TracChangeset
for help on using the changeset viewer.
