Changeset 9116


Ignore:
Timestamp:
2017-12-18T15:24:31+01:00 (3 years ago)
Author:
jchanut
Message:

Finalize AGRIF ghost cells implementation: ensure compatibility with bdy smoothing or extrapolation

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  
    4646 
    4747   ! Barotropic arrays used to store open boundary data during time-splitting loop: 
    48    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 
     48   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 
    5252 
    5353 
     
    9191         &      tabspongedone_v  (jpi,jpj), STAT = ierr(1) ) 
    9292 
    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) ) 
    9797 
    9898      agrif_oce_alloc = MAXVAL(ierr) 
  • branches/2017/dev_merge_2017/NEMOGCM/NEMO/NST_SRC/agrif_opa_interp.F90

    r9082 r9116  
    373373      IF((nbondi == -1).OR.(nbondi == 2)) THEN 
    374374         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) 
    376376            ! 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) 
    378378            ! Characteristics method (only if ghostcells=1): 
    379379            !alt            ua_e(2,jj) = 0.5_wp * ( ubdy_w(jj) * hur_e(2,jj) + ua_e(3,jj) & 
     
    384384      IF((nbondi == 1).OR.(nbondi == 2)) THEN 
    385385         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) 
    387387            ! 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) 
    389389            ! Characteristics method (only if ghostcells=1): 
    390390            !alt            ua_e(nlci-2,jj) = 0.5_wp * ( ubdy_e(jj) * hur_e(nlci-2,jj) + ua_e(nlci-3,jj) & 
     
    395395      IF((nbondj == -1).OR.(nbondj == 2)) THEN 
    396396         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) 
    398398            ! 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) 
    400400            ! Characteristics method (only if ghostcells=1): 
    401401            !alt            va_e(ji,2) = 0.5_wp * ( vbdy_s(ji) * hvr_e(ji,2) + va_e(ji,3) & 
     
    406406      IF((nbondj == 1).OR.(nbondj == 2)) THEN 
    407407         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) 
    409409            ! 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) 
    411411            ! Characteristics method (only if ghostcells=1): 
    412412            !alt            va_e(ji,nlcj-2) = 0.5_wp * ( vbdy_n(ji) * hvr_e(ji,nlcj-2)  + va_e(ji,nlcj-3) & 
     
    451451      ELSE ! Linear interpolation 
    452452         bdy_tinterp = 0 
    453          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 
     453         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 
    457457         CALL Agrif_Bc_variable( unb_id, procname=interpunb ) 
    458458         CALL Agrif_Bc_variable( vnb_id, procname=interpvnb ) 
     
    474474      IF( Agrif_Root() )   RETURN 
    475475      !       
    476       ! Linear interpolation in time of sea level 
     476      ! Linear time interpolation of sea level 
    477477      ! 
    478478      Agrif_SpecialValue    = 0._wp 
     
    481481      Agrif_UseSpecialValue = .FALSE. 
    482482      ! 
     483      ! --- West --- ! 
    483484      IF((nbondi == -1).OR.(nbondi == 2)) THEN 
    484485         indx = 1+nbghostcells 
    485486         DO jj = 1, jpj 
    486487            DO ji = 2, indx 
    487                ssha(ji,jj) = hbdy_w(jj) 
     488               ssha(ji,jj) = hbdy_w(ji-1,jj) 
    488489            ENDDO 
    489490         ENDDO 
     
    495496         DO jj = 1, jpj 
    496497            DO ji = indx, nlci-1 
    497                ssha(indx,jj) = hbdy_e(jj) 
     498               ssha(ji,jj) = hbdy_e(ji-indx+1,jj) 
    498499            ENDDO 
    499500         ENDDO 
     
    505506         DO jj = 2, indy 
    506507            DO ji = 1, jpi 
    507                ssha(ji,indy) = hbdy_s(ji) 
     508               ssha(ji,jj) = hbdy_s(ji,jj-1) 
    508509            ENDDO 
    509510         ENDDO 
     
    513514      IF((nbondj == 1).OR.(nbondj == 2)) THEN 
    514515         indy = nlcj-nbghostcells 
    515          DO jj = indx, nlcj-1 
     516         DO jj = indy, nlcj-1 
    516517            DO ji = 1, jpi 
    517                ssha(ji,indy) = hbdy_n(ji) 
     518               ssha(ji,jj) = hbdy_n(ji,jj-indy+1) 
    518519            ENDDO 
    519520         ENDDO 
     
    529530      INTEGER, INTENT(in) ::   jn 
    530531      !! 
    531       INTEGER :: ji, jj 
     532      INTEGER :: ji, jj, indx, indy 
    532533      !!----------------------------------------------------------------------   
    533534      !! clem ghost (starting at i,j=1 is important I think otherwise you introduce a grad(ssh)/=0 at point 2) 
     
    535536      IF( Agrif_Root() )   RETURN 
    536537      ! 
     538      ! --- West --- ! 
    537539      IF((nbondi == -1).OR.(nbondi == 2)) THEN 
     540         indx = 1+nbghostcells 
    538541         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 --- ! 
    543549      IF((nbondi == 1).OR.(nbondi == 2)) THEN 
     550         indx = nlci-nbghostcells 
    544551         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 --- ! 
    549559      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 --- ! 
    555569      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 
    559576      ENDIF 
    560577      ! 
     
    592609      INTEGER                                     , INTENT(in   ) ::   nb , ndir 
    593610      ! 
    594       INTEGER  ::   ji, jj, jk, jn, iref, jref   ! dummy loop indices 
     611      INTEGER  ::   ji, jj, jk, jn, iref, jref, ibdy, jbdy   ! dummy loop indices 
    595612      INTEGER  ::   imin, imax, jmin, jmax, N_in, N_out 
    596613      REAL(wp) ::   zrhox, z1, z2, z3, z4, z5, z6, z7 
     
    600617      REAL(wp), DIMENSION(k1:k2,n1:n2-1) :: tabin 
    601618      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 
    606622      IF( before ) THEN          
    607623         DO jn = 1,jpts 
     
    662678# endif 
    663679         ! 
    664          IF( lk_agrif_clp ) THEN  ! Clamped bcs 
    665             tsa(i1:i2,j1:j2,k1:k2,n1:n2) = ptab_child(i1:i2,j1:j2,k1:k2,n1:n2) 
    666          ELSE                         ! smoothing 
     680         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  
    667683            ! 
    668684            zrhox = Agrif_Rhox() 
     
    686702            ! 
    687703            IF( eastern_side ) THEN 
     704               ibdy = nlci-nbghostcells 
    688705               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) 
    690707                  DO jk = 1, jpkm1 
    691708                     DO jj = jmin,jmax 
    692                         IF( umask(nlci-2,jj,jk) == 0._wp ) THEN 
    693                            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) 
    694711                        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 ) THEN 
    697                               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) 
    699716                           ENDIF 
    700717                        ENDIF 
    701718                     END DO 
    702719                  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) 
    704722               END DO 
    705723            ENDIF 
    706724            !  
    707             IF( northern_side ) THEN             
     725            IF( northern_side ) THEN 
     726               jbdy = nlcj-nbghostcells          
    708727               DO jn = 1, jpts 
    709                   tsa(i1: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) 
    710729                  DO jk = 1, jpkm1 
    711730                     DO ji = imin,imax 
    712                         IF( vmask(ji,nlcj-2,jk) == 0._wp ) THEN 
    713                            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) 
    714733                        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 ) THEN 
    717                               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) 
    719738                           ENDIF 
    720739                        ENDIF 
    721740                     END DO 
    722741                  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) 
    724744               END DO 
    725745            ENDIF 
    726746            ! 
    727             IF( western_side ) THEN             
     747            IF( western_side ) THEN     
     748               ibdy = 1+nbghostcells        
    728749               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) 
    730751                  DO jk = 1, jpkm1 
    731752                     DO jj = jmin,jmax 
    732                         IF( umask(2,jj,jk) == 0._wp ) THEN 
    733                            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) 
    734755                        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 ) THEN 
    737                               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) 
    738759                           ENDIF 
    739760                        ENDIF 
    740761                     END DO 
    741762                  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) 
    743765               END DO 
    744766            ENDIF 
    745767            ! 
    746             IF( southern_side ) THEN            
     768            IF( southern_side ) THEN   
     769               jbdy=1+nbghostcells         
    747770               DO jn = 1, jpts 
    748                   tsa(i1: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) 
    749772                  DO jk = 1, jpk       
    750773                     DO ji=imin,imax 
    751                         IF( vmask(ji,2,jk) == 0._wp ) THEN 
    752                            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) 
    753776                        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 ) THEN 
    756                               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) 
    757780                           ENDIF 
    758781                        ENDIF 
    759782                     END DO 
    760783                  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 
    783787            ENDIF 
    784788            ! 
     
    808812         northern_side = (nb == 2).AND.(ndir == 2) 
    809813         !! 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) 
    814818      ENDIF 
    815819      ! 
     
    836840      !!---------------------------------------------     
    837841      ! 
    838       zrhoy = Agrif_rhoy() 
    839842      IF (before) THEN  
    840843         DO jk=1,jpk 
     
    10231026         ENDIF 
    10241027         !    
    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)  
    10291032         !             
    10301033         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) 
    10351038         ENDIF 
    10361039      ENDIF 
     
    10751078         ENDIF 
    10761079         !! 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)  
    10811084         !             
    10821085         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) 
    10871090         ENDIF 
    10881091      ENDIF 
     
    11231126            &           - zt0**2._wp * (-2._wp*zt0 + 3._wp)    )  
    11241127         !! 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)  
    11291132      ENDIF 
    11301133      !  
     
    11651168            &           - zt0**2._wp * (-2._wp*zt0 + 3._wp)    )  
    11661169         ! 
    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)  
    11711174      ENDIF 
    11721175      !       
     
    13091312      !!                  ***  ROUTINE interavm  *** 
    13101313      !!----------------------------------------------------------------------   
    1311       INTEGER                              , INTENT(in   ) ::   i1, i2, j1, j2, k1, k2, m1, m2 
     1314      INTEGER                                    , INTENT(in   ) ::   i1, i2, j1, j2, k1, k2, m1, m2 
    13121315      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 
    13181319      INTEGER  :: N_in, N_out, ji, jj, jk 
    13191320      !!----------------------------------------------------------------------   
    13201321      !       
    1321       zrhoxy = Agrif_rhox()*Agrif_rhoy() 
    13221322      IF (before) THEN          
    13231323         DO jk=k1,k2 
     
    13321332           DO jj=j1,j2 
    13331333              DO ji=i1,i2 
    1334                  ptab(ji,jj,jk,2) = wmask(ji,jj,jk) * e1e2t(ji,jj) * e3w_n(ji,jj,jk)  
     1334                 ptab(ji,jj,jk,2) = wmask(ji,jj,jk) * e3w_n(ji,jj,jk)  
    13351335              END DO 
    13361336           END DO 
     
    13471347                  N_in = N_in + 1 
    13481348                  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) 
    13501350               END DO 
    13511351               N_out = 0 
  • branches/2017/dev_merge_2017/NEMOGCM/NEMO/NST_SRC/agrif_opa_update.F90

    r9095 r9116  
    261261      ! 2) BEFORE fields: 
    262262      !------------------ 
    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)))) THEN 
    266263      IF (.NOT.(lk_agrif_fstep.AND.(neuler==0) )) THEN 
    267264         ! 
     
    305302      INTEGER  :: N_in, N_out 
    306303      REAL(wp) :: h_diff 
    307       REAL(wp) :: zrho_xy 
    308304      REAL(wp) :: tabin(k1:k2,n1:n2) 
    309305      !!--------------------------------------------- 
  • branches/2017/dev_merge_2017/NEMOGCM/NEMO/NST_SRC/agrif_user.F90

    r9096 r9116  
    218218   Agrif_UseSpecialValue = .TRUE. 
    219219   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.e0 
     220   hbdy_w(:,:) = 0.e0 ; hbdy_e(:,:) = 0.e0 ; hbdy_n(:,:) = 0.e0 ; hbdy_s(:,:) = 0.e0 
    221221   ssha(:,:) = 0.e0 
    222222 
     
    227227      CALL Agrif_Bc_variable(ub2b_interp_id,calledweight=1.,procname=interpub2b) 
    228228      CALL Agrif_Bc_variable(vb2b_interp_id,calledweight=1.,procname=interpvb2b) 
    229       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 
     229      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 
    233233   ENDIF 
    234234 
  • branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/DYN/divhor.F90

    r9023 r9116  
    8787#if defined key_agrif 
    8888      IF( .NOT. Agrif_Root() ) THEN 
    89          IF( nbondi == -1 .OR. nbondi == 2 )   hdivn( 2:nbghostcells+1,:        ,:) = 0._wp      ! west 
    90          IF( nbondi ==  1 .OR. nbondi == 2 )   hdivn( nlci-nbghostcells:nlci-1,:,:) = 0._wp      ! east 
    91          IF( nbondj == -1 .OR. nbondj == 2 )   hdivn( :,2:nbghostcells+1        ,:) = 0._wp      ! south 
    92          IF( nbondj ==  1 .OR. nbondj == 2 )   hdivn( :,nlcj-nbghostcells:nlcj-1,:) = 0._wp      ! north 
     89         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 
    9393      ENDIF 
    9494#endif 
  • branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_ts.F90

    r9112 r9116  
    785785            IF((nbondi == -1).OR.(nbondi == 2)) THEN 
    786786               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) 
    788788               END DO 
    789789            ENDIF 
    790790            IF((nbondi ==  1).OR.(nbondi == 2)) THEN 
    791791               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) 
    793793               END DO 
    794794            ENDIF 
    795795            IF((nbondj == -1).OR.(nbondj == 2)) THEN 
    796796               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) 
    798798               END DO 
    799799            ENDIF 
    800800            IF((nbondj ==  1).OR.(nbondj == 2)) THEN 
    801801               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) 
    803803               END DO 
    804804            ENDIF 
Note: See TracChangeset for help on using the changeset viewer.