- Timestamp:
- 2020-11-27T17:26:33+01:00 (3 years ago)
- Location:
- NEMO/branches/2020/tickets_icb_1900
- Files:
-
- 2 edited
-
. (modified) (1 prop)
-
src/NST/agrif_oce_sponge.F90 (modified) (30 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2020/tickets_icb_1900
- Property svn:externals
-
NEMO/branches/2020/tickets_icb_1900/src/NST/agrif_oce_sponge.F90
r13226 r13899 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.82 use_sign_north = .TRUE. 83 sign_north = -1._wp 84 84 ! 85 85 tabspongedone_u = .FALSE. … … 92 92 ! 93 93 Agrif_UseSpecialValue = .FALSE. 94 use_sign_north = .FALSE.94 use_sign_north = .FALSE. 95 95 #endif 96 96 ! … … 109 109 REAL(wp) :: z1_ispongearea, z1_jspongearea 110 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 111 115 REAL(wp), DIMENSION(jpjmax) :: zmskwest, zmskeast 112 116 REAL(wp), DIMENSION(jpimax) :: zmsknorth, zmsksouth … … 129 133 ! Retrieve masks at open boundaries: 130 134 131 ! --- West --- ! 132 IF( lk_west) THEN 135 IF( lk_west ) THEN ! --- West --- ! 133 136 ztabramp(:,:) = 0._wp 134 ind1 = 1+nbghostcells137 ind1 = nn_hls + 1 + nbghostcells ! halo + land + nbghostcells 135 138 DO ji = mi0(ind1), mi1(ind1) 136 139 ztabramp(ji,:) = ssumask(ji,:) 137 140 END DO 138 ! 139 zmskwest(:) = 0._wp 140 zmskwest(1:jpj) = MAXVAL(ztabramp(:,:), dim=1) 141 zmskwest( 1:jpj ) = MAXVAL(ztabramp(:,:), dim=1) 142 zmskwest(jpj+1:jpjmax) = 0._wp 141 143 ENDIF 142 143 ! --- East --- ! 144 IF( lk_east ) THEN 144 IF( lk_east ) THEN ! --- East --- ! 145 145 ztabramp(:,:) = 0._wp 146 ind1 = jpiglo - nbghostcells - 1146 ind1 = jpiglo - ( nn_hls + nbghostcells + 1) ! halo + land + nbghostcells 147 147 DO ji = mi0(ind1), mi1(ind1) 148 148 ztabramp(ji,:) = ssumask(ji,:) 149 149 END DO 150 ! 151 zmskeast(:) = 0._wp 152 zmskeast(1:jpj) = MAXVAL(ztabramp(:,:), dim=1) 150 zmskeast( 1:jpj ) = MAXVAL(ztabramp(:,:), dim=1) 151 zmskeast(jpj+1:jpjmax) = 0._wp 153 152 ENDIF 154 155 ! --- South --- ! 156 IF( lk_south ) THEN 153 IF( lk_south ) THEN ! --- South --- ! 157 154 ztabramp(:,:) = 0._wp 158 ind1 = 1+nbghostcells155 ind1 = nn_hls + 1 + nbghostcells ! halo + land + nbghostcells 159 156 DO jj = mj0(ind1), mj1(ind1) 160 157 ztabramp(:,jj) = ssvmask(:,jj) 161 158 END DO 162 ! 163 zmsksouth(:) = 0._wp 164 zmsksouth(1:jpi) = MAXVAL(ztabramp(:,:), dim=2) 159 zmsksouth( 1:jpi ) = MAXVAL(ztabramp(:,:), dim=2) 160 zmsksouth(jpi+1:jpimax) = 0._wp 165 161 ENDIF 166 167 ! --- North --- ! 168 IF( lk_north) THEN 162 IF( lk_north ) THEN ! --- North --- ! 169 163 ztabramp(:,:) = 0._wp 170 ind1 = jpjglo - nbghostcells - 1164 ind1 = jpjglo - ( nn_hls + nbghostcells + 1) ! halo + land + nbghostcells 171 165 DO jj = mj0(ind1), mj1(ind1) 172 166 ztabramp(:,jj) = ssvmask(:,jj) 173 167 END DO 174 ! 175 zmsknorth(:) = 0._wp 176 zmsknorth(1:jpi) = MAXVAL(ztabramp(:,:), dim=2) 168 zmsknorth( 1:jpi ) = MAXVAL(ztabramp(:,:), dim=2) 169 zmsknorth(jpi+1:jpimax) = 0._wp 177 170 ENDIF 178 171 … … 180 173 zmskwest(:) = 1._wp 181 174 zmskeast(:) = 1._wp 175 zmsksouth(:) = 1._wp 182 176 zmsknorth(:) = 1._wp 183 zmsksouth(:) = 1._wp184 177 #if defined key_mpp_mpi 185 178 ! CALL mpp_max( 'AGRIF_sponge', zmskwest(:) , jpjmax ) … … 192 185 ! Store it in ztabramp 193 186 194 ispongearea = nn_sponge_len * Agrif_irhox()195 z1_ispongearea = 1._wp / REAL( ispongearea )196 jspongearea = nn_sponge_len * Agrif_irhoy()197 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 ) 198 191 199 192 ztabramp(:,:) = 0._wp … … 203 196 IF ( nbcellsy <= 3 ) jspongearea = -1 204 197 205 ! --- West --- ! 206 IF(lk_west) THEN 207 ind1 = 1+nbghostcells 208 ind2 = 1+nbghostcells + ispongearea 198 IF( lk_west ) THEN ! --- West --- ! 199 ind1 = nn_hls + 1 + nbghostcells ! halo + land + nbghostcells 200 ind2 = nn_hls + 1 + nbghostcells + ispongearea 209 201 DO ji = mi0(ind1), mi1(ind2) 210 202 DO jj = 1, jpj 211 ztabramp(ji,jj) = REAL( ind2 - mig(ji) ) * z1_ispongearea * zmskwest(jj) 212 END DO 213 END DO 214 203 ztabramp(ji,jj) = REAL(ind2 - mig(ji), wp) * z1_ispongearea * zmskwest(jj) 204 END DO 205 END DO 215 206 ! ghost cells: 216 207 ind1 = 1 217 ind2 = n bghostcells + 1208 ind2 = nn_hls + 1 + nbghostcells ! halo + land + nbghostcells 218 209 DO ji = mi0(ind1), mi1(ind2) 219 210 DO jj = 1, jpj … … 222 213 END DO 223 214 ENDIF 224 225 ! --- East --- ! 226 IF(lk_east) THEN 227 ind1 = jpiglo - nbghostcells - ispongearea 228 ind2 = jpiglo - nbghostcells 215 IF( lk_east ) THEN ! --- East --- ! 216 ind1 = jpiglo - ( nn_hls + nbghostcells ) - ispongearea 217 ind2 = jpiglo - ( nn_hls + nbghostcells ) ! halo + land + nbghostcells - 1 229 218 DO ji = mi0(ind1), mi1(ind2) 230 231 219 DO jj = 1, jpj 232 ztabramp(ji,jj) = MAX( ztabramp(ji,jj), REAL( mig(ji) - ind1 ) * z1_ispongearea) * zmskeast(jj) 233 ENDDO 234 END DO 235 220 ztabramp(ji,jj) = MAX( ztabramp(ji,jj), REAL(mig(ji) - ind1, wp) * z1_ispongearea ) * zmskeast(jj) 221 END DO 222 END DO 236 223 ! ghost cells: 237 ind1 = jpiglo - nbghostcells224 ind1 = jpiglo - ( nn_hls + nbghostcells ) ! halo + land + nbghostcells - 1 238 225 ind2 = jpiglo 239 226 DO ji = mi0(ind1), mi1(ind2) 240 241 227 DO jj = 1, jpj 242 228 ztabramp(ji,jj) = zmskeast(jj) 243 ENDDO 244 END DO 245 ENDIF 246 247 ! --- South --- ! 248 IF( lk_south ) THEN 249 ind1 = 1+nbghostcells 250 ind2 = 1+nbghostcells + jspongearea 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 251 235 DO jj = mj0(ind1), mj1(ind2) 252 236 DO ji = 1, jpi 253 ztabramp(ji,jj) = MAX( ztabramp(ji,jj), REAL( ind2 - mjg(jj) ) * z1_jspongearea) * zmsksouth(ji) 254 END DO 255 END DO 256 237 ztabramp(ji,jj) = MAX( ztabramp(ji,jj), REAL(ind2 - mjg(jj), wp) * z1_jspongearea ) * zmsksouth(ji) 238 END DO 239 END DO 257 240 ! ghost cells: 258 241 ind1 = 1 259 ind2 = n bghostcells + 1242 ind2 = nn_hls + 1 + nbghostcells ! halo + land + nbghostcells 260 243 DO jj = mj0(ind1), mj1(ind2) 261 244 DO ji = 1, jpi … … 264 247 END DO 265 248 ENDIF 266 267 ! --- North --- ! 268 IF( lk_north ) THEN 269 ind1 = jpjglo - nbghostcells - jspongearea 270 ind2 = jpjglo - nbghostcells 249 IF( lk_north ) THEN ! --- North --- ! 250 ind1 = jpjglo - ( nn_hls + nbghostcells ) - jspongearea 251 ind2 = jpjglo - ( nn_hls + nbghostcells ) ! halo + land + nbghostcells - 1 271 252 DO jj = mj0(ind1), mj1(ind2) 272 253 DO ji = 1, jpi 273 ztabramp(ji,jj) = MAX( ztabramp(ji,jj), REAL( mjg(jj) - ind1 ) * z1_jspongearea) * zmsknorth(ji) 274 END DO 275 END DO 276 254 ztabramp(ji,jj) = MAX( ztabramp(ji,jj), REAL(mjg(jj) - ind1, wp) * z1_jspongearea ) * zmsknorth(ji) 255 END DO 256 END DO 277 257 ! ghost cells: 278 ind1 = jpjglo - nbghostcells258 ind1 = jpjglo - ( nn_hls + nbghostcells ) ! halo + land + nbghostcells - 1 279 259 ind2 = jpjglo 280 260 DO jj = mj0(ind1), mj1(ind2) … … 284 264 END DO 285 265 ENDIF 286 266 ! 287 267 ENDIF 288 268 … … 291 271 fspu(:,:) = 0._wp 292 272 fspv(:,:) = 0._wp 293 DO_2D _00_00273 DO_2D( 0, 0, 0, 0 ) 294 274 fspu(ji,jj) = 0.5_wp * ( ztabramp(ji,jj) + ztabramp(ji+1,jj ) ) * ssumask(ji,jj) 295 275 fspv(ji,jj) = 0.5_wp * ( ztabramp(ji,jj) + ztabramp(ji ,jj+1) ) * ssvmask(ji,jj) 296 276 END_2D 297 CALL lbc_lnk( 'agrif_Sponge', fspu, 'U', 1.0_wp ) ! Lateral boundary conditions298 CALL lbc_lnk( 'agrif_Sponge', fspv, 'V', 1.0_wp )299 300 spongedoneT = .TRUE.301 277 ENDIF 302 278 … … 305 281 fspt(:,:) = 0._wp 306 282 fspf(:,:) = 0._wp 307 DO_2D _00_00283 DO_2D( 0, 0, 0, 0 ) 308 284 fspt(ji,jj) = ztabramp(ji,jj) * ssmask(ji,jj) 309 285 fspf(ji,jj) = 0.25_wp * ( ztabramp(ji ,jj ) + ztabramp(ji ,jj+1) & … … 311 287 & * ssvmask(ji,jj) * ssvmask(ji,jj+1) 312 288 END_2D 313 CALL lbc_lnk( 'agrif_Sponge', fspt, 'T', 1.0_wp ) ! Lateral boundary conditions 314 CALL lbc_lnk( 'agrif_Sponge', fspf, 'F', 1.0_wp ) 315 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. 316 294 spongedoneU = .TRUE. 317 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 318 304 319 305 #if defined key_vertical 320 306 ! Remove vertical interpolation where not needed: 321 DO_2D _00_00307 DO_2D( 0, 0, 0, 0 ) 322 308 IF ((fspu(ji-1,jj)==0._wp).AND.(fspu(ji,jj)==0._wp).AND. & 323 309 & (fspv(ji,jj-1)==0._wp).AND.(fspv(ji,jj)==0._wp)) mbkt_parent(ji,jj) = 0 … … 334 320 END_2D 335 321 ! 336 ztabramp(:,:) = REAL( mbkt_parent(:,:), wp ) ; CALL lbc_lnk( 'Agrif_Sponge', ztabramp, 'T', 1.0_wp ) 337 mbkt_parent(:,:) = NINT( ztabramp(:,:) ) 338 ztabramp(:,:) = REAL( mbku_parent(:,:), wp ) ; CALL lbc_lnk( 'Agrif_Sponge', ztabramp, 'U', 1.0_wp ) 339 mbku_parent(:,:) = NINT( ztabramp(:,:) ) 340 ztabramp(:,:) = REAL( mbkv_parent(:,:), wp ) ; CALL lbc_lnk( 'Agrif_Sponge', ztabramp, 'V', 1.0_wp ) 341 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(:,:) ) 342 329 #endif 343 330 ! … … 346 333 END SUBROUTINE Agrif_Sponge 347 334 335 348 336 SUBROUTINE interptsn_sponge( tabres, i1, i2, j1, j2, k1, k2, n1, n2, before ) 349 337 !!---------------------------------------------------------------------- … … 433 421 N_out = N_out + 1 434 422 h_out(jk) = e3t(ji,jj,jk,Kbb_a) !Child grid scale factors. Could multiply by e1e2t here instead of division above 435 END DO423 END DO 436 424 437 425 ! Account for small differences in free-surface … … 444 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) 445 433 ENDIF 446 END DO447 END DO434 END DO 435 END DO 448 436 # endif 449 437 … … 456 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) 457 445 # endif 458 END DO459 END DO460 END DO446 END DO 447 END DO 448 END DO 461 449 462 450 DO jn = 1, jpts … … 513 501 END SUBROUTINE interptsn_sponge 514 502 503 515 504 SUBROUTINE interpun_sponge(tabres,i1,i2,j1,j2,k1,k2,m1,m2, before) 516 505 !!--------------------------------------------- … … 521 510 LOGICAL, INTENT(in) :: before 522 511 523 INTEGER :: ji,jj,jk,jmax524 512 INTEGER :: ji,jj,jk,jmax 513 INTEGER :: ind1 525 514 ! sponge parameters 526 515 REAL(wp) :: ze2u, ze1v, zua, zva, zbtr, zhtot … … 586 575 zhtot = zhtot + h_in(jk) 587 576 tabin(jk) = tabres(ji,jj,jk,m1) 588 END DO577 END DO 589 578 ! 590 579 N_out = 0 … … 593 582 N_out = N_out + 1 594 583 h_out(N_out) = e3u(ji,jj,jk,Kbb_a) 595 END DO584 END DO 596 585 597 586 ! Account for small differences in free-surface … … 605 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) 606 595 ENDIF 607 END DO608 END DO596 END DO 597 END DO 609 598 610 599 ubdiff(i1:i2,j1:j2,:) = (uu(i1:i2,j1:j2,:,Kbb_a) - tabres_child(i1:i2,j1:j2,:))*umask(i1:i2,j1:j2,:) … … 659 648 660 649 jmax = j2-1 661 ! IF (lk_north) jmax = MIN(jmax,nlcj-nbghostcells-2) ! North 662 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 663 654 664 655 DO jj = j1+1, jmax … … 688 679 END SUBROUTINE interpun_sponge 689 680 690 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) 691 683 !!--------------------------------------------- 692 684 !! *** ROUTINE interpvn_sponge *** … … 695 687 REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2,m1:m2), INTENT(inout) :: tabres 696 688 LOGICAL, INTENT(in) :: before 697 INTEGER, INTENT(in) :: nb , ndir698 689 ! 699 690 INTEGER :: ji, jj, jk, imax 691 INTEGER :: ind1 700 692 REAL(wp) :: ze2u, ze1v, zua, zva, zbtr, zhtot 701 693 REAL(wp), DIMENSION(i1:i2,j1:j2,1:jpk) :: vbdiff … … 759 751 zhtot = zhtot + h_in(jk) 760 752 tabin(jk) = tabres(ji,jj,jk,m1) 761 END DO753 END DO 762 754 ! 763 755 N_out = 0 … … 766 758 N_out = N_out + 1 767 759 h_out(N_out) = e3v(ji,jj,jk,Kbb_a) 768 END DO760 END DO 769 761 770 762 ! Account for small differences in free-surface … … 778 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) 779 771 ENDIF 780 END DO781 END DO772 END DO 773 END DO 782 774 783 775 vbdiff(i1:i2,j1:j2,:) = (vv(i1:i2,j1:j2,:,Kbb_a) - tabres_child(i1:i2,j1:j2,:))*vmask(i1:i2,j1:j2,:) … … 812 804 813 805 imax = i2 - 1 814 ! IF(lk_east) imax = MIN(imax,nlci-nbghostcells-2) ! East 815 IF ((nbondi == 1).OR.(nbondi == 2)) imax = MIN(imax,nlci-nbghostcells-2) ! East 816 806 ind1 = jpiglo - ( nn_hls + nbghostcells + 2 ) ! East 807 DO ji = mi0(ind1), mi1(ind1) 808 imax = MIN(imax,ji) 809 END DO 810 817 811 DO jj = j1+1, j2 818 812 DO ji = i1+1, imax ! vector opt.
Note: See TracChangeset
for help on using the changeset viewer.
