Ignore:
Timestamp:
2017-12-01T18:44:09+01:00 (3 years ago)
Author:
flavoni
Message:

dev_CNRS_2017 branch: merged dev_r7881_ENHANCE09_RK3 with trunk r8864

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/2017/dev_CNRS_2017/NEMOGCM/NEMO/OPA_SRC/LBC/lbclnk.F90

    r8114 r8882  
    22   !!====================================================================== 
    33   !!                       ***  MODULE  lbclnk  *** 
    4    !! Ocean        : lateral boundary conditions 
     4   !! NEMO        : lateral boundary conditions 
    55   !!===================================================================== 
    66   !! History :  OPA  ! 1997-06  (G. Madec)  Original code 
    77   !!   NEMO     1.0  ! 2002-09  (G. Madec)  F90: Free form and module 
    88   !!            3.2  ! 2009-03  (R. Benshila)  External north fold treatment   
    9    !!            3.5  ! 2012     (S.Mocavero, I. Epicoco) optimization of BDY comm. via lbc_bdy_lnk and lbc_obc_lnk 
     9   !!            3.5  ! 2012     (S.Mocavero, I. Epicoco)  optimization of BDY comm. via lbc_bdy_lnk and lbc_obc_lnk 
    1010   !!            3.4  ! 2012-12  (R. Bourdalle-Badie, G. Reffray)  add a C1D case   
    1111   !!            3.6  ! 2015-06  (O. Tintó and M. Castrillo)  add lbc_lnk_multi   
     12   !!            4.0  ! 2017-03  (G. Madec) automatique allocation of array size (use with any 3rd dim size) 
     13   !!             -   ! 2017-04  (G. Madec) remove duplicated routines (lbc_lnk_2d_9, lbc_lnk_2d_multiple, lbc_lnk_3d_gather) 
     14   !!             -   ! 2017-05  (G. Madec) create generic.h90 files to generate all lbc and north fold routines 
    1215   !!---------------------------------------------------------------------- 
    1316#if defined key_mpp_mpi 
     
    1518   !!   'key_mpp_mpi'             MPI massively parallel processing library 
    1619   !!---------------------------------------------------------------------- 
    17    !!   lbc_lnk      : generic interface for mpp_lnk_3d and mpp_lnk_2d routines defined in lib_mpp 
    18    !!   lbc_sum      : generic interface for mpp_lnk_sum_3d and mpp_lnk_sum_2d routines defined in lib_mpp 
    19    !!   lbc_lnk_e    : generic interface for mpp_lnk_2d_e routine defined in lib_mpp 
    20    !!   lbc_bdy_lnk  : generic interface for mpp_lnk_bdy_2d and mpp_lnk_bdy_3d routines defined in lib_mpp 
    21    !!---------------------------------------------------------------------- 
     20   !!           define the generic interfaces of lib_mpp routines 
     21   !!---------------------------------------------------------------------- 
     22   !!   lbc_lnk       : generic interface for mpp_lnk_3d and mpp_lnk_2d routines defined in lib_mpp 
     23   !!   lbc_lnk_e     : generic interface for mpp_lnk_2d_e routine defined in lib_mpp 
     24   !!   lbc_bdy_lnk   : generic interface for mpp_lnk_bdy_2d and mpp_lnk_bdy_3d routines defined in lib_mpp 
     25   !!---------------------------------------------------------------------- 
     26   USE par_oce        ! ocean dynamics and tracers    
    2227   USE lib_mpp        ! distributed memory computing library 
    23  
     28   USE lbcnfd         ! north fold 
     29 
     30   INTERFACE lbc_lnk 
     31      MODULE PROCEDURE   mpp_lnk_2d      , mpp_lnk_3d      , mpp_lnk_4d 
     32   END INTERFACE 
     33   INTERFACE lbc_lnk_ptr 
     34      MODULE PROCEDURE   mpp_lnk_2d_ptr  , mpp_lnk_3d_ptr  , mpp_lnk_4d_ptr 
     35   END INTERFACE 
    2436   INTERFACE lbc_lnk_multi 
    25       MODULE PROCEDURE mpp_lnk_2d_9, mpp_lnk_2d_multiple 
    26    END INTERFACE 
    27    ! 
    28    INTERFACE lbc_lnk 
    29       MODULE PROCEDURE mpp_lnk_3d_gather, mpp_lnk_3d, mpp_lnk_2d 
    30    END INTERFACE 
    31    ! 
    32    INTERFACE lbc_sum 
    33       MODULE PROCEDURE mpp_lnk_sum_3d, mpp_lnk_sum_2d 
     37      MODULE PROCEDURE   lbc_lnk_2d_multi, lbc_lnk_3d_multi, lbc_lnk_4d_multi 
    3438   END INTERFACE 
    3539   ! 
     
    4650   END INTERFACE 
    4751 
    48    PUBLIC   lbc_lnk       ! ocean lateral boundary conditions 
    49    PUBLIC   lbc_lnk_multi ! modified ocean lateral boundary conditions 
    50    PUBLIC   lbc_sum 
    51    PUBLIC   lbc_lnk_e     ! 
     52   PUBLIC   lbc_lnk       ! ocean/ice lateral boundary conditions 
     53   PUBLIC   lbc_lnk_multi ! modified ocean/ice lateral boundary conditions 
     54   PUBLIC   lbc_lnk_e     ! extended ocean/ice lateral boundary conditions 
    5255   PUBLIC   lbc_bdy_lnk   ! ocean lateral BDY boundary conditions 
    53    PUBLIC   lbc_lnk_icb   ! 
    54  
    55    !!---------------------------------------------------------------------- 
    56    !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
     56   PUBLIC   lbc_lnk_icb   ! iceberg lateral boundary conditions 
     57 
     58   !!---------------------------------------------------------------------- 
     59   !! NEMO/OPA 4.0 , NEMO Consortium (2017) 
    5760   !! $Id$ 
    5861   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    5962   !!---------------------------------------------------------------------- 
     63CONTAINS 
     64 
    6065#else 
    6166   !!---------------------------------------------------------------------- 
    6267   !!   Default option                              shared memory computing 
    6368   !!---------------------------------------------------------------------- 
    64    !!   lbc_sum       : generic interface for mpp_lnk_sum_3d and mpp_lnk_sum_2d  
     69   !!                routines setting the appropriate values 
     70   !!         on first and last row and column of the global domain 
     71   !!---------------------------------------------------------------------- 
    6572   !!   lbc_lnk_sum_3d: compute sum over the halos on a 3D variable on ocean mesh 
    6673   !!   lbc_lnk_sum_3d: compute sum over the halos on a 2D variable on ocean mesh 
     
    7077   !!   lbc_bdy_lnk   : set the lateral BDY boundary condition 
    7178   !!---------------------------------------------------------------------- 
    72    USE oce             ! ocean dynamics and tracers    
    73    USE dom_oce         ! ocean space and time domain  
    74    USE in_out_manager  ! I/O manager 
    75    USE lbcnfd          ! north fold 
     79   USE oce            ! ocean dynamics and tracers    
     80   USE dom_oce        ! ocean space and time domain  
     81   USE in_out_manager ! I/O manager 
     82   USE lbcnfd         ! north fold 
    7683 
    7784   IMPLICIT NONE 
     
    7986 
    8087   INTERFACE lbc_lnk 
    81       MODULE PROCEDURE lbc_lnk_3d_gather, lbc_lnk_3d, lbc_lnk_2d 
    82    END INTERFACE 
    83    ! 
    84    INTERFACE lbc_sum 
    85       MODULE PROCEDURE lbc_lnk_sum_3d, lbc_lnk_sum_2d 
    86    END INTERFACE 
    87  
     88      MODULE PROCEDURE   lbc_lnk_2d      , lbc_lnk_3d      , lbc_lnk_4d 
     89   END INTERFACE 
     90   INTERFACE lbc_lnk_ptr 
     91      MODULE PROCEDURE   lbc_lnk_2d_ptr  , lbc_lnk_3d_ptr  , lbc_lnk_4d_ptr 
     92   END INTERFACE 
     93   INTERFACE lbc_lnk_multi 
     94      MODULE PROCEDURE   lbc_lnk_2d_multi, lbc_lnk_3d_multi, lbc_lnk_4d_multi 
     95   END INTERFACE 
     96   ! 
    8897   INTERFACE lbc_lnk_e 
    8998      MODULE PROCEDURE lbc_lnk_2d_e 
    9099   END INTERFACE 
    91100   ! 
    92    INTERFACE lbc_lnk_multi 
    93       MODULE PROCEDURE lbc_lnk_2d_9, lbc_lnk_2d_multiple 
    94    END INTERFACE 
    95  
    96101   INTERFACE lbc_bdy_lnk 
    97102      MODULE PROCEDURE lbc_bdy_lnk_2d, lbc_bdy_lnk_3d 
     
    102107   END INTERFACE 
    103108    
    104    TYPE arrayptr 
    105       REAL , DIMENSION (:,:),  POINTER :: pt2d 
    106    END TYPE arrayptr 
    107    PUBLIC   arrayptr 
    108  
    109109   PUBLIC   lbc_lnk       ! ocean/ice  lateral boundary conditions 
    110    PUBLIC   lbc_sum       ! ocean/ice  lateral boundary conditions (sum of the overlap region) 
    111    PUBLIC   lbc_lnk_e     ! 
    112    PUBLIC   lbc_lnk_multi ! modified ocean lateral boundary conditions 
     110   PUBLIC   lbc_lnk_e     ! extended ocean/ice lateral boundary conditions 
     111   PUBLIC   lbc_lnk_multi ! modified ocean/ice lateral boundary conditions 
    113112   PUBLIC   lbc_bdy_lnk   ! ocean lateral BDY boundary conditions 
    114    PUBLIC   lbc_lnk_icb   ! 
    115     
    116    !!---------------------------------------------------------------------- 
    117    !! NEMO/OPA 3.7 , NEMO Consortium (2015) 
     113   PUBLIC   lbc_lnk_icb   ! iceberg lateral boundary conditions 
     114    
     115   !!---------------------------------------------------------------------- 
     116   !! NEMO/OPA 4.0 , NEMO Consortium (2017) 
    118117   !! $Id$ 
    119118   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     
    122121 
    123122# if defined key_c1d 
    124    !!---------------------------------------------------------------------- 
     123   !!====================================================================== 
    125124   !!   'key_c1d'                                          1D configuration 
    126    !!---------------------------------------------------------------------- 
    127  
    128    SUBROUTINE lbc_lnk_3d_gather( pt3d1, cd_type1, pt3d2, cd_type2, psgn ) 
    129       !!--------------------------------------------------------------------- 
    130       !!                  ***  ROUTINE lbc_lnk_3d_gather  *** 
    131       !! 
    132       !! ** Purpose :   set lateral boundary conditions on two 3D arrays (C1D case) 
    133       !! 
    134       !! ** Method  :   call lbc_lnk_3d on pt3d1 and pt3d2 
    135       !!---------------------------------------------------------------------- 
    136       CHARACTER(len=1)                , INTENT(in   ) ::   cd_type1, cd_type2   ! nature of pt3d grid-points 
    137       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pt3d1   , pt3d2      ! 3D array on which the lbc is applied 
    138       REAL(wp)                        , INTENT(in   ) ::   psgn                 ! control of the sign  
    139       !!---------------------------------------------------------------------- 
    140       ! 
    141       CALL lbc_lnk_3d( pt3d1, cd_type1, psgn) 
    142       CALL lbc_lnk_3d( pt3d2, cd_type2, psgn) 
    143       ! 
    144    END SUBROUTINE lbc_lnk_3d_gather 
    145  
     125   !!====================================================================== 
     126   !!     central point value replicated over the 8 surrounding points 
     127   !!---------------------------------------------------------------------- 
    146128 
    147129   SUBROUTINE lbc_lnk_3d( pt3d, cd_type, psgn, cd_mpp, pval ) 
     
    153135      !! ** Method  :   1D case, the central water column is set everywhere 
    154136      !!---------------------------------------------------------------------- 
    155       CHARACTER(len=1)                , INTENT(in   )           ::   cd_type   ! nature of pt3d grid-points 
    156       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout)           ::   pt3d      ! 3D array on which the lbc is applied 
    157       REAL(wp)                        , INTENT(in   )           ::   psgn      ! control of the sign  
    158       CHARACTER(len=3)                , INTENT(in   ), OPTIONAL ::   cd_mpp    ! MPP only (here do nothing) 
    159       REAL(wp)                        , INTENT(in   ), OPTIONAL ::   pval      ! background value (for closed boundaries) 
     137      REAL(wp), DIMENSION(:,:,:), INTENT(inout)           ::   pt3d      ! 3D array on which the lbc is applied 
     138      CHARACTER(len=1)          , INTENT(in   )           ::   cd_type   ! nature of pt3d grid-points 
     139      REAL(wp)                  , INTENT(in   )           ::   psgn      ! sign used across north fold  
     140      CHARACTER(len=3)          , INTENT(in   ), OPTIONAL ::   cd_mpp    ! MPP only (here do nothing) 
     141      REAL(wp)                  , INTENT(in   ), OPTIONAL ::   pval      ! background value (for closed boundaries) 
    160142      ! 
    161143      INTEGER  ::   jk     ! dummy loop index 
     
    163145      !!---------------------------------------------------------------------- 
    164146      ! 
    165       DO jk = 1, jpk 
     147      DO jk = 1, SIZE( pt3d, 3 ) 
    166148         ztab = pt3d(2,2,jk) 
    167149         pt3d(:,:,jk) = ztab 
     
    179161      !! ** Method  :   1D case, the central water column is set everywhere 
    180162      !!---------------------------------------------------------------------- 
     163      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout)           ::   pt2d      ! 2D array on which the lbc is applied 
    181164      CHARACTER(len=1)            , INTENT(in   )           ::   cd_type   ! nature of pt3d grid-points 
    182       REAL(wp), DIMENSION(jpi,jpj), INTENT(inout)           ::   pt2d      ! 2D array on which the lbc is applied 
    183       REAL(wp)                    , INTENT(in   )           ::   psgn      ! control of the sign  
     165      REAL(wp)                    , INTENT(in   )           ::   psgn      ! sign used across north fold  
    184166      CHARACTER(len=3)            , INTENT(in   ), OPTIONAL ::   cd_mpp    ! MPP only (here do nothing) 
    185167      REAL(wp)                    , INTENT(in   ), OPTIONAL ::   pval      ! background value (for closed boundaries) 
     
    193175   END SUBROUTINE lbc_lnk_2d 
    194176    
    195    SUBROUTINE lbc_lnk_2d_multiple( pt2d_array , type_array , psgn_array , num_fields ) 
    196       !! 
    197       INTEGER :: num_fields 
    198       TYPE( arrayptr ), DIMENSION(:) :: pt2d_array 
    199       CHARACTER(len=1), DIMENSION(:), INTENT(in   ) ::   type_array   ! define the nature of ptab array grid-points 
    200       !                                                               ! = T , U , V , F , W and I points 
    201       REAL(wp)        , DIMENSION(:), INTENT(in   ) ::   psgn_array   ! =-1 the sign change across the north fold boundary 
    202       !                                                               ! =  1. , the sign is kept 
    203       ! 
    204       INTEGER  ::   ii    !!MULTI SEND DUMMY LOOP INDICES 
    205       ! 
    206       DO ii = 1, num_fields 
    207         CALL lbc_lnk_2d( pt2d_array(ii)%pt2d, type_array(ii), psgn_array(ii) ) 
    208       END DO      
    209       ! 
    210    END SUBROUTINE lbc_lnk_2d_multiple 
    211  
    212    SUBROUTINE lbc_lnk_2d_9( pt2dA, cd_typeA, psgnA, pt2dB, cd_typeB, psgnB, pt2dC, cd_typeC, psgnC   & 
    213       &                   , pt2dD, cd_typeD, psgnD, pt2dE, cd_typeE, psgnE, pt2dF, cd_typeF, psgnF   & 
    214       &                   , pt2dG, cd_typeG, psgnG, pt2dH, cd_typeH, psgnH, pt2dI, cd_typeI, psgnI, cd_mpp, pval) 
    215       !!--------------------------------------------------------------------- 
    216       ! Second 2D array on which the boundary condition is applied 
    217       REAL(wp), DIMENSION(jpi,jpj), TARGET          , INTENT(inout) ::   pt2dA 
    218       REAL(wp), DIMENSION(jpi,jpj), TARGET, OPTIONAL, INTENT(inout) ::   pt2dB , pt2dC , pt2dD , pt2dE 
    219       REAL(wp), DIMENSION(jpi,jpj), TARGET, OPTIONAL, INTENT(inout) ::   pt2dF , pt2dG , pt2dH , pt2dI 
    220       ! define the nature of ptab array grid-points 
    221       CHARACTER(len=1)                              , INTENT(in   ) ::   cd_typeA 
    222       CHARACTER(len=1)                    , OPTIONAL, INTENT(in   ) ::   cd_typeB , cd_typeC , cd_typeD , cd_typeE 
    223       CHARACTER(len=1)                    , OPTIONAL, INTENT(in   ) ::   cd_typeF , cd_typeG , cd_typeH , cd_typeI 
    224       ! =-1 the sign change across the north fold boundary 
    225       REAL(wp)                                      , INTENT(in   ) ::   psgnA 
    226       REAL(wp)                            , OPTIONAL, INTENT(in   ) ::   psgnB , psgnC , psgnD , psgnE 
    227       REAL(wp)                            , OPTIONAL, INTENT(in   ) ::   psgnF , psgnG , psgnH , psgnI 
    228       CHARACTER(len=3)                    , OPTIONAL, INTENT(in   ) ::   cd_mpp   ! fill the overlap area only 
    229       REAL(wp)                            , OPTIONAL, INTENT(in   ) ::   pval     ! background value (used at closed boundaries) 
    230       !! 
    231       !!--------------------------------------------------------------------- 
    232  
    233       !!The first array 
    234       CALL lbc_lnk( pt2dA, cd_typeA, psgnA )  
    235  
    236       !! Look if more arrays to process 
    237       IF(PRESENT (psgnB) )CALL lbc_lnk( pt2dB, cd_typeB, psgnB ) 
    238       IF(PRESENT (psgnC) )CALL lbc_lnk( pt2dC, cd_typeC, psgnC )  
    239       IF(PRESENT (psgnD) )CALL lbc_lnk( pt2dD, cd_typeD, psgnD )  
    240       IF(PRESENT (psgnE) )CALL lbc_lnk( pt2dE, cd_typeE, psgnE )  
    241       IF(PRESENT (psgnF) )CALL lbc_lnk( pt2dF, cd_typeF, psgnF )  
    242       IF(PRESENT (psgnG) )CALL lbc_lnk( pt2dG, cd_typeG, psgnG )  
    243       IF(PRESENT (psgnH) )CALL lbc_lnk( pt2dH, cd_typeH, psgnH )  
    244       IF(PRESENT (psgnI) )CALL lbc_lnk( pt2dI, cd_typeI, psgnI )  
    245  
    246    END SUBROUTINE lbc_lnk_2d_9 
    247  
    248  
    249  
    250  
    251  
    252177#else 
    253    !!---------------------------------------------------------------------- 
     178   !!====================================================================== 
    254179   !!   Default option                           3D shared memory computing 
    255    !!---------------------------------------------------------------------- 
    256  
    257    SUBROUTINE lbc_lnk_3d_gather( pt3d1, cd_type1, pt3d2, cd_type2, psgn ) 
    258       !!--------------------------------------------------------------------- 
    259       !!                  ***  ROUTINE lbc_lnk_3d_gather  *** 
    260       !! 
    261       !! ** Purpose :   set lateral boundary conditions on two 3D arrays (non mpp case) 
    262       !! 
    263       !! ** Method  :   psign = -1 :    change the sign across the north fold 
    264       !!                      =  1 : no change of the sign across the north fold 
    265       !!                      =  0 : no change of the sign across the north fold and 
    266       !!                             strict positivity preserved: use inner row/column 
    267       !!                             for closed boundaries. 
    268       !!---------------------------------------------------------------------- 
    269       CHARACTER(len=1)                , INTENT(in   ) ::   cd_type1, cd_type2   ! nature of pt3d grid-points 
    270       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pt3d1   , pt3d2      ! 3D array on which the lbc is applied 
    271       REAL(wp)                        , INTENT(in   ) ::   psgn                 ! control of the sign  
    272       !!---------------------------------------------------------------------- 
    273       ! 
    274       CALL lbc_lnk_3d( pt3d1, cd_type1, psgn) 
    275       CALL lbc_lnk_3d( pt3d2, cd_type2, psgn) 
    276       ! 
    277    END SUBROUTINE lbc_lnk_3d_gather 
    278  
    279  
    280    SUBROUTINE lbc_lnk_3d( pt3d, cd_type, psgn, cd_mpp, pval ) 
    281       !!--------------------------------------------------------------------- 
    282       !!                  ***  ROUTINE lbc_lnk_3d  *** 
    283       !! 
    284       !! ** Purpose :   set lateral boundary conditions on a 3D array (non mpp case) 
    285       !! 
    286       !! ** Method  :   psign = -1 :    change the sign across the north fold 
    287       !!                      =  1 : no change of the sign across the north fold 
    288       !!                      =  0 : no change of the sign across the north fold and 
    289       !!                             strict positivity preserved: use inner row/column 
    290       !!                             for closed boundaries. 
    291       !!---------------------------------------------------------------------- 
    292       CHARACTER(len=1)                , INTENT(in   )           ::   cd_type   ! nature of pt3d grid-points 
    293       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout)           ::   pt3d      ! 3D array on which the lbc is applied 
    294       REAL(wp)                        , INTENT(in   )           ::   psgn      ! control of the sign  
    295       CHARACTER(len=3)                , INTENT(in   ), OPTIONAL ::   cd_mpp    ! MPP only (here do nothing) 
    296       REAL(wp)                        , INTENT(in   ), OPTIONAL ::   pval      ! background value (for closed boundaries) 
    297       !! 
    298       REAL(wp) ::   zland 
    299       !!---------------------------------------------------------------------- 
    300  
    301       IF( PRESENT( pval ) ) THEN   ;   zland = pval      ! set land value (zero by default) 
    302       ELSE                         ;   zland = 0._wp 
    303       ENDIF 
    304  
    305  
    306       IF( PRESENT( cd_mpp ) ) THEN 
    307          ! only fill the overlap area and extra allows  
    308          ! this is in mpp case. In this module, just do nothing 
    309       ELSE 
    310          !                                     !  East-West boundaries 
    311          !                                     ! ====================== 
    312          SELECT CASE ( nperio ) 
    313          ! 
    314          CASE ( 1 , 4 , 6 )                       !**  cyclic east-west 
    315             pt3d( 1 ,:,:) = pt3d(jpim1,:,:)            ! all points 
    316             pt3d(jpi,:,:) = pt3d(  2  ,:,:) 
    317             ! 
    318          CASE DEFAULT                             !**  East closed  --  West closed 
    319             SELECT CASE ( cd_type ) 
    320             CASE ( 'T' , 'U' , 'V' , 'W' )             ! T-, U-, V-, W-points 
    321                pt3d( 1 ,:,:) = zland 
    322                pt3d(jpi,:,:) = zland 
    323             CASE ( 'F' )                               ! F-point 
    324                pt3d(jpi,:,:) = zland 
    325             END SELECT 
    326             ! 
    327          END SELECT 
    328          !                                     ! North-South boundaries 
    329          !                                     ! ====================== 
    330          SELECT CASE ( nperio ) 
    331          ! 
    332          CASE ( 2 )                               !**  South symmetric  --  North closed 
    333             SELECT CASE ( cd_type ) 
    334             CASE ( 'T' , 'U' , 'W' )                   ! T-, U-, W-points 
    335                pt3d(:, 1 ,:) = pt3d(:,3,:) 
    336                pt3d(:,jpj,:) = zland 
    337             CASE ( 'V' , 'F' )                         ! V-, F-points 
    338                pt3d(:, 1 ,:) = psgn * pt3d(:,2,:) 
    339                pt3d(:,jpj,:) = zland 
    340             END SELECT 
    341             ! 
    342          CASE ( 3 , 4 , 5 , 6 )                   !**  North fold  T or F-point pivot  --  South closed 
    343             SELECT CASE ( cd_type )                    ! South : closed 
    344             CASE ( 'T' , 'U' , 'V' , 'W' , 'I' )             ! all points except F-point 
    345                pt3d(:, 1 ,:) = zland 
    346             END SELECT 
    347             !                                          ! North fold 
    348             CALL lbc_nfd( pt3d(:,:,:), cd_type, psgn ) 
    349             ! 
    350          CASE DEFAULT                             !**  North closed  --  South closed 
    351             SELECT CASE ( cd_type ) 
    352             CASE ( 'T' , 'U' , 'V' , 'W' )             ! T-, U-, V-, W-points 
    353                pt3d(:, 1 ,:) = zland 
    354                pt3d(:,jpj,:) = zland 
    355             CASE ( 'F' )                               ! F-point 
    356                pt3d(:,jpj,:) = zland 
    357             END SELECT 
    358             ! 
    359          END SELECT 
    360          ! 
    361       ENDIF 
    362       ! 
    363    END SUBROUTINE lbc_lnk_3d 
    364  
    365  
    366    SUBROUTINE lbc_lnk_2d( pt2d, cd_type, psgn, cd_mpp, pval ) 
    367       !!--------------------------------------------------------------------- 
    368       !!                 ***  ROUTINE lbc_lnk_2d  *** 
    369       !! 
    370       !! ** Purpose :   set lateral boundary conditions on a 2D array (non mpp case) 
    371       !! 
    372       !! ** Method  :   psign = -1 :    change the sign across the north fold 
    373       !!                      =  1 : no change of the sign across the north fold 
    374       !!                      =  0 : no change of the sign across the north fold and 
    375       !!                             strict positivity preserved: use inner row/column 
    376       !!                             for closed boundaries. 
    377       !!---------------------------------------------------------------------- 
    378       CHARACTER(len=1)            , INTENT(in   )           ::   cd_type   ! nature of pt3d grid-points 
    379       REAL(wp), DIMENSION(jpi,jpj), INTENT(inout)           ::   pt2d      ! 2D array on which the lbc is applied 
    380       REAL(wp)                    , INTENT(in   )           ::   psgn      ! control of the sign  
    381       CHARACTER(len=3)            , INTENT(in   ), OPTIONAL ::   cd_mpp    ! MPP only (here do nothing) 
    382       REAL(wp)                    , INTENT(in   ), OPTIONAL ::   pval      ! background value (for closed boundaries) 
    383       !! 
    384       REAL(wp) ::   zland 
    385       !!---------------------------------------------------------------------- 
    386  
    387       IF( PRESENT( pval ) ) THEN   ;   zland = pval      ! set land value (zero by default) 
    388       ELSE                         ;   zland = 0._wp 
    389       ENDIF 
    390  
    391       IF (PRESENT(cd_mpp)) THEN 
    392          ! only fill the overlap area and extra allows  
    393          ! this is in mpp case. In this module, just do nothing 
    394       ELSE       
    395          !                                     ! East-West boundaries 
    396          !                                     ! ==================== 
    397          SELECT CASE ( nperio ) 
    398          ! 
    399          CASE ( 1 , 4 , 6 )                       !** cyclic east-west 
    400             pt2d( 1 ,:) = pt2d(jpim1,:)               ! all points 
    401             pt2d(jpi,:) = pt2d(  2  ,:) 
    402             ! 
    403          CASE DEFAULT                             !** East closed  --  West closed 
    404             SELECT CASE ( cd_type ) 
    405             CASE ( 'T' , 'U' , 'V' , 'W' )            ! T-, U-, V-, W-points 
    406                pt2d( 1 ,:) = zland 
    407                pt2d(jpi,:) = zland 
    408             CASE ( 'F' )                              ! F-point 
    409                pt2d(jpi,:) = zland 
    410             END SELECT 
    411             ! 
    412          END SELECT 
    413          !                                     ! North-South boundaries 
    414          !                                     ! ====================== 
    415          SELECT CASE ( nperio ) 
    416          ! 
    417          CASE ( 2 )                               !**  South symmetric  --  North closed 
    418             SELECT CASE ( cd_type ) 
    419             CASE ( 'T' , 'U' , 'W' )                   ! T-, U-, W-points 
    420                pt2d(:, 1 ) = pt2d(:,3) 
    421                pt2d(:,jpj) = zland 
    422             CASE ( 'V' , 'F' )                         ! V-, F-points 
    423                pt2d(:, 1 ) = psgn * pt2d(:,2) 
    424                pt2d(:,jpj) = zland 
    425             END SELECT 
    426             ! 
    427          CASE ( 3 , 4 , 5 , 6 )                   !**  North fold  T or F-point pivot  --  South closed 
    428             SELECT CASE ( cd_type )                    ! South : closed 
    429             CASE ( 'T' , 'U' , 'V' , 'W' , 'I' )             ! all points except F-point 
    430                pt2d(:, 1 ) = zland 
    431             END SELECT 
    432             !                                          ! North fold 
    433             CALL lbc_nfd( pt2d(:,:), cd_type, psgn ) 
    434             ! 
    435          CASE DEFAULT                             !**  North closed  --  South closed 
    436             SELECT CASE ( cd_type ) 
    437             CASE ( 'T' , 'U' , 'V' , 'W' )             ! T-, U-, V-, W-points 
    438                pt2d(:, 1 ) = zland 
    439                pt2d(:,jpj) = zland 
    440             CASE ( 'F' )                               ! F-point 
    441                pt2d(:,jpj) = zland 
    442             END SELECT 
    443             ! 
    444          END SELECT 
    445          ! 
    446       ENDIF 
    447       !     
    448    END SUBROUTINE lbc_lnk_2d 
    449     
    450    SUBROUTINE lbc_lnk_2d_multiple( pt2d_array , type_array , psgn_array , num_fields ) 
    451       !! 
    452       INTEGER :: num_fields 
    453       TYPE( arrayptr ), DIMENSION(:) :: pt2d_array 
    454       CHARACTER(len=1), DIMENSION(:), INTENT(in   ) ::   type_array   ! define the nature of ptab array grid-points 
    455       !                                                               ! = T , U , V , F , W and I points 
    456       REAL(wp)        , DIMENSION(:), INTENT(in   ) ::   psgn_array   ! =-1 the sign change across the north fold boundary 
    457       !                                                               ! =  1. , the sign is kept 
    458       ! 
    459       INTEGER  ::   ii    !!MULTI SEND DUMMY LOOP INDICES 
    460       ! 
    461       DO ii = 1, num_fields 
    462         CALL lbc_lnk_2d( pt2d_array(ii)%pt2d, type_array(ii), psgn_array(ii) ) 
    463       END DO      
    464       ! 
    465    END SUBROUTINE lbc_lnk_2d_multiple 
    466  
    467    SUBROUTINE lbc_lnk_2d_9( pt2dA, cd_typeA, psgnA, pt2dB, cd_typeB, psgnB, pt2dC, cd_typeC, psgnC   & 
    468       &                   , pt2dD, cd_typeD, psgnD, pt2dE, cd_typeE, psgnE, pt2dF, cd_typeF, psgnF   & 
    469       &                   , pt2dG, cd_typeG, psgnG, pt2dH, cd_typeH, psgnH, pt2dI, cd_typeI, psgnI, cd_mpp, pval) 
    470       !!--------------------------------------------------------------------- 
    471       ! Second 2D array on which the boundary condition is applied 
    472       REAL(wp), DIMENSION(jpi,jpj), TARGET          , INTENT(inout) ::   pt2dA 
    473       REAL(wp), DIMENSION(jpi,jpj), TARGET, OPTIONAL, INTENT(inout) ::   pt2dB , pt2dC , pt2dD , pt2dE 
    474       REAL(wp), DIMENSION(jpi,jpj), TARGET, OPTIONAL, INTENT(inout) ::   pt2dF , pt2dG , pt2dH , pt2dI 
    475       ! define the nature of ptab array grid-points 
    476       CHARACTER(len=1)                              , INTENT(in   ) ::   cd_typeA 
    477       CHARACTER(len=1)                    , OPTIONAL, INTENT(in   ) ::   cd_typeB , cd_typeC , cd_typeD , cd_typeE 
    478       CHARACTER(len=1)                    , OPTIONAL, INTENT(in   ) ::   cd_typeF , cd_typeG , cd_typeH , cd_typeI 
    479       ! =-1 the sign change across the north fold boundary 
    480       REAL(wp)                                      , INTENT(in   ) ::   psgnA 
    481       REAL(wp)                            , OPTIONAL, INTENT(in   ) ::   psgnB , psgnC , psgnD , psgnE 
    482       REAL(wp)                            , OPTIONAL, INTENT(in   ) ::   psgnF , psgnG , psgnH , psgnI 
    483       CHARACTER(len=3)                    , OPTIONAL, INTENT(in   ) ::   cd_mpp   ! fill the overlap area only 
    484       REAL(wp)                            , OPTIONAL, INTENT(in   ) ::   pval     ! background value (used at closed boundaries) 
    485       !! 
    486       !!--------------------------------------------------------------------- 
    487  
    488       !!The first array 
    489       CALL lbc_lnk( pt2dA, cd_typeA, psgnA )  
    490  
    491       !! Look if more arrays to process 
    492       IF(PRESENT (psgnB) )CALL lbc_lnk( pt2dB, cd_typeB, psgnB ) 
    493       IF(PRESENT (psgnC) )CALL lbc_lnk( pt2dC, cd_typeC, psgnC )  
    494       IF(PRESENT (psgnD) )CALL lbc_lnk( pt2dD, cd_typeD, psgnD )  
    495       IF(PRESENT (psgnE) )CALL lbc_lnk( pt2dE, cd_typeE, psgnE )  
    496       IF(PRESENT (psgnF) )CALL lbc_lnk( pt2dF, cd_typeF, psgnF )  
    497       IF(PRESENT (psgnG) )CALL lbc_lnk( pt2dG, cd_typeG, psgnG )  
    498       IF(PRESENT (psgnH) )CALL lbc_lnk( pt2dH, cd_typeH, psgnH )  
    499       IF(PRESENT (psgnI) )CALL lbc_lnk( pt2dI, cd_typeI, psgnI )  
    500  
    501    END SUBROUTINE lbc_lnk_2d_9 
    502  
    503    SUBROUTINE lbc_lnk_sum_2d( pt2d, cd_type, psgn, cd_mpp, pval ) 
    504       !!--------------------------------------------------------------------- 
    505       !!                 ***  ROUTINE lbc_lnk_sum_2d  *** 
    506       !! 
    507       !! ** Purpose :   set lateral boundary conditions on a 2D array (non mpp case) 
    508       !! 
    509       !! ** Comments:   compute the sum of the common cell (overlap region) for the ice sheet/ocean  
    510       !!                coupling if conservation option activated. As no ice shelf are present along 
    511       !!                this line, nothing is done along the north fold. 
    512       !!---------------------------------------------------------------------- 
    513       CHARACTER(len=1)            , INTENT(in   )           ::   cd_type   ! nature of pt3d grid-points 
    514       REAL(wp), DIMENSION(jpi,jpj), INTENT(inout)           ::   pt2d      ! 2D array on which the lbc is applied 
    515       REAL(wp)                    , INTENT(in   )           ::   psgn      ! control of the sign  
    516       CHARACTER(len=3)            , INTENT(in   ), OPTIONAL ::   cd_mpp    ! MPP only (here do nothing) 
    517       REAL(wp)                    , INTENT(in   ), OPTIONAL ::   pval      ! background value (for closed boundaries) 
    518       !! 
    519       REAL(wp) ::   zland 
    520       !!---------------------------------------------------------------------- 
    521  
    522       IF( PRESENT( pval ) ) THEN   ;   zland = pval      ! set land value (zero by default) 
    523       ELSE                         ;   zland = 0._wp 
    524       ENDIF 
    525  
    526       IF (PRESENT(cd_mpp)) THEN 
    527          ! only fill the overlap area and extra allows  
    528          ! this is in mpp case. In this module, just do nothing 
    529       ELSE 
    530          !                                     ! East-West boundaries 
    531          !                                     ! ==================== 
    532          SELECT CASE ( nperio ) 
    533          ! 
    534          CASE ( 1 , 4 , 6 )                       !** cyclic east-west 
    535             pt2d(jpim1,:) = pt2d(jpim1,:) + pt2d( 1 ,:) 
    536             pt2d(  2  ,:) = pt2d(  2  ,:) + pt2d(jpi,:) 
    537             pt2d( 1 ,:) = 0.0_wp               ! all points 
    538             pt2d(jpi,:) = 0.0_wp 
    539             ! 
    540          CASE DEFAULT                             !** East closed  --  West closed 
    541             SELECT CASE ( cd_type ) 
    542             CASE ( 'T' , 'U' , 'V' , 'W' )            ! T-, U-, V-, W-points 
    543                pt2d( 1 ,:) = zland 
    544                pt2d(jpi,:) = zland 
    545             CASE ( 'F' )                              ! F-point 
    546                pt2d(jpi,:) = zland 
    547             END SELECT 
    548             ! 
    549          END SELECT 
    550          !                                     ! North-South boundaries 
    551          !                                     ! ====================== 
    552          ! Nothing to do for the north fold, there is no ice shelf along this line. 
    553          ! 
    554       END IF 
    555  
    556    END SUBROUTINE 
    557  
    558    SUBROUTINE lbc_lnk_sum_3d( pt3d, cd_type, psgn, cd_mpp, pval ) 
    559       !!--------------------------------------------------------------------- 
    560       !!                 ***  ROUTINE lbc_lnk_sum_3d  *** 
    561       !! 
    562       !! ** Purpose :   set lateral boundary conditions on a 3D array (non mpp case) 
    563       !! 
    564       !! ** Comments:   compute the sum of the common cell (overlap region) for the ice sheet/ocean  
    565       !!                coupling if conservation option activated. As no ice shelf are present along 
    566       !!                this line, nothing is done along the north fold. 
    567       !!---------------------------------------------------------------------- 
    568       CHARACTER(len=1)                , INTENT(in   )           ::   cd_type   ! nature of pt3d grid-points 
    569       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout)           ::   pt3d      ! 3D array on which the lbc is applied 
    570       REAL(wp)                        , INTENT(in   )           ::   psgn      ! control of the sign  
    571       CHARACTER(len=3)                , INTENT(in   ), OPTIONAL ::   cd_mpp    ! MPP only (here do nothing) 
    572       REAL(wp)                        , INTENT(in   ), OPTIONAL ::   pval      ! background value (for closed boundaries) 
    573       !! 
    574       REAL(wp) ::   zland 
    575       !!---------------------------------------------------------------------- 
    576  
    577       IF( PRESENT( pval ) ) THEN   ;   zland = pval      ! set land value (zero by default) 
    578       ELSE                         ;   zland = 0._wp 
    579       ENDIF 
    580  
    581  
    582       IF( PRESENT( cd_mpp ) ) THEN 
    583          ! only fill the overlap area and extra allows  
    584          ! this is in mpp case. In this module, just do nothing 
    585       ELSE 
    586          !                                     !  East-West boundaries 
    587          !                                     ! ====================== 
    588          SELECT CASE ( nperio ) 
    589          ! 
    590          CASE ( 1 , 4 , 6 )                       !**  cyclic east-west 
    591             pt3d(jpim1,:,:) = pt3d(jpim1,:,:) + pt3d( 1 ,:,:) 
    592             pt3d(  2  ,:,:) = pt3d(  2  ,:,:) + pt3d(jpi,:,:)  
    593             pt3d( 1 ,:,:) = 0.0_wp            ! all points 
    594             pt3d(jpi,:,:) = 0.0_wp 
    595             ! 
    596          CASE DEFAULT                             !**  East closed  --  West closed 
    597             SELECT CASE ( cd_type ) 
    598             CASE ( 'T' , 'U' , 'V' , 'W' )             ! T-, U-, V-, W-points 
    599                pt3d( 1 ,:,:) = zland 
    600                pt3d(jpi,:,:) = zland 
    601             CASE ( 'F' )                               ! F-point 
    602                pt3d(jpi,:,:) = zland 
    603             END SELECT 
    604             ! 
    605          END SELECT 
    606          !                                     ! North-South boundaries 
    607          !                                     ! ====================== 
    608          ! Nothing to do for the north fold, there is no ice shelf along this line. 
    609          ! 
    610       END IF 
    611    END SUBROUTINE 
    612  
    613  
     180   !!====================================================================== 
     181   !!          routines setting land point, or east-west cyclic, 
     182   !!             or north-south cyclic, or north fold values 
     183   !!         on first and last row and column of the global domain 
     184   !!---------------------------------------------------------------------- 
     185 
     186   !!---------------------------------------------------------------------- 
     187   !!                   ***  routine lbc_lnk_(2,3,4)d  *** 
     188   !! 
     189   !!   * Argument : dummy argument use in lbc_lnk_... routines 
     190   !!                ptab   :   array or pointer of arrays on which the boundary condition is applied 
     191   !!                cd_nat :   nature of array grid-points 
     192   !!                psgn   :   sign used across the north fold boundary 
     193   !!                kfld   :   optional, number of pt3d arrays 
     194   !!                cd_mpp :   optional, fill the overlap area only 
     195   !!                pval   :   optional, background value (used at closed boundaries) 
     196   !!---------------------------------------------------------------------- 
     197   ! 
     198   !                       !==  2D array and array of 2D pointer  ==! 
     199   ! 
     200#  define DIM_2d 
     201#     define ROUTINE_LNK           lbc_lnk_2d 
     202#     include "lbc_lnk_generic.h90" 
     203#     undef ROUTINE_LNK 
     204#     define MULTI 
     205#     define ROUTINE_LNK           lbc_lnk_2d_ptr 
     206#     include "lbc_lnk_generic.h90" 
     207#     undef ROUTINE_LNK 
     208#     undef MULTI 
     209#  undef DIM_2d 
     210   ! 
     211   !                       !==  3D array and array of 3D pointer  ==! 
     212   ! 
     213#  define DIM_3d 
     214#     define ROUTINE_LNK           lbc_lnk_3d 
     215#     include "lbc_lnk_generic.h90" 
     216#     undef ROUTINE_LNK 
     217#     define MULTI 
     218#     define ROUTINE_LNK           lbc_lnk_3d_ptr 
     219#     include "lbc_lnk_generic.h90" 
     220#     undef ROUTINE_LNK 
     221#     undef MULTI 
     222#  undef DIM_3d 
     223   ! 
     224   !                       !==  4D array and array of 4D pointer  ==! 
     225   ! 
     226#  define DIM_4d 
     227#     define ROUTINE_LNK           lbc_lnk_4d 
     228#     include "lbc_lnk_generic.h90" 
     229#     undef ROUTINE_LNK 
     230#     define MULTI 
     231#     define ROUTINE_LNK           lbc_lnk_4d_ptr 
     232#     include "lbc_lnk_generic.h90" 
     233#     undef ROUTINE_LNK 
     234#     undef MULTI 
     235#  undef DIM_4d 
     236    
    614237#endif 
    615238 
     239   !!====================================================================== 
     240   !!   identical routines in both C1D and shared memory computing 
     241   !!====================================================================== 
     242 
     243   !!---------------------------------------------------------------------- 
     244   !!                   ***  routine lbc_bdy_lnk_(2,3)d  *** 
     245   !! 
     246   !!   wrapper rountine to 'lbc_lnk_3d'. This wrapper is used 
     247   !!   to maintain the same interface with regards to the mpp case 
     248   !!---------------------------------------------------------------------- 
     249    
    616250   SUBROUTINE lbc_bdy_lnk_3d( pt3d, cd_type, psgn, ib_bdy ) 
    617       !!--------------------------------------------------------------------- 
    618       !!                  ***  ROUTINE lbc_bdy_lnk  *** 
    619       !! 
    620       !! ** Purpose :   wrapper rountine to 'lbc_lnk_3d'. This wrapper is used 
    621       !!              to maintain the same interface with regards to the mpp case 
    622       !! 
    623       !!---------------------------------------------------------------------- 
    624       CHARACTER(len=1)                , INTENT(in   ) ::   cd_type   ! nature of pt3d grid-points 
    625       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pt3d      ! 3D array on which the lbc is applied 
    626       REAL(wp)                        , INTENT(in   ) ::   psgn      ! control of the sign  
    627       INTEGER                         , INTENT(in   ) ::   ib_bdy    ! BDY boundary set 
    628       !!---------------------------------------------------------------------- 
    629       ! 
     251      !!---------------------------------------------------------------------- 
     252      REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   pt3d      ! 3D array on which the lbc is applied 
     253      CHARACTER(len=1)          , INTENT(in   ) ::   cd_type   ! nature of pt3d grid-points 
     254      REAL(wp)                  , INTENT(in   ) ::   psgn      ! sign used across north fold  
     255      INTEGER                   , INTENT(in   ) ::   ib_bdy    ! BDY boundary set 
     256      !!---------------------------------------------------------------------- 
    630257      CALL lbc_lnk_3d( pt3d, cd_type, psgn) 
    631       ! 
    632258   END SUBROUTINE lbc_bdy_lnk_3d 
    633259 
    634260 
    635261   SUBROUTINE lbc_bdy_lnk_2d( pt2d, cd_type, psgn, ib_bdy ) 
    636       !!--------------------------------------------------------------------- 
    637       !!                  ***  ROUTINE lbc_bdy_lnk  *** 
    638       !! 
    639       !! ** Purpose :   wrapper rountine to 'lbc_lnk_3d'. This wrapper is used 
    640       !!              to maintain the same interface with regards to the mpp case 
    641       !! 
    642       !!---------------------------------------------------------------------- 
    643       CHARACTER(len=1)            , INTENT(in   ) ::   cd_type   ! nature of pt3d grid-points 
    644       REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   pt2d      ! 3D array on which the lbc is applied 
    645       REAL(wp)                    , INTENT(in   ) ::   psgn      ! control of the sign  
    646       INTEGER                     , INTENT(in   ) ::   ib_bdy    ! BDY boundary set 
    647       !!---------------------------------------------------------------------- 
    648       ! 
     262      !!---------------------------------------------------------------------- 
     263      REAL(wp), DIMENSION(:,:), INTENT(inout) ::   pt2d      ! 3D array on which the lbc is applied 
     264      CHARACTER(len=1)        , INTENT(in   ) ::   cd_type   ! nature of pt3d grid-points 
     265      REAL(wp)                , INTENT(in   ) ::   psgn      ! sign used across north fold  
     266      INTEGER                 , INTENT(in   ) ::   ib_bdy    ! BDY boundary set 
     267      !!---------------------------------------------------------------------- 
    649268      CALL lbc_lnk_2d( pt2d, cd_type, psgn) 
    650       ! 
    651269   END SUBROUTINE lbc_bdy_lnk_2d 
    652270 
    653271 
    654    SUBROUTINE lbc_lnk_2d_e( pt2d, cd_type, psgn, jpri, jprj ) 
    655       !!--------------------------------------------------------------------- 
    656       !!                 ***  ROUTINE lbc_lnk_2d  *** 
    657       !! 
    658       !! ** Purpose :   set lateral boundary conditions on a 2D array (non mpp case) 
    659       !!                special dummy routine to allow for use of halo indexing in mpp case 
    660       !! 
    661       !! ** Method  :   psign = -1 :    change the sign across the north fold 
    662       !!                      =  1 : no change of the sign across the north fold 
    663       !!                      =  0 : no change of the sign across the north fold and 
    664       !!                             strict positivity preserved: use inner row/column 
    665       !!                             for closed boundaries. 
    666       !!---------------------------------------------------------------------- 
    667       CHARACTER(len=1)            , INTENT(in   ) ::   cd_type   ! nature of pt3d grid-points 
    668       REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   pt2d      ! 2D array on which the lbc is applied 
    669       REAL(wp)                    , INTENT(in   ) ::   psgn      ! control of the sign  
    670       INTEGER                     , INTENT(in   ) ::   jpri      ! size of extra halo (not needed in non-mpp) 
    671       INTEGER                     , INTENT(in   ) ::   jprj      ! size of extra halo (not needed in non-mpp) 
    672       !!---------------------------------------------------------------------- 
    673       ! 
     272!!gm  This routine should be remove with an optional halos size added in orgument of generic routines 
     273 
     274   SUBROUTINE lbc_lnk_2d_e( pt2d, cd_type, psgn, ki, kj ) 
     275      !!---------------------------------------------------------------------- 
     276      REAL(wp), DIMENSION(:,:), INTENT(inout) ::   pt2d      ! 2D array on which the lbc is applied 
     277      CHARACTER(len=1)        , INTENT(in   ) ::   cd_type   ! nature of pt3d grid-points 
     278      REAL(wp)                , INTENT(in   ) ::   psgn      ! sign used across north fold  
     279      INTEGER                 , INTENT(in   ) ::   ki, kj    ! sizes of extra halo (not needed in non-mpp) 
     280      !!---------------------------------------------------------------------- 
    674281      CALL lbc_lnk_2d( pt2d, cd_type, psgn ) 
    675       !     
    676282   END SUBROUTINE lbc_lnk_2d_e 
     283!!gm end 
    677284 
    678285#endif 
    679286 
    680287   !!====================================================================== 
     288   !!   identical routines in both distributed and shared memory computing 
     289   !!====================================================================== 
     290 
     291   !!---------------------------------------------------------------------- 
     292   !!                   ***   load_ptr_(2,3,4)d   *** 
     293   !! 
     294   !!   * Dummy Argument : 
     295   !!       in    ==>   ptab       ! array to be loaded (2D, 3D or 4D) 
     296   !!                   cd_nat     ! nature of pt2d array grid-points 
     297   !!                   psgn       ! sign used across the north fold boundary 
     298   !!       inout <=>   ptab_ptr   ! array of 2D, 3D or 4D pointers 
     299   !!                   cdna_ptr   ! nature of ptab array grid-points 
     300   !!                   psgn_ptr   ! sign used across the north fold boundary 
     301   !!                   kfld       ! number of elements that has been attributed 
     302   !!---------------------------------------------------------------------- 
     303 
     304   !!---------------------------------------------------------------------- 
     305   !!                  ***   lbc_lnk_(2,3,4)d_multi   *** 
     306   !!                     ***   load_ptr_(2,3,4)d   *** 
     307   !! 
     308   !!   * Argument : dummy argument use in lbc_lnk_multi_... routines 
     309   !! 
     310   !!---------------------------------------------------------------------- 
     311 
     312#  define DIM_2d 
     313#     define ROUTINE_MULTI          lbc_lnk_2d_multi 
     314#     define ROUTINE_LOAD           load_ptr_2d 
     315#     include "lbc_lnk_multi_generic.h90" 
     316#     undef ROUTINE_MULTI 
     317#     undef ROUTINE_LOAD 
     318#  undef DIM_2d 
     319 
     320 
     321#  define DIM_3d 
     322#     define ROUTINE_MULTI          lbc_lnk_3d_multi 
     323#     define ROUTINE_LOAD           load_ptr_3d 
     324#     include "lbc_lnk_multi_generic.h90" 
     325#     undef ROUTINE_MULTI 
     326#     undef ROUTINE_LOAD 
     327#  undef DIM_3d 
     328 
     329 
     330#  define DIM_4d 
     331#     define ROUTINE_MULTI          lbc_lnk_4d_multi 
     332#     define ROUTINE_LOAD           load_ptr_4d 
     333#     include "lbc_lnk_multi_generic.h90" 
     334#     undef ROUTINE_MULTI 
     335#     undef ROUTINE_LOAD 
     336#  undef DIM_4d 
     337 
     338   !!====================================================================== 
    681339END MODULE lbclnk 
    682340 
Note: See TracChangeset for help on using the changeset viewer.