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_generic.h90 in NEMO/branches/2018/dev_r10164_HPC09_ESIWACE_PREP_MERGE/src/OCE/LBC – NEMO

source: NEMO/branches/2018/dev_r10164_HPC09_ESIWACE_PREP_MERGE/src/OCE/LBC/lbc_lnk_generic.h90 @ 10314

Last change on this file since 10314 was 10314, checked in by smasson, 5 years ago

dev_r10164_HPC09_ESIWACE_PREP_MERGE: action 2: add generic glob_min/max/sum and locmin/max, complete timing and report (including bdy and icb), see #2133
  • Property svn:keywords set to Id
  • Property svn:mime-type set to text/x-fortran
File size: 5.5 KB
Line 
1#if defined MULTI
2#   define NAT_IN(k)                cd_nat(k)   
3#   define SGN_IN(k)                psgn(k)
4#   define F_SIZE(ptab)             kfld
5#   define OPT_K(k)                 ,ipf
6#   if defined DIM_2d
7#      define ARRAY_TYPE(i,j,k,l,f)    TYPE(PTR_2D)                , INTENT(inout) ::   ptab(f)
8#      define ARRAY_IN(i,j,k,l,f)      ptab(f)%pt2d(i,j)
9#      define K_SIZE(ptab)             1
10#      define L_SIZE(ptab)             1
11#   endif
12#   if defined DIM_3d
13#      define ARRAY_TYPE(i,j,k,l,f)    TYPE(PTR_3D),INTENT(inout)::ptab(f)
14#      define ARRAY_IN(i,j,k,l,f)      ptab(f)%pt3d(i,j,k)
15#      define K_SIZE(ptab)             SIZE(ptab(1)%pt3d,3)
16#      define L_SIZE(ptab)             1
17#   endif
18#   if defined DIM_4d
19#      define ARRAY_TYPE(i,j,k,l,f)    TYPE(PTR_4D),INTENT(inout)::ptab(f)
20#      define ARRAY_IN(i,j,k,l,f)      ptab(f)%pt4d(i,j,k,l)
21#      define K_SIZE(ptab)             SIZE(ptab(1)%pt4d,3)
22#      define L_SIZE(ptab)             SIZE(ptab(1)%pt4d,4)
23#   endif
24#else
25#   define ARRAY_TYPE(i,j,k,l,f)    REAL(wp)                    , INTENT(inout) ::   ARRAY_IN(i,j,k,l,f)
26#   define NAT_IN(k)                cd_nat
27#   define SGN_IN(k)                psgn
28#   define F_SIZE(ptab)             1
29#   define OPT_K(k)                 
30#   if defined DIM_2d
31#      define ARRAY_IN(i,j,k,l,f)   ptab(i,j)
32#      define K_SIZE(ptab)          1
33#      define L_SIZE(ptab)          1
34#   endif
35#   if defined DIM_3d
36#      define ARRAY_IN(i,j,k,l,f)   ptab(i,j,k)
37#      define K_SIZE(ptab)          SIZE(ptab,3)
38#      define L_SIZE(ptab)          1
39#   endif
40#   if defined DIM_4d
41#      define ARRAY_IN(i,j,k,l,f)   ptab(i,j,k,l)
42#      define K_SIZE(ptab)          SIZE(ptab,3)
43#      define L_SIZE(ptab)          SIZE(ptab,4)
44#   endif
45#endif
46
47#if defined MULTI
48   SUBROUTINE ROUTINE_LNK( cdname, ptab, cd_nat, psgn, kfld, cd_mpp, pval )
49      INTEGER                     , INTENT(in   ) ::   kfld        ! number of pt3d arrays
50#else
51   SUBROUTINE ROUTINE_LNK( cdname, ptab, cd_nat, psgn      , cd_mpp, pval )
52#endif
53      CHARACTER(len=*)            , INTENT(in   ) ::   cdname      ! name of the calling subroutine
54      ARRAY_TYPE(:,:,:,:,:)                                        ! array or pointer of arrays on which the boundary condition is applied
55      CHARACTER(len=1)            , INTENT(in   ) ::   NAT_IN(:)   ! nature of array grid-points
56      REAL(wp)                    , INTENT(in   ) ::   SGN_IN(:)   ! sign used across the north fold boundary
57      CHARACTER(len=3), OPTIONAL  , INTENT(in   ) ::   cd_mpp      ! fill the overlap area only
58      REAL(wp)        , OPTIONAL  , INTENT(in   ) ::   pval        ! background value (used at closed boundaries)
59      !
60      INTEGER  ::    ji,  jj,  jk,  jl, jh, jf   ! dummy loop indices
61      INTEGER  ::   ipi, ipj, ipk, ipl, ipf      ! dimension of the input array
62      REAL(wp) ::   zland
63      LOGICAL  ::   ll_nfd
64      !!----------------------------------------------------------------------
65      !
66      ipk = K_SIZE(ptab)   ! 3rd dimension
67      ipl = L_SIZE(ptab)   ! 4th    -
68      ipf = F_SIZE(ptab)   ! 5th    -      use in "multi" case (array of pointers)
69      !
70      ll_nfd    = jperio==3 .OR. jperio==4 .OR. jperio==5 .OR. jperio==6
71      !
72      IF( PRESENT( pval ) ) THEN   ;   zland = pval      ! set land value
73      ELSE                         ;   zland = 0._wp     ! zero by default
74      ENDIF
75
76      ! ------------------------------- !
77      !   standard boundary treatment   !    ! CAUTION: semi-column notation is often impossible
78      ! ------------------------------- !
79      !
80      IF( PRESENT( cd_mpp ) ) THEN     !==  halos filled with inner values  ==!
81         !
82         ! only fill the overlap area and extra allows
83         ! this is in mpp case. In this module, just do nothing
84         !
85      ELSE                             !==  standard close or cyclic treatment  ==!
86         !
87         DO jf = 1, ipf                   ! number of arrays to be treated
88            !
89            !                                ! East-West boundaries
90            IF( l_Iperio ) THEN                   !* cyclic
91               ARRAY_IN( 1 ,:,:,:,jf) = ARRAY_IN(jpim1,:,:,:,jf)
92               ARRAY_IN(jpi,:,:,:,jf) = ARRAY_IN(  2  ,:,:,:,jf)
93            ELSE                                   !* closed
94               IF( .NOT. NAT_IN(jf) == 'F' )   ARRAY_IN( 1 ,:,:,:,jf) = zland    ! east except F-point
95                                               ARRAY_IN(jpi,:,:,:,jf) = zland    ! west
96            ENDIF
97            !                                ! North-South boundaries
98            IF( l_Jperio ) THEN                   !* cyclic
99               ARRAY_IN(:, 1 ,:,:,jf) = ARRAY_IN(:, jpjm1,:,:,jf)
100               ARRAY_IN(:,jpj,:,:,jf) = ARRAY_IN(:,   2  ,:,:,jf)
101            ELSEIF( ll_nfd ) THEN                  !* north fold
102               IF( .NOT. NAT_IN(jf) == 'F' )   ARRAY_IN(:, 1 ,:,:,jf) = zland    ! south except F-point
103               CALL lbc_nfd( ptab, NAT_IN(:), SGN_IN(:) OPT_K(:) )                       ! north fold treatment         
104            ELSE                                   !* closed
105               IF( .NOT. NAT_IN(jf) == 'F' )   ARRAY_IN(:, 1 ,:,:,jf) = zland    ! south except F-point
106                                               ARRAY_IN(:,jpj,:,:,jf) = zland    ! north
107            ENDIF
108            !
109         END DO
110         !
111      ENDIF
112      !
113   END SUBROUTINE ROUTINE_LNK
114
115#undef ARRAY_TYPE
116#undef NAT_IN
117#undef SGN_IN
118#undef ARRAY_IN
119#undef K_SIZE
120#undef L_SIZE
121#undef F_SIZE
122#undef OPT_K
Note: See TracBrowser for help on using the repository browser.