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_call_generic.h90 in NEMO/branches/2021/dev_r14312_MPI_Interface/src/OCE/LBC – NEMO

source: NEMO/branches/2021/dev_r14312_MPI_Interface/src/OCE/LBC/lbc_lnk_call_generic.h90 @ 14338

Last change on this file since 14338 was 14338, checked in by smasson, 3 years ago

dev_r14312_MPI_Interface: simplification of lbclnk and lbcnfd and their generic interfaces, #2598
  • Property svn:keywords set to Id
  • Property svn:mime-type set to text/x-fortran
File size: 7.0 KB
Line 
1#if defined DIM_2d
2#   define XD      2d
3#   define DIMS1   :,:
4#   define DIMS2   :,:,1,1
5#endif
6#if defined DIM_3d
7#   define XD      3d
8#   define DIMS1   :,:,:
9#   define DIMS2   :,:,:,1
10#endif
11#if defined DIM_4d
12#   define XD      4d
13#   define DIMS1   :,:,:,:
14#   define DIMS2   :,:,:,:
15#endif
16
17   SUBROUTINE lbc_lnk_call_/**/XD/**/_/**/PRECISION(                                                              &
18      &                     cdname                                                                                  &
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, pt12, cdna12, psgn12  &
22      &                   , pt13, cdna13, psgn13, pt14, cdna14, psgn14, pt15, cdna15, psgn15, pt16, cdna16, psgn16  &
23      &                   , kfillmode, pfillval, lsend, lrecv, ncsten )
24      !!---------------------------------------------------------------------
25      CHARACTER(len=*)     ,                   INTENT(in   ) ::   cdname  ! name of the calling subroutine
26      REAL(PRECISION), DIMENSION(DIMS1)          , TARGET, INTENT(inout) ::   pt1        ! arrays on which the lbc is applied
27      REAL(PRECISION), DIMENSION(DIMS1), OPTIONAL, TARGET, INTENT(inout) ::   pt2 , pt3 , pt4 , pt5 , pt6 , pt7 , pt8 , pt9, &
28         &                                                                    pt10, pt11, pt12, pt13, pt14, pt15, pt16
29      CHARACTER(len=1)                       , INTENT(in   ) ::   cdna1   ! nature of pt2D. array grid-points
30      CHARACTER(len=1)     , OPTIONAL        , INTENT(in   ) ::   cdna2 , cdna3 , cdna4 , cdna5 , cdna6 , cdna7 , cdna8 , cdna9, &
31         &                                                        cdna10, cdna11, cdna12, cdna13, cdna14, cdna15, cdna16
32      REAL(PRECISION)                        , INTENT(in   ) ::   psgn1   ! sign used across the north fold
33      REAL(PRECISION)      , OPTIONAL        , INTENT(in   ) ::   psgn2 , psgn3 , psgn4 , psgn5 , psgn6 , psgn7 , psgn8 , psgn9, &
34         &                                                        psgn10, psgn11, psgn12, psgn13, psgn14, psgn15, psgn16
35      INTEGER              , OPTIONAL        , INTENT(in   ) ::   kfillmode   ! filling method for halo over land (default = constant)
36      REAL(PRECISION)      , OPTIONAL        , INTENT(in   ) ::   pfillval    ! background value (used at closed boundaries)
37      LOGICAL, DIMENSION(4), OPTIONAL        , INTENT(in   ) ::   lsend, lrecv   ! indicate how communications are to be carried out
38      LOGICAL              , OPTIONAL        , INTENT(in   ) ::   ncsten
39      !!
40      INTEGER                          ::   kfld        ! number of elements that will be attributed
41      TYPE(PTR_/**/XD/**/_/**/PRECISION), DIMENSION(16) ::   ptab_ptr    ! pointer array
42      CHARACTER(len=1) , DIMENSION(16) ::   cdna_ptr    ! nature of ptab_ptr grid-points
43      REAL(PRECISION)  , DIMENSION(16) ::   psgn_ptr    ! sign used across the north fold boundary
44      !!---------------------------------------------------------------------
45      !
46      kfld = 0          ! initial array of pointer size
47      !
48      !                 ! Load the first array
49      CALL load_ptr_/**/XD/**/_/**/PRECISION( pt1, cdna1, psgn1, ptab_ptr, cdna_ptr, psgn_ptr, kfld )
50      !
51      !                 ! Look if more arrays are added
52      IF( PRESENT(psgn2 ) )   CALL load_ptr_/**/XD/**/_/**/PRECISION( pt2 , cdna2 , psgn2 , ptab_ptr, cdna_ptr, psgn_ptr, kfld )
53      IF( PRESENT(psgn3 ) )   CALL load_ptr_/**/XD/**/_/**/PRECISION( pt3 , cdna3 , psgn3 , ptab_ptr, cdna_ptr, psgn_ptr, kfld )
54      IF( PRESENT(psgn4 ) )   CALL load_ptr_/**/XD/**/_/**/PRECISION( pt4 , cdna4 , psgn4 , ptab_ptr, cdna_ptr, psgn_ptr, kfld )
55      IF( PRESENT(psgn5 ) )   CALL load_ptr_/**/XD/**/_/**/PRECISION( pt5 , cdna5 , psgn5 , ptab_ptr, cdna_ptr, psgn_ptr, kfld )
56      IF( PRESENT(psgn6 ) )   CALL load_ptr_/**/XD/**/_/**/PRECISION( pt6 , cdna6 , psgn6 , ptab_ptr, cdna_ptr, psgn_ptr, kfld )
57      IF( PRESENT(psgn7 ) )   CALL load_ptr_/**/XD/**/_/**/PRECISION( pt7 , cdna7 , psgn7 , ptab_ptr, cdna_ptr, psgn_ptr, kfld )
58      IF( PRESENT(psgn8 ) )   CALL load_ptr_/**/XD/**/_/**/PRECISION( pt8 , cdna8 , psgn8 , ptab_ptr, cdna_ptr, psgn_ptr, kfld )
59      IF( PRESENT(psgn9 ) )   CALL load_ptr_/**/XD/**/_/**/PRECISION( pt9 , cdna9 , psgn9 , ptab_ptr, cdna_ptr, psgn_ptr, kfld )
60      IF( PRESENT(psgn10) )   CALL load_ptr_/**/XD/**/_/**/PRECISION( pt10, cdna10, psgn10, ptab_ptr, cdna_ptr, psgn_ptr, kfld )
61      IF( PRESENT(psgn11) )   CALL load_ptr_/**/XD/**/_/**/PRECISION( pt11, cdna11, psgn11, ptab_ptr, cdna_ptr, psgn_ptr, kfld )
62      IF( PRESENT(psgn12) )   CALL load_ptr_/**/XD/**/_/**/PRECISION( pt12, cdna12, psgn12, ptab_ptr, cdna_ptr, psgn_ptr, kfld )
63      IF( PRESENT(psgn13) )   CALL load_ptr_/**/XD/**/_/**/PRECISION( pt13, cdna13, psgn13, ptab_ptr, cdna_ptr, psgn_ptr, kfld )
64      IF( PRESENT(psgn14) )   CALL load_ptr_/**/XD/**/_/**/PRECISION( pt14, cdna14, psgn14, ptab_ptr, cdna_ptr, psgn_ptr, kfld )
65      IF( PRESENT(psgn15) )   CALL load_ptr_/**/XD/**/_/**/PRECISION( pt15, cdna15, psgn15, ptab_ptr, cdna_ptr, psgn_ptr, kfld )
66      IF( PRESENT(psgn16) )   CALL load_ptr_/**/XD/**/_/**/PRECISION( pt16, cdna16, psgn16, ptab_ptr, cdna_ptr, psgn_ptr, kfld )
67      !
68      IF( nn_comm == 1 ) THEN
69         CALL lbc_lnk_pt2pt(   cdname, ptab_ptr, cdna_ptr, psgn_ptr, kfld, kfillmode, pfillval, lsend, lrecv )
70      ELSE
71         CALL lbc_lnk_neicoll( cdname, ptab_ptr, cdna_ptr, psgn_ptr, kfld, kfillmode, pfillval, lsend, lrecv, ncsten )
72      ENDIF
73      !
74   END SUBROUTINE lbc_lnk_call_/**/XD/**/_/**/PRECISION
75
76
77   SUBROUTINE load_ptr_/**/XD/**/_/**/PRECISION( ptab, cdna, psgn, ptab_ptr, cdna_ptr, psgn_ptr, kfld )
78      !!---------------------------------------------------------------------
79      REAL(PRECISION), DIMENSION(DIMS1), TARGET, INTENT(inout) ::   ptab       ! arrays on which the lbc is applied
80      CHARACTER(len=1)              , INTENT(in   ) ::   cdna       ! nature of pt2d array grid-points
81      REAL(PRECISION)               , INTENT(in   ) ::   psgn       ! sign used across the north fold boundary
82      TYPE(PTR_/**/XD/**/_/**/PRECISION), DIMENSION(:), INTENT(inout) ::   ptab_ptr   ! array of pointers
83      CHARACTER(len=1), DIMENSION(:), INTENT(inout) ::   cdna_ptr   ! nature of pt2d_array array grid-points
84      REAL(PRECISION) , DIMENSION(:), INTENT(inout) ::   psgn_ptr   ! sign used across the north fold boundary
85      INTEGER                       , INTENT(inout) ::   kfld       ! number of elements that has been attributed
86      !!---------------------------------------------------------------------
87      !
88      kfld                    =  kfld + 1
89      ptab_ptr(kfld)%pt/**/XD => ptab
90      cdna_ptr(kfld)          =  cdna
91      psgn_ptr(kfld)          =  psgn
92      !
93   END SUBROUTINE load_ptr_/**/XD/**/_/**/PRECISION
94
95#undef XD
96#undef DIMS1
97#undef DIMS2
Note: See TracBrowser for help on using the repository browser.