Changeset 13554 for NEMO/releases/r4.0/r4.0-HEAD/src/ICE/icedyn_adv_pra.F90
- Timestamp:
- 2020-10-02T08:48:30+02:00 (4 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/releases/r4.0/r4.0-HEAD/src/ICE/icedyn_adv_pra.F90
r13284 r13554 362 362 !! 363 363 INTEGER :: ji, jj, jl, jcat ! dummy loop indices 364 INTEGER :: jjmin, jjmax ! dummy loop indices 364 365 REAL(wp) :: zs1max, zslpmax, ztemp ! local scalars 365 366 REAL(wp) :: zs1new, zalf , zalfq , zbt ! - - … … 369 370 REAL(wp), DIMENSION(jpi,jpj) :: zalg, zalg1, zalg1q ! - - 370 371 !----------------------------------------------------------------------- 372 ! in order to avoid lbc_lnk (communications): 373 ! jj loop must be 1:jpj if adv_x is called first 374 ! and 2:jpj-1 if adv_x is called second 375 jjmin = 2 - NINT(pcrh) ! 1 or 2 376 jjmax = jpjm1 + NINT(pcrh) ! jpj or jpj-1 371 377 ! 372 378 jcat = SIZE( ps0 , 3 ) ! size of input arrays … … 375 381 ! 376 382 ! Limitation of moments. 377 DO jj = 2, jpjm1 383 DO jj = jjmin, jjmax 384 378 385 DO ji = 1, jpi 379 386 ! Initialize volumes of boxes (=area if adv_x first called, =psm otherwise) … … 383 390 zs1max = 1.5 * zslpmax 384 391 zs1new = MIN( zs1max, MAX( -zs1max, psx(ji,jj,jl) ) ) 385 zs2new = MIN( 2.0 * zslpmax - 0.3334 * ABS( zs1new ), & 386 & MAX( ABS( zs1new ) - zslpmax, psxx(ji,jj,jl) ) ) 392 zs2new = MIN( 2.0 * zslpmax - 0.3334 * ABS( zs1new ), MAX( ABS( zs1new ) - zslpmax, psxx(ji,jj,jl) ) ) 387 393 rswitch = ( 1.0 - MAX( 0._wp, SIGN( 1._wp, -zslpmax) ) ) * tmask(ji,jj,1) ! Case of empty boxes & Apply mask 388 394 … … 393 399 psyy(ji,jj,jl) = psyy(ji,jj,jl) * rswitch 394 400 psxy(ji,jj,jl) = MIN( zslpmax, MAX( -zslpmax, psxy(ji,jj,jl) ) ) * rswitch 395 END DO 396 END DO 397 398 ! Calculate fluxes and moments between boxes i<-->i+1 399 DO jj = 2, jpjm1 ! Flux from i to i+1 WHEN u GT 0 400 DO ji = 1, jpi 401 402 ! Calculate fluxes and moments between boxes i<-->i+1 403 ! ! Flux from i to i+1 WHEN u GT 0 401 404 zbet(ji,jj) = MAX( 0._wp, SIGN( 1._wp, put(ji,jj) ) ) 402 405 zalf = MAX( 0._wp, put(ji,jj) ) * pdt / psm(ji,jj,jl) … … 413 416 zfyy(ji,jj) = zalf * psyy(ji,jj,jl) 414 417 415 ! Readjust moments remaining in the box.418 ! ! Readjust moments remaining in the box. 416 419 psm (ji,jj,jl) = psm (ji,jj,jl) - zfm(ji,jj) 417 420 ps0 (ji,jj,jl) = ps0 (ji,jj,jl) - zf0(ji,jj) … … 422 425 psxy(ji,jj,jl) = zalf1q * psxy(ji,jj,jl) 423 426 END DO 424 END DO 425 426 DO jj = 2, jpjm1 ! Flux from i+1 to i when u LT 0. 427 427 428 DO ji = 1, fs_jpim1 429 ! ! Flux from i+1 to i when u LT 0. 428 430 zalf = MAX( 0._wp, -put(ji,jj) ) * pdt / psm(ji+1,jj,jl) 429 431 zalg (ji,jj) = zalf … … 443 445 zfyy (ji,jj) = zfyy(ji,jj) + zalf * psyy(ji+1,jj,jl) 444 446 END DO 445 END DO 446 447 DO jj = 2, jpjm1 ! Readjust moments remaining in the box. 448 DO ji = fs_2, fs_jpim1 447 448 DO ji = fs_2, fs_jpim1 449 449 zbt = zbet(ji-1,jj) 450 450 zbt1 = 1.0 - zbet(ji-1,jj) 451 ! 451 ! ! Readjust moments remaining in the box. 452 452 psm (ji,jj,jl) = zbt * psm(ji,jj,jl) + zbt1 * ( psm(ji,jj,jl) - zfm(ji-1,jj) ) 453 453 ps0 (ji,jj,jl) = zbt * ps0(ji,jj,jl) + zbt1 * ( ps0(ji,jj,jl) - zf0(ji-1,jj) ) … … 457 457 psyy(ji,jj,jl) = zbt * psyy(ji,jj,jl) + zbt1 * ( psyy(ji,jj,jl) - zfyy(ji-1,jj) ) 458 458 psxy(ji,jj,jl) = zalg1q(ji-1,jj) * psxy(ji,jj,jl) 459 END DO 460 END DO 461 462 ! Put the temporary moments into appropriate neighboring boxes. 463 DO jj = 2, jpjm1 ! Flux from i to i+1 IF u GT 0. 464 DO ji = fs_2, fs_jpim1 459 460 ! Put the temporary moments into appropriate neighboring boxes. 461 ! ! Flux from i to i+1 IF u GT 0. 465 462 zbt = zbet(ji-1,jj) 466 463 zbt1 = 1.0 - zbet(ji-1,jj) … … 480 477 psy (ji,jj,jl) = zbt * ( psy (ji,jj,jl) + zfy (ji-1,jj) ) + zbt1 * psy (ji,jj,jl) 481 478 psyy(ji,jj,jl) = zbt * ( psyy(ji,jj,jl) + zfyy(ji-1,jj) ) + zbt1 * psyy(ji,jj,jl) 482 END DO 483 END DO 484 485 DO jj = 2, jpjm1 ! Flux from i+1 to i IF u LT 0. 486 DO ji = fs_2, fs_jpim1 479 480 ! ! Flux from i+1 to i IF u LT 0. 487 481 zbt = zbet(ji,jj) 488 482 zbt1 = 1.0 - zbet(ji,jj) … … 502 496 psyy(ji,jj,jl) = zbt * psyy(ji,jj,jl) + zbt1 * ( psyy(ji,jj,jl) + zfyy(ji,jj) ) 503 497 END DO 498 504 499 END DO 505 500 … … 507 502 508 503 !-- Lateral boundary conditions 509 CALL lbc_lnk_multi( 'icedyn_adv_pra', psm(:,:,1:jcat) , 'T', 1., ps0 , 'T', 1. & 510 & , psx , 'T', -1., psy , 'T', -1. & ! caution gradient ==> the sign changes 511 & , psxx , 'T', 1., psyy, 'T', 1. , psxy, 'T', 1. ) 504 IF( NINT( pcrh ) == 0 ) THEN ! adv_x is called after adv_y 505 CALL lbc_lnk_multi( 'icedyn_adv_pra', psm(:,:,1:jcat) , 'T', 1., ps0 , 'T', 1. & 506 & , psx , 'T', -1., psy , 'T', -1. & ! caution gradient ==> the sign changes 507 & , psxx , 'T', 1., psyy, 'T', 1. , psxy, 'T', 1. ) 508 ENDIF 512 509 ! 513 510 END SUBROUTINE adv_x … … 531 528 !! 532 529 INTEGER :: ji, jj, jl, jcat ! dummy loop indices 530 INTEGER :: jimin, jimax ! dummy loop indices 533 531 REAL(wp) :: zs1max, zslpmax, ztemp ! temporary scalars 534 532 REAL(wp) :: zs1new, zalf , zalfq , zbt ! - - … … 538 536 REAL(wp), DIMENSION(jpi,jpj) :: zalg, zalg1, zalg1q ! - - 539 537 !--------------------------------------------------------------------- 538 ! in order to avoid lbc_lnk (communications): 539 ! ji loop must be 1:jpi if adv_y is called first 540 ! and 2:jpi-1 if adv_y is called second 541 jimin = 2 - NINT(pcrh) ! 1 or 2 542 jimax = jpim1 + NINT(pcrh) ! jpi or jpi-1 540 543 ! 541 544 jcat = SIZE( ps0 , 3 ) ! size of input arrays … … 545 548 ! Limitation of moments. 546 549 DO jj = 1, jpj 547 DO ji = fs_2, fs_jpim1548 ! Initialize volumes of boxes (=area if adv_ xfirst called, =psm otherwise)550 DO ji = jimin, jimax 551 ! Initialize volumes of boxes (=area if adv_y first called, =psm otherwise) 549 552 psm(ji,jj,jl) = MAX( pcrh * e1e2t(ji,jj) + ( 1.0 - pcrh ) * psm(ji,jj,jl) , epsi20 ) 550 553 ! … … 552 555 zs1max = 1.5 * zslpmax 553 556 zs1new = MIN( zs1max, MAX( -zs1max, psy(ji,jj,jl) ) ) 554 zs2new = MIN( ( 2.0 * zslpmax - 0.3334 * ABS( zs1new ) ), & 555 & MAX( ABS( zs1new )-zslpmax, psyy(ji,jj,jl) ) ) 557 zs2new = MIN( ( 2.0 * zslpmax - 0.3334 * ABS( zs1new ) ), MAX( ABS( zs1new )-zslpmax, psyy(ji,jj,jl) ) ) 556 558 rswitch = ( 1.0 - MAX( 0._wp, SIGN( 1._wp, -zslpmax) ) ) * tmask(ji,jj,1) ! Case of empty boxes & Apply mask 557 559 ! … … 562 564 psyy(ji,jj,jl) = zs2new * rswitch 563 565 psxy(ji,jj,jl) = MIN( zslpmax, MAX( -zslpmax, psxy(ji,jj,jl) ) ) * rswitch 564 END DO565 END DO566 566 567 ! Calculate fluxes and moments between boxes j<-->j+1 568 DO jj = 1, jpj ! Flux from j to j+1 WHEN v GT 0 569 DO ji = fs_2, fs_jpim1 567 ! Calculate fluxes and moments between boxes j<-->j+1 568 ! ! Flux from j to j+1 WHEN v GT 0 570 569 zbet(ji,jj) = MAX( 0._wp, SIGN( 1._wp, pvt(ji,jj) ) ) 571 570 zalf = MAX( 0._wp, pvt(ji,jj) ) * pdt / psm(ji,jj,jl) … … 582 581 zfxx(ji,jj) = zalf * psxx(ji,jj,jl) 583 582 ! 584 ! Readjust moments remaining in the box.583 ! ! Readjust moments remaining in the box. 585 584 psm (ji,jj,jl) = psm (ji,jj,jl) - zfm(ji,jj) 586 585 ps0 (ji,jj,jl) = ps0 (ji,jj,jl) - zf0(ji,jj) … … 593 592 END DO 594 593 ! 595 DO jj = 1, jpjm1 ! Flux from j+1 to j when v LT 0. 596 DO ji = fs_2, fs_jpim1 594 DO jj = 1, jpjm1 595 DO ji = jimin, jimax 596 ! ! Flux from j+1 to j when v LT 0. 597 597 zalf = MAX( 0._wp, -pvt(ji,jj) ) * pdt / psm(ji,jj+1,jl) 598 598 zalg (ji,jj) = zalf … … 614 614 END DO 615 615 616 ! Readjust moments remaining in the box.617 616 DO jj = 2, jpjm1 618 DO ji = fs_2, fs_jpim1 617 DO ji = jimin, jimax 618 ! ! Readjust moments remaining in the box. 619 619 zbt = zbet(ji,jj-1) 620 620 zbt1 = ( 1.0 - zbet(ji,jj-1) ) … … 627 627 psxx(ji,jj,jl) = zbt * psxx(ji,jj,jl) + zbt1 * ( psxx(ji,jj,jl) - zfxx(ji,jj-1) ) 628 628 psxy(ji,jj,jl) = zalg1q(ji,jj-1) * psxy(ji,jj,jl) 629 END DO 630 END DO 631 632 ! Put the temporary moments into appropriate neighboring boxes. 633 DO jj = 2, jpjm1 ! Flux from j to j+1 IF v GT 0. 634 DO ji = fs_2, fs_jpim1 629 630 ! Put the temporary moments into appropriate neighboring boxes. 631 ! ! Flux from j to j+1 IF v GT 0. 635 632 zbt = zbet(ji,jj-1) 636 633 zbt1 = 1.0 - zbet(ji,jj-1) … … 651 648 psx (ji,jj,jl) = zbt * ( psx (ji,jj,jl) + zfx (ji,jj-1) ) + zbt1 * psx (ji,jj,jl) 652 649 psxx(ji,jj,jl) = zbt * ( psxx(ji,jj,jl) + zfxx(ji,jj-1) ) + zbt1 * psxx(ji,jj,jl) 653 END DO 654 END DO 655 656 DO jj = 2, jpjm1 ! Flux from j+1 to j IF v LT 0. 657 DO ji = fs_2, fs_jpim1 650 651 ! ! Flux from j+1 to j IF v LT 0. 658 652 zbt = zbet(ji,jj) 659 653 zbt1 = 1.0 - zbet(ji,jj) … … 678 672 679 673 !-- Lateral boundary conditions 680 CALL lbc_lnk_multi( 'icedyn_adv_pra', psm(:,:,1:jcat) , 'T', 1., ps0 , 'T', 1. & 681 & , psx , 'T', -1., psy , 'T', -1. & ! caution gradient ==> the sign changes 682 & , psxx , 'T', 1., psyy, 'T', 1. , psxy, 'T', 1. ) 674 IF( NINT( pcrh ) == 0 ) THEN ! adv_y is called after adv_x 675 CALL lbc_lnk_multi( 'icedyn_adv_pra', psm(:,:,1:jcat) , 'T', 1., ps0 , 'T', 1. & 676 & , psx , 'T', -1., psy , 'T', -1. & ! caution gradient ==> the sign changes 677 & , psxx , 'T', 1., psyy, 'T', 1. , psxy, 'T', 1. ) 678 ENDIF 683 679 ! 684 680 END SUBROUTINE adv_y
Note: See TracChangeset
for help on using the changeset viewer.