New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
Changeset 8998 for branches/2017/dev_METO_MERCATOR_2017_agrif/NEMOGCM/NEMO/NST_SRC/agrif_opa_update.F90 – NEMO

Ignore:
Timestamp:
2017-12-13T09:34:57+01:00 (6 years ago)
Author:
timgraham
Message:

First commit of Jerome's modified versions of agrif_opa routines

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/2017/dev_METO_MERCATOR_2017_agrif/NEMOGCM/NEMO/NST_SRC/agrif_opa_update.F90

    r8993 r8998  
    11#define TWO_WAY        /* TWO WAY NESTING */ 
    2 #undef DECAL_FEEDBACK /* SEPARATION of INTERFACES*/ 
     2#define DECAL_FEEDBACK /* SEPARATION of INTERFACES*/ 
    33#undef VOL_REFLUX      /* VOLUME REFLUXING*/ 
    44  
     
    9797      ! Account for updated thicknesses at boundary edges 
    9898      IF (.NOT.ln_linssh) THEN 
    99 ! For the time being calls below do not ensure reproducible results  
    10099!         CALL Agrif_Update_Variable(un_update_id,locupdate1=(/0,0/),locupdate2=(/0,0/),procname = correct_u_bdy) 
    101100!         CALL Agrif_Update_Variable(vn_update_id,locupdate1=(/0,0/),locupdate2=(/0,0/),procname = correct_v_bdy) 
     
    283282   END SUBROUTINE dom_vvl_update_UVF 
    284283 
     284#if defined key_vertical 
     285 
     286   SUBROUTINE updateTS( tabres, i1, i2, j1, j2, k1, k2, n1, n2, before ) 
     287      !!--------------------------------------------- 
     288      !!           *** ROUTINE updateT *** 
     289      !!--------------------------------------------- 
     290      INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2,n1,n2 
     291      REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2), INTENT(inout) :: tabres 
     292      LOGICAL, INTENT(in) :: before 
     293      !! 
     294      INTEGER :: ji,jj,jk,jn 
     295      REAL(wp), DIMENSION(i1:i2,j1:j2,1:jpk,n1:n2) :: tabres_child 
     296      REAL(wp) :: h_in(k1:k2) 
     297      REAL(wp) :: h_out(1:jpk) 
     298      INTEGER  :: N_in, N_out 
     299      REAL(wp) :: h_diff 
     300      REAL(wp) :: zrho_xy 
     301      REAL(wp) :: tabin(k1:k2,n1:n2) 
     302      !!--------------------------------------------- 
     303      ! 
     304      IF (before) THEN 
     305         AGRIF_SpecialValue = -999._wp 
     306         zrho_xy = Agrif_rhox() * Agrif_rhoy()  
     307         DO jn = n1,n2-1 
     308            DO jk=k1,k2 
     309               DO jj=j1,j2 
     310                  DO ji=i1,i2 
     311                     tabres(ji,jj,jk,jn) = (tsn(ji,jj,jk,jn) * e1e2t(ji,jj) * e3t_n(ji,jj,jk) ) & 
     312                                           * tmask(ji,jj,jk) * zrho_xy + (tmask(ji,jj,jk)-1)*999._wp 
     313                  END DO 
     314               END DO 
     315            END DO 
     316         END DO 
     317         DO jk=k1,k2 
     318            DO jj=j1,j2 
     319               DO ji=i1,i2 
     320                  tabres(ji,jj,jk,n2) = tmask(ji,jj,jk) * e1e2t(ji,jj) * e3t_n(ji,jj,jk) * zrho_xy  & 
     321                                           + (tmask(ji,jj,jk)-1)*999._wp 
     322               END DO 
     323            END DO 
     324         END DO 
     325      ELSE 
     326         tabres_child(:,:,:,:) = 0. 
     327         AGRIF_SpecialValue = 0._wp 
     328         DO jj=j1,j2 
     329            DO ji=i1,i2 
     330               N_in = 0 
     331               DO jk=k1,k2 !k2 = jpk of child grid 
     332                  IF (tabres(ji,jj,jk,n2) == 0  ) EXIT 
     333                  N_in = N_in + 1 
     334                  tabin(jk,:) = tabres(ji,jj,jk,n1:n2-1)/tabres(ji,jj,jk,n2) 
     335                  h_in(N_in) = tabres(ji,jj,jk,n2)/e1e2t(ji,jj) 
     336               ENDDO 
     337               N_out = 0 
     338               DO jk=1,jpk ! jpk of parent grid 
     339                  IF (tmask(ji,jj,jk) < -900) EXIT ! TODO: Will not work with ISF 
     340                  N_out = N_out + 1 
     341                  h_out(N_out) = e3t_n(ji,jj,jk) !Parent grid scale factors. Could multiply by e1e2t here instead of division above 
     342               ENDDO 
     343               IF (N_in > 0) THEN !Remove this? 
     344                  h_diff = sum(h_out(1:N_out))-sum(h_in(1:N_in)) 
     345                  IF (h_diff < -1.e-4) THEN 
     346                     print *,'CHECK YOUR bathy T points ...',ji,jj,h_diff,sum(h_in(1:N_in)),sum(h_out(1:N_out)) 
     347                     print *,h_in(1:N_in) 
     348                     print *,h_out(1:N_out) 
     349                     STOP 
     350                  ENDIF 
     351                  DO jn=n1,n2-1 
     352                     CALL reconstructandremap(tabin(1:N_in,jn),h_in(1:N_in),tabres_child(ji,jj,1:N_out,jn),h_out(1:N_out),N_in,N_out) 
     353                  ENDDO 
     354               ENDIF 
     355            ENDDO 
     356         ENDDO 
     357 
     358         IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN 
     359            ! Add asselin part 
     360            DO jn = n1,n2-1 
     361               DO jk=1,jpk 
     362                  DO jj=j1,j2 
     363                     DO ji=i1,i2 
     364                        IF( tabres_child(ji,jj,jk,jn) .NE. 0. ) THEN 
     365                           tsb(ji,jj,jk,jn) = tsb(ji,jj,jk,jn) &  
     366                                 & + atfp * ( tabres_child(ji,jj,jk,jn) & 
     367                                 &          - tsn(ji,jj,jk,jn) ) * tmask(ji,jj,jk) 
     368                        ENDIF 
     369                     ENDDO 
     370                  ENDDO 
     371               ENDDO 
     372            ENDDO 
     373         ENDIF 
     374         DO jn = n1,n2-1 
     375            DO jk=1,jpk 
     376               DO jj=j1,j2 
     377                  DO ji=i1,i2 
     378                     IF( tabres_child(ji,jj,jk,jn) .NE. 0. ) THEN  
     379                        tsn(ji,jj,jk,jn) = tabres_child(ji,jj,jk,jn) * tmask(ji,jj,jk) 
     380                     END IF 
     381                  END DO 
     382               END DO 
     383            END DO 
     384         END DO 
     385      ENDIF 
     386      !  
     387   END SUBROUTINE updateTS 
     388 
     389# else 
     390 
    285391   SUBROUTINE updateTS( tabres, i1, i2, j1, j2, k1, k2, n1, n2, before ) 
    286392      !!--------------------------------------------- 
     
    296402      ! 
    297403      IF (before) THEN 
    298          DO jn = n1,n2 
     404         DO jn = 1,jpts 
    299405            DO jk=k1,k2 
    300406               DO jj=j1,j2 
     
    310416      ELSE 
    311417!> jc tmp 
    312          DO jn = n1,n2 
     418         DO jn = 1,jpts 
    313419            tabres(i1:i2,j1:j2,k1:k2,jn) =  tabres(i1:i2,j1:j2,k1:k2,jn) * e3t_0(i1:i2,j1:j2,k1:k2) & 
    314420                                         & * tmask(i1:i2,j1:j2,k1:k2) 
     
    317423         IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN 
    318424            ! Add asselin part 
    319             DO jn = n1,n2 
     425            DO jn = 1,jpts 
    320426               DO jk=k1,k2 
    321427                  DO jj=j1,j2 
     
    333439            ENDDO 
    334440         ENDIF 
    335          DO jn = n1,n2 
     441         DO jn = 1,jpts 
    336442            DO jk=k1,k2 
    337443               DO jj=j1,j2 
     
    346452         ! 
    347453         IF  ((neuler==0).AND.(Agrif_Nb_Step()==0) ) THEN 
    348             tsb(i1:i2,j1:j2,k1:k2,n1:n2)  = tsn(i1:i2,j1:j2,k1:k2,n1:n2) 
     454            tsb(i1:i2,j1:j2,k1:k2,1:jpts)  = tsn(i1:i2,j1:j2,k1:k2,1:jpts) 
    349455         ENDIF 
    350456         ! 
     
    353459   END SUBROUTINE updateTS 
    354460 
    355  
    356    SUBROUTINE updateu( tabres, i1, i2, j1, j2, k1, k2, before ) 
     461# endif 
     462 
     463# if defined key_vertical 
     464 
     465   SUBROUTINE updateu( tabres, i1, i2, j1, j2, k1, k2, n1, n2, before ) 
    357466      !!--------------------------------------------- 
    358467      !!           *** ROUTINE updateu *** 
    359468      !!--------------------------------------------- 
    360       INTEGER                               , INTENT(in   ) :: i1, i2, j1, j2, k1, k2 
    361       REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: tabres 
    362       LOGICAL                               , INTENT(in   ) :: before 
     469      INTEGER                                     , INTENT(in   ) :: i1, i2, j1, j2, k1, k2, n1, n2 
     470      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2), INTENT(inout) :: tabres 
     471      LOGICAL                                     , INTENT(in   ) :: before 
     472      ! 
     473      INTEGER  ::   ji, jj, jk 
     474      REAL(wp) ::   zrhoy 
     475! VERTICAL REFINEMENT BEGIN 
     476      REAL(wp), DIMENSION(i1:i2,j1:j2,1:jpk) :: tabres_child 
     477      REAL(wp) :: h_in(k1:k2) 
     478      REAL(wp) :: h_out(1:jpk) 
     479      INTEGER  :: N_in, N_out 
     480      REAL(wp) :: h_diff, excess, thick 
     481      REAL(wp) :: tabin(k1:k2) 
     482! VERTICAL REFINEMENT END 
     483      !!--------------------------------------------- 
     484      !  
     485      IF( before ) THEN 
     486         zrhoy = Agrif_Rhoy() 
     487         AGRIF_SpecialValue = -999._wp 
     488         DO jk=k1,k2 
     489            DO jj=j1,j2 
     490               DO ji=i1,i2 
     491                  tabres(ji,jj,jk,1) = zrhoy * e2u(ji,jj) * e3u_n(ji,jj,jk) * umask(ji,jj,jk) * un(ji,jj,jk)  & 
     492                                       + (umask(ji,jj,jk)-1)*999._wp 
     493                  tabres(ji,jj,jk,2) = zrhoy * umask(ji,jj,jk) * e2u(ji,jj) * e3u_n(ji,jj,jk)  & 
     494                                       + (umask(ji,jj,jk)-1)*999._wp 
     495               END DO 
     496            END DO 
     497         END DO 
     498      ELSE 
     499         tabres_child(:,:,:) = 0. 
     500         AGRIF_SpecialValue = 0._wp 
     501         DO jj=j1,j2 
     502            DO ji=i1,i2 
     503               N_in = 0 
     504               h_in(:) = 0._wp 
     505               tabin(:) = 0._wp 
     506               DO jk=k1,k2 !k2=jpk of child grid 
     507                  IF( tabres(ji,jj,jk,2) < -900) EXIT 
     508                  N_in = N_in + 1 
     509                  tabin(jk) = tabres(ji,jj,jk,1)/tabres(ji,jj,jk,2) 
     510                  h_in(N_in) = tabres(ji,jj,jk,2)/e2u(ji,jj) 
     511               ENDDO 
     512               N_out = 0 
     513               DO jk=1,jpk 
     514                  IF (umask(ji,jj,jk) == 0) EXIT 
     515                  N_out = N_out + 1 
     516                  h_out(N_out) = e3u_n(ji,jj,jk) 
     517               ENDDO 
     518               IF (N_in * N_out > 0) THEN 
     519                  h_diff = sum(h_out(1:N_out))-sum(h_in(1:N_in)) 
     520                  IF (h_diff < -1.e-4) THEN 
     521!Even if bathy at T points match it's possible for the U points to be deeper in the child grid.  
     522!In this case we need to move transport from the child grid cells below bed of parent grid into the bottom cell. 
     523                     excess = 0._wp 
     524                     DO jk=N_in,1,-1 
     525                        thick = MIN(-1*h_diff, h_in(jk)) 
     526                        excess = excess + tabin(jk)*thick*e2u(ji,jj) 
     527                        tabin(jk) = tabin(jk)*(1. - thick/h_in(jk)) 
     528                        h_diff = h_diff + thick 
     529                        IF ( h_diff == 0) THEN 
     530                           N_in = jk 
     531                           h_in(jk) = h_in(jk) - thick 
     532                           EXIT 
     533                        ENDIF 
     534                     ENDDO 
     535                  ENDIF 
     536                  CALL reconstructandremap(tabin(1:N_in),h_in(1:N_in),tabres_child(ji,jj,1:N_out),h_out(1:N_out),N_in,N_out) 
     537                  tabres_child(ji,jj,N_out) = tabres_child(ji,jj,N_out) + excess/(e2u(ji,jj)*h_out(N_out)) 
     538               ENDIF 
     539            ENDDO 
     540         ENDDO 
     541 
     542         DO jk=1,jpk 
     543            DO jj=j1,j2 
     544               DO ji=i1,i2 
     545                  IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN ! Add asselin part 
     546                     ub(ji,jj,jk) = ub(ji,jj,jk) &  
     547                           & + atfp * ( tabres_child(ji,jj,jk) - un(ji,jj,jk) ) * umask(ji,jj,jk) 
     548                  ENDIF 
     549                  ! 
     550                  un(ji,jj,jk) = tabres_child(ji,jj,jk) * umask(ji,jj,jk) 
     551               END DO 
     552            END DO 
     553         END DO 
     554      ENDIF 
     555      !  
     556   END SUBROUTINE updateu 
     557 
     558#else 
     559 
     560   SUBROUTINE updateu( tabres, i1, i2, j1, j2, k1, k2, n1, n2, before ) 
     561      !!--------------------------------------------- 
     562      !!           *** ROUTINE updateu *** 
     563      !!--------------------------------------------- 
     564      INTEGER                               , INTENT(in   ) :: i1, i2, j1, j2, k1, k2, n1, n2 
     565      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2), INTENT(inout) :: tabres 
     566      LOGICAL                                     , INTENT(in   ) :: before 
    363567      ! 
    364568      INTEGER  :: ji, jj, jk 
     
    369573         zrhoy = Agrif_Rhoy() 
    370574         DO jk = k1, k2 
    371             tabres(i1:i2,j1:j2,jk) = zrhoy * e2u(i1:i2,j1:j2) * e3u_n(i1:i2,j1:j2,jk) * un(i1:i2,j1:j2,jk) 
     575            tabres(i1:i2,j1:j2,jk,1) = zrhoy * e2u(i1:i2,j1:j2) * e3u_n(i1:i2,j1:j2,jk) * un(i1:i2,j1:j2,jk) 
    372576         END DO 
    373577      ELSE 
     
    375579            DO jj=j1,j2 
    376580               DO ji=i1,i2 
    377                   tabres(ji,jj,jk) = tabres(ji,jj,jk) * r1_e2u(ji,jj)  
     581                  tabres(ji,jj,jk,1) = tabres(ji,jj,jk,1) * r1_e2u(ji,jj)  
    378582                  ! 
    379583                  IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN ! Add asselin part 
    380584                     zub  = ub(ji,jj,jk) * e3u_b(ji,jj,jk)  ! fse3t_b prior update should be used 
    381585                     zuno = un(ji,jj,jk) * e3u_a(ji,jj,jk) 
    382                      zunu = tabres(ji,jj,jk) 
     586                     zunu = tabres(ji,jj,jk,1) 
    383587                     ub(ji,jj,jk) = ( zub + atfp * ( zunu - zuno) ) &       
    384588                                    & * umask(ji,jj,jk) / e3u_b(ji,jj,jk) 
    385589                  ENDIF 
    386590                  ! 
    387                   un(ji,jj,jk) = tabres(ji,jj,jk) * umask(ji,jj,jk) / e3u_n(ji,jj,jk) 
     591                  un(ji,jj,jk) = tabres(ji,jj,jk,1) * umask(ji,jj,jk) / e3u_n(ji,jj,jk) 
    388592               END DO 
    389593            END DO 
     
    398602   END SUBROUTINE updateu 
    399603 
    400    SUBROUTINE correct_u_bdy( tabres, i1, i2, j1, j2, k1, k2, before, nb, ndir ) 
     604# endif 
     605 
     606   SUBROUTINE correct_u_bdy( tabres, i1, i2, j1, j2, k1, k2, n1, n2, before, nb, ndir ) 
    401607      !!--------------------------------------------- 
    402608      !!           *** ROUTINE correct_u_bdy *** 
    403609      !!--------------------------------------------- 
    404       INTEGER                               , INTENT(in   ) :: i1, i2, j1, j2, k1, k2 
    405       REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: tabres 
    406       LOGICAL                               , INTENT(in   ) :: before 
    407       INTEGER                               , INTENT(in)    :: nb, ndir 
     610      INTEGER                                     , INTENT(in   ) :: i1, i2, j1, j2, k1, k2, n1, n2 
     611      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2), INTENT(inout) :: tabres 
     612      LOGICAL                                     , INTENT(in   ) :: before 
     613      INTEGER                                     , INTENT(in)    :: nb, ndir 
    408614      !! 
    409615      LOGICAL :: western_side, eastern_side  
     
    442648   END SUBROUTINE correct_u_bdy 
    443649 
    444  
    445    SUBROUTINE updatev( tabres, i1, i2, j1, j2, k1, k2, before) 
     650# if  defined key_vertical 
     651 
     652   SUBROUTINE updatev( tabres, i1, i2, j1, j2, k1, k2, n1, n2, before ) 
    446653      !!--------------------------------------------- 
    447654      !!           *** ROUTINE updatev *** 
    448655      !!--------------------------------------------- 
    449       INTEGER                               , INTENT(in   ) :: i1, i2, j1, j2, k1, k2 
    450       REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: tabres 
    451       LOGICAL                               , INTENT(in   ) :: before 
     656      INTEGER                                     , INTENT(in   ) :: i1, i2, j1, j2, k1, k2, n1, n2 
     657      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2), INTENT(inout) :: tabres 
     658      LOGICAL                                     , INTENT(in   ) :: before 
     659      ! 
     660      INTEGER  ::   ji, jj, jk 
     661      REAL(wp) ::   zrhox 
     662! VERTICAL REFINEMENT BEGIN 
     663      REAL(wp), DIMENSION(i1:i2,j1:j2,1:jpk) :: tabres_child 
     664      REAL(wp) :: h_in(k1:k2) 
     665      REAL(wp) :: h_out(1:jpk) 
     666      INTEGER :: N_in, N_out 
     667      REAL(wp) :: h_diff, excess, thick 
     668      REAL(wp) :: tabin(k1:k2) 
     669! VERTICAL REFINEMENT END 
     670      !!---------------------------------------------       
     671      ! 
     672      IF (before) THEN 
     673         zrhox = Agrif_Rhox() 
     674         AGRIF_SpecialValue = -999._wp 
     675         DO jk=k1,k2 
     676            DO jj=j1,j2 
     677               DO ji=i1,i2 
     678                  tabres(ji,jj,jk,1) = zrhox * e1v(ji,jj) * e3v_n(ji,jj,jk) * vmask(ji,jj,jk) * vn(ji,jj,jk) & 
     679                                       + (vmask(ji,jj,jk)-1)*999._wp 
     680                  tabres(ji,jj,jk,2) = vmask(ji,jj,jk) * zrhox * e1v(ji,jj) * e3v_n(ji,jj,jk) & 
     681                                       + (vmask(ji,jj,jk)-1)*999._wp 
     682               END DO 
     683            END DO 
     684         END DO 
     685      ELSE 
     686         tabres_child(:,:,:) = 0. 
     687         AGRIF_SpecialValue = 0._wp 
     688         DO jj=j1,j2 
     689            DO ji=i1,i2 
     690               N_in = 0 
     691               DO jk=k1,k2 
     692                  IF (tabres(ji,jj,jk,2) < -900) EXIT 
     693                  N_in = N_in + 1 
     694                  tabin(jk) = tabres(ji,jj,jk,1)/tabres(ji,jj,jk,2) 
     695                  h_in(N_in) = tabres(ji,jj,jk,2)/e1v(ji,jj) 
     696               ENDDO 
     697               N_out = 0 
     698               DO jk=1,jpk 
     699                  IF (vmask(ji,jj,jk) == 0) EXIT 
     700                  N_out = N_out + 1 
     701                  h_out(N_out) = e3v_n(ji,jj,jk) 
     702               ENDDO 
     703               IF (N_in * N_out > 0) THEN 
     704                  h_diff = sum(h_out(1:N_out))-sum(h_in(1:N_in)) 
     705                  IF (h_diff < -1.e-4) then 
     706!Even if bathy at T points match it's possible for the U points to be deeper in the child grid.  
     707!In this case we need to move transport from the child grid cells below bed of parent grid into the bottom cell. 
     708                     excess = 0._wp 
     709                     DO jk=N_in,1,-1 
     710                        thick = MIN(-1*h_diff, h_in(jk)) 
     711                        excess = excess + tabin(jk)*thick*e2u(ji,jj) 
     712                        tabin(jk) = tabin(jk)*(1. - thick/h_in(jk)) 
     713                        h_diff = h_diff + thick 
     714                        IF ( h_diff == 0) THEN 
     715                           N_in = jk 
     716                           h_in(jk) = h_in(jk) - thick 
     717                           EXIT 
     718                        ENDIF 
     719                     ENDDO 
     720                  ENDIF 
     721                  CALL reconstructandremap(tabin(1:N_in),h_in(1:N_in),tabres_child(ji,jj,1:N_out),h_out(1:N_out),N_in,N_out) 
     722                  tabres_child(ji,jj,N_out) = tabres_child(ji,jj,N_out) + excess/(e1v(ji,jj)*h_out(N_out)) 
     723               ENDIF 
     724            ENDDO 
     725         ENDDO 
     726 
     727         DO jk=1,jpk 
     728            DO jj=j1,j2 
     729               DO ji=i1,i2 
     730                  ! 
     731                  IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN ! Add asselin part 
     732                     vb(ji,jj,jk) = vb(ji,jj,jk) &  
     733                           & + atfp * ( tabres_child(ji,jj,jk) - vn(ji,jj,jk) ) * vmask(ji,jj,jk) 
     734                  ENDIF 
     735                  ! 
     736                  vn(ji,jj,jk) = tabres_child(ji,jj,jk) * vmask(ji,jj,jk) 
     737               END DO 
     738            END DO 
     739         END DO 
     740      ENDIF 
     741      !  
     742   END SUBROUTINE updatev 
     743 
     744# else 
     745 
     746   SUBROUTINE updatev( tabres, i1, i2, j1, j2, k1, k2, n1, n2, before) 
     747      !!--------------------------------------------- 
     748      !!           *** ROUTINE updatev *** 
     749      !!--------------------------------------------- 
     750      INTEGER                                     , INTENT(in   ) :: i1, i2, j1, j2, k1, k2, n1, n2 
     751      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2), INTENT(inout) :: tabres 
     752      LOGICAL                                     , INTENT(in   ) :: before 
    452753      ! 
    453754      INTEGER  :: ji, jj, jk 
     
    460761            DO jj=j1,j2 
    461762               DO ji=i1,i2 
    462                   tabres(ji,jj,jk) = zrhox * e1v(ji,jj) * e3v_n(ji,jj,jk) * vn(ji,jj,jk) 
     763                  tabres(ji,jj,jk,1) = zrhox * e1v(ji,jj) * e3v_n(ji,jj,jk) * vn(ji,jj,jk) 
    463764               END DO 
    464765            END DO 
     
    468769            DO jj=j1,j2 
    469770               DO ji=i1,i2 
    470                   tabres(ji,jj,jk) = tabres(ji,jj,jk) * r1_e1v(ji,jj) 
     771                  tabres(ji,jj,jk,1) = tabres(ji,jj,jk,1) * r1_e1v(ji,jj) 
    471772                  ! 
    472773                  IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN ! Add asselin part 
    473774                     zvb  = vb(ji,jj,jk) * e3v_b(ji,jj,jk) ! fse3t_b prior update should be used 
    474775                     zvno = vn(ji,jj,jk) * e3v_a(ji,jj,jk) 
    475                      zvnu = tabres(ji,jj,jk) 
     776                     zvnu = tabres(ji,jj,jk,1) 
    476777                     vb(ji,jj,jk) = ( zvb + atfp * ( zvnu - zvno) ) &       
    477778                                    & * vmask(ji,jj,jk) / e3v_b(ji,jj,jk) 
    478779                  ENDIF 
    479780                  ! 
    480                   vn(ji,jj,jk) = tabres(ji,jj,jk) * vmask(ji,jj,jk) / e3v_n(ji,jj,jk) 
     781                  vn(ji,jj,jk) = tabres(ji,jj,jk,1) * vmask(ji,jj,jk) / e3v_n(ji,jj,jk) 
    481782               END DO 
    482783            END DO 
     
    491792   END SUBROUTINE updatev 
    492793 
    493    SUBROUTINE correct_v_bdy( tabres, i1, i2, j1, j2, k1, k2, before, nb, ndir ) 
     794# endif 
     795 
     796   SUBROUTINE correct_v_bdy( tabres, i1, i2, j1, j2, k1, k2, n1, n2, before, nb, ndir ) 
    494797      !!--------------------------------------------- 
    495798      !!           *** ROUTINE correct_u_bdy *** 
    496799      !!--------------------------------------------- 
    497       INTEGER                               , INTENT(in   ) :: i1, i2, j1, j2, k1, k2 
    498       REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: tabres 
    499       LOGICAL                               , INTENT(in   ) :: before 
    500       INTEGER                               , INTENT(in)    :: nb, ndir 
     800      INTEGER                                     , INTENT(in   ) :: i1, i2, j1, j2, k1, k2, n1, n2 
     801      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2), INTENT(inout) :: tabres 
     802      LOGICAL                                     , INTENT(in   ) :: before 
     803      INTEGER                                     , INTENT(in)    :: nb, ndir 
    501804      !! 
    502805      LOGICAL :: southern_side, northern_side  
Note: See TracChangeset for help on using the changeset viewer.