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 13056 for utils/tools_dev_r12970_AGRIF_CMEMS/DOMAINcfg/src/agrif_connect.F90 – NEMO

Ignore:
Timestamp:
2020-06-07T18:26:09+02:00 (4 years ago)
Author:
rblod
Message:

ticket #2129 : cleaning domcfg

File:
1 moved

Legend:

Unmodified
Added
Removed
  • utils/tools_dev_r12970_AGRIF_CMEMS/DOMAINcfg/src/agrif_connect.F90

    r13055 r13056  
     1MODULE agrif_connect 
     2 
     3   USE dom_oce 
     4   USE domzgr 
     5   USE agrif_parameters 
     6   USE agrif_profiles 
     7 
     8   IMPLICIT NONE 
     9   PRIVATE 
     10 
     11   PUBLIC agrif_boundary_connections  
     12 
     13CONTAINS 
     14 
    115#if defined key_agrif 
    2 subroutine agrif_boundary_connections 
    3 use agrif_profiles 
    4 use agrif_parameters 
    5 implicit none 
    6 external connect_e3t_copy, connect_e3t_connect, connect_bottom_level,connect_e3u, connect_e3v 
    7 if (agrif_root()) return 
    8  
    9 call Agrif_connection() 
    10  
    11 call Agrif_Bc_variable(bottom_level_id, procname = connect_bottom_level) 
    12  
    13 call Agrif_Bc_variable(e3t_copy_id, procname = connect_e3t_copy) 
    14  
    15 Allocate(e3t_interp(jpi,jpj,jpk)) 
    16 e3t_interp = -10. 
    17 Agrif_UseSpecialValue = .TRUE. 
    18 Agrif_SpecialValue = 0. 
    19 call Agrif_Bc_variable(e3t_connect_id, procname = connect_e3t_connect) 
    20 Agrif_UseSpecialValue = .FALSE. 
    21  
    22 ! Call Agrif_make_connection() 
    23  
    24       Agrif_SpecialValue    = 0. 
    25       Agrif_UseSpecialValue = ln_spc_dyn 
    26       ! 
    27 !      CALL Agrif_Bc_variable( e3u_id, procname=connect_e3u ) 
    28 !      CALL Agrif_Bc_variable( e3v_id, procname=connect_e3v ) 
    29       ! 
     16 
     17   SUBROUTINE agrif_boundary_connections 
     18      !!---------------------------------------------------------------------- 
     19      !!                  ***  ROUTINE agrif_boundary_connections  *** 
     20      !!----------------------------------------------------------------------   
     21      IF( Agrif_Root() ) return 
     22 
     23      CALL agrif_connection() 
     24      ! 
     25      CALL Agrif_Bc_variable(bottom_level_id, procname = connect_bottom_level) 
     26      !  
     27      CALL Agrif_Bc_variable(e3t_copy_id, procname = connect_e3t_copy) 
     28 
     29      ALLOCATE(e3t_interp(jpi,jpj,jpk)) 
     30      e3t_interp = -10. 
     31      Agrif_UseSpecialValue = .TRUE. 
     32      Agrif_SpecialValue = 0. 
     33      CALL Agrif_Bc_variable(e3t_connect_id, procname = connect_e3t_connect) 
    3034      Agrif_UseSpecialValue = .FALSE. 
    31        
    32 end subroutine agrif_boundary_connections 
    33  
    34  
    35     SUBROUTINE connect_e3t_copy( ptab, i1, i2, j1, j2, k1, k2, before, nb,ndir) 
    36     USE dom_oce 
    37     USE domzgr 
    38     USE agrif_parameters 
    39       !!---------------------------------------------------------------------- 
    40       !!                  ***  ROUTINE interpsshn  *** 
    41       !!----------------------------------------------------------------------   
    42       INTEGER                         , INTENT(in   ) ::   i1, i2, j1, j2, k1, k2 
    43       REAL, DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) ::   ptab 
    44       LOGICAL                         , INTENT(in   ) ::   before 
    45       INTEGER                         , INTENT(in   ) ::   nb , ndir 
    46       LOGICAL  ::   western_side, eastern_side,northern_side,southern_side 
     35      !     
     36   END SUBROUTINE agrif_boundary_connections 
     37 
     38   SUBROUTINE connect_e3t_copy( ptab, i1, i2, j1, j2, k1, k2, before, nb,ndir) 
     39      !!---------------------------------------------------------------------- 
     40      !!                  ***  ROUTINE connect_e3t_copy  *** 
     41      !!----------------------------------------------------------------------   
     42      INTEGER                               , INTENT(in   ) ::   i1, i2, j1, j2, k1, k2 
     43      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) ::   ptab 
     44      LOGICAL                               , INTENT(in   ) ::   before 
     45      INTEGER                               , INTENT(in   ) ::   nb , ndir 
    4746      ! 
    4847      !!----------------------------------------------------------------------  
    49       INTEGER :: ji,jj,jk       
    50       ! 
    51          western_side  = (nb == 1).AND.(ndir == 1) 
    52          eastern_side  = (nb == 1).AND.(ndir == 2) 
    53          southern_side = (nb == 2).AND.(ndir == 1) 
    54          northern_side = (nb == 2).AND.(ndir == 2) 
    55  
     48      ! 
    5649      IF( before) THEN 
    5750         ptab(i1:i2,j1:j2,k1:k2) = e3t_0(i1:i2,j1:j2,k1:k2) 
     
    6255   END SUBROUTINE connect_e3t_copy 
    6356    
    64     SUBROUTINE connect_bottom_level( ptab, i1, i2, j1, j2, before, nb,ndir) 
    65     USE dom_oce 
    66     USE domzgr 
    67       !!---------------------------------------------------------------------- 
    68       !!                  ***  ROUTINE interpsshn  *** 
     57   SUBROUTINE connect_bottom_level( ptab, i1, i2, j1, j2, before, nb,ndir) 
     58      !!---------------------------------------------------------------------- 
     59      !!                  ***  ROUTINE connect_bottom_level  *** 
    6960      !!----------------------------------------------------------------------   
    7061      INTEGER                         , INTENT(in   ) ::   i1, i2, j1, j2 
    71       REAL, DIMENSION(i1:i2,j1:j2)    , INTENT(inout) ::   ptab 
     62      REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) ::   ptab 
    7263      LOGICAL                         , INTENT(in   ) ::   before 
    7364      INTEGER                         , INTENT(in   ) ::   nb , ndir 
    74       LOGICAL  ::   western_side, eastern_side,northern_side,southern_side 
    7565      ! 
    7666      !!----------------------------------------------------------------------  
    77       INTEGER :: ji,jj      
    78       ! 
    79          western_side  = (nb == 1).AND.(ndir == 1) 
    80          eastern_side  = (nb == 1).AND.(ndir == 2) 
    81          southern_side = (nb == 2).AND.(ndir == 1) 
    82          northern_side = (nb == 2).AND.(ndir == 2) 
    83  
     67      ! 
    8468      IF( before) THEN 
    8569         ptab(i1:i2,j1:j2) = mbkt(i1:i2,j1:j2)*ssmask(i1:i2,j1:j2) 
     
    9074         ELSEWHERE 
    9175           ssmask(i1:i2,j1:j2) = 1. 
    92          END WHERE 
    93             
     76         END WHERE            
    9477      ENDIF 
    9578      ! 
    9679   END SUBROUTINE connect_bottom_level 
    9780    
    98     SUBROUTINE connect_e3t_connect( ptab, i1, i2, j1, j2, k1, k2, before, nb,ndir) 
    99     USE dom_oce 
    100     USE domzgr 
    101       !!---------------------------------------------------------------------- 
    102       !!                  ***  ROUTINE interpsshn  *** 
    103       !!----------------------------------------------------------------------   
    104       INTEGER                         , INTENT(in   ) ::   i1, i2, j1, j2, k1, k2 
    105       REAL, DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) ::   ptab 
    106       LOGICAL                         , INTENT(in   ) ::   before 
    107       INTEGER                         , INTENT(in   ) ::   nb , ndir 
    108       LOGICAL  ::   western_side, eastern_side,northern_side,southern_side 
     81   SUBROUTINE connect_e3t_connect( ptab, i1, i2, j1, j2, k1, k2, before, nb,ndir) 
     82      !!---------------------------------------------------------------------- 
     83      !!                  ***  ROUTINE connect_e3t_connect  *** 
     84      !!----------------------------------------------------------------------   
     85      INTEGER                               , INTENT(in   ) ::   i1, i2, j1, j2, k1, k2 
     86      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) ::   ptab 
     87      LOGICAL                               , INTENT(in   ) ::   before 
     88      INTEGER                               , INTENT(in   ) ::   nb , ndir 
    10989      ! 
    11090      !!----------------------------------------------------------------------  
    111       INTEGER :: ji,jj,jk     
    112       REAL,DIMENSION(i1:i2,j1:j2) :: bathy_local       
    113       ! 
    114          western_side  = (nb == 1).AND.(ndir == 1) 
    115          eastern_side  = (nb == 1).AND.(ndir == 2) 
    116          southern_side = (nb == 2).AND.(ndir == 1) 
    117          northern_side = (nb == 2).AND.(ndir == 2) 
    118  
     91      INTEGER :: ji, jj, jk  
     92      REAL(wp), DIMENSION(i1:i2,j1:j2) :: bathy_local    
     93      ! 
    11994      IF( before) THEN 
    120          do jk=1,jpk 
    121          do jj=j1,j2 
    122          do ji=i1,i2 
    123           if (mbkt(ji,jj)>=jk) then 
    124             ptab(ji,jj,jk) = e3t_0(ji,jj,jk) 
    125           else 
    126             ptab(ji,jj,jk) = 0. 
    127           endif 
    128          enddo 
    129          enddo 
    130          enddo 
    131           
    132          do jj=j1,j2 
    133          do ji=i1,i2 
    134            ptab(ji,jj,jpk+1) = SUM ( e3t_0(ji,jj, 1:mbkt(ji,jj) ) ) * ssmask(ji,jj) 
    135          enddo 
    136          enddo 
    137  
    138       ELSE 
    139          do jj=j1,j2 
    140          do ji=i1,i2 
    141            bathy_local (ji,jj) = SUM ( e3t_0(ji,jj, 1:mbkt(ji,jj) ) ) * ssmask(ji,jj) 
    142          enddo 
    143          enddo 
    144           
    145          DO jk=1,jpk 
    146            DO jj=j1,j2 
    147              DO ji=i1,i2 
    148              if (e3t_interp(ji,jj,jk) == -10) then ! the connection has not yet been done 
    149                  e3t_interp(ji,jj,jk) = MAX(ptab(ji,jj,jk),MIN(e3zps_min, e3t_1d(jk)*e3zps_rat )) 
    150                  e3t_interp(ji,jj,jk) = MIN(e3t_interp(ji,jj,jk),e3t_1d(jk)) 
    151                  e3t_0(ji,jj,jk) = ztabramp(ji,jj)*e3t_0(ji,jj,jk)+(1.-ztabramp(ji,jj))*e3t_interp(ji,jj,jk) 
    152              endif 
    153              ENDDO 
    154            ENDDO 
    155          ENDDO 
    156       ENDIF 
    157       ! 
    158    END SUBROUTINE connect_e3t_connect 
    159     
    160    SUBROUTINE connect_e3u( ptab, i1, i2, j1, j2, k1, k2,before, nb, ndir ) 
    161    USE dom_oce 
    162       !!---------------------------------------------------------------------- 
    163       !!                  *** ROUTINE interpun *** 
    164       !!---------------------------------------------     
    165       !! 
    166       INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2 
    167       REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: ptab 
    168       LOGICAL, INTENT(in) :: before 
    169       INTEGER, INTENT(in) :: nb , ndir 
    170       !! 
    171       INTEGER :: ji,jj,jk 
    172       REAL(wp) :: zrhoy 
    173       ! vertical interpolation: 
    174       REAL(wp), DIMENSION(k1:k2) :: tabin, h_in 
    175       REAL(wp), DIMENSION(1:jpk) :: h_out 
    176       INTEGER  :: N_in, N_out, iref 
    177       REAL(wp) :: h_diff 
    178       LOGICAL  :: western_side, eastern_side 
    179       !!---------------------------------------------     
    180       ! 
    181       IF (before) THEN  
    18295         DO jk=1,jpk 
    18396            DO jj=j1,j2 
    18497               DO ji=i1,i2 
    185                  if (min(mbkt(ji,jj),mbkt(ji+1,jj))<jk) then 
    186                   ptab(ji,jj,jk) = 0. 
    187                  else 
    188                   ptab(ji,jj,jk) = e2u(ji,jj) * e3u_0(ji,jj,jk) 
    189                  endif 
    190 # if defined key_vertical 
    191                   ptab(ji,jj,jk,2) = (umask(ji,jj,jk) * e2u(ji,jj) * e3u_n(ji,jj,jk)) 
    192 # endif 
     98                  IF( mbkt(ji,jj) .GE. jk ) THEN 
     99                     ptab(ji,jj,jk) = e3t_0(ji,jj,jk) 
     100                  ELSE 
     101                     ptab(ji,jj,jk) = 0. 
     102                  ENDIF 
    193103               END DO 
    194104            END DO 
    195105         END DO 
     106         ! 
     107         DO jj=j1,j2 
     108            DO ji=i1,i2 
     109               ptab(ji,jj,jpk+1) = SUM ( e3t_0(ji,jj, 1:mbkt(ji,jj) ) ) * ssmask(ji,jj) 
     110            END DO 
     111         END DO 
    196112      ELSE 
    197          zrhoy = Agrif_rhoy() 
    198 # if defined key_vertical 
    199 ! VERTICAL REFINEMENT BEGIN 
    200          western_side  = (nb == 1).AND.(ndir == 1) 
    201          eastern_side  = (nb == 1).AND.(ndir == 2) 
    202  
    203          DO ji=i1,i2 
    204             iref = ji 
    205             IF (western_side) iref = MAX(2,ji) 
    206             IF (eastern_side) iref = MIN(nlci-2,ji) 
    207             DO jj=j1,j2 
    208                N_in = 0 
    209                DO jk=k1,k2 
    210                   IF (ptab(ji,jj,jk,2) == 0) EXIT 
    211                   N_in = N_in + 1 
    212                   tabin(jk) = ptab(ji,jj,jk,1)/ptab(ji,jj,jk,2) 
    213                   h_in(N_in) = ptab(ji,jj,jk,2)/(e2u(ji,jj)*zrhoy)  
    214               ENDDO 
    215           
    216               IF (N_in == 0) THEN 
    217                  ua(ji,jj,:) = 0._wp 
    218                  CYCLE 
    219               ENDIF 
    220           
    221               N_out = 0 
    222               DO jk=1,jpk 
    223                  if (umask(iref,jj,jk) == 0) EXIT 
    224                  N_out = N_out + 1 
    225                  h_out(N_out) = e3u_a(iref,jj,jk) 
    226               ENDDO 
    227           
    228               IF (N_out == 0) THEN 
    229                  ua(ji,jj,:) = 0._wp 
    230                  CYCLE 
    231               ENDIF 
    232           
    233               IF (N_in * N_out > 0) THEN 
    234                  h_diff = sum(h_out(1:N_out))-sum(h_in(1:N_in)) 
    235 ! Should be able to remove the next IF/ELSEIF statement once scale factors are dealt with properly 
    236                  if (h_diff < -1.e4) then 
    237                     print *,'CHECK YOUR BATHY ...', h_diff, sum(h_out(1:N_out)), sum(h_in(1:N_in)) 
    238 !                    stop 
    239                  endif 
    240               ENDIF 
    241               call reconstructandremap(tabin(1:N_in),h_in(1:N_in),ua(ji,jj,1:N_out),h_out(1:N_out),N_in,N_out) 
    242             ENDDO 
    243          ENDDO 
    244  
    245 # else 
    246          DO jk = 1, jpkm1 
    247             DO jj=j1,j2 
    248             do ji=i1,i2 
    249               if (min(mbkt(ji+1,jj),mbkt(ji,jj))<jk) then 
    250                 e3u_0(ji,jj,jk)=e3t_1d(jk) 
    251               else 
    252                 e3u_0(ji,jj,jk) = MAX(ptab(ji,jj,jk) / ( zrhoy * e2u(ji,jj) ),MIN(e3zps_min,e3t_1d(jk)*e3zps_rat)) 
    253               endif 
    254             enddo 
    255                 
    256             END DO 
    257          END DO 
    258 # endif 
    259  
    260       ENDIF 
    261       !  
    262    END SUBROUTINE connect_e3u 
    263     
    264    SUBROUTINE connect_e3v( ptab, i1, i2, j1, j2, k1, k2, before, nb, ndir ) 
    265    USE dom_oce 
    266       !!---------------------------------------------------------------------- 
    267       !!                  *** ROUTINE interpvn *** 
    268       !!---------------------------------------------------------------------- 
    269       ! 
    270       INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2 
    271       REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: ptab 
    272       LOGICAL, INTENT(in) :: before 
    273       INTEGER, INTENT(in) :: nb , ndir 
    274       ! 
    275       INTEGER :: ji,jj,jk 
    276       REAL(wp) :: zrhox 
    277       ! vertical interpolation: 
    278       REAL(wp), DIMENSION(k1:k2) :: tabin, h_in 
    279       REAL(wp), DIMENSION(1:jpk) :: h_out 
    280       INTEGER  :: N_in, N_out, jref 
    281       REAL(wp) :: h_diff 
    282       LOGICAL  :: northern_side,southern_side 
    283       !!---------------------------------------------     
    284       !       
    285       IF (before) THEN           
    286          DO jk=k1,k2 
     113         DO jj=j1,j2 
     114            DO ji=i1,i2 
     115               bathy_local (ji,jj) = SUM ( e3t_0(ji,jj, 1:mbkt(ji,jj) ) ) * ssmask(ji,jj) 
     116            END DO 
     117         END DO 
     118         ! 
     119         DO jk=1,jpk 
    287120            DO jj=j1,j2 
    288121               DO ji=i1,i2 
    289                  if (min(mbkt(ji,jj),mbkt(ji,jj+1))<jk) then 
    290                   ptab(ji,jj,jk) = 0. 
    291                  else 
    292                   ptab(ji,jj,jk) = (e1v(ji,jj) * e3v_0(ji,jj,jk)) 
    293                  endif 
    294 # if defined key_vertical 
    295                   ptab(ji,jj,jk,2) = vmask(ji,jj,jk) * e1v(ji,jj) * e3v_n(ji,jj,jk) 
    296 # endif 
    297                END DO 
    298             END DO 
    299          END DO 
    300       ELSE        
    301          zrhox = Agrif_rhox() 
    302 # if defined key_vertical 
    303  
    304          southern_side = (nb == 2).AND.(ndir == 1) 
    305          northern_side = (nb == 2).AND.(ndir == 2) 
    306  
    307          DO jj=j1,j2 
    308             jref = jj 
    309             IF (southern_side) jref = MAX(2,jj) 
    310             IF (northern_side) jref = MIN(nlcj-2,jj) 
    311             DO ji=i1,i2 
    312                N_in = 0 
    313                DO jk=k1,k2 
    314                   if (ptab(ji,jj,jk,2) == 0) EXIT 
    315                   N_in = N_in + 1 
    316                   tabin(jk) = ptab(ji,jj,jk,1)/ptab(ji,jj,jk,2) 
    317                   h_in(N_in) = ptab(ji,jj,jk,2)/(e1v(ji,jj)*zrhox) 
    318                END DO 
    319                IF (N_in == 0) THEN 
    320                   va(ji,jj,:) = 0._wp 
    321                   CYCLE 
    322                ENDIF 
    323           
    324                N_out = 0 
    325                DO jk=1,jpk 
    326                   if (vmask(ji,jref,jk) == 0) EXIT 
    327                   N_out = N_out + 1 
    328                   h_out(N_out) = e3v_a(ji,jref,jk) 
    329                END DO 
    330                IF (N_out == 0) THEN 
    331                  va(ji,jj,:) = 0._wp 
    332                  CYCLE 
    333                ENDIF 
    334                call reconstructandremap(tabin(1:N_in),h_in(1:N_in),va(ji,jj,1:N_out),h_out(1:N_out),N_in,N_out) 
    335             END DO 
    336          END DO 
    337 # else 
    338          DO jk = 1, jpkm1 
    339           DO jj=j1,j2 
    340           DO ji=i1,i2 
    341               if (min(mbkt(ji,jj),mbkt(ji,jj+1))<jk) then 
    342                 e3v_0(ji,jj,jk)=e3t_1d(jk) 
    343               else 
    344                 e3v_0(ji,jj,jk) = MAX(ptab(ji,jj,jk) / ( zrhox * e1v(ji,jj) ),MIN(e3zps_min,e3t_1d(jk)*e3zps_rat)) 
    345               endif 
    346           ENDDO 
    347           ENDDO 
    348          END DO 
    349 # endif 
    350       ENDIF 
    351       !         
    352    END SUBROUTINE connect_e3v 
     122                  IF( e3t_interp(ji,jj,jk) == -10 ) THEN ! the connection has not yet been done 
     123                     e3t_interp(ji,jj,jk) = MAX( ptab(ji,jj,jk),MIN(e3zps_min, e3t_1d(jk)*e3zps_rat) ) 
     124                     e3t_interp(ji,jj,jk) = MIN( e3t_interp(ji,jj,jk),e3t_1d(jk) ) 
     125                     e3t_0(ji,jj,jk) = ztabramp(ji,jj)*e3t_0(ji,jj,jk)+(1.-ztabramp(ji,jj))*e3t_interp(ji,jj,jk) 
     126                  ENDIF 
     127             END DO 
     128           END DO 
     129         END DO 
     130      ENDIF 
     131      ! 
     132   END SUBROUTINE connect_e3t_connect 
     133    
     134   SUBROUTINE agrif_connection 
     135      !!---------------------------------------------------------------------- 
     136      !!                 *** ROUTINE  Agrif_connection *** 
     137      !!---------------------------------------------------------------------- 
     138      INTEGER  ::   ji, jj, ind1, ind2 
     139      INTEGER  ::   ispongearea, istart 
     140      REAL(wp) ::   z1_spongearea 
     141      !!---------------------------------------------------------------------- 
     142      ! 
     143      ! Define ramp from boundaries towards domain interior at T-points 
     144      ! Store it in ztabramp 
     145 
     146      ALLOCATE(ztabramp(jpi,jpj)) 
     147      ispongearea = 1 + npt_connect * Agrif_irhox() 
     148      istart = npt_copy * Agrif_irhox() 
     149      z1_spongearea = 1._wp / REAL( ispongearea, wp ) 
     150       
     151      ztabramp(:,:) = 0._wp 
     152 
     153      ! --- West --- ! 
     154      IF( ((nbondi == -1) .OR. (nbondi == 2) ).AND. .NOT. (jperio == 1 .OR. jperio == 4 .OR. jperio == 6)) THEN 
     155         ind1 = 1+nbghostcells + istart 
     156         ind2 = ind1 + ispongearea  
     157         DO jj = 1, jpj 
     158            DO ji = ind1, ind2                 
     159               ztabramp(ji,jj) = REAL( ind2 - ji ) * z1_spongearea * umask(ind1,jj,1) 
     160            END DO 
     161         ENDDO 
     162      ENDIF 
     163 
     164      ! --- East --- ! 
     165      IF( ((nbondi == 1) .OR. (nbondi == 2) ).AND. .NOT. (jperio == 1 .OR. jperio == 4 .OR. jperio == 6)) THEN 
     166         ind2 = nlci - nbghostcells - istart 
     167         ind1 = ind2 -ispongearea        
     168         DO jj = 1, jpj 
     169            DO ji = ind1, ind2 
     170               ztabramp(ji,jj) = MAX( ztabramp(ji,jj), REAL( ji - ind1 ) * z1_spongearea * umask(ind2-1,jj,1) ) 
     171            ENDDO 
     172         ENDDO 
     173      ENDIF 
     174 
     175      ! --- South --- ! 
     176      IF(( (nbondj == -1) .OR. (nbondj == 2) ).AND.(ln_bry_south)) THEN 
     177         ind1 = 1+nbghostcells + istart 
     178         ind2 = ind1 + ispongearea  
     179         DO jj = ind1, ind2  
     180            DO ji = 1, jpi 
     181               ztabramp(ji,jj) = MAX( ztabramp(ji,jj), REAL( ind2 - jj ) * z1_spongearea * vmask(ji,ind1,1) ) 
     182            END DO 
     183         ENDDO 
     184      ENDIF 
     185 
     186      ! --- North --- ! 
     187      IF( (nbondj == 1) .OR. (nbondj == 2) ) THEN 
     188         ind2 = nlcj - nbghostcells - istart 
     189         ind1 = ind2 -ispongearea          
     190         DO jj = ind1, ind2 
     191            DO ji = 1, jpi 
     192               ztabramp(ji,jj) = MAX( ztabramp(ji,jj), REAL( jj - ind1 ) * z1_spongearea * vmask(ji,ind2-1,1) ) 
     193            END DO 
     194         ENDDO 
     195      ENDIF 
     196      ! 
     197   END SUBROUTINE agrif_connection 
    353198 
    354199#else 
    355 subroutine agrif_boundary_connections_empty 
    356 end subroutine agrif_boundary_connections_empty 
     200   SUBROUTINE agrif_boundary_connections 
     201   END SUBROUTINE agrif_boundary_connections 
    357202#endif 
     203 
     204END MODULE agrif_connect 
Note: See TracChangeset for help on using the changeset viewer.