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_nc_generic.h90 in NEMO/branches/2020/dev_r13923_Tiling_Cleanup_MPI3_LoopFusion/src/OCE/LBC – NEMO

source: NEMO/branches/2020/dev_r13923_Tiling_Cleanup_MPI3_LoopFusion/src/OCE/LBC/lbc_lnk_nc_generic.h90 @ 13946

Last change on this file since 13946 was 13946, checked in by francesca, 4 years ago

Merge with dev_r13508_HPC-09_loop_fusion
File size: 7.2 KB
Line 
1#if defined SINGLE_PRECISION
2#   if defined DIM_2d
3#      define ARRAY_TYPE(i,j,k,l)   REAL(sp), DIMENSION(i,j)
4#      define PTR_TYPE              TYPE(PTR_2D_sp)
5#      define PTR_ptab              pt2d
6#   endif
7#   if defined DIM_3d
8#      define ARRAY_TYPE(i,j,k,l)   REAL(sp), DIMENSION(i,j,k)
9#      define PTR_TYPE              TYPE(PTR_3D_sp)
10#      define PTR_ptab              pt3d
11#   endif
12#   if defined DIM_4d
13#      define ARRAY_TYPE(i,j,k,l)   REAL(sp), DIMENSION(i,j,k,l)
14#      define PTR_TYPE              TYPE(PTR_4D_sp)
15#      define PTR_ptab              pt4d
16#   endif
17#   define PRECISION sp
18#else
19#   if defined DIM_2d
20#      define ARRAY_TYPE(i,j,k,l)   REAL(dp), DIMENSION(i,j)
21#      define PTR_TYPE              TYPE(PTR_2D_dp)
22#      define PTR_ptab              pt2d
23#   endif
24#   if defined DIM_3d
25#      define ARRAY_TYPE(i,j,k,l)   REAL(dp), DIMENSION(i,j,k)
26#      define PTR_TYPE              TYPE(PTR_3D_dp)
27#      define PTR_ptab              pt3d
28#   endif
29#   if defined DIM_4d
30#      define ARRAY_TYPE(i,j,k,l)   REAL(dp), DIMENSION(i,j,k,l)
31#      define PTR_TYPE              TYPE(PTR_4D_dp)
32#      define PTR_ptab              pt4d
33#   endif
34#   define PRECISION dp
35#endif
36
37   SUBROUTINE ROUTINE_MULTI_NC( cdname                                                                             &
38      &                    , pt1 , cdna1 , psgn1 , pt2 , cdna2 , psgn2 , pt3 , cdna3 , psgn3 , pt4 , cdna4 , psgn4   &
39      &                    , pt5 , cdna5 , psgn5 , pt6 , cdna6 , psgn6 , pt7 , cdna7 , psgn7 , pt8 , cdna8 , psgn8   &
40      &                    , pt9 , cdna9 , psgn9 , pt10, cdna10, psgn10, pt11, cdna11, psgn11, pt12, cdna12, psgn12  &
41      &                    , pt13, cdna13, psgn13, pt14, cdna14, psgn14, pt15, cdna15, psgn15, pt16, cdna16, psgn16  &
42      &                    , kfillmode, pfillval, lsend, lrecv, ncsten )
43      !!---------------------------------------------------------------------
44      CHARACTER(len=*)   ,                   INTENT(in   ) :: cdname  ! name of the calling subroutine
45      ARRAY_TYPE(:,:,:,:)          , TARGET, INTENT(inout) :: pt1     ! arrays on which the lbc is applied
46      ARRAY_TYPE(:,:,:,:), OPTIONAL, TARGET, INTENT(inout) :: pt2  , pt3  , pt4  , pt5  , pt6  , pt7  , pt8  , pt9  , &
47         &                                                    pt10  , pt11  , pt12  , pt13  , pt14  , pt15  , pt16
48      CHARACTER(len=1)                     , INTENT(in   ) :: cdna1   ! nature of pt2D. array grid-points
49      CHARACTER(len=1)   , OPTIONAL        , INTENT(in   ) :: cdna2, cdna3, cdna4, cdna5, cdna6, cdna7, cdna8, cdna9, &
50         &                                                    cdna10, cdna11, cdna12, cdna13, cdna14, cdna15, cdna16
51      REAL(wp)                             , INTENT(in   ) :: psgn1   ! sign used across the north fold
52      REAL(wp)           , OPTIONAL        , INTENT(in   ) :: psgn2, psgn3, psgn4, psgn5, psgn6, psgn7, psgn8, psgn9, &
53         &                                                    psgn10, psgn11, psgn12, psgn13, psgn14, psgn15, psgn16
54      INTEGER            , OPTIONAL        , INTENT(in   ) :: kfillmode   ! filling method for halo over land (default = constant)
55      REAL(wp)           , OPTIONAL        , INTENT(in   ) :: pfillval    ! background value (used at closed boundaries)
56      LOGICAL, DIMENSION(4), OPTIONAL      , INTENT(in   ) :: lsend, lrecv   ! indicate how communications are to be carried out
57      LOGICAL            , OPTIONAL      , INTENT(in   ) :: ncsten
58      !!
59      INTEGER                          ::   kfld        ! number of elements that will be attributed
60      PTR_TYPE         , DIMENSION(16) ::   ptab_ptr    ! pointer array
61      CHARACTER(len=1) , DIMENSION(16) ::   cdna_ptr    ! nature of ptab_ptr grid-points
62      REAL(wp)         , DIMENSION(16) ::   psgn_ptr    ! sign used across the north fold boundary
63      !!---------------------------------------------------------------------
64      !
65      kfld = 0          ! initial array of pointer size
66      !
67      !                 ! Load the first array
68      CALL ROUTINE_NC_LOAD( pt1, cdna1, psgn1, ptab_ptr, cdna_ptr, psgn_ptr, kfld )
69      !
70      !                 ! Look if more arrays are added
71      IF( PRESENT(psgn2 ) )   CALL ROUTINE_NC_LOAD( pt2 , cdna2 , psgn2 , ptab_ptr, cdna_ptr, psgn_ptr, kfld )
72      IF( PRESENT(psgn3 ) )   CALL ROUTINE_NC_LOAD( pt3 , cdna3 , psgn3 , ptab_ptr, cdna_ptr, psgn_ptr, kfld )
73      IF( PRESENT(psgn4 ) )   CALL ROUTINE_NC_LOAD( pt4 , cdna4 , psgn4 , ptab_ptr, cdna_ptr, psgn_ptr, kfld )
74      IF( PRESENT(psgn5 ) )   CALL ROUTINE_NC_LOAD( pt5 , cdna5 , psgn5 , ptab_ptr, cdna_ptr, psgn_ptr, kfld )
75      IF( PRESENT(psgn6 ) )   CALL ROUTINE_NC_LOAD( pt6 , cdna6 , psgn6 , ptab_ptr, cdna_ptr, psgn_ptr, kfld )
76      IF( PRESENT(psgn7 ) )   CALL ROUTINE_NC_LOAD( pt7 , cdna7 , psgn7 , ptab_ptr, cdna_ptr, psgn_ptr, kfld )
77      IF( PRESENT(psgn8 ) )   CALL ROUTINE_NC_LOAD( pt8 , cdna8 , psgn8 , ptab_ptr, cdna_ptr, psgn_ptr, kfld )
78      IF( PRESENT(psgn9 ) )   CALL ROUTINE_NC_LOAD( pt9 , cdna9 , psgn9 , ptab_ptr, cdna_ptr, psgn_ptr, kfld )
79      IF( PRESENT(psgn10) )   CALL ROUTINE_NC_LOAD( pt10, cdna10, psgn10, ptab_ptr, cdna_ptr, psgn_ptr, kfld )
80      IF( PRESENT(psgn11) )   CALL ROUTINE_NC_LOAD( pt11, cdna11, psgn11, ptab_ptr, cdna_ptr, psgn_ptr, kfld )
81      IF( PRESENT(psgn12) )   CALL ROUTINE_NC_LOAD( pt12, cdna12, psgn12, ptab_ptr, cdna_ptr, psgn_ptr, kfld )
82      IF( PRESENT(psgn13) )   CALL ROUTINE_NC_LOAD( pt13, cdna13, psgn13, ptab_ptr, cdna_ptr, psgn_ptr, kfld )
83      IF( PRESENT(psgn14) )   CALL ROUTINE_NC_LOAD( pt14, cdna14, psgn14, ptab_ptr, cdna_ptr, psgn_ptr, kfld )
84      IF( PRESENT(psgn15) )   CALL ROUTINE_NC_LOAD( pt15, cdna15, psgn15, ptab_ptr, cdna_ptr, psgn_ptr, kfld )
85      IF( PRESENT(psgn16) )   CALL ROUTINE_NC_LOAD( pt16, cdna16, psgn16, ptab_ptr, cdna_ptr, psgn_ptr, kfld )
86      !
87      CALL lbc_lnk_nc    ( cdname,               ptab_ptr, cdna_ptr, psgn_ptr, kfld, kfillmode, pfillval, lsend, lrecv, ncsten )
88      !
89   END SUBROUTINE ROUTINE_MULTI_NC
90
91
92   SUBROUTINE ROUTINE_NC_LOAD( ptab, cdna, psgn, ptab_ptr, cdna_ptr, psgn_ptr, kfld )
93      !!---------------------------------------------------------------------
94      ARRAY_TYPE(:,:,:,:)   , TARGET, INTENT(inout) ::   ptab       ! arrays on which the lbc is applied
95      CHARACTER(len=1)              , INTENT(in   ) ::   cdna       ! nature of pt2d array grid-points
96      REAL(wp)                      , INTENT(in   ) ::   psgn       ! sign used across the north fold boundary
97      PTR_TYPE        , DIMENSION(:), INTENT(inout) ::   ptab_ptr   ! array of pointers
98      CHARACTER(len=1), DIMENSION(:), INTENT(inout) ::   cdna_ptr   ! nature of pt2d_array array grid-points
99      REAL(wp)        , DIMENSION(:), INTENT(inout) ::   psgn_ptr   ! sign used across the north fold boundary
100      INTEGER                       , INTENT(inout) ::   kfld       ! number of elements that has been attributed
101      !!---------------------------------------------------------------------
102      !
103      kfld                    =  kfld + 1
104      ptab_ptr(kfld)%PTR_ptab => ptab
105      cdna_ptr(kfld)          =  cdna
106      psgn_ptr(kfld)          =  psgn
107      !
108   END SUBROUTINE ROUTINE_NC_LOAD
109
110#undef PRECISION
111#undef ARRAY_TYPE
112#undef PTR_TYPE
113#undef PTR_ptab
Note: See TracBrowser for help on using the repository browser.