Changeset 9116
- Timestamp:
- 2017-12-18T15:24:31+01:00 (7 years ago)
- Location:
- branches/2017/dev_merge_2017/NEMOGCM/NEMO
- Files:
-
- 6 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2017/dev_merge_2017/NEMOGCM/NEMO/NST_SRC/agrif_oce.F90
r9058 r9116 46 46 47 47 ! Barotropic arrays used to store open boundary data during time-splitting loop: 48 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(: ) :: ubdy_w, vbdy_w, hbdy_w49 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(: ) :: ubdy_e, vbdy_e, hbdy_e50 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(: ) :: ubdy_n, vbdy_n, hbdy_n51 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(: ) :: ubdy_s, vbdy_s, hbdy_s48 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ubdy_w, vbdy_w, hbdy_w 49 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ubdy_e, vbdy_e, hbdy_e 50 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ubdy_n, vbdy_n, hbdy_n 51 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ubdy_s, vbdy_s, hbdy_s 52 52 53 53 … … 91 91 & tabspongedone_v (jpi,jpj), STAT = ierr(1) ) 92 92 93 ALLOCATE( ubdy_w( jpj), vbdy_w(jpj), hbdy_w(jpj), &94 & ubdy_e( jpj), vbdy_e(jpj), hbdy_e(jpj), &95 & ubdy_n(jpi ), vbdy_n(jpi), hbdy_n(jpi), &96 & ubdy_s(jpi ), vbdy_s(jpi), hbdy_s(jpi), STAT = ierr(2) )93 ALLOCATE( ubdy_w(nbghostcells,jpj), vbdy_w(nbghostcells,jpj), hbdy_w(nbghostcells,jpj), & 94 & ubdy_e(nbghostcells,jpj), vbdy_e(nbghostcells,jpj), hbdy_e(nbghostcells,jpj), & 95 & ubdy_n(jpi,nbghostcells), vbdy_n(jpi,nbghostcells), hbdy_n(jpi,nbghostcells), & 96 & ubdy_s(jpi,nbghostcells), vbdy_s(jpi,nbghostcells), hbdy_s(jpi,nbghostcells), STAT = ierr(2) ) 97 97 98 98 agrif_oce_alloc = MAXVAL(ierr) -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/NST_SRC/agrif_opa_interp.F90
r9082 r9116 373 373 IF((nbondi == -1).OR.(nbondi == 2)) THEN 374 374 DO jj=1,jpj 375 va_e(2:nbghostcells+1,jj) = vbdy_w( jj) * hvr_e(2:nbghostcells+1,jj)375 va_e(2:nbghostcells+1,jj) = vbdy_w(1:nbghostcells,jj) * hvr_e(2:nbghostcells+1,jj) 376 376 ! Specified fluxes: 377 ua_e(2:nbghostcells+1,jj) = ubdy_w( jj) * hur_e(2:nbghostcells+1,jj)377 ua_e(2:nbghostcells+1,jj) = ubdy_w(1:nbghostcells,jj) * hur_e(2:nbghostcells+1,jj) 378 378 ! Characteristics method (only if ghostcells=1): 379 379 !alt ua_e(2,jj) = 0.5_wp * ( ubdy_w(jj) * hur_e(2,jj) + ua_e(3,jj) & … … 384 384 IF((nbondi == 1).OR.(nbondi == 2)) THEN 385 385 DO jj=1,jpj 386 va_e(nlci-nbghostcells:nlci-1,jj) = vbdy_e( jj) * hvr_e(nlci-nbghostcells:nlci-1,jj)386 va_e(nlci-nbghostcells:nlci-1,jj) = vbdy_e(1:nbghostcells,jj) * hvr_e(nlci-nbghostcells:nlci-1,jj) 387 387 ! Specified fluxes: 388 ua_e(nlci-nbghostcells-1:nlci-2,jj) = ubdy_e( jj) * hur_e(nlci-nbghostcells-1:nlci-2,jj)388 ua_e(nlci-nbghostcells-1:nlci-2,jj) = ubdy_e(1:nbghostcells,jj) * hur_e(nlci-nbghostcells-1:nlci-2,jj) 389 389 ! Characteristics method (only if ghostcells=1): 390 390 !alt ua_e(nlci-2,jj) = 0.5_wp * ( ubdy_e(jj) * hur_e(nlci-2,jj) + ua_e(nlci-3,jj) & … … 395 395 IF((nbondj == -1).OR.(nbondj == 2)) THEN 396 396 DO ji=1,jpi 397 ua_e(ji,2:nbghostcells+1) = ubdy_s(ji ) * hur_e(ji,2:nbghostcells+1)397 ua_e(ji,2:nbghostcells+1) = ubdy_s(ji,1:nbghostcells) * hur_e(ji,2:nbghostcells+1) 398 398 ! Specified fluxes: 399 va_e(ji,2:nbghostcells+1) = vbdy_s(ji ) * hvr_e(ji,2:nbghostcells+1)399 va_e(ji,2:nbghostcells+1) = vbdy_s(ji,1:nbghostcells) * hvr_e(ji,2:nbghostcells+1) 400 400 ! Characteristics method (only if ghostcells=1): 401 401 !alt va_e(ji,2) = 0.5_wp * ( vbdy_s(ji) * hvr_e(ji,2) + va_e(ji,3) & … … 406 406 IF((nbondj == 1).OR.(nbondj == 2)) THEN 407 407 DO ji=1,jpi 408 ua_e(ji,nlcj-nbghostcells:nlcj-1) = ubdy_n(ji ) * hur_e(ji,nlcj-nbghostcells:nlcj-1)408 ua_e(ji,nlcj-nbghostcells:nlcj-1) = ubdy_n(ji,1:nbghostcells) * hur_e(ji,nlcj-nbghostcells:nlcj-1) 409 409 ! Specified fluxes: 410 va_e(ji,nlcj-nbghostcells-1:nlcj-2) = vbdy_n(ji ) * hvr_e(ji,nlcj-nbghostcells-1:nlcj-2)410 va_e(ji,nlcj-nbghostcells-1:nlcj-2) = vbdy_n(ji,1:nbghostcells) * hvr_e(ji,nlcj-nbghostcells-1:nlcj-2) 411 411 ! Characteristics method (only if ghostcells=1): 412 412 !alt va_e(ji,nlcj-2) = 0.5_wp * ( vbdy_n(ji) * hvr_e(ji,nlcj-2) + va_e(ji,nlcj-3) & … … 451 451 ELSE ! Linear interpolation 452 452 bdy_tinterp = 0 453 ubdy_w(: ) = 0._wp ; vbdy_w(:) = 0._wp454 ubdy_e(: ) = 0._wp ; vbdy_e(:) = 0._wp455 ubdy_n(: ) = 0._wp ; vbdy_n(:) = 0._wp456 ubdy_s(: ) = 0._wp ; vbdy_s(:) = 0._wp453 ubdy_w(:,:) = 0._wp ; vbdy_w(:,:) = 0._wp 454 ubdy_e(:,:) = 0._wp ; vbdy_e(:,:) = 0._wp 455 ubdy_n(:,:) = 0._wp ; vbdy_n(:,:) = 0._wp 456 ubdy_s(:,:) = 0._wp ; vbdy_s(:,:) = 0._wp 457 457 CALL Agrif_Bc_variable( unb_id, procname=interpunb ) 458 458 CALL Agrif_Bc_variable( vnb_id, procname=interpvnb ) … … 474 474 IF( Agrif_Root() ) RETURN 475 475 ! 476 ! Linear interpolation in timeof sea level476 ! Linear time interpolation of sea level 477 477 ! 478 478 Agrif_SpecialValue = 0._wp … … 481 481 Agrif_UseSpecialValue = .FALSE. 482 482 ! 483 ! --- West --- ! 483 484 IF((nbondi == -1).OR.(nbondi == 2)) THEN 484 485 indx = 1+nbghostcells 485 486 DO jj = 1, jpj 486 487 DO ji = 2, indx 487 ssha(ji,jj) = hbdy_w(j j)488 ssha(ji,jj) = hbdy_w(ji-1,jj) 488 489 ENDDO 489 490 ENDDO … … 495 496 DO jj = 1, jpj 496 497 DO ji = indx, nlci-1 497 ssha( indx,jj) = hbdy_e(jj)498 ssha(ji,jj) = hbdy_e(ji-indx+1,jj) 498 499 ENDDO 499 500 ENDDO … … 505 506 DO jj = 2, indy 506 507 DO ji = 1, jpi 507 ssha(ji, indy) = hbdy_s(ji)508 ssha(ji,jj) = hbdy_s(ji,jj-1) 508 509 ENDDO 509 510 ENDDO … … 513 514 IF((nbondj == 1).OR.(nbondj == 2)) THEN 514 515 indy = nlcj-nbghostcells 515 DO jj = ind x, nlcj-1516 DO jj = indy, nlcj-1 516 517 DO ji = 1, jpi 517 ssha(ji, indy) = hbdy_n(ji)518 ssha(ji,jj) = hbdy_n(ji,jj-indy+1) 518 519 ENDDO 519 520 ENDDO … … 529 530 INTEGER, INTENT(in) :: jn 530 531 !! 531 INTEGER :: ji, jj 532 INTEGER :: ji, jj, indx, indy 532 533 !!---------------------------------------------------------------------- 533 534 !! clem ghost (starting at i,j=1 is important I think otherwise you introduce a grad(ssh)/=0 at point 2) … … 535 536 IF( Agrif_Root() ) RETURN 536 537 ! 538 ! --- West --- ! 537 539 IF((nbondi == -1).OR.(nbondi == 2)) THEN 540 indx = 1+nbghostcells 538 541 DO jj = 1, jpj 539 ssha_e(2:nbghostcells+1,jj) = hbdy_w(jj) 540 END DO 541 ENDIF 542 ! 542 DO ji = 2, indx 543 ssha_e(ji,jj) = hbdy_w(ji-1,jj) 544 ENDDO 545 ENDDO 546 ENDIF 547 ! 548 ! --- East --- ! 543 549 IF((nbondi == 1).OR.(nbondi == 2)) THEN 550 indx = nlci-nbghostcells 544 551 DO jj = 1, jpj 545 ssha_e(nlci-nbghostcells:nlci-1,jj) = hbdy_e(jj) 546 END DO 547 ENDIF 548 ! 552 DO ji = indx, nlci-1 553 ssha_e(ji,jj) = hbdy_e(ji-indx+1,jj) 554 ENDDO 555 ENDDO 556 ENDIF 557 ! 558 ! --- South --- ! 549 559 IF((nbondj == -1).OR.(nbondj == 2)) THEN 550 DO ji = 1, jpi 551 ssha_e(ji,2:nbghostcells+1) = hbdy_s(ji) 552 END DO 553 ENDIF 554 ! 560 indy = 1+nbghostcells 561 DO jj = 2, indy 562 DO ji = 1, jpi 563 ssha_e(ji,jj) = hbdy_s(ji,jj-1) 564 ENDDO 565 ENDDO 566 ENDIF 567 ! 568 ! --- North --- ! 555 569 IF((nbondj == 1).OR.(nbondj == 2)) THEN 556 DO ji = 1, jpi 557 ssha_e(ji,nlcj-nbghostcells:nlcj-1) = hbdy_n(ji) 558 END DO 570 indy = nlcj-nbghostcells 571 DO jj = indy, nlcj-1 572 DO ji = 1, jpi 573 ssha_e(ji,jj) = hbdy_n(ji,jj-indy+1) 574 ENDDO 575 ENDDO 559 576 ENDIF 560 577 ! … … 592 609 INTEGER , INTENT(in ) :: nb , ndir 593 610 ! 594 INTEGER :: ji, jj, jk, jn, iref, jref ! dummy loop indices611 INTEGER :: ji, jj, jk, jn, iref, jref, ibdy, jbdy ! dummy loop indices 595 612 INTEGER :: imin, imax, jmin, jmax, N_in, N_out 596 613 REAL(wp) :: zrhox, z1, z2, z3, z4, z5, z6, z7 … … 600 617 REAL(wp), DIMENSION(k1:k2,n1:n2-1) :: tabin 601 618 REAL(wp), DIMENSION(k1:k2) :: h_in 602 REAL(wp), DIMENSION(1:jpk) :: h_out(1:jpk) 603 REAL(wp) :: h_diff, zrhoxy 604 605 zrhoxy = Agrif_rhox()*Agrif_rhoy() 619 REAL(wp), DIMENSION(1:jpk) :: h_out 620 REAL(wp) :: h_diff 621 606 622 IF( before ) THEN 607 623 DO jn = 1,jpts … … 662 678 # endif 663 679 ! 664 IF( lk_agrif_clp ) THEN ! Clamped bcs665 tsa(i1:i2,j1:j2,k1:k2,n1:n2) = ptab_child(i1:i2,j1:j2,k1:k2,n1:n2) 666 ELSE ! smoothing680 tsa(i1:i2,j1:j2,1:jpk,1:jpts) = ptab_child(i1:i2,j1:j2,1:jpk,1:jpts) 681 682 IF ( .NOT.lk_agrif_clp ) THEN 667 683 ! 668 684 zrhox = Agrif_Rhox() … … 686 702 ! 687 703 IF( eastern_side ) THEN 704 ibdy = nlci-nbghostcells 688 705 DO jn = 1, jpts 689 tsa( nlci,j1:j2,k1:k2,jn) = z1 * ptab_child(nlci,j1:j2,k1:k2,jn) + z2 * ptab_child(nlci-1,j1:j2,k1:k2,jn)706 tsa(ibdy+1,jmin:jmax,k1:k2,jn) = z1 * ptab_child(ibdy+1,jmin:jmax,k1:k2,jn) + z2 * ptab_child(ibdy,jmin:jmax,k1:k2,jn) 690 707 DO jk = 1, jpkm1 691 708 DO jj = jmin,jmax 692 IF( umask( nlci-2,jj,jk) == 0._wp ) THEN693 tsa( nlci-1,jj,jk,jn) = tsa(nlci,jj,jk,jn) * tmask(nlci-1,jj,jk)709 IF( umask(ibdy-1,jj,jk) == 0._wp ) THEN 710 tsa(ibdy,jj,jk,jn) = tsa(ibdy+1,jj,jk,jn) * tmask(ibdy,jj,jk) 694 711 ELSE 695 tsa( nlci-1,jj,jk,jn)=(z4*tsa(nlci,jj,jk,jn)+z3*tsa(nlci-2,jj,jk,jn))*tmask(nlci-1,jj,jk)696 IF( un( nlci-2,jj,jk) > 0._wp ) THEN697 tsa( nlci-1,jj,jk,jn)=( z6*tsa(nlci-2,jj,jk,jn)+z5*tsa(nlci,jj,jk,jn) &698 + z7*tsa(nlci-3,jj,jk,jn) ) * tmask(nlci-1,jj,jk)712 tsa(ibdy,jj,jk,jn)=(z4*tsa(ibdy+1,jj,jk,jn)+z3*tsa(ibdy-1,jj,jk,jn))*tmask(ibdy,jj,jk) 713 IF( un(ibdy-1,jj,jk) > 0._wp ) THEN 714 tsa(ibdy,jj,jk,jn)=( z6*tsa(ibdy-1,jj,jk,jn)+z5*tsa(ibdy+1,jj,jk,jn) & 715 + z7*tsa(ibdy-2,jj,jk,jn) ) * tmask(ibdy,jj,jk) 699 716 ENDIF 700 717 ENDIF 701 718 END DO 702 719 END DO 703 tsa(nlci,j1:j2,k1:k2,jn) = 0._wp 720 ! Restore ghost points: 721 tsa(ibdy+1,jmin:jmax,k1:k2,jn) = ptab_child(ibdy+1,jmin:jmax,k1:k2,jn) * tmask(ibdy+1,jmin:jmax,k1:k2) 704 722 END DO 705 723 ENDIF 706 724 ! 707 IF( northern_side ) THEN 725 IF( northern_side ) THEN 726 jbdy = nlcj-nbghostcells 708 727 DO jn = 1, jpts 709 tsa(i 1:i2,nlcj,k1:k2,jn) = z1 * ptab_child(i1:i2,nlcj,k1:k2,jn) + z2 * ptab_child(i1:i2,nlcj-1,k1:k2,jn)728 tsa(imin:imax,jbdy+1,k1:k2,jn) = z1 * ptab_child(imin:imax,jbdy+1,k1:k2,jn) + z2 * ptab_child(imin:imax,jbdy,k1:k2,jn) 710 729 DO jk = 1, jpkm1 711 730 DO ji = imin,imax 712 IF( vmask(ji, nlcj-2,jk) == 0._wp ) THEN713 tsa(ji, nlcj-1,jk,jn) = tsa(ji,nlcj,jk,jn) * tmask(ji,nlcj-1,jk)731 IF( vmask(ji,jbdy-1,jk) == 0._wp ) THEN 732 tsa(ji,jbdy,jk,jn) = tsa(ji,jbdy+1,jk,jn) * tmask(ji,jbdy,jk) 714 733 ELSE 715 tsa(ji, nlcj-1,jk,jn)=(z4*tsa(ji,nlcj,jk,jn)+z3*tsa(ji,nlcj-2,jk,jn))*tmask(ji,nlcj-1,jk)716 IF (vn(ji, nlcj-2,jk) > 0._wp ) THEN717 tsa(ji, nlcj-1,jk,jn)=( z6*tsa(ji,nlcj-2,jk,jn)+z5*tsa(ji,nlcj,jk,jn) &718 + z7*tsa(ji,nlcj-3,jk,jn) ) * tmask(ji,nlcj-1,jk)734 tsa(ji,jbdy,jk,jn)=(z4*tsa(ji,jbdy+1,jk,jn)+z3*tsa(ji,jbdy-1,jk,jn))*tmask(ji,jbdy,jk) 735 IF (vn(ji,jbdy-1,jk) > 0._wp ) THEN 736 tsa(ji,jbdy,jk,jn)=( z6*tsa(ji,jbdy-1,jk,jn)+z5*tsa(ji,jbdy+1,jk,jn) & 737 + z7*tsa(ji,jbdy-2,jk,jn) ) * tmask(ji,jbdy,jk) 719 738 ENDIF 720 739 ENDIF 721 740 END DO 722 741 END DO 723 tsa(i1:i2,nlcj,k1:k2,jn) = 0._wp 742 ! Restore ghost points: 743 tsa(imin:imax,jbdy+1,k1:k2,jn) = ptab_child(imin:imax,jbdy+1,k1:k2,jn) * tmask(imin:imax,jbdy+1,k1:k2) 724 744 END DO 725 745 ENDIF 726 746 ! 727 IF( western_side ) THEN 747 IF( western_side ) THEN 748 ibdy = 1+nbghostcells 728 749 DO jn = 1, jpts 729 tsa( 1,j1:j2,k1:k2,jn) = z1 * ptab_child(1,j1:j2,k1:k2,jn) + z2 * ptab_child(2,j1:j2,k1:k2,jn)750 tsa(ibdy-1,jmin:jmax,k1:k2,jn) = z1 * ptab_child(ibdy-1,jmin:jmax,k1:k2,jn) + z2 * ptab_child(ibdy,jmin:jmax,k1:k2,jn) 730 751 DO jk = 1, jpkm1 731 752 DO jj = jmin,jmax 732 IF( umask( 2,jj,jk) == 0._wp ) THEN733 tsa( 2,jj,jk,jn) = tsa(1,jj,jk,jn) * tmask(2,jj,jk)753 IF( umask(ibdy,jj,jk) == 0._wp ) THEN 754 tsa(ibdy,jj,jk,jn) = tsa(ibdy-1,jj,jk,jn) * tmask(ibdy,jj,jk) 734 755 ELSE 735 tsa( 2,jj,jk,jn)=(z4*tsa(1,jj,jk,jn)+z3*tsa(3,jj,jk,jn))*tmask(2,jj,jk)736 IF( un( 2,jj,jk) < 0._wp ) THEN737 tsa( 2,jj,jk,jn)=(z6*tsa(3,jj,jk,jn)+z5*tsa(1,jj,jk,jn)+z7*tsa(4,jj,jk,jn))*tmask(2,jj,jk)756 tsa(ibdy,jj,jk,jn)=(z4*tsa(ibdy-1,jj,jk,jn)+z3*tsa(ibdy+1,jj,jk,jn))*tmask(ibdy,jj,jk) 757 IF( un(ibdy,jj,jk) < 0._wp ) THEN 758 tsa(ibdy,jj,jk,jn)=(z6*tsa(ibdy+1,jj,jk,jn)+z5*tsa(ibdy-1,jj,jk,jn)+z7*tsa(ibdy+2,jj,jk,jn))*tmask(ibdy,jj,jk) 738 759 ENDIF 739 760 ENDIF 740 761 END DO 741 762 END DO 742 tsa(1,j1:j2,k1:k2,jn) = 0._wp 763 ! Restore ghost points: 764 tsa(ibdy-1,jmin:jmax,k1:k2,jn) = ptab_child(ibdy-1,jmin:jmax,k1:k2,jn) * tmask(ibdy-1,jmin:jmax,k1:k2) 743 765 END DO 744 766 ENDIF 745 767 ! 746 IF( southern_side ) THEN 768 IF( southern_side ) THEN 769 jbdy=1+nbghostcells 747 770 DO jn = 1, jpts 748 tsa(i 1:i2,1,k1:k2,jn) = z1 * ptab_child(i1:i2,1,k1:k2,jn) + z2 * ptab_child(i1:i2,2,k1:k2,jn)771 tsa(imin:imax,jbdy-1,k1:k2,jn) = z1 * ptab_child(imin:imax,jbdy-1,k1:k2,jn) + z2 * ptab_child(imin:imax,jbdy,k1:k2,jn) 749 772 DO jk = 1, jpk 750 773 DO ji=imin,imax 751 IF( vmask(ji, 2,jk) == 0._wp ) THEN752 tsa(ji, 2,jk,jn)=tsa(ji,1,jk,jn) * tmask(ji,2,jk)774 IF( vmask(ji,jbdy,jk) == 0._wp ) THEN 775 tsa(ji,jbdy,jk,jn)=tsa(ji,jbdy-1,jk,jn) * tmask(ji,jbdy,jk) 753 776 ELSE 754 tsa(ji, 2,jk,jn)=(z4*tsa(ji,1,jk,jn)+z3*tsa(ji,3,jk,jn))*tmask(ji,2,jk)755 IF( vn(ji, 2,jk) < 0._wp ) THEN756 tsa(ji, 2,jk,jn)=(z6*tsa(ji,3,jk,jn)+z5*tsa(ji,1,jk,jn)+z7*tsa(ji,4,jk,jn))*tmask(ji,2,jk)777 tsa(ji,jbdy,jk,jn)=(z4*tsa(ji,jbdy-1,jk,jn)+z3*tsa(ji,jbdy+1,jk,jn))*tmask(ji,jbdy,jk) 778 IF( vn(ji,jbdy,jk) < 0._wp ) THEN 779 tsa(ji,jbdy,jk,jn)=(z6*tsa(ji,jbdy+1,jk,jn)+z5*tsa(ji,jbdy-1,jk,jn)+z7*tsa(ji,jbdy+2,jk,jn))*tmask(ji,jbdy,jk) 757 780 ENDIF 758 781 ENDIF 759 782 END DO 760 783 END DO 761 tsa(i1:i2,1,k1:k2,jn) = 0._wp 762 END DO 763 ENDIF 764 ! 765 ! 766 ! Treatment of corners 767 ! 768 ! East south 769 IF ((eastern_side).AND.((nbondj == -1).OR.(nbondj == 2))) THEN 770 tsa(nlci-1,2,:,:) = ptab_child(nlci-1,2,:,1:jpts) 771 ENDIF 772 ! East north 773 IF ((eastern_side).AND.((nbondj == 1).OR.(nbondj == 2))) THEN 774 tsa(nlci-1,nlcj-1,:,:) = ptab_child(nlci-1,nlcj-1,:,1:jpts) 775 ENDIF 776 ! West south 777 IF ((western_side).AND.((nbondj == -1).OR.(nbondj == 2))) THEN 778 tsa(2,2,:,:) = ptab_child(2,2,:,1:jpts) 779 ENDIF 780 ! West north 781 IF ((western_side).AND.((nbondj == 1).OR.(nbondj == 2))) THEN 782 tsa(2,nlcj-1,:,:) = ptab_child(2,nlcj-1,:,1:jpts) 784 ! Restore ghost points: 785 tsa(imin:imax,jbdy-1,k1:k2,jn) = tsa(imin:imax,jbdy-1,k1:k2,jn) * tmask(imin:imax,jbdy-1,k1:k2) 786 END DO 783 787 ENDIF 784 788 ! … … 808 812 northern_side = (nb == 2).AND.(ndir == 2) 809 813 !! clem ghost 810 IF(western_side) hbdy_w( j1:j2) = ptab(i2,j1:j2) * tmask(i2,j1:j2,1)811 IF(eastern_side) hbdy_e( j1:j2) = ptab(i1,j1:j2) * tmask(i1,j1:j2,1)812 IF(southern_side) hbdy_s(i1:i2 ) = ptab(i1:i2,j2) * tmask(i1:i2,j2,1)813 IF(northern_side) hbdy_n(i1:i2 ) = ptab(i1:i2,j1) * tmask(i1:i2,j1,1)814 IF(western_side) hbdy_w(1:nbghostcells,j1:j2) = ptab(i1:i2,j1:j2) * tmask(i1:i2,j1:j2,1) 815 IF(eastern_side) hbdy_e(1:nbghostcells,j1:j2) = ptab(i1:i2,j1:j2) * tmask(i1:i2,j1:j2,1) 816 IF(southern_side) hbdy_s(i1:i2,1:nbghostcells) = ptab(i1:i2,j1:j2) * tmask(i1:i2,j1:j2,1) 817 IF(northern_side) hbdy_n(i1:i2,1:nbghostcells) = ptab(i1:i2,j1:j2) * tmask(i1:i2,j1:j2,1) 814 818 ENDIF 815 819 ! … … 836 840 !!--------------------------------------------- 837 841 ! 838 zrhoy = Agrif_rhoy()839 842 IF (before) THEN 840 843 DO jk=1,jpk … … 1023 1026 ENDIF 1024 1027 ! 1025 IF(western_side) ubdy_w( j1:j2) = ubdy_w(j1:j2) + ztcoeff * ptab(i2,j1:j2)1026 IF(eastern_side) ubdy_e( j1:j2) = ubdy_e(j1:j2) + ztcoeff * ptab(i1,j1:j2)1027 IF(southern_side) ubdy_s(i1:i2 ) = ubdy_s(i1:i2) + ztcoeff * ptab(i1:i2,j2)1028 IF(northern_side) ubdy_n(i1:i2 ) = ubdy_n(i1:i2) + ztcoeff * ptab(i1:i2,j1)1028 IF(western_side) ubdy_w(1:nbghostcells,j1:j2) = ubdy_w(1:nbghostcells,j1:j2) + ztcoeff * ptab(i1:i2,j1:j2) 1029 IF(eastern_side) ubdy_e(1:nbghostcells,j1:j2) = ubdy_e(1:nbghostcells,j1:j2) + ztcoeff * ptab(i1:i2,j1:j2) 1030 IF(southern_side) ubdy_s(i1:i2,1:nbghostcells) = ubdy_s(i1:i2,1:nbghostcells) + ztcoeff * ptab(i1:i2,j1:j2) 1031 IF(northern_side) ubdy_n(i1:i2,1:nbghostcells) = ubdy_n(i1:i2,1:nbghostcells) + ztcoeff * ptab(i1:i2,j1:j2) 1029 1032 ! 1030 1033 IF( bdy_tinterp == 0 .OR. bdy_tinterp == 2) THEN 1031 IF(western_side) ubdy_w( j1:j2) = ubdy_w(j1:j2) / (zrhoy*e2u(i2,j1:j2)) * umask(i2,j1:j2,1)1032 IF(eastern_side) ubdy_e( j1:j2) = ubdy_e(j1:j2) / (zrhoy*e2u(i1,j1:j2)) * umask(i1,j1:j2,1)1033 IF(southern_side) ubdy_s(i1:i2 ) = ubdy_s(i1:i2) / (zrhoy*e2u(i1:i2,j2)) * umask(i1:i2,j2,1)1034 IF(northern_side) ubdy_n(i1:i2 ) = ubdy_n(i1:i2) / (zrhoy*e2u(i1:i2,j1)) * umask(i1:i2,j1,1)1034 IF(western_side) ubdy_w(1:nbghostcells,j1:j2) = ubdy_w(1:nbghostcells,j1:j2) / (zrhoy*e2u(i1:i2,j1:j2)) * umask(i1:i2,j1:j2,1) 1035 IF(eastern_side) ubdy_e(1:nbghostcells,j1:j2) = ubdy_e(1:nbghostcells,j1:j2) / (zrhoy*e2u(i1:i2,j1:j2)) * umask(i1:i2,j1:j2,1) 1036 IF(southern_side) ubdy_s(i1:i2,1:nbghostcells) = ubdy_s(i1:i2,1:nbghostcells) / (zrhoy*e2u(i1:i2,j1:j2)) * umask(i1:i2,j1:j2,1) 1037 IF(northern_side) ubdy_n(i1:i2,1:nbghostcells) = ubdy_n(i1:i2,1:nbghostcells) / (zrhoy*e2u(i1:i2,j1:j2)) * umask(i1:i2,j1:j2,1) 1035 1038 ENDIF 1036 1039 ENDIF … … 1075 1078 ENDIF 1076 1079 !! clem ghost 1077 IF(western_side) vbdy_w( j1:j2) = vbdy_w(j1:j2) + ztcoeff * ptab(i2,j1:j2)1078 IF(eastern_side) vbdy_e( j1:j2) = vbdy_e(j1:j2) + ztcoeff * ptab(i1,j1:j2)1079 IF(southern_side) vbdy_s(i1:i2 ) = vbdy_s(i1:i2) + ztcoeff * ptab(i1:i2,j2)1080 IF(northern_side) vbdy_n(i1:i2 ) = vbdy_n(i1:i2) + ztcoeff * ptab(i1:i2,j1)1080 IF(western_side) vbdy_w(1:nbghostcells,j1:j2) = vbdy_w(1:nbghostcells,j1:j2) + ztcoeff * ptab(i1:i2,j1:j2) 1081 IF(eastern_side) vbdy_e(1:nbghostcells,j1:j2) = vbdy_e(1:nbghostcells,j1:j2) + ztcoeff * ptab(i1:i2,j1:j2) 1082 IF(southern_side) vbdy_s(i1:i2,1:nbghostcells) = vbdy_s(i1:i2,1:nbghostcells) + ztcoeff * ptab(i1:i2,j1:j2) 1083 IF(northern_side) vbdy_n(i1:i2,1:nbghostcells) = vbdy_n(i1:i2,1:nbghostcells) + ztcoeff * ptab(i1:i2,j1:j2) 1081 1084 ! 1082 1085 IF( bdy_tinterp == 0 .OR. bdy_tinterp == 2) THEN 1083 IF(western_side) vbdy_w( j1:j2) = vbdy_w(j1:j2) / (zrhox*e1v(i2,j1:j2)) * vmask(i2,j1:j2,1)1084 IF(eastern_side) vbdy_e( j1:j2) = vbdy_e(j1:j2) / (zrhox*e1v(i1,j1:j2)) * vmask(i1,j1:j2,1)1085 IF(southern_side) vbdy_s(i1:i2 ) = vbdy_s(i1:i2) / (zrhox*e1v(i1:i2,j2)) * vmask(i1:i2,j2,1)1086 IF(northern_side) vbdy_n(i1:i2 ) = vbdy_n(i1:i2) / (zrhox*e1v(i1:i2,j1)) * vmask(i1:i2,j1,1)1086 IF(western_side) vbdy_w(1:nbghostcells,j1:j2) = vbdy_w(1:nbghostcells,j1:j2) / (zrhox*e1v(i1:i2,j1:j2)) * vmask(i1:i2,j1:j2,1) 1087 IF(eastern_side) vbdy_e(1:nbghostcells,j1:j2) = vbdy_e(1:nbghostcells,j1:j2) / (zrhox*e1v(i1:i2,j1:j2)) * vmask(i1:i2,j1:j2,1) 1088 IF(southern_side) vbdy_s(i1:i2,1:nbghostcells) = vbdy_s(i1:i2,1:nbghostcells) / (zrhox*e1v(i1:i2,j1:j2)) * vmask(i1:i2,j1:j2,1) 1089 IF(northern_side) vbdy_n(i1:i2,1:nbghostcells) = vbdy_n(i1:i2,1:nbghostcells) / (zrhox*e1v(i1:i2,j1:j2)) * vmask(i1:i2,j1:j2,1) 1087 1090 ENDIF 1088 1091 ENDIF … … 1123 1126 & - zt0**2._wp * (-2._wp*zt0 + 3._wp) ) 1124 1127 !! clem ghost 1125 IF(western_side ) ubdy_w( j1:j2) = zat * ptab(i2,j1:j2)1126 IF(eastern_side ) ubdy_e( j1:j2) = zat * ptab(i1,j1:j2)1127 IF(southern_side) ubdy_s(i1:i2 ) = zat * ptab(i1:i2,j2)1128 IF(northern_side) ubdy_n(i1:i2 ) = zat * ptab(i1:i2,j1)1128 IF(western_side ) ubdy_w(1:nbghostcells,j1:j2) = zat * ptab(i1:i2,j1:j2) 1129 IF(eastern_side ) ubdy_e(1:nbghostcells,j1:j2) = zat * ptab(i1:i2,j1:j2) 1130 IF(southern_side) ubdy_s(i1:i2,1:nbghostcells) = zat * ptab(i1:i2,j1:j2) 1131 IF(northern_side) ubdy_n(i1:i2,1:nbghostcells) = zat * ptab(i1:i2,j1:j2) 1129 1132 ENDIF 1130 1133 ! … … 1165 1168 & - zt0**2._wp * (-2._wp*zt0 + 3._wp) ) 1166 1169 ! 1167 IF(western_side ) vbdy_w( j1:j2) = zat * ptab(i2,j1:j2)1168 IF(eastern_side ) vbdy_e( j1:j2) = zat * ptab(i1,j1:j2)1169 IF(southern_side) vbdy_s(i1:i2 ) = zat * ptab(i1:i2,j2)1170 IF(northern_side) vbdy_n(i1:i2 ) = zat * ptab(i1:i2,j1)1170 IF(western_side ) vbdy_w(1:nbghostcells,j1:j2) = zat * ptab(i1:i2,j1:j2) 1171 IF(eastern_side ) vbdy_e(1:nbghostcells,j1:j2) = zat * ptab(i1:i2,j1:j2) 1172 IF(southern_side) vbdy_s(i1:i2,1:nbghostcells) = zat * ptab(i1:i2,j1:j2) 1173 IF(northern_side) vbdy_n(i1:i2,1:nbghostcells) = zat * ptab(i1:i2,j1:j2) 1171 1174 ENDIF 1172 1175 ! … … 1309 1312 !! *** ROUTINE interavm *** 1310 1313 !!---------------------------------------------------------------------- 1311 INTEGER , INTENT(in ) :: i1, i2, j1, j2, k1, k2, m1, m21314 INTEGER , INTENT(in ) :: i1, i2, j1, j2, k1, k2, m1, m2 1312 1315 REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2,m1:m2), INTENT(inout) :: ptab 1313 LOGICAL , INTENT(in ) :: before 1314 REAL(wp), DIMENSION(k1:k2) :: tabin 1315 REAL(wp) :: h_in(k1:k2) 1316 REAL(wp) :: h_out(1:jpk) 1317 REAL(wp) :: zrhoxy 1316 LOGICAL , INTENT(in ) :: before 1317 REAL(wp), DIMENSION(k1:k2) :: tabin, h_in 1318 REAL(wp), DIMENSION(1:jpk) :: h_out 1318 1319 INTEGER :: N_in, N_out, ji, jj, jk 1319 1320 !!---------------------------------------------------------------------- 1320 1321 ! 1321 zrhoxy = Agrif_rhox()*Agrif_rhoy()1322 1322 IF (before) THEN 1323 1323 DO jk=k1,k2 … … 1332 1332 DO jj=j1,j2 1333 1333 DO ji=i1,i2 1334 ptab(ji,jj,jk,2) = wmask(ji,jj,jk) * e 1e2t(ji,jj) * e3w_n(ji,jj,jk)1334 ptab(ji,jj,jk,2) = wmask(ji,jj,jk) * e3w_n(ji,jj,jk) 1335 1335 END DO 1336 1336 END DO … … 1347 1347 N_in = N_in + 1 1348 1348 tabin(jk) = ptab(ji,jj,jk,1) 1349 h_in(N_in) = ptab(ji,jj,jk,2) /(e1e2t(ji,jj)*zrhoxy)1349 h_in(N_in) = ptab(ji,jj,jk,2) 1350 1350 END DO 1351 1351 N_out = 0 -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/NST_SRC/agrif_opa_update.F90
r9095 r9116 261 261 ! 2) BEFORE fields: 262 262 !------------------ 263 ! IF ( (.NOT.(lk_agrif_fstep.AND.(neuler==0)).AND.(ln_dynspg_exp)) &264 ! & .OR.(.NOT.(lk_agrif_fstep.AND.(neuler==0)).AND.(ln_dynspg_ts &265 ! & .AND.(.NOT.ln_bt_fw)))) THEN266 263 IF (.NOT.(lk_agrif_fstep.AND.(neuler==0) )) THEN 267 264 ! … … 305 302 INTEGER :: N_in, N_out 306 303 REAL(wp) :: h_diff 307 REAL(wp) :: zrho_xy308 304 REAL(wp) :: tabin(k1:k2,n1:n2) 309 305 !!--------------------------------------------- -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/NST_SRC/agrif_user.F90
r9096 r9116 218 218 Agrif_UseSpecialValue = .TRUE. 219 219 CALL Agrif_Bc_variable(sshn_id,calledweight=1., procname=interpsshn ) 220 hbdy_w(: ) = 0.e0 ; hbdy_e(:) = 0.e0 ; hbdy_n(:) = 0.e0 ; hbdy_s(:) = 0.e0220 hbdy_w(:,:) = 0.e0 ; hbdy_e(:,:) = 0.e0 ; hbdy_n(:,:) = 0.e0 ; hbdy_s(:,:) = 0.e0 221 221 ssha(:,:) = 0.e0 222 222 … … 227 227 CALL Agrif_Bc_variable(ub2b_interp_id,calledweight=1.,procname=interpub2b) 228 228 CALL Agrif_Bc_variable(vb2b_interp_id,calledweight=1.,procname=interpvb2b) 229 ubdy_w(: ) = 0.e0 ; vbdy_w(:) = 0.e0230 ubdy_e(: ) = 0.e0 ; vbdy_e(:) = 0.e0231 ubdy_n(: ) = 0.e0 ; vbdy_n(:) = 0.e0232 ubdy_s(: ) = 0.e0 ; vbdy_s(:) = 0.e0229 ubdy_w(:,:) = 0.e0 ; vbdy_w(:,:) = 0.e0 230 ubdy_e(:,:) = 0.e0 ; vbdy_e(:,:) = 0.e0 231 ubdy_n(:,:) = 0.e0 ; vbdy_n(:,:) = 0.e0 232 ubdy_s(:,:) = 0.e0 ; vbdy_s(:,:) = 0.e0 233 233 ENDIF 234 234 -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/DYN/divhor.F90
r9023 r9116 87 87 #if defined key_agrif 88 88 IF( .NOT. Agrif_Root() ) THEN 89 IF( nbondi == -1 .OR. nbondi == 2 ) hdivn( 2:nbghostcells+1,:,:) = 0._wp ! west90 IF( nbondi == 1 .OR. nbondi == 2 ) hdivn( nlci- nbghostcells:nlci-1,:,:) = 0._wp ! east91 IF( nbondj == -1 .OR. nbondj == 2 ) hdivn( :,2:nbghostcells+1,:) = 0._wp ! south92 IF( nbondj == 1 .OR. nbondj == 2 ) hdivn( :,nlcj-nbghostcells:nlcj-1,:) = 0._wp ! north89 IF( nbondi == -1 .OR. nbondi == 2 ) hdivn( 2 , : ,:) = 0._wp ! west 90 IF( nbondi == 1 .OR. nbondi == 2 ) hdivn( nlci-1, : ,:) = 0._wp ! east 91 IF( nbondj == -1 .OR. nbondj == 2 ) hdivn( : , 2 ,:) = 0._wp ! south 92 IF( nbondj == 1 .OR. nbondj == 2 ) hdivn( : ,nlcj-1,:) = 0._wp ! north 93 93 ENDIF 94 94 #endif -
branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_ts.F90
r9112 r9116 785 785 IF((nbondi == -1).OR.(nbondi == 2)) THEN 786 786 DO jj = 1, jpj 787 zwx(2:nbghostcells+1,jj) = ubdy_w( jj) * e2u(2:nbghostcells+1,jj)787 zwx(2:nbghostcells+1,jj) = ubdy_w(1:nbghostcells,jj) * e2u(2:nbghostcells+1,jj) 788 788 END DO 789 789 ENDIF 790 790 IF((nbondi == 1).OR.(nbondi == 2)) THEN 791 791 DO jj=1,jpj 792 zwx(nlci-nbghostcells-1:nlci-2,jj) = ubdy_e( jj) * e2u(nlci-nbghostcells-1:nlci-2,jj)792 zwx(nlci-nbghostcells-1:nlci-2,jj) = ubdy_e(1:nbghostcells,jj) * e2u(nlci-nbghostcells-1:nlci-2,jj) 793 793 END DO 794 794 ENDIF 795 795 IF((nbondj == -1).OR.(nbondj == 2)) THEN 796 796 DO ji=1,jpi 797 zwy(ji,2:nbghostcells+1) = vbdy_s(ji ) * e1v(ji,2:nbghostcells+1)797 zwy(ji,2:nbghostcells+1) = vbdy_s(ji,1:nbghostcells) * e1v(ji,2:nbghostcells+1) 798 798 END DO 799 799 ENDIF 800 800 IF((nbondj == 1).OR.(nbondj == 2)) THEN 801 801 DO ji=1,jpi 802 zwy(ji,nlcj-nbghostcells-1:nlcj-2) = vbdy_n(ji ) * e1v(ji,nlcj-nbghostcells-1:nlcj-2)802 zwy(ji,nlcj-nbghostcells-1:nlcj-2) = vbdy_n(ji,1:nbghostcells) * e1v(ji,nlcj-nbghostcells-1:nlcj-2) 803 803 END DO 804 804 ENDIF
Note: See TracChangeset
for help on using the changeset viewer.