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.
lbc_lnk_multi_generic.h90 in NEMO/branches/2019/dev_r10984_HPC-13_IRRMANN_BDY_optimization/src/OCE/LBC – NEMO

source: NEMO/branches/2019/dev_r10984_HPC-13_IRRMANN_BDY_optimization/src/OCE/LBC/lbc_lnk_multi_generic.h90 @ 11067

Last change on this file since 11067 was 11067, checked in by girrmann, 5 years ago

dev_r10984_HPC-13 : new implementation of lbc_bdy_lnk in prevision of step 2, regroup communications, see #2285
  • Property svn:keywords set to Id
  • Property svn:mime-type set to text/x-fortran
File size: 6.0 KB
Line 
1#if defined DIM_2d
2#   define ARRAY_TYPE(i,j,k,l)   REAL(wp), DIMENSION(i,j)
3#   define PTR_TYPE              TYPE(PTR_2D)
4#   define PTR_ptab              pt2d
5#endif
6#if defined DIM_3d
7#   define ARRAY_TYPE(i,j,k,l)   REAL(wp), DIMENSION(i,j,k)
8#   define PTR_TYPE              TYPE(PTR_3D)
9#   define PTR_ptab              pt3d
10#endif
11#if defined DIM_4d
12#   define ARRAY_TYPE(i,j,k,l)   REAL(wp), DIMENSION(i,j,k,l)
13#   define PTR_TYPE              TYPE(PTR_4D)
14#   define PTR_ptab              pt4d
15#endif
16
17#if defined IS_BDY
18   SUBROUTINE ROUTINE_MULTI( cdname, lsend, lrecv                                                               &
19      &                    , pt1, cdna1, psgn1, pt2 , cdna2 , psgn2 , pt3 , cdna3 , psgn3 , pt4, cdna4, psgn4   &
20      &                    , pt5, cdna5, psgn5, pt6 , cdna6 , psgn6 , pt7 , cdna7 , psgn7 , pt8, cdna8, psgn8   &
21      &                    , pt9, cdna9, psgn9, pt10, cdna10, psgn10, pt11, cdna11, psgn11                      &
22      &                    , cd_mpp, pval )
23      LOGICAL, DIMENSION(4)        , INTENT(in   ) ::   lsend, lrecv   ! indicate how communications are to be carried out
24#else
25   SUBROUTINE ROUTINE_MULTI( cdname                                                                             &
26      &                    , pt1, cdna1, psgn1, pt2 , cdna2 , psgn2 , pt3 , cdna3 , psgn3 , pt4, cdna4, psgn4   &
27      &                    , pt5, cdna5, psgn5, pt6 , cdna6 , psgn6 , pt7 , cdna7 , psgn7 , pt8, cdna8, psgn8   &
28      &                    , pt9, cdna9, psgn9, pt10, cdna10, psgn10, pt11, cdna11, psgn11                      &
29      &                    , cd_mpp, pval )
30#endif
31      !!---------------------------------------------------------------------
32      CHARACTER(len=*)   ,                   INTENT(in   ) ::  cdname  ! name of the calling subroutine
33      ARRAY_TYPE(:,:,:,:)          , TARGET, INTENT(inout) ::  pt1     ! arrays on which the lbc is applied
34      ARRAY_TYPE(:,:,:,:), OPTIONAL, TARGET, INTENT(inout) ::  pt2  , pt3  , pt4  , pt5  , pt6  , pt7  , pt8  , pt9  , pt10  , pt11
35      CHARACTER(len=1)                     , INTENT(in   ) ::  cdna1   ! nature of pt2D. array grid-points
36      CHARACTER(len=1)   , OPTIONAL        , INTENT(in   ) ::  cdna2, cdna3, cdna4, cdna5, cdna6, cdna7, cdna8, cdna9, cdna10, cdna11
37      REAL(wp)                             , INTENT(in   ) ::  psgn1   ! sign used across the north fold
38      REAL(wp)           , OPTIONAL        , INTENT(in   ) ::  psgn2, psgn3, psgn4, psgn5, psgn6, psgn7, psgn8, psgn9, psgn10, psgn11
39      CHARACTER(len=3)   , OPTIONAL        , INTENT(in   ) ::  cd_mpp  ! fill the overlap area only
40      REAL(wp)           , OPTIONAL        , INTENT(in   ) ::  pval    ! background value (used at closed boundaries)
41      !!
42      INTEGER                          ::   kfld        ! number of elements that will be attributed
43      PTR_TYPE         , DIMENSION(11) ::   ptab_ptr    ! pointer array
44      CHARACTER(len=1) , DIMENSION(11) ::   cdna_ptr    ! nature of ptab_ptr grid-points
45      REAL(wp)         , DIMENSION(11) ::   psgn_ptr    ! sign used across the north fold boundary
46      !!---------------------------------------------------------------------
47      !
48      kfld = 0          ! initial array of pointer size
49      !
50      !                 ! Load the first array
51      CALL ROUTINE_LOAD( pt1, cdna1, psgn1, ptab_ptr, cdna_ptr, psgn_ptr, kfld )
52      !
53      !                 ! Look if more arrays are added
54      IF( PRESENT(psgn2 ) )   CALL ROUTINE_LOAD( pt2 , cdna2 , psgn2 , ptab_ptr, cdna_ptr, psgn_ptr, kfld )
55      IF( PRESENT(psgn3 ) )   CALL ROUTINE_LOAD( pt3 , cdna3 , psgn3 , ptab_ptr, cdna_ptr, psgn_ptr, kfld )
56      IF( PRESENT(psgn4 ) )   CALL ROUTINE_LOAD( pt4 , cdna4 , psgn4 , ptab_ptr, cdna_ptr, psgn_ptr, kfld )
57      IF( PRESENT(psgn5 ) )   CALL ROUTINE_LOAD( pt5 , cdna5 , psgn5 , ptab_ptr, cdna_ptr, psgn_ptr, kfld )
58      IF( PRESENT(psgn6 ) )   CALL ROUTINE_LOAD( pt6 , cdna6 , psgn6 , ptab_ptr, cdna_ptr, psgn_ptr, kfld )
59      IF( PRESENT(psgn7 ) )   CALL ROUTINE_LOAD( pt7 , cdna7 , psgn7 , ptab_ptr, cdna_ptr, psgn_ptr, kfld )
60      IF( PRESENT(psgn8 ) )   CALL ROUTINE_LOAD( pt8 , cdna8 , psgn8 , ptab_ptr, cdna_ptr, psgn_ptr, kfld )
61      IF( PRESENT(psgn9 ) )   CALL ROUTINE_LOAD( pt9 , cdna9 , psgn9 , ptab_ptr, cdna_ptr, psgn_ptr, kfld )
62      IF( PRESENT(psgn10) )   CALL ROUTINE_LOAD( pt10, cdna10, psgn10, ptab_ptr, cdna_ptr, psgn_ptr, kfld )
63      IF( PRESENT(psgn11) )   CALL ROUTINE_LOAD( pt11, cdna11, psgn11, ptab_ptr, cdna_ptr, psgn_ptr, kfld )
64      !
65#if defined IS_BDY
66      CALL lbc_bdy_lnk_ptr( cdname, lsend, lrecv, ptab_ptr, cdna_ptr, psgn_ptr, kfld               )
67#else
68      CALL lbc_lnk_ptr    ( cdname,               ptab_ptr, cdna_ptr, psgn_ptr, kfld, cd_mpp, pval )
69#endif
70      !
71   END SUBROUTINE ROUTINE_MULTI
72
73
74   SUBROUTINE ROUTINE_LOAD( ptab, cdna, psgn, ptab_ptr, cdna_ptr, psgn_ptr, kfld )
75      !!---------------------------------------------------------------------
76      ARRAY_TYPE(:,:,:,:)   , TARGET, INTENT(inout) ::   ptab       ! arrays on which the lbc is applied
77      CHARACTER(len=1)              , INTENT(in   ) ::   cdna       ! nature of pt2d array grid-points
78      REAL(wp)                      , INTENT(in   ) ::   psgn       ! sign used across the north fold boundary
79      PTR_TYPE        , DIMENSION(:), INTENT(inout) ::   ptab_ptr   ! array of pointers
80      CHARACTER(len=1), DIMENSION(:), INTENT(inout) ::   cdna_ptr   ! nature of pt2d_array array grid-points
81      REAL(wp)        , DIMENSION(:), INTENT(inout) ::   psgn_ptr   ! sign used across the north fold boundary
82      INTEGER                       , INTENT(inout) ::   kfld       ! number of elements that has been attributed
83      !!---------------------------------------------------------------------
84      !
85      kfld                    =  kfld + 1
86      ptab_ptr(kfld)%PTR_ptab => ptab
87      cdna_ptr(kfld)          =  cdna
88      psgn_ptr(kfld)          =  psgn
89      !
90   END SUBROUTINE ROUTINE_LOAD
91
92#undef ARRAY_TYPE
93#undef PTR_TYPE
94#undef PTR_ptab
Note: See TracBrowser for help on using the repository browser.