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 11967 for NEMO/branches/2019/ENHANCE-02_ISF_nemo_TEST_MERGE/src/OCE/LBC/lbc_lnk_multi_generic.h90 – NEMO

Ignore:
Timestamp:
2019-11-26T15:11:43+01:00 (4 years ago)
Author:
davestorkey
Message:

2019/ENHANCE-02_ISF_nemo_TEST_MERGE : Update to rev 11953.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • NEMO/branches/2019/ENHANCE-02_ISF_nemo_TEST_MERGE/src/OCE/LBC/lbc_lnk_multi_generic.h90

    r10425 r11967  
    1414#   define PTR_ptab              pt4d 
    1515#endif 
    16    SUBROUTINE ROUTINE_MULTI( cdname                                                    & 
    17       &                    , pt1, cdna1, psgn1, pt2, cdna2, psgn2, pt3, cdna3, psgn3   & 
    18       &                    , pt4, cdna4, psgn4, pt5, cdna5, psgn5, pt6, cdna6, psgn6   & 
    19       &                    , pt7, cdna7, psgn7, pt8, cdna8, psgn8, pt9, cdna9, psgn9, cd_mpp, pval) 
     16 
     17   SUBROUTINE ROUTINE_MULTI( cdname                                                                             & 
     18      &                    , pt1, cdna1, psgn1, pt2 , cdna2 , psgn2 , pt3 , cdna3 , psgn3 , pt4, cdna4, psgn4   & 
     19      &                    , pt5, cdna5, psgn5, pt6 , cdna6 , psgn6 , pt7 , cdna7 , psgn7 , pt8, cdna8, psgn8   & 
     20      &                    , pt9, cdna9, psgn9, pt10, cdna10, psgn10, pt11, cdna11, psgn11                      & 
     21      &                    , kfillmode, pfillval, lsend, lrecv, ihlcom ) 
    2022      !!--------------------------------------------------------------------- 
    21       CHARACTER(len=*)   ,                   INTENT(in   ) ::   cdname  ! name of the calling subroutine 
    22       ARRAY_TYPE(:,:,:,:)          , TARGET, INTENT(inout) ::   pt1     ! arrays on which the lbc is applied 
    23       ARRAY_TYPE(:,:,:,:), OPTIONAL, TARGET, INTENT(inout) ::   pt2  ,  pt3  , pt4  , pt5  , pt6  , pt7  , pt8  , pt9 
    24       CHARACTER(len=1)                     , INTENT(in   ) ::   cdna1   ! nature of pt2D. array grid-points 
    25       CHARACTER(len=1)   , OPTIONAL        , INTENT(in   ) ::   cdna2,  cdna3, cdna4, cdna5, cdna6, cdna7, cdna8, cdna9 
    26       REAL(wp)                             , INTENT(in   ) ::   psgn1   ! sign used across the north fold 
    27       REAL(wp)           , OPTIONAL        , INTENT(in   ) ::   psgn2,  psgn3, psgn4, psgn5, psgn6, psgn7, psgn8, psgn9    
    28       CHARACTER(len=3)   , OPTIONAL        , INTENT(in   ) ::   cd_mpp  ! fill the overlap area only 
    29       REAL(wp)           , OPTIONAL        , INTENT(in   ) ::   pval    ! background value (used at closed boundaries) 
     23      CHARACTER(len=*)   ,                   INTENT(in   ) :: cdname  ! name of the calling subroutine 
     24      ARRAY_TYPE(:,:,:,:)          , TARGET, INTENT(inout) :: pt1     ! arrays on which the lbc is applied 
     25      ARRAY_TYPE(:,:,:,:), OPTIONAL, TARGET, INTENT(inout) :: pt2  , pt3  , pt4  , pt5  , pt6  , pt7  , pt8  , pt9  , pt10  , pt11 
     26      CHARACTER(len=1)                     , INTENT(in   ) :: cdna1   ! nature of pt2D. array grid-points 
     27      CHARACTER(len=1)   , OPTIONAL        , INTENT(in   ) :: cdna2, cdna3, cdna4, cdna5, cdna6, cdna7, cdna8, cdna9, cdna10, cdna11 
     28      REAL(wp)                             , INTENT(in   ) :: psgn1   ! sign used across the north fold 
     29      REAL(wp)           , OPTIONAL        , INTENT(in   ) :: psgn2, psgn3, psgn4, psgn5, psgn6, psgn7, psgn8, psgn9, psgn10, psgn11 
     30      INTEGER            , OPTIONAL        , INTENT(in   ) :: kfillmode   ! filling method for halo over land (default = constant) 
     31      REAL(wp)           , OPTIONAL        , INTENT(in   ) :: pfillval    ! background value (used at closed boundaries) 
     32      LOGICAL, DIMENSION(4), OPTIONAL      , INTENT(in   ) :: lsend, lrecv   ! indicate how communications are to be carried out 
     33      INTEGER            , OPTIONAL        , INTENT(in   ) :: ihlcom         ! number of ranks and rows to be communicated 
    3034      !! 
    31       INTEGER                         ::   kfld        ! number of elements that will be attributed 
    32       PTR_TYPE         , DIMENSION(9) ::   ptab_ptr    ! pointer array 
    33       CHARACTER(len=1) , DIMENSION(9) ::   cdna_ptr    ! nature of ptab_ptr grid-points 
    34       REAL(wp)         , DIMENSION(9) ::   psgn_ptr    ! sign used across the north fold boundary 
     35      INTEGER                          ::   kfld        ! number of elements that will be attributed 
     36      PTR_TYPE         , DIMENSION(11) ::   ptab_ptr    ! pointer array 
     37      CHARACTER(len=1) , DIMENSION(11) ::   cdna_ptr    ! nature of ptab_ptr grid-points 
     38      REAL(wp)         , DIMENSION(11) ::   psgn_ptr    ! sign used across the north fold boundary 
    3539      !!--------------------------------------------------------------------- 
    3640      ! 
     
    4145      ! 
    4246      !                 ! Look if more arrays are added 
    43       IF( PRESENT(psgn2) )   CALL ROUTINE_LOAD( pt2, cdna2, psgn2, ptab_ptr, cdna_ptr, psgn_ptr, kfld ) 
    44       IF( PRESENT(psgn3) )   CALL ROUTINE_LOAD( pt3, cdna3, psgn3, ptab_ptr, cdna_ptr, psgn_ptr, kfld ) 
    45       IF( PRESENT(psgn4) )   CALL ROUTINE_LOAD( pt4, cdna4, psgn4, ptab_ptr, cdna_ptr, psgn_ptr, kfld ) 
    46       IF( PRESENT(psgn5) )   CALL ROUTINE_LOAD( pt5, cdna5, psgn5, ptab_ptr, cdna_ptr, psgn_ptr, kfld ) 
    47       IF( PRESENT(psgn6) )   CALL ROUTINE_LOAD( pt6, cdna6, psgn6, ptab_ptr, cdna_ptr, psgn_ptr, kfld ) 
    48       IF( PRESENT(psgn7) )   CALL ROUTINE_LOAD( pt7, cdna7, psgn7, ptab_ptr, cdna_ptr, psgn_ptr, kfld ) 
    49       IF( PRESENT(psgn8) )   CALL ROUTINE_LOAD( pt8, cdna8, psgn8, ptab_ptr, cdna_ptr, psgn_ptr, kfld ) 
    50       IF( PRESENT(psgn9) )   CALL ROUTINE_LOAD( pt9, cdna9, psgn9, ptab_ptr, cdna_ptr, psgn_ptr, kfld ) 
     47      IF( PRESENT(psgn2 ) )   CALL ROUTINE_LOAD( pt2 , cdna2 , psgn2 , ptab_ptr, cdna_ptr, psgn_ptr, kfld ) 
     48      IF( PRESENT(psgn3 ) )   CALL ROUTINE_LOAD( pt3 , cdna3 , psgn3 , ptab_ptr, cdna_ptr, psgn_ptr, kfld ) 
     49      IF( PRESENT(psgn4 ) )   CALL ROUTINE_LOAD( pt4 , cdna4 , psgn4 , ptab_ptr, cdna_ptr, psgn_ptr, kfld ) 
     50      IF( PRESENT(psgn5 ) )   CALL ROUTINE_LOAD( pt5 , cdna5 , psgn5 , ptab_ptr, cdna_ptr, psgn_ptr, kfld ) 
     51      IF( PRESENT(psgn6 ) )   CALL ROUTINE_LOAD( pt6 , cdna6 , psgn6 , ptab_ptr, cdna_ptr, psgn_ptr, kfld ) 
     52      IF( PRESENT(psgn7 ) )   CALL ROUTINE_LOAD( pt7 , cdna7 , psgn7 , ptab_ptr, cdna_ptr, psgn_ptr, kfld ) 
     53      IF( PRESENT(psgn8 ) )   CALL ROUTINE_LOAD( pt8 , cdna8 , psgn8 , ptab_ptr, cdna_ptr, psgn_ptr, kfld ) 
     54      IF( PRESENT(psgn9 ) )   CALL ROUTINE_LOAD( pt9 , cdna9 , psgn9 , ptab_ptr, cdna_ptr, psgn_ptr, kfld ) 
     55      IF( PRESENT(psgn10) )   CALL ROUTINE_LOAD( pt10, cdna10, psgn10, ptab_ptr, cdna_ptr, psgn_ptr, kfld ) 
     56      IF( PRESENT(psgn11) )   CALL ROUTINE_LOAD( pt11, cdna11, psgn11, ptab_ptr, cdna_ptr, psgn_ptr, kfld ) 
    5157      ! 
    52       CALL lbc_lnk_ptr( cdname, ptab_ptr, cdna_ptr, psgn_ptr, kfld, cd_mpp, pval ) 
     58      CALL lbc_lnk_ptr    ( cdname,               ptab_ptr, cdna_ptr, psgn_ptr, kfld, kfillmode, pfillval, lsend, lrecv, ihlcom ) 
    5359      ! 
    5460   END SUBROUTINE ROUTINE_MULTI 
     
    7278      ! 
    7379   END SUBROUTINE ROUTINE_LOAD 
     80 
    7481#undef ARRAY_TYPE 
    7582#undef PTR_TYPE 
Note: See TracChangeset for help on using the changeset viewer.