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 7351 for branches/2016/dev_INGV_UKMO_2016/NEMOGCM/NEMO/OPA_SRC/LBC/lbclnk.F90 – NEMO

Ignore:
Timestamp:
2016-11-28T17:04:10+01:00 (7 years ago)
Author:
emanuelaclementi
Message:

ticket #1805 step 3: /2016/dev_INGV_UKMO_2016 aligned to the trunk at revision 7161

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/2016/dev_INGV_UKMO_2016/NEMOGCM/NEMO/OPA_SRC/LBC/lbclnk.F90

    r5429 r7351  
    44   !! Ocean        : lateral boundary conditions 
    55   !!===================================================================== 
    6    !! History :  OPA  ! 1997-06  (G. Madec)     Original code 
    7    !!   NEMO     1.0  ! 2002-09  (G. Madec)     F90: Free form and module 
     6   !! History :  OPA  ! 1997-06  (G. Madec)  Original code 
     7   !!   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) Add 'lbc_bdy_lnk'  
    10    !!                            and lbc_obc_lnk' routine to optimize   
    11    !!                            the BDY/OBC communications 
    12    !!            3.4  ! 2012-12  (R. Bourdalle-Badie and G. Reffray)  add a C1D case   
     9   !!            3.5  ! 2012     (S.Mocavero, I. Epicoco) optimization of BDY comm. via lbc_bdy_lnk and lbc_obc_lnk 
     10   !!            3.4  ! 2012-12  (R. Bourdalle-Badie, G. Reffray)  add a C1D case   
     11   !!            3.6  ! 2015-06  (O. Tintó and M. Castrillo)  add lbc_lnk_multi   
    1312   !!---------------------------------------------------------------------- 
    1413#if defined key_mpp_mpi 
     
    1716   !!---------------------------------------------------------------------- 
    1817   !!   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 
    1919   !!   lbc_lnk_e    : generic interface for mpp_lnk_2d_e routine defined in lib_mpp 
    2020   !!   lbc_bdy_lnk  : generic interface for mpp_lnk_bdy_2d and mpp_lnk_bdy_3d routines defined in lib_mpp 
    2121   !!---------------------------------------------------------------------- 
    22    USE lib_mpp          ! distributed memory computing library 
    23  
     22   USE lib_mpp        ! distributed memory computing library 
    2423 
    2524   INTERFACE lbc_lnk_multi 
    26       MODULE PROCEDURE mpp_lnk_2d_9 
    27    END INTERFACE 
    28  
     25      MODULE PROCEDURE mpp_lnk_2d_9, mpp_lnk_2d_multiple 
     26   END INTERFACE 
     27   ! 
    2928   INTERFACE lbc_lnk 
    3029      MODULE PROCEDURE mpp_lnk_3d_gather, mpp_lnk_3d, mpp_lnk_2d 
    3130   END INTERFACE 
    32  
     31   ! 
     32   INTERFACE lbc_sum 
     33      MODULE PROCEDURE mpp_lnk_sum_3d, mpp_lnk_sum_2d 
     34   END INTERFACE 
     35   ! 
    3336   INTERFACE lbc_bdy_lnk 
    3437      MODULE PROCEDURE mpp_lnk_bdy_2d, mpp_lnk_bdy_3d 
    3538   END INTERFACE 
    36  
     39   ! 
    3740   INTERFACE lbc_lnk_e 
    3841      MODULE PROCEDURE mpp_lnk_2d_e 
    3942   END INTERFACE 
    40  
     43   ! 
    4144   INTERFACE lbc_lnk_icb 
    4245      MODULE PROCEDURE mpp_lnk_2d_icb 
    4346   END INTERFACE 
    4447 
    45    PUBLIC lbc_lnk       ! ocean lateral boundary conditions 
    46    PUBLIC lbc_lnk_multi ! modified ocean lateral boundary conditions 
    47    PUBLIC lbc_lnk_e 
    48    PUBLIC lbc_bdy_lnk   ! ocean lateral BDY boundary conditions 
    49    PUBLIC lbc_lnk_icb 
     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_bdy_lnk   ! ocean lateral BDY boundary conditions 
     53   PUBLIC   lbc_lnk_icb   ! 
    5054 
    5155   !!---------------------------------------------------------------------- 
     
    5458   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    5559   !!---------------------------------------------------------------------- 
    56  
    5760#else 
    5861   !!---------------------------------------------------------------------- 
    5962   !!   Default option                              shared memory computing 
    6063   !!---------------------------------------------------------------------- 
    61    !!   lbc_lnk      : generic interface for lbc_lnk_3d and lbc_lnk_2d 
    62    !!   lbc_lnk_3d   : set the lateral boundary condition on a 3D variable on ocean mesh 
    63    !!   lbc_lnk_2d   : set the lateral boundary condition on a 2D variable on ocean mesh 
    64    !!   lbc_bdy_lnk  : set the lateral BDY boundary condition 
     64   !!   lbc_sum       : generic interface for mpp_lnk_sum_3d and mpp_lnk_sum_2d  
     65   !!   lbc_lnk_sum_3d: compute sum over the halos on a 3D variable on ocean mesh 
     66   !!   lbc_lnk_sum_3d: compute sum over the halos on a 2D variable on ocean mesh 
     67   !!   lbc_lnk       : generic interface for lbc_lnk_3d and lbc_lnk_2d 
     68   !!   lbc_lnk_3d    : set the lateral boundary condition on a 3D variable on ocean mesh 
     69   !!   lbc_lnk_2d    : set the lateral boundary condition on a 2D variable on ocean mesh 
     70   !!   lbc_bdy_lnk   : set the lateral BDY boundary condition 
    6571   !!---------------------------------------------------------------------- 
    6672   USE oce             ! ocean dynamics and tracers    
     
    7581      MODULE PROCEDURE lbc_lnk_3d_gather, lbc_lnk_3d, lbc_lnk_2d 
    7682   END INTERFACE 
     83   ! 
     84   INTERFACE lbc_sum 
     85      MODULE PROCEDURE lbc_lnk_sum_3d, lbc_lnk_sum_2d 
     86   END INTERFACE 
    7787 
    7888   INTERFACE lbc_lnk_e 
    7989      MODULE PROCEDURE lbc_lnk_2d_e 
    8090   END INTERFACE 
     91   ! 
     92   INTERFACE lbc_lnk_multi 
     93      MODULE PROCEDURE lbc_lnk_2d_9, lbc_lnk_2d_multiple 
     94   END INTERFACE 
    8195 
    8296   INTERFACE lbc_bdy_lnk 
    8397      MODULE PROCEDURE lbc_bdy_lnk_2d, lbc_bdy_lnk_3d 
    8498   END INTERFACE 
    85  
     99   ! 
    86100   INTERFACE lbc_lnk_icb 
    87101      MODULE PROCEDURE lbc_lnk_2d_e 
    88102   END INTERFACE 
     103    
     104   TYPE arrayptr 
     105      REAL , DIMENSION (:,:),  POINTER :: pt2d 
     106   END TYPE arrayptr 
     107   PUBLIC   arrayptr 
    89108 
    90109   PUBLIC   lbc_lnk       ! ocean/ice  lateral boundary conditions 
    91    PUBLIC   lbc_lnk_e  
     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 
    92113   PUBLIC   lbc_bdy_lnk   ! ocean lateral BDY boundary conditions 
    93    PUBLIC   lbc_lnk_icb 
     114   PUBLIC   lbc_lnk_icb   ! 
    94115    
    95116   !!---------------------------------------------------------------------- 
    96    !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
     117   !! NEMO/OPA 3.7 , NEMO Consortium (2015) 
    97118   !! $Id$ 
    98119   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     
    171192      ! 
    172193   END SUBROUTINE lbc_lnk_2d 
     194    
     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( pt2dA, cd_typeA, psgnA )  
     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 
    173251 
    174252#else 
     
    230308         ! this is in mpp case. In this module, just do nothing 
    231309      ELSE 
    232          ! 
    233310         !                                     !  East-West boundaries 
    234311         !                                     ! ====================== 
     
    249326            ! 
    250327         END SELECT 
    251          ! 
    252328         !                                     ! North-South boundaries 
    253329         !                                     ! ====================== 
     
    287363   END SUBROUTINE lbc_lnk_3d 
    288364 
     365 
    289366   SUBROUTINE lbc_lnk_2d( pt2d, cd_type, psgn, cd_mpp, pval ) 
    290367      !!--------------------------------------------------------------------- 
     
    316393         ! this is in mpp case. In this module, just do nothing 
    317394      ELSE       
    318          ! 
    319395         !                                     ! East-West boundaries 
    320396         !                                     ! ==================== 
     
    335411            ! 
    336412         END SELECT 
    337          ! 
    338413         !                                     ! North-South boundaries 
    339414         !                                     ! ====================== 
     
    372447      !     
    373448   END SUBROUTINE lbc_lnk_2d 
    374  
    375 #endif 
    376  
    377  
    378    SUBROUTINE lbc_bdy_lnk_3d( pt3d, cd_type, psgn, ib_bdy ) 
    379       !!--------------------------------------------------------------------- 
    380       !!                  ***  ROUTINE lbc_bdy_lnk  *** 
    381       !! 
    382       !! ** Purpose :   wrapper rountine to 'lbc_lnk_3d'. This wrapper is used 
    383       !!                to maintain the same interface with regards to the mpp 
    384       !case 
    385       !! 
     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( pt2dA, cd_typeA, psgnA )  
     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. 
    386567      !!---------------------------------------------------------------------- 
    387568      CHARACTER(len=1)                , INTENT(in   )           ::   cd_type   ! nature of pt3d grid-points 
    388569      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout)           ::   pt3d      ! 3D array on which the lbc is applied 
    389570      REAL(wp)                        , INTENT(in   )           ::   psgn      ! control of the sign  
    390       INTEGER                                                   ::   ib_bdy    ! BDY boundary set 
    391       !! 
     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 
     614#endif 
     615 
     616   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      ! 
    392630      CALL lbc_lnk_3d( pt3d, cd_type, psgn) 
    393  
     631      ! 
    394632   END SUBROUTINE lbc_bdy_lnk_3d 
    395633 
     634 
    396635   SUBROUTINE lbc_bdy_lnk_2d( pt2d, cd_type, psgn, ib_bdy ) 
    397636      !!--------------------------------------------------------------------- 
     
    399638      !! 
    400639      !! ** Purpose :   wrapper rountine to 'lbc_lnk_3d'. This wrapper is used 
    401       !!                to maintain the same interface with regards to the mpp 
    402       !case 
    403       !! 
    404       !!---------------------------------------------------------------------- 
    405       CHARACTER(len=1)                , INTENT(in   )           ::   cd_type   ! nature of pt3d grid-points 
    406       REAL(wp), DIMENSION(jpi,jpj),     INTENT(inout)           ::   pt2d      ! 3D array on which the lbc is applied 
    407       REAL(wp)                        , INTENT(in   )           ::   psgn      ! control of the sign  
    408       INTEGER                                                   ::   ib_bdy    ! BDY boundary set 
    409       !! 
     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      ! 
    410649      CALL lbc_lnk_2d( pt2d, cd_type, psgn) 
    411  
     650      ! 
    412651   END SUBROUTINE lbc_bdy_lnk_2d 
    413652 
     
    426665      !!                             for closed boundaries. 
    427666      !!---------------------------------------------------------------------- 
    428       CHARACTER(len=1)            , INTENT(in   )           ::   cd_type   ! nature of pt3d grid-points 
    429       REAL(wp), DIMENSION(jpi,jpj), INTENT(inout)           ::   pt2d      ! 2D array on which the lbc is applied 
    430       REAL(wp)                    , INTENT(in   )           ::   psgn      ! control of the sign  
    431       INTEGER                     , INTENT(in   )           ::   jpri      ! size of extra halo (not needed in non-mpp) 
    432       INTEGER                     , INTENT(in   )           ::   jprj      ! size of extra halo (not needed in non-mpp) 
    433       !!---------------------------------------------------------------------- 
    434  
     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      ! 
    435674      CALL lbc_lnk_2d( pt2d, cd_type, psgn ) 
    436675      !     
     
    441680   !!====================================================================== 
    442681END MODULE lbclnk 
     682 
Note: See TracChangeset for help on using the changeset viewer.