- Timestamp:
- 2021-12-03T20:32:50+01:00 (3 years ago)
- Location:
- NEMO/branches/2021/dev_r14318_RK3_stage1
- Files:
-
- 2 edited
-
. (modified) (1 prop)
-
src/NST/agrif_oce_sponge.F90 (modified) (30 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2021/dev_r14318_RK3_stage1
- Property svn:externals
-
old new 9 9 10 10 # SETTE 11 ^/utils/CI/sette@14244 sette 11 ^/utils/CI/sette@HEAD sette 12
-
- Property svn:externals
-
NEMO/branches/2021/dev_r14318_RK3_stage1/src/NST/agrif_oce_sponge.F90
r14800 r15574 159 159 ztabramp(:,:) = 0._wp 160 160 161 IF( lk_west ) THEN 162 ind1 = nn_hls + 1 + nbghostcells ! halo + land+ nbghostcells163 ind2 = nn_hls + 1 +nbghostcells + ispongearea161 IF( lk_west ) THEN ! --- West --- ! 162 ind1 = nn_hls + nbghostcells ! halo + nbghostcells 163 ind2 = nn_hls + nbghostcells + ispongearea 164 164 DO ji = mi0(ind1), mi1(ind2) 165 165 DO jj = 1, jpj … … 169 169 ! ghost cells: 170 170 ind1 = 1 171 ind2 = nn_hls + 1 + nbghostcells ! halo + land+ nbghostcells171 ind2 = nn_hls + nbghostcells ! halo + nbghostcells 172 172 DO ji = mi0(ind1), mi1(ind2) 173 173 DO jj = 1, jpj … … 177 177 ENDIF 178 178 IF( lk_east ) THEN ! --- East --- ! 179 ind1 = jpiglo - ( nn_hls + nbghostcells ) - ispongearea - 1180 ind2 = jpiglo - ( nn_hls + nbghostcells ) - 1 ! halo + land + nbghostcells - 1179 ind1 = jpiglo - ( nn_hls + nbghostcells -1 ) - ispongearea - 1 180 ind2 = jpiglo - ( nn_hls + nbghostcells -1 ) - 1 ! halo + land + nbghostcells - 1 181 181 DO ji = mi0(ind1), mi1(ind2) 182 182 DO jj = 1, jpj … … 185 185 END DO 186 186 ! ghost cells: 187 ind1 = jpiglo - ( nn_hls + nbghostcells ) - 1 ! halo + land + nbghostcells - 1187 ind1 = jpiglo - ( nn_hls + nbghostcells -1 ) - 1 ! halo + land + nbghostcells - 1 188 188 ind2 = jpiglo - 1 189 189 DO ji = mi0(ind1), mi1(ind2) … … 194 194 ENDIF 195 195 IF( lk_south ) THEN ! --- South --- ! 196 ind1 = nn_hls + 1 + nbghostcells ! halo + land+ nbghostcells197 ind2 = nn_hls + 1 +nbghostcells + jspongearea196 ind1 = nn_hls + nbghostcells ! halo + nbghostcells 197 ind2 = nn_hls + nbghostcells + jspongearea 198 198 DO jj = mj0(ind1), mj1(ind2) 199 199 DO ji = 1, jpi … … 203 203 ! ghost cells: 204 204 ind1 = 1 205 ind2 = nn_hls + 1 + nbghostcells ! halo + land+ nbghostcells205 ind2 = nn_hls + nbghostcells ! halo + nbghostcells 206 206 DO jj = mj0(ind1), mj1(ind2) 207 207 DO ji = 1, jpi … … 211 211 ENDIF 212 212 IF( lk_north ) THEN ! --- North --- ! 213 ind1 = jpjglo - ( nn_hls + nbghostcells ) - jspongearea - 1214 ind2 = jpjglo - ( nn_hls + nbghostcells ) - 1 ! halo + land+ nbghostcells - 1213 ind1 = jpjglo - ( nn_hls + nbghostcells -1 ) - jspongearea - 1 214 ind2 = jpjglo - ( nn_hls + nbghostcells -1 ) - 1 ! halo + nbghostcells - 1 215 215 DO jj = mj0(ind1), mj1(ind2) 216 216 DO ji = 1, jpi … … 219 219 END DO 220 220 ! ghost cells: 221 ind1 = jpjglo - ( nn_hls + nbghostcells ) ! halo + land + nbghostcells - 1221 ind1 = jpjglo - ( nn_hls + nbghostcells -1 ) ! halo + land + nbghostcells - 1 222 222 ind2 = jpjglo 223 223 DO jj = mj0(ind1), mj1(ind2) … … 245 245 END_2D 246 246 247 CALL lbc_lnk _multi( 'agrif_Sponge', fspu, 'U', 1._wp, fspv, 'V', 1._wp, fspt, 'T', 1._wp, fspf, 'F', 1._wp )247 CALL lbc_lnk( 'agrif_Sponge', fspu, 'U', 1._wp, fspv, 'V', 1._wp, fspt, 'T', 1._wp, fspf, 'F', 1._wp ) 248 248 ! 249 249 ! Remove vertical interpolation where not needed: … … 293 293 294 294 IF( lk_west ) THEN ! --- West --- ! 295 ind1 = nn_hls + 1 +nbghostcells + ishift296 ind2 = nn_hls + 1 +nbghostcells + ishift + ispongearea295 ind1 = nn_hls + nbghostcells + ishift 296 ind2 = nn_hls + nbghostcells + ishift + ispongearea 297 297 DO ji = mi0(ind1), mi1(ind2) 298 298 DO jj = 1, jpj … … 302 302 ! ghost cells: 303 303 ind1 = 1 304 ind2 = nn_hls + 1 + nbghostcells + ishift ! halo + land+ nbghostcells304 ind2 = nn_hls + nbghostcells + ishift ! halo + nbghostcells 305 305 DO ji = mi0(ind1), mi1(ind2) 306 306 DO jj = 1, jpj … … 310 310 ENDIF 311 311 IF( lk_east ) THEN ! --- East --- ! 312 ind1 = jpiglo - ( nn_hls + nbghostcells + ishift) - ispongearea - 1313 ind2 = jpiglo - ( nn_hls + nbghostcells + ishift) - 1 ! halo + land+ nbghostcells - 1312 ind1 = jpiglo - ( nn_hls + nbghostcells -1 + ishift) - ispongearea - 1 313 ind2 = jpiglo - ( nn_hls + nbghostcells -1 + ishift) - 1 ! halo + nbghostcells - 1 314 314 DO ji = mi0(ind1), mi1(ind2) 315 315 DO jj = 1, jpj … … 318 318 END DO 319 319 ! ghost cells: 320 ind1 = jpiglo - ( nn_hls + nbghostcells + ishift) - 1 ! halo + land+ nbghostcells - 1320 ind1 = jpiglo - ( nn_hls + nbghostcells -1 + ishift) - 1 ! halo + nbghostcells - 1 321 321 ind2 = jpiglo - 1 322 322 DO ji = mi0(ind1), mi1(ind2) … … 327 327 ENDIF 328 328 IF( lk_south ) THEN ! --- South --- ! 329 ind1 = nn_hls + 1 + nbghostcells + jshift ! halo + land+ nbghostcells330 ind2 = nn_hls + 1 +nbghostcells + jshift + jspongearea329 ind1 = nn_hls + nbghostcells + jshift ! halo + nbghostcells 330 ind2 = nn_hls + nbghostcells + jshift + jspongearea 331 331 DO jj = mj0(ind1), mj1(ind2) 332 332 DO ji = 1, jpi … … 336 336 ! ghost cells: 337 337 ind1 = 1 338 ind2 = nn_hls + 1 +nbghostcells + jshift ! halo + land + nbghostcells338 ind2 = nn_hls + nbghostcells + jshift ! halo + land + nbghostcells 339 339 DO jj = mj0(ind1), mj1(ind2) 340 340 DO ji = 1, jpi … … 344 344 ENDIF 345 345 IF( lk_north ) THEN ! --- North --- ! 346 ind1 = jpjglo - ( nn_hls + nbghostcells + jshift) - jspongearea - 1347 ind2 = jpjglo - ( nn_hls + nbghostcells + jshift) - 1 ! halo + land + nbghostcells - 1346 ind1 = jpjglo - ( nn_hls + nbghostcells -1 + jshift) - jspongearea - 1 347 ind2 = jpjglo - ( nn_hls + nbghostcells -1 + jshift) - 1 ! halo + land + nbghostcells - 1 348 348 DO jj = mj0(ind1), mj1(ind2) 349 349 DO ji = 1, jpi … … 352 352 END DO 353 353 ! ghost cells: 354 ind1 = jpjglo - ( nn_hls + nbghostcells + jshift) ! halo + land + nbghostcells - 1354 ind1 = jpjglo - ( nn_hls + nbghostcells -1 + jshift) ! halo + land + nbghostcells - 1 355 355 ind2 = jpjglo 356 356 DO jj = mj0(ind1), mj1(ind2) … … 377 377 fspf_2d(ji,jj) = ztabramp(ji,jj) * ssvmask(ji,jj) * ssvmask(ji,jj+1) 378 378 END_2D 379 CALL lbc_lnk _multi( 'agrif_Sponge_2d', fspu_2d, 'U', 1._wp, fspv_2d, 'V', 1._wp, fspt_2d, 'T', 1._wp, fspf_2d, 'F', 1._wp )379 CALL lbc_lnk( 'agrif_Sponge_2d', fspu_2d, 'U', 1._wp, fspv_2d, 'V', 1._wp, fspt_2d, 'T', 1._wp, fspf_2d, 'F', 1._wp ) 380 380 ! 381 381 #endif … … 395 395 INTEGER :: iku, ikv 396 396 REAL(wp) :: ztsa, zabe1, zabe2, zbtr, zhtot 397 REAl(wp) :: zflag, zdmod, zdtot 397 398 REAL(wp), DIMENSION(i1-1:i2,j1-1:j2,jpk) :: ztu, ztv 398 399 REAL(wp), DIMENSION(i1:i2,j1:j2,jpk,n1:n2) ::tsbdiff … … 410 411 DO jj=j1,j2 411 412 DO ji=i1,i2 412 tabres(ji,jj,jk,jn) = ts(ji,jj,jk,jn,Kbb_a) 413 ! JC: masking is mandatory here: before tracer field seems 414 ! to hold non zero values where tmask=0 415 tabres(ji,jj,jk,jn) = ts(ji,jj,jk,jn,Kbb_a) * tmask(ji,jj,jk) 413 416 END DO 414 417 END DO … … 545 548 DO ji = i1,i2-1 546 549 zabe1 = rn_sponge_tra * r1_Dt * umask(ji,jj,jk) * e1e2u(ji,jj) * e3u(ji,jj,jk,Kmm_a) 547 ztu(ji,jj,jk) = zabe1 * fspu(ji,jj) * ( tsbdiff(ji+1,jj ,jk,jn) - tsbdiff(ji,jj,jk,jn) ) 550 zdtot = tsbdiff(ji+1,jj,jk,jn) - tsbdiff(ji,jj,jk,jn) 551 zdmod = ts(ji+1,jj,jk,jn,Kbb_a) - ts(ji,jj,jk,jn,Kbb_a) 552 zflag = 0.5_wp + SIGN(0.5_wp, zdtot*zdmod) 553 ztu(ji,jj,jk) = zabe1 * fspu(ji,jj) * ( zflag * zdtot + (1._wp - zflag) * zdmod ) 548 554 END DO 549 555 END DO … … 553 559 zabe2 = rn_sponge_tra * r1_Dt * vmask(ji,jj,jk) * e1e2v(ji,jj) * e3v(ji,jj,jk,Kmm_a) 554 560 ztv(ji,jj,jk) = zabe2 * fspv(ji,jj) * ( tsbdiff(ji ,jj+1,jk,jn) - tsbdiff(ji,jj,jk,jn) ) 561 zdtot = tsbdiff(ji,jj+1,jk,jn) - tsbdiff(ji,jj,jk,jn) 562 zdmod = ts(ji,jj+1,jk,jn,Kbb_a) - ts(ji,jj,jk,jn,Kbb_a) 563 zflag = 0.5_wp + SIGN(0.5_wp, zdtot*zdmod) 564 ztv(ji,jj,jk) = zabe2 * fspv(ji,jj) * ( zflag * zdtot + (1._wp - zflag) * zdmod ) 555 565 END DO 556 566 END DO … … 621 631 DO jj=j1,j2 622 632 DO ji=i1,i2 623 tabres(ji,jj,jk,m1) = uu(ji,jj,jk,Kbb_a) 633 tabres(ji,jj,jk,m1) = uu(ji,jj,jk,Kbb_a) * umask(ji,jj,jk) 624 634 END DO 625 635 END DO … … 697 707 END DO 698 708 699 ubdiff(i1:i2,j1:j2, :) = (uu(i1:i2,j1:j2,:,Kbb_a) - tabres_child(i1:i2,j1:j2,:))*umask(i1:i2,j1:j2,:)709 ubdiff(i1:i2,j1:j2,1:jpk) = (uu(i1:i2,j1:j2,1:jpk,Kbb_a) - tabres_child(i1:i2,j1:j2,1:jpk))*umask(i1:i2,j1:j2,1:jpk) 700 710 ELSE 701 711 702 ubdiff(i1:i2,j1:j2, :) = (uu(i1:i2,j1:j2,:,Kbb_a) - tabres(i1:i2,j1:j2,:,1))*umask(i1:i2,j1:j2,:)712 ubdiff(i1:i2,j1:j2,1:jpk) = (uu(i1:i2,j1:j2,1:jpk,Kbb_a) - tabres(i1:i2,j1:j2,1:jpk,1))*umask(i1:i2,j1:j2,1:jpk) 703 713 704 714 ENDIF … … 750 760 751 761 jmax = j2-1 752 ind1 = jpjglo - ( nn_hls + nbghostcells + 2) ! North762 ind1 = jpjglo - ( nn_hls + nbghostcells + 1 ) ! North 753 763 DO jj = mj0(ind1), mj1(ind1) 754 764 jmax = MIN(jmax,jj) … … 806 816 DO jj=j1,j2 807 817 DO ji=i1,i2 808 tabres(ji,jj,jk,m1) = vv(ji,jj,jk,Kbb_a) 818 tabres(ji,jj,jk,m1) = vv(ji,jj,jk,Kbb_a) * vmask(ji,jj,jk) 809 819 END DO 810 820 END DO … … 881 891 END DO 882 892 883 vbdiff(i1:i2,j1:j2, :) = (vv(i1:i2,j1:j2,:,Kbb_a) - tabres_child(i1:i2,j1:j2,:))*vmask(i1:i2,j1:j2,:)893 vbdiff(i1:i2,j1:j2,1:jpk) = (vv(i1:i2,j1:j2,1:jpk,Kbb_a) - tabres_child(i1:i2,j1:j2,1:jpk))*vmask(i1:i2,j1:j2,1:jpk) 884 894 ELSE 885 895 886 vbdiff(i1:i2,j1:j2, :) = (vv(i1:i2,j1:j2,:,Kbb_a) - tabres(i1:i2,j1:j2,:,1))*vmask(i1:i2,j1:j2,:)896 vbdiff(i1:i2,j1:j2,1:jpk) = (vv(i1:i2,j1:j2,1:jpk,Kbb_a) - tabres(i1:i2,j1:j2,1:jpk,1))*vmask(i1:i2,j1:j2,1:jpk) 887 897 888 898 ENDIF … … 914 924 915 925 imax = i2 - 1 916 ind1 = jpiglo - ( nn_hls + nbghostcells + 2) ! East926 ind1 = jpiglo - ( nn_hls + nbghostcells + 1 ) ! East 917 927 DO ji = mi0(ind1), mi1(ind1) 918 928 imax = MIN(imax,ji) … … 1014 1024 1015 1025 jmax = j2-1 1016 ind1 = jpjglo - ( nn_hls + nbghostcells + 2) ! North1026 ind1 = jpjglo - ( nn_hls + nbghostcells + 1 ) ! North 1017 1027 DO jj = mj0(ind1), mj1(ind1) 1018 1028 jmax = MIN(jmax,jj) … … 1081 1091 1082 1092 imax = i2 - 1 1083 ind1 = jpiglo - ( nn_hls + nbghostcells + 2) ! East1093 ind1 = jpiglo - ( nn_hls + nbghostcells + 1 ) ! East 1084 1094 DO ji = mi0(ind1), mi1(ind1) 1085 1095 imax = MIN(imax,ji)
Note: See TracChangeset
for help on using the changeset viewer.
