- Timestamp:
- 2020-06-08T18:11:57+02:00 (4 years ago)
- Location:
- NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/NST
- Files:
-
- 4 edited
-
agrif_oce.F90 (modified) (1 diff)
-
agrif_oce_interp.F90 (modified) (30 diffs)
-
agrif_oce_sponge.F90 (modified) (17 diffs)
-
agrif_user.F90 (modified) (12 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/NST/agrif_oce.F90
r12377 r13065 67 67 INTEGER, PUBLIC :: avt_id, avm_id, en_id ! TKE related identificators 68 68 INTEGER, PUBLIC :: mbkt_id, ht0_id 69 INTEGER, PUBLIC :: glamt_id, gphit_id 69 70 INTEGER, PUBLIC :: kindic_agr 70 71 -
NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/NST/agrif_oce_interp.F90
r12377 r13065 43 43 PUBLIC interptsn, interpsshn, interpavm 44 44 PUBLIC interpunb, interpvnb , interpub2b, interpvb2b 45 PUBLIC interpe3t 45 PUBLIC interpe3t, interpglamt, interpgphit 46 46 #if defined key_vertical 47 47 PUBLIC interpht0, interpmbkt … … 95 95 ! 96 96 ! --- West --- ! 97 ibdy1 = 298 ibdy2 = 1+nbghostcells99 ! 100 IF( .NOT.ln_dynspg_ts ) THEN ! Store t ransport97 ibdy1 = nn_hls + 2 ! halo + land + 1 98 ibdy2 = nn_hls + 1 + nbghostcells ! halo + land + nbghostcells 99 ! 100 IF( .NOT.ln_dynspg_ts ) THEN ! Store tangential transport 101 101 DO ji = mi0(ibdy1), mi1(ibdy2) 102 102 uu_b(ji,:,Krhs_a) = 0._wp … … 115 115 ! 116 116 DO ji = mi0(ibdy1), mi1(ibdy2) 117 zub(ji,:) = 0._wp ! Correct t ransport117 zub(ji,:) = 0._wp ! Correct tangential transport 118 118 DO jk = 1, jpkm1 119 119 DO jj = 1, jpj … … 153 153 154 154 ! --- East --- ! 155 ibdy1 = jpiglo -1-nbghostcells156 ibdy2 = jpiglo -2155 ibdy1 = jpiglo - ( nn_hls + nbghostcells + 1) ! halo + land + nbghostcells 156 ibdy2 = jpiglo - ( nn_hls + 2 ) ! halo + land + 1 157 157 ! 158 158 IF( .NOT.ln_dynspg_ts ) THEN ! Store transport … … 192 192 193 193 IF( ln_dynspg_ts ) THEN ! Set tangential velocities to time splitting estimate 194 ibdy1 = jpiglo -nbghostcells195 ibdy2 = jpiglo -1194 ibdy1 = jpiglo - ( nn_hls + nbghostcells ) ! halo + land + nbghostcells - 1 195 ibdy2 = jpiglo - ( nn_hls + 1 ) ! halo + land + 1 - 1 196 196 DO ji = mi0(ibdy1), mi1(ibdy2) 197 197 zvb(ji,:) = 0._wp … … 215 215 216 216 ! --- South --- ! 217 jbdy1 = 2218 jbdy2 = 1+nbghostcells217 jbdy1 = nn_hls + 2 ! halo + land + 1 218 jbdy2 = nn_hls + 1 + nbghostcells ! halo + land + nbghostcells 219 219 ! 220 220 IF( .NOT.ln_dynspg_ts ) THEN ! Store transport … … 276 276 277 277 ! --- North --- ! 278 jbdy1 = jpjglo -1-nbghostcells279 jbdy2 = jpjglo -2278 jbdy1 = jpjglo - ( nn_hls + nbghostcells + 1) ! halo + land + nbghostcells 279 jbdy2 = jpjglo - ( nn_hls + 2 ) ! halo + land + 1 280 280 ! 281 281 IF( .NOT.ln_dynspg_ts ) THEN ! Store transport … … 315 315 316 316 IF( ln_dynspg_ts ) THEN ! Set tangential velocities to time splitting estimate 317 jbdy1 = jpjglo -nbghostcells318 jbdy2 = jpjglo -1317 jbdy1 = jpjglo - ( nn_hls + nbghostcells ) ! halo + land + nbghostcells - 1 318 jbdy2 = jpjglo - ( nn_hls + 1 ) ! halo + land + 1 - 1 319 319 DO jj = mj0(jbdy1), mj1(jbdy2) 320 320 zub(:,jj) = 0._wp … … 354 354 ! 355 355 !--- West ---! 356 istart = 2357 iend = n bghostcells+1356 istart = nn_hls + 2 ! halo + land + 1 357 iend = nn_hls + 1 + nbghostcells ! halo + land + nbghostcells 358 358 DO ji = mi0(istart), mi1(iend) 359 359 DO jj=1,jpj … … 364 364 ! 365 365 !--- East ---! 366 istart = jpiglo -nbghostcells367 iend = jpiglo -1366 istart = jpiglo - ( nn_hls + nbghostcells ) ! halo + land + nbghostcells - 1 367 iend = jpiglo - ( nn_hls + 1 ) ! halo + land + 1 - 1 368 368 DO ji = mi0(istart), mi1(iend) 369 369 DO jj=1,jpj … … 371 371 END DO 372 372 END DO 373 istart = jpiglo -nbghostcells-1374 iend = jpiglo -2373 istart = jpiglo - ( nn_hls + nbghostcells + 1) ! halo + land + nbghostcells 374 iend = jpiglo - ( nn_hls + 2 ) ! halo + land + 1 375 375 DO ji = mi0(istart), mi1(iend) 376 376 DO jj=1,jpj … … 380 380 ! 381 381 !--- South ---! 382 jstart = 2383 jend = n bghostcells+1382 jstart = nn_hls + 2 ! halo + land + 1 383 jend = nn_hls + 1 + nbghostcells ! halo + land + nbghostcells 384 384 DO jj = mj0(jstart), mj1(jend) 385 385 DO ji=1,jpi … … 390 390 ! 391 391 !--- North ---! 392 jstart = jpjglo -nbghostcells393 jend = jpjglo -1392 jstart = jpjglo - ( nn_hls + nbghostcells ) ! halo + land + nbghostcells - 1 393 jend = jpjglo - ( nn_hls + 1 ) ! halo + land + 1 - 1 394 394 DO jj = mj0(jstart), mj1(jend) 395 395 DO ji=1,jpi … … 397 397 END DO 398 398 END DO 399 jstart = jpjglo -nbghostcells-1400 jend = jpjglo -2399 jstart = jpjglo - ( nn_hls + nbghostcells + 1) ! halo + land + nbghostcells 400 jend = jpjglo - ( nn_hls + 2 ) ! halo + land + 1 401 401 DO jj = mj0(jstart), mj1(jend) 402 402 DO ji=1,jpi … … 421 421 ! 422 422 !--- West ---! 423 istart = 2424 iend = n bghostcells+1423 istart = nn_hls + 2 ! halo + land + 1 424 iend = nn_hls + 1 + nbghostcells ! halo + land + nbghostcells 425 425 DO ji = mi0(istart), mi1(iend) 426 426 DO jj=1,jpj … … 431 431 ! 432 432 !--- East ---! 433 istart = jpiglo -nbghostcells434 iend = jpiglo -1433 istart = jpiglo - ( nn_hls + nbghostcells ) ! halo + land + nbghostcells - 1 434 iend = jpiglo - ( nn_hls + 1 ) ! halo + land + 1 - 1 435 435 DO ji = mi0(istart), mi1(iend) 436 436 DO jj=1,jpj … … 438 438 END DO 439 439 END DO 440 istart = jpiglo -nbghostcells-1441 iend = jpiglo -2440 istart = jpiglo - ( nn_hls + nbghostcells + 1) ! halo + land + nbghostcells 441 iend = jpiglo - ( nn_hls + 2 ) ! halo + land + 1 442 442 DO ji = mi0(istart), mi1(iend) 443 443 DO jj=1,jpj … … 447 447 ! 448 448 !--- South ---! 449 jstart = 2450 jend = n bghostcells+1449 jstart = nn_hls + 2 ! halo + land + 1 450 jend = nn_hls + 1 + nbghostcells ! halo + land + nbghostcells 451 451 DO jj = mj0(jstart), mj1(jend) 452 452 DO ji=1,jpi … … 457 457 ! 458 458 !--- North ---! 459 jstart = jpjglo -nbghostcells460 jend = jpjglo -1459 jstart = jpjglo - ( nn_hls + nbghostcells ) ! halo + land + nbghostcells - 1 460 jend = jpjglo - ( nn_hls + 1 ) ! halo + land + 1 - 1 461 461 DO jj = mj0(jstart), mj1(jend) 462 462 DO ji=1,jpi … … 464 464 END DO 465 465 END DO 466 jstart = jpjglo -nbghostcells-1467 jend = jpjglo -2466 jstart = jpjglo - ( nn_hls + nbghostcells + 1) ! halo + land + nbghostcells 467 jend = jpjglo - ( nn_hls + 2 ) ! halo + land + 1 468 468 DO jj = mj0(jstart), mj1(jend) 469 469 DO ji=1,jpi … … 542 542 ! 543 543 ! --- West --- ! 544 istart = 2545 iend = 1+ nbghostcells544 istart = nn_hls + 2 ! halo + land + 1 545 iend = nn_hls + 1 + nbghostcells ! halo + land + nbghostcells 546 546 DO ji = mi0(istart), mi1(iend) 547 547 DO jj = 1, jpj … … 551 551 ! 552 552 ! --- East --- ! 553 istart = jpiglo - nbghostcells554 iend = jpiglo - 1553 istart = jpiglo - ( nn_hls + nbghostcells ) ! halo + land + nbghostcells - 1 554 iend = jpiglo - ( nn_hls + 1 ) ! halo + land + 1 - 1 555 555 DO ji = mi0(istart), mi1(iend) 556 556 DO jj = 1, jpj … … 560 560 ! 561 561 ! --- South --- ! 562 jstart = 2563 jend = 1+ nbghostcells562 jstart = nn_hls + 2 ! halo + land + 1 563 jend = nn_hls + 1 + nbghostcells ! halo + land + nbghostcells 564 564 DO jj = mj0(jstart), mj1(jend) 565 565 DO ji = 1, jpi … … 569 569 ! 570 570 ! --- North --- ! 571 jstart = jpjglo - nbghostcells572 jend = jpjglo - 1571 jstart = jpjglo - ( nn_hls + nbghostcells ) ! halo + land + nbghostcells - 1 572 jend = jpjglo - ( nn_hls + 1 ) ! halo + land + 1 - 1 573 573 DO jj = mj0(jstart), mj1(jend) 574 574 DO ji = 1, jpi … … 593 593 ! 594 594 ! --- West --- ! 595 istart = 2596 iend = 1+nbghostcells595 istart = nn_hls + 2 ! halo + land + 1 596 iend = nn_hls + 1 + nbghostcells ! halo + land + nbghostcells 597 597 DO ji = mi0(istart), mi1(iend) 598 598 DO jj = 1, jpj … … 602 602 ! 603 603 ! --- East --- ! 604 istart = jpiglo - nbghostcells605 iend = jpiglo - 1604 istart = jpiglo - ( nn_hls + nbghostcells ) ! halo + land + nbghostcells - 1 605 iend = jpiglo - ( nn_hls + 1 ) ! halo + land + 1 - 1 606 606 DO ji = mi0(istart), mi1(iend) 607 607 DO jj = 1, jpj … … 611 611 ! 612 612 ! --- South --- ! 613 jstart = 2614 jend = 1+nbghostcells613 jstart = nn_hls + 2 ! halo + land + 1 614 jend = nn_hls + 1 + nbghostcells ! halo + land + nbghostcells 615 615 DO jj = mj0(jstart), mj1(jend) 616 616 DO ji = 1, jpi … … 620 620 ! 621 621 ! --- North --- ! 622 jstart = jpjglo - nbghostcells623 jend = jpjglo - 1622 jstart = jpjglo - ( nn_hls + nbghostcells ) ! halo + land + nbghostcells - 1 623 jend = jpjglo - ( nn_hls + 1 ) ! halo + land + 1 - 1 624 624 DO jj = mj0(jstart), mj1(jend) 625 625 DO ji = 1, jpi … … 1152 1152 WRITE(numout,*) ' Agrif error for e3t_0: parent , child, i, j, k ', & 1153 1153 & ptab(ji,jj,jk), tmask(ji,jj,jk) * e3t_0(ji,jj,jk), & 1154 & ji+nimpp-1, jj+njmpp-1, jk1155 kindic_agr = kindic_agr + 11154 & mig0(ji), mig0(jj), jk 1155 ! kindic_agr = kindic_agr + 1 1156 1156 ENDIF 1157 1157 END DO … … 1162 1162 ! 1163 1163 END SUBROUTINE interpe3t 1164 1165 1166 SUBROUTINE interpglamt( ptab, i1, i2, j1, j2, before ) 1167 !!---------------------------------------------------------------------- 1168 !! *** ROUTINE interpglamt *** 1169 !!---------------------------------------------------------------------- 1170 INTEGER , INTENT(in ) :: i1, i2, j1, j2 1171 REAL(wp),DIMENSION(i1:i2,j1:j2), INTENT(inout) :: ptab 1172 LOGICAL , INTENT(in ) :: before 1173 ! 1174 INTEGER :: ji, jj, jk 1175 REAL(wp):: ztst 1176 !!---------------------------------------------------------------------- 1177 ! 1178 IF( before ) THEN 1179 ptab(i1:i2,j1:j2) = glamt(i1:i2,j1:j2) 1180 ELSE 1181 ztst = MAXVAL(ABS(glamt(i1:i2,j1:j2)))*1.e-4 1182 DO jj = j1, j2 1183 DO ji = i1, i2 1184 IF( ABS( ptab(ji,jj) - glamt(ji,jj) ) > ztst ) THEN 1185 WRITE(numout,*) ' Agrif error for glamt: parent, child, i, j ', ptab(ji,jj), glamt(ji,jj), mig0(ji), mig0(jj) 1186 kindic_agr = kindic_agr + 1 1187 ENDIF 1188 END DO 1189 END DO 1190 ENDIF 1191 ! 1192 END SUBROUTINE interpglamt 1193 1194 1195 SUBROUTINE interpgphit( ptab, i1, i2, j1, j2, before ) 1196 !!---------------------------------------------------------------------- 1197 !! *** ROUTINE interpgphit *** 1198 !!---------------------------------------------------------------------- 1199 INTEGER , INTENT(in ) :: i1, i2, j1, j2 1200 REAL(wp),DIMENSION(i1:i2,j1:j2), INTENT(inout) :: ptab 1201 LOGICAL , INTENT(in ) :: before 1202 ! 1203 INTEGER :: ji, jj, jk 1204 REAL(wp):: ztst 1205 !!---------------------------------------------------------------------- 1206 ! 1207 IF( before ) THEN 1208 ptab(i1:i2,j1:j2) = gphit(i1:i2,j1:j2) 1209 ELSE 1210 ztst = MAXVAL(ABS(gphit(i1:i2,j1:j2)))*1.e-4 1211 DO jj = j1, j2 1212 DO ji = i1, i2 1213 IF( ABS( ptab(ji,jj) - gphit(ji,jj) ) > ztst ) THEN 1214 WRITE(numout,*) ' Agrif error for gphit: parent, child, i, j ', ptab(ji,jj), gphit(ji,jj), mig0(ji), mig0(jj) 1215 kindic_agr = kindic_agr + 1 1216 ENDIF 1217 END DO 1218 END DO 1219 ENDIF 1220 ! 1221 END SUBROUTINE interpgphit 1164 1222 1165 1223 -
NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/NST/agrif_oce_sponge.F90
r12807 r13065 106 106 REAL(wp) :: z1_ispongearea, z1_jspongearea 107 107 REAL(wp), DIMENSION(jpi,jpj) :: ztabramp 108 #if defined key_vertical 109 REAL(wp), DIMENSION(jpi,jpj) :: ztabrampu 110 REAL(wp), DIMENSION(jpi,jpj) :: ztabrampv 111 #endif 108 112 REAL(wp), DIMENSION(jpjmax) :: zmskwest, zmskeast 109 113 REAL(wp), DIMENSION(jpimax) :: zmsknorth, zmsksouth … … 128 132 ! --- West --- ! 129 133 ztabramp(:,:) = 0._wp 130 ind1 = 1+nbghostcells134 ind1 = nn_hls + 1 + nbghostcells ! halo + land + nbghostcells 131 135 DO ji = mi0(ind1), mi1(ind1) 132 136 ztabramp(ji,:) = ssumask(ji,:) 133 137 END DO 134 138 ! 135 zmskwest(:) = 0._wp136 139 zmskwest(1:jpj) = MAXVAL(ztabramp(:,:), dim=1) 140 zmskwest(jpj+1:jpjmax) = 0._wp 137 141 138 142 ! --- East --- ! 139 143 ztabramp(:,:) = 0._wp 140 ind1 = jpiglo - nbghostcells - 1144 ind1 = jpiglo - ( nn_hls + nbghostcells + 1) ! halo + land + nbghostcells 141 145 DO ji = mi0(ind1), mi1(ind1) 142 146 ztabramp(ji,:) = ssumask(ji,:) 143 147 END DO 144 148 ! 145 zmskeast(:) = 0._wp146 149 zmskeast(1:jpj) = MAXVAL(ztabramp(:,:), dim=1) 150 zmskeast(jpj+1:jpjmax) = 0._wp 147 151 148 152 ! --- South --- ! 149 153 ztabramp(:,:) = 0._wp 150 ind1 = 1+nbghostcells154 ind1 = nn_hls + 1 + nbghostcells ! halo + land + nbghostcells 151 155 DO jj = mj0(ind1), mj1(ind1) 152 156 ztabramp(:,jj) = ssvmask(:,jj) 153 157 END DO 154 158 ! 155 zmsksouth(:) = 0._wp156 159 zmsksouth(1:jpi) = MAXVAL(ztabramp(:,:), dim=2) 160 zmsksouth(jpi+1:jpimax) = 0._wp 157 161 158 162 ! --- North --- ! 159 163 ztabramp(:,:) = 0._wp 160 ind1 = jpjglo - nbghostcells - 1164 ind1 = jpjglo - ( nn_hls + nbghostcells + 1) ! halo + land + nbghostcells 161 165 DO jj = mj0(ind1), mj1(ind1) 162 166 ztabramp(:,jj) = ssvmask(:,jj) 163 167 END DO 164 168 ! 165 zmsknorth(:) = 0._wp166 169 zmsknorth(1:jpi) = MAXVAL(ztabramp(:,:), dim=2) 170 zmsknorth(jpi+1:jpimax) = 0._wp 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 ) … … 192 197 193 198 ! --- West --- ! 194 ind1 = 1+nbghostcells195 ind2 = 1+nbghostcells + ispongearea199 ind1 = nn_hls + 1 + nbghostcells ! halo + land + nbghostcells 200 ind2 = nn_hls + 1 + nbghostcells + ispongearea 196 201 DO ji = mi0(ind1), mi1(ind2) 197 202 DO jj = 1, jpj … … 202 207 ! ghost cells: 203 208 ind1 = 1 204 ind2 = n bghostcells + 1209 ind2 = nn_hls + 1 + nbghostcells ! halo + land + nbghostcells 205 210 DO ji = mi0(ind1), mi1(ind2) 206 211 DO jj = 1, jpj … … 210 215 211 216 ! --- East --- ! 212 ind1 = jpiglo - nbghostcells- ispongearea213 ind2 = jpiglo - nbghostcells217 ind1 = jpiglo - ( nn_hls + nbghostcells ) - ispongearea 218 ind2 = jpiglo - ( nn_hls + nbghostcells ) ! halo + land + nbghostcells - 1 214 219 DO ji = mi0(ind1), mi1(ind2) 215 220 DO jj = 1, jpj … … 219 224 220 225 ! ghost cells: 221 ind1 = jpiglo - nbghostcells226 ind1 = jpiglo - ( nn_hls + nbghostcells ) ! halo + land + nbghostcells - 1 222 227 ind2 = jpiglo 223 228 DO ji = mi0(ind1), mi1(ind2) … … 228 233 229 234 ! --- South --- ! 230 ind1 = 1+nbghostcells231 ind2 = 1+nbghostcells + jspongearea235 ind1 = nn_hls + 1 + nbghostcells ! halo + land + nbghostcells 236 ind2 = nn_hls + 1 + nbghostcells + jspongearea 232 237 DO jj = mj0(ind1), mj1(ind2) 233 238 DO ji = 1, jpi … … 238 243 ! ghost cells: 239 244 ind1 = 1 240 ind2 = n bghostcells + 1245 ind2 = nn_hls + 1 + nbghostcells ! halo + land + nbghostcells 241 246 DO jj = mj0(ind1), mj1(ind2) 242 247 DO ji = 1, jpi … … 246 251 247 252 ! --- North --- ! 248 ind1 = jpjglo - nbghostcells- jspongearea249 ind2 = jpjglo - nbghostcells253 ind1 = jpjglo - ( nn_hls + nbghostcells ) - jspongearea 254 ind2 = jpjglo - ( nn_hls + nbghostcells ) ! halo + land + nbghostcells - 1 250 255 DO jj = mj0(ind1), mj1(ind2) 251 256 DO ji = 1, jpi … … 255 260 256 261 ! ghost cells: 257 ind1 = jpjglo - nbghostcells262 ind1 = jpjglo - ( nn_hls + nbghostcells ) ! halo + land + nbghostcells - 1 258 263 ind2 = jpjglo 259 264 DO jj = mj0(ind1), mj1(ind2) … … 273 278 fspv(ji,jj) = 0.5_wp * ( ztabramp(ji,jj) + ztabramp(ji ,jj+1) ) * ssvmask(ji,jj) 274 279 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 280 ENDIF 280 281 … … 289 290 & * ssvmask(ji,jj) * ssvmask(ji,jj+1) 290 291 END_2D 291 CALL lbc_lnk( 'agrif_Sponge', fspt, 'T', 1. ) ! Lateral boundary conditions 292 CALL lbc_lnk( 'agrif_Sponge', fspf, 'F', 1. ) 293 292 ENDIF 293 294 IF( .NOT. spongedoneT .AND. .NOT. spongedoneU ) THEN 295 CALL lbc_lnk_multi( 'agrif_Sponge', fspu, 'U', 1., fspv, 'V', 1., fspt, 'T', 1., fspf, 'F', 1. ) 296 spongedoneT = .TRUE. 297 spongedoneU = .TRUE. 298 ENDIF 299 IF( .NOT. spongedoneT ) THEN 300 CALL lbc_lnk_multi( 'agrif_Sponge', fspu, 'U', 1., fspv, 'V', 1. ) 301 spongedoneT = .TRUE. 302 ENDIF 303 IF( .NOT. spongedoneT .AND. .NOT. spongedoneU ) THEN 304 CALL lbc_lnk_multi( 'agrif_Sponge', fspt, 'T', 1., fspf, 'F', 1. ) 294 305 spongedoneU = .TRUE. 295 306 ENDIF … … 312 323 END_2D 313 324 ! 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(:,:) ) 325 ztabramp (:,:) = REAL( mbkt_parent (:,:), wp ) 326 ztabrampu(:,:) = REAL( mbku_parentu(:,:), wp ) 327 ztabrampv(:,:) = REAL( mbkv_parentv(:,:), wp ) 328 CALL lbc_lnk_multi( 'Agrif_Sponge', ztabramp, 'T', 1., ztabrampu, 'U', 1., ztabrampv, 'V', 1. ) 329 mbkt_parent(:,:) = NINT( ztabramp (:,:) ) 330 mbku_parent(:,:) = NINT( ztabrampu(:,:) ) 331 mbkv_parent(:,:) = NINT( ztabrampv(:,:) ) 320 332 #endif 321 333 ! … … 505 517 506 518 INTEGER :: ji,jj,jk,jmax 507 519 INTEGER :: ind1 508 520 ! sponge parameters 509 521 REAL(wp) :: ze2u, ze1v, zua, zva, zbtr, zhtot, ztrelax … … 646 658 647 659 jmax = j2-1 648 IF ((nbondj == 1).OR.(nbondj == 2)) jmax = MIN(jmax,jpj-nbghostcells-2) ! North 660 ind1 = jpjglo - ( nn_hls + nbghostcells + 2 ) ! North 661 DO jj = mj0(ind1), mj1(ind1) 662 jmax = MIN(jmax,jj) 663 END DO 649 664 650 665 DO jj = j1+1, jmax … … 684 699 ! 685 700 INTEGER :: ji, jj, jk, imax 701 INTEGER :: ind1 702 ! sponge parameters 686 703 REAL(wp) :: ze2u, ze1v, zua, zva, zbtr, zhtot, ztrelax 687 704 REAL(wp), DIMENSION(i1:i2,j1:j2,1:jpk) :: vbdiff … … 802 819 803 820 imax = i2 - 1 804 IF ((nbondi == 1).OR.(nbondi == 2)) imax = MIN(imax,jpi-nbghostcells-2) ! East 805 821 ind1 = jpiglo - ( nn_hls + nbghostcells + 2 ) ! East 822 DO ji = mi0(ind1), mi1(ind1) 823 imax = MIN(imax,ji) 824 END DO 825 806 826 DO jj = j1+1, j2 807 827 DO ji = i1+1, imax ! vector opt. -
NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/NST/agrif_user.F90
r12807 r13065 62 62 ! 1. Declaration of the type of variable which have to be interpolated 63 63 !--------------------------------------------------------------------- 64 ind1 = nbghostcells65 ind2 = 1 + nbghostcells66 ind3 = 2 + nbghostcells64 ind1 = nbghostcells ! do the interpolation over nbghostcells points 65 ind2 = nn_hls + nbghostcells + 1 ! U/V points: array index of the first point in the reference grid 66 ind3 = nn_hls + nbghostcells + 2 ! T points: array index of the first point in the reference grid 67 67 CALL agrif_declare_variable((/1,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),e1u_id) 68 68 CALL agrif_declare_variable((/2,1/),(/ind3,ind2/),(/'x','y'/),(/1,1/),(/jpi,jpj/),e2v_id) … … 270 270 ! 271 271 ! In case of vertical interpolation, check only that total depths agree between child and parent: 272 DO ji = 1, jpi 273 DO jj = 1, jpj 274 IF ((mbkt_parent(ji,jj)/=0).AND.(ABS(ht0_parent(ji,jj)-ht_0(ji,jj))>1.e-3)) kindic_agr = kindic_agr + 1 275 IF ((mbku_parent(ji,jj)/=0).AND.(ABS(hu0_parent(ji,jj)-hu_0(ji,jj))>1.e-3)) kindic_agr = kindic_agr + 1 276 IF ((mbkv_parent(ji,jj)/=0).AND.(ABS(hv0_parent(ji,jj)-hv_0(ji,jj))>1.e-3)) kindic_agr = kindic_agr + 1 277 END DO 278 END DO 272 DO_2D_00_00 273 IF ((mbkt_parent(ji,jj)/=0).AND.(ABS(ht0_parent(ji,jj)-ht_0(ji,jj))>1.e-3)) kindic_agr = kindic_agr + 1 274 IF ((mbku_parent(ji,jj)/=0).AND.(ABS(hu0_parent(ji,jj)-hu_0(ji,jj))>1.e-3)) kindic_agr = kindic_agr + 1 275 IF ((mbkv_parent(ji,jj)/=0).AND.(ABS(hv0_parent(ji,jj)-hv_0(ji,jj))>1.e-3)) kindic_agr = kindic_agr + 1 276 END_2D 279 277 # endif 280 278 CALL mpp_sum( 'agrif_user', kindic_agr ) … … 286 284 END IF 287 285 ! 286 IF(lwp) WRITE(numout,*) ' ' 287 IF(lwp) WRITE(numout,*) 'AGRIF: Check longitude and latitude near bdys. Level: ', Agrif_Level() 288 ! 289 ! check glamt in sponge area: 290 kindic_agr = 0 291 CALL Agrif_Bc_variable(glamt_id,calledweight=1.,procname=interpglamt) 292 CALL mpp_sum( 'agrif_user', kindic_agr ) 293 IF( kindic_agr /= 0 ) THEN 294 CALL ctl_stop('==> Child glamt is NOT correct near boundaries.') 295 ELSE 296 IF(lwp) WRITE(numout,*) '==> Child glamt is ok near boundaries.' 297 IF(lwp) WRITE(numout,*) ' ' 298 END IF 299 ! 300 ! check gphit in sponge area: 301 kindic_agr = 0 302 CALL Agrif_Bc_variable(gphit_id,calledweight=1.,procname=interpgphit) 303 CALL mpp_sum( 'agrif_user', kindic_agr ) 304 IF( kindic_agr /= 0 ) THEN 305 CALL ctl_stop('==> Child gphit is NOT correct near boundaries.') 306 ELSE 307 IF(lwp) WRITE(numout,*) '==> Child gphit is ok near boundaries.' 308 IF(lwp) WRITE(numout,*) ' ' 309 END IF 288 310 ENDIF 289 311 … … 314 336 ! 1. Declaration of the type of variable which have to be interpolated 315 337 !--------------------------------------------------------------------- 316 ind1 = nbghostcells317 ind2 = 1 + nbghostcells318 ind3 = 2 + nbghostcells338 ind1 = nbghostcells ! do the interpolation over nbghostcells points 339 ind2 = nn_hls + nbghostcells + 1 ! U/V points: array index of the first point in the reference grid 340 ind3 = nn_hls + nbghostcells + 2 ! T points: array index of the first point in the reference grid 319 341 # if defined key_vertical 320 342 CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jpts+1/),tsn_id) … … 340 362 341 363 CALL agrif_declare_variable((/2,2,0/),(/ind3,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),e3t_id) 364 CALL agrif_declare_variable((/2,2/),(/ind3,ind3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),glamt_id) 365 CALL agrif_declare_variable((/2,2/),(/ind3,ind3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),gphit_id) 342 366 343 367 # if defined key_vertical … … 393 417 CALL Agrif_Set_bcinterp(vn_sponge_id,interp1=AGRIF_ppm,interp2=Agrif_linear) 394 418 395 CALL Agrif_Set_bcinterp(e3t_id,interp=AGRIF_constant) 419 CALL Agrif_Set_bcinterp( e3t_id,interp=AGRIF_constant) 420 CALL Agrif_Set_bcinterp(gphit_id,interp=AGRIF_constant) 421 CALL Agrif_Set_bcinterp(glamt_id,interp=AGRIF_constant) 396 422 397 423 # if defined key_vertical … … 421 447 ! JC: check near the boundary only until matching in sponge has been sorted out: 422 448 CALL Agrif_Set_bc( e3t_id, (/0,ind1-1/) ) 449 CALL Agrif_Set_bc(glamt_id, (/0,ind1-1/) ) 450 CALL Agrif_Set_bc(gphit_id, (/0,ind1-1/) ) 423 451 424 452 # if defined key_vertical … … 433 461 !--------------- 434 462 CALL Agrif_Set_Updatetype(scales_t_id, update = AGRIF_Update_Average) 463 !!$ CALL Agrif_Set_Updatetype(glamt_id, update = AGRIF_Update_Average) 464 !!$ CALL Agrif_Set_Updatetype(gphit_id, update = AGRIF_Update_Average) 435 465 436 466 # if defined UPD_HIGH … … 532 562 ! 2,2 = two ghost lines 533 563 !------------------------------------------------------------------------------------- 534 ind1 = nbghostcells535 ind2 = 1 + nbghostcells536 ind3 = 2 + nbghostcells564 ind1 = nbghostcells ! do the interpolation over nbghostcells points 565 ind2 = nn_hls + nbghostcells + 1 ! U/V points: array index of the first point in the reference grid 566 ind3 = nn_hls + nbghostcells + 2 ! T points: array index of the first point in the reference grid 537 567 CALL agrif_declare_variable((/2,2,0/),(/ind3,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpl*(8+nlay_s+nlay_i)/),tra_ice_id) 538 568 CALL agrif_declare_variable((/1,2/) ,(/ind2,ind3/) ,(/'x','y'/) ,(/1,1/) ,(/jpi,jpj/) ,u_ice_id ) … … 657 687 ! 1. Declaration of the type of variable which have to be interpolated 658 688 !--------------------------------------------------------------------- 659 ind1 = nbghostcells660 ind2 = 1 + nbghostcells661 ind3 = 2 + nbghostcells689 ind1 = nbghostcells ! do the interpolation over nbghostcells points 690 ind2 = nn_hls + nbghostcells + 1 ! U/V points: array index of the first point in the reference grid 691 ind3 = nn_hls + nbghostcells + 2 ! T points: array index of the first point in the reference grid 662 692 # if defined key_vertical 663 693 CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jptra+1/),trn_id) … … 756 786 ! 757 787 SELECT CASE( i ) 758 CASE(1) ; indglob = indloc + nimppt(nprocloc+1) - 1 759 CASE(2) ; indglob = indloc + njmppt(nprocloc+1) - 1 760 CASE DEFAULT 761 indglob = indloc 788 CASE(1) ; indglob = mig(indloc) 789 CASE(2) ; indglob = mjg(indloc) 790 CASE DEFAULT ; indglob = indloc 762 791 END SELECT 763 792 ! … … 776 805 !!---------------------------------------------------------------------- 777 806 ! 778 imin = nimppt(Agrif_Procrank+1) ! ?????779 jmin = njmppt(Agrif_Procrank+1) ! ?????780 imax = imin + jpi - 1781 jmax = jmin + jpj - 1807 imin = mig( 1 ) 808 jmin = mjg( 1 ) 809 imax = mig(jpi) 810 jmax = mjg(jpj) 782 811 ! 783 812 END SUBROUTINE Agrif_get_proc_info
Note: See TracChangeset
for help on using the changeset viewer.
