Changeset 13286 for NEMO/trunk/src/NST/agrif_oce_interp.F90
- Timestamp:
- 2020-07-09T17:48:29+02:00 (4 years ago)
- Location:
- NEMO/trunk
- Files:
-
- 2 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/trunk
- Property svn:externals
-
old new 2 2 ^/utils/build/makenemo@HEAD makenemo 3 3 ^/utils/build/mk@HEAD mk 4 ^/utils/tools /@HEADtools4 ^/utils/tools@HEAD tools 5 5 ^/vendors/AGRIF/dev_r12970_AGRIF_CMEMS ext/AGRIF 6 6 ^/vendors/FCM@HEAD ext/FCM … … 8 8 9 9 # SETTE 10 ^/utils/CI/ sette@12931sette10 ^/utils/CI/r12931_sette_ticket2366@HEAD sette
-
- Property svn:externals
-
NEMO/trunk/src/NST/agrif_oce_interp.F90
r13216 r13286 44 44 PUBLIC interptsn, interpsshn, interpavm 45 45 PUBLIC interpunb, interpvnb , interpub2b, interpvb2b 46 PUBLIC interpe3t 46 PUBLIC interpe3t, interpglamt, interpgphit 47 47 PUBLIC interpht0, interpmbkt 48 48 PUBLIC agrif_initts, agrif_initssh … … 87 87 IF( Agrif_Root() ) RETURN 88 88 ! 89 Agrif_SpecialValue = 0. _wp89 Agrif_SpecialValue = 0.0_wp 90 90 Agrif_UseSpecialValue = ln_spc_dyn 91 91 ! 92 92 use_sign_north = .TRUE. 93 sign_north = -1. 93 sign_north = -1.0_wp 94 94 CALL Agrif_Bc_variable( un_interp_id, procname=interpun ) 95 95 CALL Agrif_Bc_variable( vn_interp_id, procname=interpvn ) … … 100 100 ! --- West --- ! 101 101 IF( lk_west ) THEN 102 ibdy1 = 2103 ibdy2 = 1+nbghostcells102 ibdy1 = nn_hls + 2 ! halo + land + 1 103 ibdy2 = nn_hls + 1 + nbghostcells ! halo + land + nbghostcells 104 104 ! 105 105 IF( .NOT.ln_dynspg_ts ) THEN ! Store transport 106 106 DO ji = mi0(ibdy1), mi1(ibdy2) 107 107 uu_b(ji,:,Krhs_a) = 0._wp 108 109 108 DO jk = 1, jpkm1 110 109 DO jj = 1, jpj … … 112 111 END DO 113 112 END DO 114 115 113 DO jj = 1, jpj 116 114 uu_b(ji,jj,Krhs_a) = uu_b(ji,jj,Krhs_a) * r1_hu(ji,jj,Krhs_a) … … 123 121 DO jk = 1, jpkm1 124 122 DO jj = 1, jpj 125 zub(ji,jj) = zub(ji,jj) & 126 & + e3u(ji,jj,jk,Krhs_a) * uu(ji,jj,jk,Krhs_a)*umask(ji,jj,jk) 123 zub(ji,jj) = zub(ji,jj) + e3u(ji,jj,jk,Krhs_a) * uu(ji,jj,jk,Krhs_a) * umask(ji,jj,jk) 127 124 END DO 128 125 END DO 129 126 DO jj=1,jpj 130 127 zub(ji,jj) = zub(ji,jj) * r1_hu(ji,jj,Krhs_a) 131 END DO 132 128 END DO 133 129 DO jk = 1, jpkm1 134 130 DO jj = 1, jpj 135 uu(ji,jj,jk,Krhs_a) = ( uu(ji,jj,jk,Krhs_a) + uu_b(ji,jj,Krhs_a) -zub(ji,jj)) * umask(ji,jj,jk)136 END DO 137 END DO 138 END DO 139 131 uu(ji,jj,jk,Krhs_a) = ( uu(ji,jj,jk,Krhs_a) + uu_b(ji,jj,Krhs_a) - zub(ji,jj) ) * umask(ji,jj,jk) 132 END DO 133 END DO 134 END DO 135 ! 140 136 IF( ln_dynspg_ts ) THEN ! Set tangential velocities to time splitting estimate 141 137 DO ji = mi0(ibdy1), mi1(ibdy2) … … 151 147 DO jk = 1, jpkm1 152 148 DO jj = 1, jpj 153 vv(ji,jj,jk,Krhs_a) = ( vv(ji,jj,jk,Krhs_a) + vv_b(ji,jj,Krhs_a) -zvb(ji,jj))*vmask(ji,jj,jk)149 vv(ji,jj,jk,Krhs_a) = ( vv(ji,jj,jk,Krhs_a) + vv_b(ji,jj,Krhs_a) - zvb(ji,jj) )*vmask(ji,jj,jk) 154 150 END DO 155 151 END DO 156 152 END DO 157 153 ENDIF 154 ! 158 155 ENDIF 159 156 160 157 ! --- East --- ! 161 158 IF( lk_east) THEN 162 ibdy1 = jpiglo -1-nbghostcells163 ibdy2 = jpiglo -2159 ibdy1 = jpiglo - ( nn_hls + nbghostcells + 1) ! halo + land + nbghostcells 160 ibdy2 = jpiglo - ( nn_hls + 2 ) ! halo + land + 1 164 161 ! 165 162 IF( .NOT.ln_dynspg_ts ) THEN ! Store transport … … 168 165 DO jk = 1, jpkm1 169 166 DO jj = 1, jpj 170 uu_b(ji,jj,Krhs_a) = uu_b(ji,jj,Krhs_a) & 171 & + e3u(ji,jj,jk,Krhs_a) * uu(ji,jj,jk,Krhs_a) * umask(ji,jj,jk) 167 uu_b(ji,jj,Krhs_a) = uu_b(ji,jj,Krhs_a) + e3u(ji,jj,jk,Krhs_a) * uu(ji,jj,jk,Krhs_a) * umask(ji,jj,jk) 172 168 END DO 173 169 END DO … … 182 178 DO jk = 1, jpkm1 183 179 DO jj = 1, jpj 184 zub(ji,jj) = zub(ji,jj) & 185 & + e3u(ji,jj,jk,Krhs_a) * uu(ji,jj,jk,Krhs_a) * umask(ji,jj,jk) 180 zub(ji,jj) = zub(ji,jj) + e3u(ji,jj,jk,Krhs_a) * uu(ji,jj,jk,Krhs_a) * umask(ji,jj,jk) 186 181 END DO 187 182 END DO … … 189 184 zub(ji,jj) = zub(ji,jj) * r1_hu(ji,jj,Krhs_a) 190 185 END DO 191 192 186 DO jk = 1, jpkm1 193 187 DO jj = 1, jpj 194 uu(ji,jj,jk,Krhs_a) = ( uu(ji,jj,jk,Krhs_a) & 195 & + uu_b(ji,jj,Krhs_a)-zub(ji,jj))*umask(ji,jj,jk) 196 END DO 197 END DO 198 END DO 199 188 uu(ji,jj,jk,Krhs_a) = ( uu(ji,jj,jk,Krhs_a) + uu_b(ji,jj,Krhs_a) - zub(ji,jj) ) * umask(ji,jj,jk) 189 END DO 190 END DO 191 END DO 192 ! 200 193 IF( ln_dynspg_ts ) THEN ! Set tangential velocities to time splitting estimate 201 ibdy1 = jpiglo -nbghostcells202 ibdy2 = jpiglo -1194 ibdy1 = jpiglo - ( nn_hls + nbghostcells ) ! halo + land + nbghostcells - 1 195 ibdy2 = jpiglo - ( nn_hls + 1 ) ! halo + land + 1 - 1 203 196 DO ji = mi0(ibdy1), mi1(ibdy2) 204 197 zvb(ji,:) = 0._wp 205 198 DO jk = 1, jpkm1 206 199 DO jj = 1, jpj 207 zvb(ji,jj) = zvb(ji,jj) & 208 & + e3v(ji,jj,jk,Krhs_a) * vv(ji,jj,jk,Krhs_a) * vmask(ji,jj,jk) 200 zvb(ji,jj) = zvb(ji,jj) + e3v(ji,jj,jk,Krhs_a) * vv(ji,jj,jk,Krhs_a) * vmask(ji,jj,jk) 209 201 END DO 210 202 END DO … … 214 206 DO jk = 1, jpkm1 215 207 DO jj = 1, jpj 216 vv(ji,jj,jk,Krhs_a) = ( vv(ji,jj,jk,Krhs_a) & 217 & + vv_b(ji,jj,Krhs_a)-zvb(ji,jj)) * vmask(ji,jj,jk) 208 vv(ji,jj,jk,Krhs_a) = ( vv(ji,jj,jk,Krhs_a) + vv_b(ji,jj,Krhs_a) - zvb(ji,jj) ) * vmask(ji,jj,jk) 218 209 END DO 219 210 END DO 220 211 END DO 221 212 ENDIF 213 ! 222 214 ENDIF 223 215 224 216 ! --- South --- ! 225 217 IF( lk_south ) THEN 226 jbdy1 = 2227 jbdy2 = 1+nbghostcells218 jbdy1 = nn_hls + 2 ! halo + land + 1 219 jbdy2 = nn_hls + 1 + nbghostcells ! halo + land + nbghostcells 228 220 ! 229 221 IF( .NOT.ln_dynspg_ts ) THEN ! Store transport … … 232 224 DO jk = 1, jpkm1 233 225 DO ji = 1, jpi 234 vv_b(ji,jj,Krhs_a) = vv_b(ji,jj,Krhs_a) & 235 & + e3v(ji,jj,jk,Krhs_a) * vv(ji,jj,jk,Krhs_a) * vmask(ji,jj,jk) 226 vv_b(ji,jj,Krhs_a) = vv_b(ji,jj,Krhs_a) + e3v(ji,jj,jk,Krhs_a) * vv(ji,jj,jk,Krhs_a) * vmask(ji,jj,jk) 236 227 END DO 237 228 END DO … … 246 237 DO jk=1,jpkm1 247 238 DO ji=1,jpi 248 zvb(ji,jj) = zvb(ji,jj) & 249 & + e3v(ji,jj,jk,Krhs_a) * vv(ji,jj,jk,Krhs_a) * vmask(ji,jj,jk) 239 zvb(ji,jj) = zvb(ji,jj) + e3v(ji,jj,jk,Krhs_a) * vv(ji,jj,jk,Krhs_a) * vmask(ji,jj,jk) 250 240 END DO 251 241 END DO … … 253 243 zvb(ji,jj) = zvb(ji,jj) * r1_hv(ji,jj,Krhs_a) 254 244 END DO 255 256 245 DO jk = 1, jpkm1 257 246 DO ji = 1, jpi 258 vv(ji,jj,jk,Krhs_a) = ( vv(ji,jj,jk,Krhs_a) & 259 & + vv_b(ji,jj,Krhs_a) - zvb(ji,jj) ) * vmask(ji,jj,jk) 260 END DO 261 END DO 262 END DO 263 247 vv(ji,jj,jk,Krhs_a) = ( vv(ji,jj,jk,Krhs_a) + vv_b(ji,jj,Krhs_a) - zvb(ji,jj) ) * vmask(ji,jj,jk) 248 END DO 249 END DO 250 END DO 251 ! 264 252 IF( ln_dynspg_ts ) THEN ! Set tangential velocities to time splitting estimate 265 253 DO jj = mj0(jbdy1), mj1(jbdy2) … … 267 255 DO jk = 1, jpkm1 268 256 DO ji = 1, jpi 269 zub(ji,jj) = zub(ji,jj) & 270 & + e3u(ji,jj,jk,Krhs_a) * uu(ji,jj,jk,Krhs_a) * umask(ji,jj,jk) 257 zub(ji,jj) = zub(ji,jj) + e3u(ji,jj,jk,Krhs_a) * uu(ji,jj,jk,Krhs_a) * umask(ji,jj,jk) 271 258 END DO 272 259 END DO … … 274 261 zub(ji,jj) = zub(ji,jj) * r1_hu(ji,jj,Krhs_a) 275 262 END DO 276 277 263 DO jk = 1, jpkm1 278 264 DO ji = 1, jpi 279 uu(ji,jj,jk,Krhs_a) = ( uu(ji,jj,jk,Krhs_a) & 280 & + uu_b(ji,jj,Krhs_a) - zub(ji,jj) ) * umask(ji,jj,jk) 265 uu(ji,jj,jk,Krhs_a) = ( uu(ji,jj,jk,Krhs_a) + uu_b(ji,jj,Krhs_a) - zub(ji,jj) ) * umask(ji,jj,jk) 281 266 END DO 282 267 END DO 283 268 END DO 284 269 ENDIF 270 ! 285 271 ENDIF 286 272 287 273 ! --- North --- ! 288 274 IF( lk_north ) THEN 289 jbdy1 = jpjglo -1-nbghostcells290 jbdy2 = jpjglo -2275 jbdy1 = jpjglo - ( nn_hls + nbghostcells + 1) ! halo + land + nbghostcells 276 jbdy2 = jpjglo - ( nn_hls + 2 ) ! halo + land + 1 291 277 ! 292 278 IF( .NOT.ln_dynspg_ts ) THEN ! Store transport … … 295 281 DO jk = 1, jpkm1 296 282 DO ji = 1, jpi 297 vv_b(ji,jj,Krhs_a) = vv_b(ji,jj,Krhs_a) & 298 & + e3v(ji,jj,jk,Krhs_a) * vv(ji,jj,jk,Krhs_a) * vmask(ji,jj,jk) 283 vv_b(ji,jj,Krhs_a) = vv_b(ji,jj,Krhs_a) + e3v(ji,jj,jk,Krhs_a) * vv(ji,jj,jk,Krhs_a) * vmask(ji,jj,jk) 299 284 END DO 300 285 END DO … … 309 294 DO jk=1,jpkm1 310 295 DO ji=1,jpi 311 zvb(ji,jj) = zvb(ji,jj) & 312 & + e3v(ji,jj,jk,Krhs_a) * vv(ji,jj,jk,Krhs_a) * vmask(ji,jj,jk) 296 zvb(ji,jj) = zvb(ji,jj) + e3v(ji,jj,jk,Krhs_a) * vv(ji,jj,jk,Krhs_a) * vmask(ji,jj,jk) 313 297 END DO 314 298 END DO … … 316 300 zvb(ji,jj) = zvb(ji,jj) * r1_hv(ji,jj,Krhs_a) 317 301 END DO 318 319 302 DO jk = 1, jpkm1 320 303 DO ji = 1, jpi 321 vv(ji,jj,jk,Krhs_a) = ( vv(ji,jj,jk,Krhs_a) & 322 & + vv_b(ji,jj,Krhs_a) - zvb(ji,jj) ) * vmask(ji,jj,jk) 323 END DO 324 END DO 325 END DO 326 304 vv(ji,jj,jk,Krhs_a) = ( vv(ji,jj,jk,Krhs_a) + vv_b(ji,jj,Krhs_a) - zvb(ji,jj) ) * vmask(ji,jj,jk) 305 END DO 306 END DO 307 END DO 308 ! 327 309 IF( ln_dynspg_ts ) THEN ! Set tangential velocities to time splitting estimate 328 jbdy1 = jpjglo -nbghostcells329 jbdy2 = jpjglo -1310 jbdy1 = jpjglo - ( nn_hls + nbghostcells ) ! halo + land + nbghostcells - 1 311 jbdy2 = jpjglo - ( nn_hls + 1 ) ! halo + land + 1 - 1 330 312 DO jj = mj0(jbdy1), mj1(jbdy2) 331 313 zub(:,jj) = 0._wp 332 314 DO jk = 1, jpkm1 333 315 DO ji = 1, jpi 334 zub(ji,jj) = zub(ji,jj) & 335 & + e3u(ji,jj,jk,Krhs_a) * uu(ji,jj,jk,Krhs_a) * umask(ji,jj,jk) 316 zub(ji,jj) = zub(ji,jj) + e3u(ji,jj,jk,Krhs_a) * uu(ji,jj,jk,Krhs_a) * umask(ji,jj,jk) 336 317 END DO 337 318 END DO … … 339 320 zub(ji,jj) = zub(ji,jj) * r1_hu(ji,jj,Krhs_a) 340 321 END DO 341 342 322 DO jk = 1, jpkm1 343 323 DO ji = 1, jpi 344 uu(ji,jj,jk,Krhs_a) = ( uu(ji,jj,jk,Krhs_a) & 345 & + uu_b(ji,jj,Krhs_a) - zub(ji,jj) ) * umask(ji,jj,jk) 324 uu(ji,jj,jk,Krhs_a) = ( uu(ji,jj,jk,Krhs_a) + uu_b(ji,jj,Krhs_a) - zub(ji,jj) ) * umask(ji,jj,jk) 346 325 END DO 347 326 END DO 348 327 END DO 349 328 ENDIF 329 ! 350 330 ENDIF 351 331 ! … … 367 347 !--- West ---! 368 348 IF( lk_west ) THEN 369 istart = 2370 iend = n bghostcells+1349 istart = nn_hls + 2 ! halo + land + 1 350 iend = nn_hls + 1 + nbghostcells ! halo + land + nbghostcells 371 351 DO ji = mi0(istart), mi1(iend) 372 352 DO jj=1,jpj … … 379 359 !--- East ---! 380 360 IF( lk_east ) THEN 381 istart = jpiglo -nbghostcells382 iend = jpiglo -1361 istart = jpiglo - ( nn_hls + nbghostcells ) ! halo + land + nbghostcells - 1 362 iend = jpiglo - ( nn_hls + 1 ) ! halo + land + 1 - 1 383 363 DO ji = mi0(istart), mi1(iend) 384 364 … … 387 367 END DO 388 368 END DO 389 istart = jpiglo -nbghostcells-1390 iend = jpiglo -2369 istart = jpiglo - ( nn_hls + nbghostcells + 1) ! halo + land + nbghostcells 370 iend = jpiglo - ( nn_hls + 2 ) ! halo + land + 1 391 371 DO ji = mi0(istart), mi1(iend) 392 372 DO jj=1,jpj … … 398 378 !--- South ---! 399 379 IF( lk_south ) THEN 400 jstart = 2401 jend = n bghostcells+1380 jstart = nn_hls + 2 ! halo + land + 1 381 jend = nn_hls + 1 + nbghostcells ! halo + land + nbghostcells 402 382 DO jj = mj0(jstart), mj1(jend) 403 383 … … 411 391 !--- North ---! 412 392 IF( lk_north ) THEN 413 jstart = jpjglo -nbghostcells414 jend = jpjglo -1393 jstart = jpjglo - ( nn_hls + nbghostcells ) ! halo + land + nbghostcells - 1 394 jend = jpjglo - ( nn_hls + 1 ) ! halo + land + 1 - 1 415 395 DO jj = mj0(jstart), mj1(jend) 416 396 DO ji=1,jpi … … 418 398 END DO 419 399 END DO 420 jstart = jpjglo -nbghostcells-1421 jend = jpjglo -2400 jstart = jpjglo - ( nn_hls + nbghostcells + 1) ! halo + land + nbghostcells 401 jend = jpjglo - ( nn_hls + 2 ) ! halo + land + 1 422 402 DO jj = mj0(jstart), mj1(jend) 423 403 DO ji=1,jpi … … 429 409 END SUBROUTINE Agrif_dyn_ts 430 410 411 431 412 SUBROUTINE Agrif_dyn_ts_flux( jn, zu, zv ) 432 413 !!---------------------------------------------------------------------- … … 444 425 !--- West ---! 445 426 IF( lk_west ) THEN 446 istart = 2447 iend = n bghostcells+1427 istart = nn_hls + 2 ! halo + land + 1 428 iend = nn_hls + 1 + nbghostcells ! halo + land + nbghostcells 448 429 DO ji = mi0(istart), mi1(iend) 449 430 DO jj=1,jpj … … 456 437 !--- East ---! 457 438 IF( lk_east ) THEN 458 istart = jpiglo -nbghostcells459 iend = jpiglo -1439 istart = jpiglo - ( nn_hls + nbghostcells ) ! halo + land + nbghostcells - 1 440 iend = jpiglo - ( nn_hls + 1 ) ! halo + land + 1 - 1 460 441 DO ji = mi0(istart), mi1(iend) 461 442 DO jj=1,jpj … … 463 444 END DO 464 445 END DO 465 istart = jpiglo -nbghostcells-1466 iend = jpiglo -2446 istart = jpiglo - ( nn_hls + nbghostcells + 1) ! halo + land + nbghostcells 447 iend = jpiglo - ( nn_hls + 2 ) ! halo + land + 1 467 448 DO ji = mi0(istart), mi1(iend) 468 449 DO jj=1,jpj … … 474 455 !--- South ---! 475 456 IF( lk_south ) THEN 476 jstart = 2477 jend = n bghostcells+1457 jstart = nn_hls + 2 ! halo + land + 1 458 jend = nn_hls + 1 + nbghostcells ! halo + land + nbghostcells 478 459 DO jj = mj0(jstart), mj1(jend) 479 460 DO ji=1,jpi … … 486 467 !--- North ---! 487 468 IF( lk_north ) THEN 488 jstart = jpjglo -nbghostcells489 jend = jpjglo -1469 jstart = jpjglo - ( nn_hls + nbghostcells ) ! halo + land + nbghostcells - 1 470 jend = jpjglo - ( nn_hls + 1 ) ! halo + land + 1 - 1 490 471 DO jj = mj0(jstart), mj1(jend) 491 472 DO ji=1,jpi … … 493 474 END DO 494 475 END DO 495 jstart = jpjglo -nbghostcells-1496 jend = jpjglo -2476 jstart = jpjglo - ( nn_hls + nbghostcells + 1) ! halo + land + nbghostcells 477 jend = jpjglo - ( nn_hls + 2 ) ! halo + land + 1 497 478 DO jj = mj0(jstart), mj1(jend) 498 479 DO ji=1,jpi … … 504 485 END SUBROUTINE Agrif_dyn_ts_flux 505 486 487 506 488 SUBROUTINE Agrif_dta_ts( kt ) 507 489 !!---------------------------------------------------------------------- … … 578 560 ! --- West --- ! 579 561 IF(lk_west) THEN 580 istart = 2581 iend = 1+ nbghostcells562 istart = nn_hls + 2 ! halo + land + 1 563 iend = nn_hls + 1 + nbghostcells ! halo + land + nbghostcells 582 564 DO ji = mi0(istart), mi1(iend) 583 565 DO jj = 1, jpj 584 566 ssh(ji,jj,Krhs_a) = hbdy(ji,jj) 585 END DO586 END DO567 END DO 568 END DO 587 569 ENDIF 588 570 ! 589 571 ! --- East --- ! 590 572 IF(lk_east) THEN 591 istart = jpiglo - nbghostcells592 iend = jpiglo - 1573 istart = jpiglo - ( nn_hls + nbghostcells ) ! halo + land + nbghostcells - 1 574 iend = jpiglo - ( nn_hls + 1 ) ! halo + land + 1 - 1 593 575 DO ji = mi0(istart), mi1(iend) 594 576 DO jj = 1, jpj 595 577 ssh(ji,jj,Krhs_a) = hbdy(ji,jj) 596 END DO597 END DO578 END DO 579 END DO 598 580 ENDIF 599 581 ! 600 582 ! --- South --- ! 601 583 IF(lk_south) THEN 602 jstart = 2603 jend = 1+ nbghostcells584 jstart = nn_hls + 2 ! halo + land + 1 585 jend = nn_hls + 1 + nbghostcells ! halo + land + nbghostcells 604 586 DO jj = mj0(jstart), mj1(jend) 605 587 DO ji = 1, jpi 606 588 ssh(ji,jj,Krhs_a) = hbdy(ji,jj) 607 END DO608 END DO589 END DO 590 END DO 609 591 ENDIF 610 592 ! 611 593 ! --- North --- ! 612 594 IF(lk_north) THEN 613 jstart = jpjglo - nbghostcells614 jend = jpjglo - 1595 jstart = jpjglo - ( nn_hls + nbghostcells ) ! halo + land + nbghostcells - 1 596 jend = jpjglo - ( nn_hls + 1 ) ! halo + land + 1 - 1 615 597 DO jj = mj0(jstart), mj1(jend) 616 598 DO ji = 1, jpi 617 599 ssh(ji,jj,Krhs_a) = hbdy(ji,jj) 618 END DO619 END DO600 END DO 601 END DO 620 602 ENDIF 621 603 ! … … 637 619 ! --- West --- ! 638 620 IF(lk_west) THEN 639 istart = 2640 iend = 1+nbghostcells621 istart = nn_hls + 2 ! halo + land + 1 622 iend = nn_hls + 1 + nbghostcells ! halo + land + nbghostcells 641 623 DO ji = mi0(istart), mi1(iend) 642 624 DO jj = 1, jpj 643 625 ssha_e(ji,jj) = hbdy(ji,jj) 644 END DO645 END DO626 END DO 627 END DO 646 628 ENDIF 647 629 ! 648 630 ! --- East --- ! 649 631 IF(lk_east) THEN 650 istart = jpiglo - nbghostcells651 iend = jpiglo - 1632 istart = jpiglo - ( nn_hls + nbghostcells ) ! halo + land + nbghostcells - 1 633 iend = jpiglo - ( nn_hls + 1 ) ! halo + land + 1 - 1 652 634 DO ji = mi0(istart), mi1(iend) 653 635 DO jj = 1, jpj 654 636 ssha_e(ji,jj) = hbdy(ji,jj) 655 END DO656 END DO637 END DO 638 END DO 657 639 ENDIF 658 640 ! 659 641 ! --- South --- ! 660 642 IF(lk_south) THEN 661 jstart = 2662 jend = 1+nbghostcells643 jstart = nn_hls + 2 ! halo + land + 1 644 jend = nn_hls + 1 + nbghostcells ! halo + land + nbghostcells 663 645 DO jj = mj0(jstart), mj1(jend) 664 646 DO ji = 1, jpi 665 647 ssha_e(ji,jj) = hbdy(ji,jj) 666 END DO667 END DO648 END DO 649 END DO 668 650 ENDIF 669 651 ! 670 652 ! --- North --- ! 671 653 IF(lk_north) THEN 672 jstart = jpjglo - nbghostcells673 jend = jpjglo - 1654 jstart = jpjglo - ( nn_hls + nbghostcells ) ! halo + land + nbghostcells - 1 655 jend = jpjglo - ( nn_hls + 1 ) ! halo + land + 1 - 1 674 656 DO jj = mj0(jstart), mj1(jend) 675 657 DO ji = 1, jpi 676 658 ssha_e(ji,jj) = hbdy(ji,jj) 677 END DO678 END DO659 END DO 660 END DO 679 661 ENDIF 680 662 ! 681 663 END SUBROUTINE Agrif_ssh_ts 682 664 665 683 666 SUBROUTINE Agrif_avm 684 667 !!---------------------------------------------------------------------- … … 701 684 ! 702 685 END SUBROUTINE Agrif_avm 703 686 704 687 705 688 SUBROUTINE interptsn( ptab, i1, i2, j1, j2, k1, k2, n1, n2, before ) … … 793 776 DO jk=2,N_in 794 777 z_in(jk) = z_in(jk-1) + 0.5_wp * h_in(jk) 795 END DO778 END DO 796 779 797 780 N_out = 0 … … 800 783 N_out = N_out + 1 801 784 h_out(jk) = e3t(ji,jj,jk,Krhs_a) 802 END DO785 END DO 803 786 804 787 z_out(1) = 0.5_wp * h_out(1) - SUM(h_out(1:N_out)) + ht_0(ji,jj) 805 788 DO jk=2,N_out 806 789 z_out(jk) = z_out(jk-1) + 0.5_wp * h_out(jk) 807 END DO790 END DO 808 791 809 792 IF (N_in*N_out > 0) THEN … … 816 799 ENDIF 817 800 ENDIF 818 END DO819 END DO801 END DO 802 END DO 820 803 Krhs_a = item 821 804 … … 831 814 END SUBROUTINE interptsn 832 815 816 833 817 SUBROUTINE interpsshn( ptab, i1, i2, j1, j2, before ) 834 818 !!---------------------------------------------------------------------- … … 849 833 END SUBROUTINE interpsshn 850 834 835 851 836 SUBROUTINE interpun( ptab, i1, i2, j1, j2, k1, k2, m1, m2, before ) 852 837 !!---------------------------------------------------------------------- … … 934 919 tabin(jk) = 0. 935 920 ENDIF 936 END DO921 END DO 937 922 z_in(1) = 0.5_wp * h_in(1) - zhtot + hu0_parent(ji,jj) 938 923 DO jk=2,N_in 939 924 z_in(jk) = z_in(jk-1) + 0.5_wp * h_in(jk) 940 END DO925 END DO 941 926 942 927 N_out = 0 … … 945 930 N_out = N_out + 1 946 931 h_out(N_out) = e3u(ji,jj,jk,Krhs_a) 947 END DO932 END DO 948 933 949 934 z_out(1) = 0.5_wp * h_out(1) - SUM(h_out(1:N_out)) + hu_0(ji,jj) 950 935 DO jk=2,N_out 951 936 z_out(jk) = z_out(jk-1) + 0.5_wp * h_out(jk) 952 END DO937 END DO 953 938 954 939 IF (N_in*N_out > 0) THEN … … 959 944 ENDIF 960 945 ENDIF 961 END DO962 END DO946 END DO 947 END DO 963 948 ELSE 964 949 DO jk = 1, jpkm1 … … 973 958 END SUBROUTINE interpun 974 959 960 975 961 SUBROUTINE interpvn( ptab, i1, i2, j1, j2, k1, k2, m1, m2, before ) 976 962 !!---------------------------------------------------------------------- … … 1055 1041 tabin(jk) = 0. 1056 1042 ENDIF 1057 END DO1043 END DO 1058 1044 1059 1045 z_in(1) = 0.5_wp * h_in(1) - zhtot + hv0_parent(ji,jj) 1060 1046 DO jk=2,N_in 1061 1047 z_in(jk) = z_in(jk-1) + 0.5_wp * h_in(jk) 1062 END DO1048 END DO 1063 1049 1064 1050 N_out = 0 … … 1067 1053 N_out = N_out + 1 1068 1054 h_out(N_out) = e3v(ji,jj,jk,Krhs_a) 1069 END DO1055 END DO 1070 1056 1071 1057 z_out(1) = 0.5_wp * h_out(1) - SUM(h_out(1:N_out)) + hv_0(ji,jj) 1072 1058 DO jk=2,N_out 1073 1059 z_out(jk) = z_out(jk-1) + 0.5_wp * h_out(jk) 1074 END DO1060 END DO 1075 1061 1076 1062 IF (N_in*N_out > 0) THEN … … 1286 1272 WRITE(numout,*) ' Agrif error for e3t_0: parent , child, i, j, k ', & 1287 1273 & ptab(ji,jj,jk), tmask(ji,jj,jk) * e3t_0(ji,jj,jk), & 1288 & ji+nimpp-1, jj+njmpp-1, jk1289 kindic_agr = kindic_agr + 11274 & mig0(ji), mig0(jj), jk 1275 ! kindic_agr = kindic_agr + 1 1290 1276 ENDIF 1291 1277 END DO … … 1296 1282 ! 1297 1283 END SUBROUTINE interpe3t 1284 1285 SUBROUTINE interpglamt( ptab, i1, i2, j1, j2, before ) 1286 !!---------------------------------------------------------------------- 1287 !! *** ROUTINE interpglamt *** 1288 !!---------------------------------------------------------------------- 1289 INTEGER , INTENT(in ) :: i1, i2, j1, j2 1290 REAL(wp),DIMENSION(i1:i2,j1:j2), INTENT(inout) :: ptab 1291 LOGICAL , INTENT(in ) :: before 1292 ! 1293 INTEGER :: ji, jj, jk 1294 REAL(wp):: ztst 1295 !!---------------------------------------------------------------------- 1296 ! 1297 IF( before ) THEN 1298 ptab(i1:i2,j1:j2) = glamt(i1:i2,j1:j2) 1299 ELSE 1300 ztst = MAXVAL(ABS(glamt(i1:i2,j1:j2)))*1.e-4 1301 DO jj = j1, j2 1302 DO ji = i1, i2 1303 IF( ABS( ptab(ji,jj) - glamt(ji,jj) ) > ztst ) THEN 1304 WRITE(numout,*) ' Agrif error for glamt: parent, child, i, j ', ptab(ji,jj), glamt(ji,jj), mig0(ji), mig0(jj) 1305 ! kindic_agr = kindic_agr + 1 1306 ENDIF 1307 END DO 1308 END DO 1309 ENDIF 1310 ! 1311 END SUBROUTINE interpglamt 1312 1313 1314 SUBROUTINE interpgphit( ptab, i1, i2, j1, j2, before ) 1315 !!---------------------------------------------------------------------- 1316 !! *** ROUTINE interpgphit *** 1317 !!---------------------------------------------------------------------- 1318 INTEGER , INTENT(in ) :: i1, i2, j1, j2 1319 REAL(wp),DIMENSION(i1:i2,j1:j2), INTENT(inout) :: ptab 1320 LOGICAL , INTENT(in ) :: before 1321 ! 1322 INTEGER :: ji, jj, jk 1323 REAL(wp):: ztst 1324 !!---------------------------------------------------------------------- 1325 ! 1326 IF( before ) THEN 1327 ptab(i1:i2,j1:j2) = gphit(i1:i2,j1:j2) 1328 ELSE 1329 ztst = MAXVAL(ABS(gphit(i1:i2,j1:j2)))*1.e-4 1330 DO jj = j1, j2 1331 DO ji = i1, i2 1332 IF( ABS( ptab(ji,jj) - gphit(ji,jj) ) > ztst ) THEN 1333 WRITE(numout,*) ' Agrif error for gphit: parent, child, i, j ', ptab(ji,jj), gphit(ji,jj), mig0(ji), mig0(jj) 1334 ! kindic_agr = kindic_agr + 1 1335 ENDIF 1336 END DO 1337 END DO 1338 ENDIF 1339 ! 1340 END SUBROUTINE interpgphit 1341 1298 1342 1299 1343 SUBROUTINE interpavm( ptab, i1, i2, j1, j2, k1, k2, m1, m2, before ) … … 1368 1412 DO jk = 1, N_out ! Child vertical grid 1369 1413 z_out(jk) = gdepw(ji,jj,jk,Kmm_a) 1370 END DO1414 END DO 1371 1415 IF (N_in*N_out > 0) THEN 1372 1416 CALL remap_linear(tabin(1:N_in),z_in(1:N_in),avm_k(ji,jj,1:N_out),z_out(1:N_out),N_in,N_out,1) 1373 1417 ENDIF 1374 END DO1375 END DO1418 END DO 1419 END DO 1376 1420 ELSE 1377 1421 avm_k(i1:i2,j1:j2,k1:k2) = ptab (i1:i2,j1:j2,k1:k2,1) … … 1381 1425 END SUBROUTINE interpavm 1382 1426 1427 1383 1428 SUBROUTINE interpmbkt( ptab, i1, i2, j1, j2, before ) 1384 1429 !!---------------------------------------------------------------------- … … 1399 1444 END SUBROUTINE interpmbkt 1400 1445 1446 1401 1447 SUBROUTINE interpht0( ptab, i1, i2, j1, j2, before ) 1402 1448 !!---------------------------------------------------------------------- … … 1417 1463 END SUBROUTINE interpht0 1418 1464 1465 1419 1466 SUBROUTINE agrif_initts(tabres,i1,i2,j1,j2,k1,k2,m1,m2,before) 1420 1467 INTEGER :: i1, i2, j1, j2, k1, k2, m1, m2 … … 1435 1482 END SUBROUTINE agrif_initts 1436 1483 1484 1437 1485 SUBROUTINE agrif_initssh( ptab, i1, i2, j1, j2, before ) 1438 1486 !!----------------------------------------------------------------------
Note: See TracChangeset
for help on using the changeset viewer.