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 9012 for branches/2017/dev_CNRS_2017/NEMOGCM/NEMO/OPA_SRC/LBC/lbcnfd.F90 – NEMO

Ignore:
Timestamp:
2017-12-13T14:57:33+01:00 (6 years ago)
Author:
acc
Message:

Branch dev_CNRS_2017. Merge in no_ghost changes from dev_r8126_ROBUST08_no_ghost. These changes include lib_mpp refresh and rationalisation of mppini from dev_r8126_ROBUST10_MPPINI

File:
1 edited

Legend:

Unmodified
Added
Removed

  • branches/2017/dev_CNRS_2017/NEMOGCM/NEMO/OPA_SRC/LBC/lbcnfd.F90

    r8882 r9012  
    2727      MODULE PROCEDURE   lbc_nfd_2d    , lbc_nfd_3d    , lbc_nfd_4d 
    2828      MODULE PROCEDURE   lbc_nfd_2d_ptr, lbc_nfd_3d_ptr, lbc_nfd_4d_ptr 
     29      MODULE PROCEDURE   lbc_nfd_2d_ext 
    2930   END INTERFACE 
    3031   ! 
    … …  
    8485#     undef ROUTINE_NFD 
    8586#     undef MULTI 
     87#  undef DIM_2d 
     88   ! 
     89   !                       !==  2D array with extra haloes  ==! 
     90   ! 
     91#  define DIM_2d 
     92#     define ROUTINE_NFD           lbc_nfd_2d_ext 
     93#     include "lbc_nfd_ext_generic.h90" 
     94#     undef ROUTINE_NFD 
    8695#  undef DIM_2d 
    8796   ! 
    … …  
    156165 
    157166 
    158 !!gm   CAUTION HERE  optional pr2dj  not implemented in generic case 
    159 !!gm                 furthermore, in the _org routine it is OK only for T-point pivot !! 
    160  
    161  
    162    SUBROUTINE lbc_nfd_2d_org( pt2d, cd_nat, psgn, pr2dj ) 
    163       !!---------------------------------------------------------------------- 
    164       !!                  ***  routine lbc_nfd_2d  *** 
    165       !! 
    166       !! ** Purpose :   2D lateral boundary condition : North fold treatment 
    167       !!       without processor exchanges.  
    168       !! 
    169       !! ** Method  :    
    170       !! 
    171       !! ** Action  :   pt2d with updated values along the north fold 
    172       !!---------------------------------------------------------------------- 
    173       REAL(wp), DIMENSION(:,:), INTENT(inout) ::   pt2d      ! 2D array on which the boundary condition is applied 
    174       CHARACTER(len=1)        , INTENT(in   ) ::   cd_nat   ! nature of pt2d grid-point 
    175       REAL(wp)                , INTENT(in   ) ::   psgn      ! sign used across north fold 
    176       INTEGER , OPTIONAL      , INTENT(in   ) ::   pr2dj     ! number of additional halos 
    177       ! 
    178       INTEGER  ::   ji, jl, ipr2dj 
    179       INTEGER  ::   ijt, iju, ijpj, ijpjm1 
    180       !!---------------------------------------------------------------------- 
    181  
    182       SELECT CASE ( jpni ) 
    183       CASE ( 1 )     ;   ijpj = nlcj      ! 1 proc only  along the i-direction 
    184       CASE DEFAULT   ;   ijpj = 4         ! several proc along the i-direction 
    185       END SELECT 
    186       ! 
    187       IF( PRESENT(pr2dj) ) THEN           ! use of additional halos 
    188          ipr2dj = pr2dj 
    189          IF( jpni > 1 )   ijpj = ijpj + ipr2dj 
    190       ELSE 
    191          ipr2dj = 0  
    192       ENDIF 
    193       ! 
    194       ijpjm1 = ijpj-1 
    195  
    196  
    197       SELECT CASE ( npolj ) 
    198       ! 
    199       CASE ( 3, 4 )                       ! *  North fold  T-point pivot 
    200          ! 
    201          SELECT CASE ( cd_nat ) 
    202          ! 
    203          CASE ( 'T' , 'W' )                               ! T- , W-points 
    204             DO jl = 0, ipr2dj 
    205                DO ji = 2, jpiglo 
    206                   ijt=jpiglo-ji+2 
    207                   pt2d(ji,ijpj+jl) = psgn * pt2d(ijt,ijpj-2-jl) 
    208                END DO 
    209             END DO 
    210             pt2d(1,ijpj)   = psgn * pt2d(3,ijpj-2) 
    211             DO ji = jpiglo/2+1, jpiglo 
    212                ijt=jpiglo-ji+2 
    213                pt2d(ji,ijpj-1) = psgn * pt2d(ijt,ijpj-1) 
    214             END DO 
    215          CASE ( 'U' )                                     ! U-point 
    216             DO jl = 0, ipr2dj 
    217                DO ji = 1, jpiglo-1 
    218                   iju = jpiglo-ji+1 
    219                   pt2d(ji,ijpj+jl) = psgn * pt2d(iju,ijpj-2-jl) 
    220                END DO 
    221             END DO 
    222             pt2d(   1  ,ijpj  ) = psgn * pt2d(    2   ,ijpj-2) 
    223             pt2d(jpiglo,ijpj  ) = psgn * pt2d(jpiglo-1,ijpj-2) 
    224             pt2d(1     ,ijpj-1) = psgn * pt2d(jpiglo  ,ijpj-1)    
    225             DO ji = jpiglo/2, jpiglo-1 
    226                iju = jpiglo-ji+1 
    227                pt2d(ji,ijpjm1) = psgn * pt2d(iju,ijpjm1) 
    228             END DO 
    229          CASE ( 'V' )                                     ! V-point 
    230             DO jl = -1, ipr2dj 
    231                DO ji = 2, jpiglo 
    232                   ijt = jpiglo-ji+2 
    233                   pt2d(ji,ijpj+jl) = psgn * pt2d(ijt,ijpj-3-jl) 
    234                END DO 
    235             END DO 
    236             pt2d( 1 ,ijpj)   = psgn * pt2d( 3 ,ijpj-3)  
    237          CASE ( 'F' )                                     ! F-point 
    238             DO jl = -1, ipr2dj 
    239                DO ji = 1, jpiglo-1 
    240                   iju = jpiglo-ji+1 
    241                   pt2d(ji,ijpj+jl) = psgn * pt2d(iju,ijpj-3-jl) 
    242                END DO 
    243             END DO 
    244             pt2d(   1  ,ijpj)   = psgn * pt2d(    2   ,ijpj-3) 
    245             pt2d(jpiglo,ijpj)   = psgn * pt2d(jpiglo-1,ijpj-3) 
    246             pt2d(jpiglo,ijpj-1) = psgn * pt2d(jpiglo-1,ijpj-2)       
    247             pt2d(   1  ,ijpj-1) = psgn * pt2d(    2   ,ijpj-2)       
    248          CASE ( 'I' )                                     ! ice U-V point (I-point) 
    249             DO jl = 0, ipr2dj 
    250                pt2d(2,ijpj+jl) = psgn * pt2d(3,ijpj-1+jl) 
    251                DO ji = 3, jpiglo 
    252                   iju = jpiglo - ji + 3 
    253                   pt2d(ji,ijpj+jl) = psgn * pt2d(iju,ijpj-1-jl) 
    254                END DO 
    255             END DO 
    256          END SELECT 
    257          ! 
    258       CASE ( 5, 6 )                        ! *  North fold  F-point pivot 
    259          ! 
    260          SELECT CASE ( cd_nat ) 
    261          CASE ( 'T' , 'W' )                               ! T-, W-point 
    262             DO jl = 0, ipr2dj 
    263                DO ji = 1, jpiglo 
    264                   ijt = jpiglo-ji+1 
    265                   pt2d(ji,ijpj+jl) = psgn * pt2d(ijt,ijpj-1-jl) 
    266                END DO 
    267             END DO 
    268          CASE ( 'U' )                                     ! U-point 
    269             DO jl = 0, ipr2dj 
    270                DO ji = 1, jpiglo-1 
    271                   iju = jpiglo-ji 
    272                   pt2d(ji,ijpj+jl) = psgn * pt2d(iju,ijpj-1-jl) 
    273                END DO 
    274             END DO 
    275             pt2d(jpiglo,ijpj) = psgn * pt2d(1,ijpj-1) 
    276          CASE ( 'V' )                                     ! V-point 
    277             DO jl = 0, ipr2dj 
    278                DO ji = 1, jpiglo 
    279                   ijt = jpiglo-ji+1 
    280                   pt2d(ji,ijpj+jl) = psgn * pt2d(ijt,ijpj-2-jl) 
    281                END DO 
    282             END DO 
    283             DO ji = jpiglo/2+1, jpiglo 
    284                ijt = jpiglo-ji+1 
    285                pt2d(ji,ijpjm1) = psgn * pt2d(ijt,ijpjm1) 
    286             END DO 
    287          CASE ( 'F' )                               ! F-point 
    288             DO jl = 0, ipr2dj 
    289                DO ji = 1, jpiglo-1 
    290                   iju = jpiglo-ji 
    291                   pt2d(ji,ijpj+jl) = psgn * pt2d(iju,ijpj-2-jl) 
    292                END DO 
    293             END DO 
    294             pt2d(jpiglo,ijpj) = psgn * pt2d(1,ijpj-2) 
    295             DO ji = jpiglo/2+1, jpiglo-1 
    296                iju = jpiglo-ji 
    297                pt2d(ji,ijpjm1) = psgn * pt2d(iju,ijpjm1) 
    298             END DO 
    299          CASE ( 'I' )                                  ! ice U-V point (I-point) 
    300             pt2d( 2 ,ijpj:ijpj+ipr2dj) = 0._wp 
    301             DO jl = 0, ipr2dj 
    302                DO ji = 2 , jpiglo-1 
    303                   ijt = jpiglo - ji + 2 
    304                   pt2d(ji,ijpj+jl)= 0.5 * ( pt2d(ji,ijpj-1-jl) + psgn * pt2d(ijt,ijpj-1-jl) ) 
    305                END DO 
    306             END DO 
    307          END SELECT 
    308          ! 
    309       CASE DEFAULT                           ! *  closed : the code probably never go through 
    310          ! 
    311          SELECT CASE ( cd_nat) 
    312          CASE ( 'T' , 'U' , 'V' , 'W' )                 ! T-, U-, V-, W-points 
    313             pt2d(:, 1:1-ipr2dj     ) = 0._wp 
    314             pt2d(:,ijpj:ijpj+ipr2dj) = 0._wp 
    315          CASE ( 'F' )                                   ! F-point 
    316             pt2d(:,ijpj:ijpj+ipr2dj) = 0._wp 
    317          CASE ( 'I' )                                   ! ice U-V point 
    318             pt2d(:, 1:1-ipr2dj     ) = 0._wp 
    319             pt2d(:,ijpj:ijpj+ipr2dj) = 0._wp 
    320          END SELECT 
    321          ! 
    322       END SELECT 
    323       ! 
    324    END SUBROUTINE lbc_nfd_2d_org 
    325  
    326167   !!====================================================================== 
    327168END MODULE lbcnfd 
Note: See TracChangeset for help on using the changeset viewer.