- Timestamp:
- 2017-12-14T11:10:02+01:00 (6 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2017/dev_merge_2017/NEMOGCM/NEMO/NST_SRC/agrif_opa_sponge.F90
r9019 r9031 44 44 ! 45 45 #if defined SPONGE 46 zcoef = REAL( Agrif_NbStepint(), wp ) / Agrif_rhot() 47 ! 46 !! Assume persistence: 47 timecoeff = REAL(Agrif_rhot()-1,wp)/REAL(Agrif_rhot()) 48 48 49 CALL Agrif_Sponge 49 50 Agrif_SpecialValue = 0._wp … … 67 68 ! 68 69 #if defined SPONGE 69 zcoef = REAL( Agrif_NbStepint(), wp ) / Agrif_rhot()70 ! 71 Agrif_SpecialValue = 0._wp70 timecoeff = REAL(Agrif_rhot()-1,wp)/REAL(Agrif_rhot()) 71 72 Agrif_SpecialValue=0. 72 73 Agrif_UseSpecialValue = ln_spc_dyn 73 74 ! … … 189 190 END SUBROUTINE Agrif_Sponge 190 191 191 192 192 SUBROUTINE interptsn_sponge( tabres, i1, i2, j1, j2, k1, k2, n1, n2, before ) 193 193 !!---------------------------------------------------------------------- … … 201 201 INTEGER :: iku, ikv 202 202 REAL(wp) :: ztsa, zabe1, zabe2, zbtr 203 REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2) :: ztu, ztv 204 REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2) ::tsbdiff 203 REAL(wp), DIMENSION(i1:i2,j1:j2,jpk) :: ztu, ztv 204 REAL(wp), DIMENSION(i1:i2,j1:j2,jpk,n1:n2) ::tsbdiff 205 ! vertical interpolation: 206 REAL(wp), DIMENSION(i1:i2,j1:j2,jpk,n1:n2) ::tabres_child 207 REAL(wp), DIMENSION(k1:k2,n1:n2-1) :: tabin 208 REAL(wp), DIMENSION(k1:k2) :: h_in 209 REAL(wp), DIMENSION(1:jpk) :: h_out 210 INTEGER :: N_in, N_out 211 REAL(wp) :: h_diff 205 212 !!---------------------------------------------------------------------- 206 213 ! 207 214 IF( before ) THEN 208 tabres(i1:i2,j1:j2,k1:k2,n1:n2) = tsn(i1:i2,j1:j2,k1:k2,n1:n2) 215 DO jn = 1, jpts 216 DO jk=k1,k2 217 DO jj=j1,j2 218 DO ji=i1,i2 219 tabres(ji,jj,jk,jn) = tsb(ji,jj,jk,jn) 220 END DO 221 END DO 222 END DO 223 END DO 224 225 # if defined key_vertical 226 DO jk=k1,k2 227 DO jj=j1,j2 228 DO ji=i1,i2 229 tabres(ji,jj,jk,jpts+1) = tmask(ji,jj,jk) * e3t_n(ji,jj,jk) 230 END DO 231 END DO 232 END DO 233 # endif 234 209 235 ELSE 210 236 ! 211 tsbdiff(:,:,:,:) = tsb(i1:i2,j1:j2,:,:) - tabres(:,:,:,:) 237 # if defined key_vertical 238 tabres_child(:,:,:,:) = 0. 239 DO jj=j1,j2 240 DO ji=i1,i2 241 N_in = 0 242 DO jk=k1,k2 !k2 = jpk of parent grid 243 IF (tabres(ji,jj,jk,n2) == 0) EXIT 244 N_in = N_in + 1 245 tabin(jk,:) = tabres(ji,jj,jk,n1:n2-1) 246 h_in(N_in) = tabres(ji,jj,jk,n2) 247 END DO 248 N_out = 0 249 DO jk=1,jpk ! jpk of child grid 250 IF (tmask(ji,jj,jk) == 0) EXIT 251 N_out = N_out + 1 252 h_out(jk) = e3t_n(ji,jj,jk) !Child grid scale factors. Could multiply by e1e2t here instead of division above 253 ENDDO 254 IF (N_in > 0) THEN 255 h_diff = sum(h_out(1:N_out))-sum(h_in(1:N_in)) 256 tabres(ji,jj,k2,:) = tabres(ji,jj,k2-1,:) !what is this line for????? 257 DO jn=1,jpts 258 call reconstructandremap(tabin(1:N_in,jn),h_in,tabres_child(ji,jj,1:N_out,jn),h_out,N_in,N_out) 259 ENDDO 260 ENDIF 261 ENDDO 262 ENDDO 263 # endif 264 265 DO jj=j1,j2 266 DO ji=i1,i2 267 DO jk=1,jpkm1 268 # if defined key_vertical 269 tsbdiff(ji,jj,jk,1:jpts) = tsb(ji,jj,jk,1:jpts) - tabres_child(ji,jj,jk,1:jpts) 270 # else 271 tsbdiff(ji,jj,jk,1:jpts) = tsb(ji,jj,jk,1:jpts) - tabres(ji,jj,jk,1:jpts) 272 # endif 273 ENDDO 274 ENDDO 275 ENDDO 276 212 277 DO jn = 1, jpts 213 278 DO jk = 1, jpkm1 … … 256 321 END SUBROUTINE interptsn_sponge 257 322 258 259 SUBROUTINE interpun_sponge( tabres, i1, i2, j1, j2, k1, k2, before )260 !! ----------------------------------------------------------------------261 !! *** ROUTINE interpun_sponge ***262 !!----------------------------------------------------------------------263 INTEGER , INTENT(in ) :: i1, i2, j1, j2, k1, k2264 REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: tabres265 LOGICAL , INTENT(in ) :: before 266 !!267 INTEGER :: ji, jj, jk 323 SUBROUTINE interpun_sponge(tabres,i1,i2,j1,j2,k1,k2,m1,m2, before) 324 !!--------------------------------------------- 325 !! *** ROUTINE interpun_sponge *** 326 !!--------------------------------------------- 327 INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2,m1,m2 328 REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2,m1:m2), INTENT(inout) :: tabres 329 LOGICAL, INTENT(in) :: before 330 331 INTEGER :: ji,jj,jk,jmax 332 268 333 ! sponge parameters 269 INTEGER :: jmax 270 REAL(wp) :: ze2u, ze1v, zua, zva, zbtr 271 REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2) :: ubdiff 272 REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2) :: rotdiff, hdivdiff 273 !!---------------------------------------------------------------------- 334 REAL(wp) :: ze2u, ze1v, zua, zva, zbtr, h_diff 335 REAL(wp), DIMENSION(i1:i2,j1:j2,1:jpk) :: ubdiff 336 REAL(wp), DIMENSION(i1:i2,j1:j2,1:jpk) :: rotdiff, hdivdiff 337 ! vertical interpolation: 338 REAL(wp), DIMENSION(i1:i2,j1:j2,1:jpk) :: tabres_child 339 REAL(wp), DIMENSION(k1:k2) :: tabin, h_in 340 REAL(wp), DIMENSION(1:jpk) :: h_out 341 INTEGER ::N_in,N_out 342 !!--------------------------------------------- 274 343 ! 275 344 IF( before ) THEN 276 tabres = un(i1:i2,j1:j2,:) 345 DO jk=1,jpkm1 346 DO jj=j1,j2 347 DO ji=i1,i2 348 tabres(ji,jj,jk,m1) = ub(ji,jj,jk) 349 # if defined key_vertical 350 tabres(ji,jj,jk,m2) = e3u_n(ji,jj,jk)*umask(ji,jj,jk) 351 # endif 352 END DO 353 END DO 354 END DO 355 277 356 ELSE 278 ubdiff(i1:i2,j1:j2,:) = ( ub(i1:i2,j1:j2,:) - tabres(:,:,:) )*umask(i1:i2,j1:j2,:) 357 358 # if defined key_vertical 359 tabres_child(:,:,:) = 0._wp 360 DO jj=j1,j2 361 DO ji=i1,i2 362 N_in = 0 363 DO jk=k1,k2 364 IF (tabres(ji,jj,jk,m2) == 0) EXIT 365 N_in = N_in + 1 366 tabin(jk) = tabres(ji,jj,jk,m1) 367 h_in(N_in) = tabres(ji,jj,jk,m2) 368 ENDDO 369 ! 370 IF (N_in == 0) THEN 371 tabres_child(ji,jj,:) = 0. 372 CYCLE 373 ENDIF 374 375 N_out = 0 376 DO jk=1,jpk 377 if (umask(ji,jj,jk) == 0) EXIT 378 N_out = N_out + 1 379 h_out(N_out) = e3u_n(ji,jj,jk) 380 ENDDO 381 382 IF (N_out == 0) THEN 383 tabres_child(ji,jj,:) = 0. 384 CYCLE 385 ENDIF 386 387 IF (N_in * N_out > 0) THEN 388 h_diff = sum(h_out(1:N_out))-sum(h_in(1:N_in)) 389 if (h_diff < -1.e4) then 390 print *,'CHECK YOUR BATHY ...', h_diff, sum(h_out(1:N_out)), sum(h_in(1:N_in)) 391 endif 392 ENDIF 393 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) 394 395 ENDDO 396 ENDDO 397 398 ubdiff(i1:i2,j1:j2,:) = (ub(i1:i2,j1:j2,:) - tabres_child(i1:i2,j1:j2,:))*umask(i1:i2,j1:j2,:) 399 #else 400 ubdiff(i1:i2,j1:j2,:) = (ub(i1:i2,j1:j2,:) - tabres(i1:i2,j1:j2,:,1))*umask(i1:i2,j1:j2,:) 401 #endif 402 >>>>>>> .merge-right.r9019 279 403 ! 280 404 DO jk = 1, jpkm1 ! Horizontal slab … … 352 476 END SUBROUTINE interpun_sponge 353 477 354 355 SUBROUTINE interpvn_sponge( tabres, i1, i2, j1, j2, k1, k2, before, nb, ndir ) 356 !!---------------------------------------------------------------------- 357 !! *** ROUTINE interpvn_sponge *** 358 !!---------------------------------------------------------------------- 359 INTEGER , INTENT(in ) :: i1, i2, j1, j2, k1, k2 360 REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: tabres 361 LOGICAL , INTENT(in ) :: before 362 INTEGER , INTENT(in ) :: nb , ndir 478 SUBROUTINE interpvn_sponge(tabres,i1,i2,j1,j2,k1,k2,m1,m2, before,nb,ndir) 479 !!--------------------------------------------- 480 !! *** ROUTINE interpvn_sponge *** 481 !!--------------------------------------------- 482 INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2,m1,m2 483 REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2,m1:m2), INTENT(inout) :: tabres 484 LOGICAL, INTENT(in) :: before 485 INTEGER, INTENT(in) :: nb , ndir 363 486 ! 364 487 INTEGER :: ji, jj, jk … … 367 490 REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2) :: vbdiff, rotdiff, hdivdiff 368 491 !!---------------------------------------------------------------------- 369 492 INTEGER :: ji, jj, jk, imax 493 REAL(wp) :: ze2u, ze1v, zua, zva, zbtr, h_diff 494 REAL(wp), DIMENSION(i1:i2,j1:j2,1:jpk) :: vbdiff 495 REAL(wp), DIMENSION(i1:i2,j1:j2,1:jpk) :: rotdiff, hdivdiff 496 ! vertical interpolation: 497 REAL(wp), DIMENSION(i1:i2,j1:j2,1:jpk) :: tabres_child 498 REAL(wp), DIMENSION(k1:k2) :: tabin, h_in 499 REAL(wp), DIMENSION(1:jpk) :: h_out 500 INTEGER :: N_in, N_out 501 !!--------------------------------------------- 502 >>>>>>> .merge-right.r9019 503 370 504 IF( before ) THEN 371 tabres = vn(i1:i2,j1:j2,:) 505 DO jk=1,jpkm1 506 DO jj=j1,j2 507 DO ji=i1,i2 508 tabres(ji,jj,jk,m1) = vb(ji,jj,jk) 509 # if defined key_vertical 510 tabres(ji,jj,jk,m2) = vmask(ji,jj,jk) * e3v_n(ji,jj,jk) 511 # endif 512 END DO 513 END DO 514 END DO 372 515 ELSE 373 ! 374 vbdiff(i1:i2,j1:j2,:) = ( vb(i1:i2,j1:j2,:) - tabres(:,:,:) ) * vmask(i1:i2,j1:j2,:) 516 517 # if defined key_vertical 518 tabres_child(:,:,:) = 0._wp 519 DO jj=j1,j2 520 DO ji=i1,i2 521 N_in = 0 522 DO jk=k1,k2 523 IF (tabres(ji,jj,jk,m2) == 0) EXIT 524 N_in = N_in + 1 525 tabin(jk) = tabres(ji,jj,jk,m1) 526 h_in(N_in) = tabres(ji,jj,jk,m2) 527 ENDDO 528 529 IF (N_in == 0) THEN 530 tabres_child(ji,jj,:) = 0. 531 CYCLE 532 ENDIF 533 534 N_out = 0 535 DO jk=1,jpk 536 if (vmask(ji,jj,jk) == 0) EXIT 537 N_out = N_out + 1 538 h_out(N_out) = e3v_n(ji,jj,jk) 539 ENDDO 540 541 IF (N_in * N_out > 0) THEN 542 h_diff = sum(h_out(1:N_out))-sum(h_in(1:N_in)) 543 if (h_diff < -1.e4) then 544 print *,'CHECK YOUR BATHY ...', h_diff, sum(h_out(1:N_out)), sum(h_in(1:N_in)) 545 endif 546 ENDIF 547 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) 548 ENDDO 549 ENDDO 550 551 vbdiff(i1:i2,j1:j2,:) = (vb(i1:i2,j1:j2,:) - tabres_child(i1:i2,j1:j2,:))*vmask(i1:i2,j1:j2,:) 552 # else 553 vbdiff(i1:i2,j1:j2,:) = (vb(i1:i2,j1:j2,:) - tabres(i1:i2,j1:j2,:,1))*vmask(i1:i2,j1:j2,:) 554 # endif 375 555 ! 376 556 DO jk = 1, jpkm1 ! Horizontal slab
Note: See TracChangeset
for help on using the changeset viewer.
