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_nfd_ext_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_nfd_ext_generic.h90 @ 14336

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

dev_r14312_MPI_Interface: replace jperio by l_Iperio, l_Jperio, l_NFold, c_NFtype, #2598
  • Property svn:keywords set to Id
  • Property svn:mime-type set to text/x-fortran
File size: 6.7 KB
Line 
1!                          !==  IN: ptab is an array  ==!
2#define NAT_IN(k)                cd_nat
3#define SGN_IN(k)                psgn
4#define F_SIZE(ptab)             1
5#if defined DIM_2d
6#   define ARRAY_IN(i,j,k,l,f)   ptab(i,j)
7#   define K_SIZE(ptab)          1
8#   define L_SIZE(ptab)          1
9#endif
10#if defined SINGLE_PRECISION
11#   define ARRAY_TYPE(i,j,k,l,f)    REAL(sp),INTENT(inout)::ARRAY_IN(i,j,k,l,f)
12#   define PRECISION sp
13#else
14#   define ARRAY_TYPE(i,j,k,l,f)    REAL(dp),INTENT(inout)::ARRAY_IN(i,j,k,l,f)
15#   define PRECISION dp
16#endif
17
18   SUBROUTINE ROUTINE_NFD( ptab, cd_nat, psgn, kextj )
19      !!----------------------------------------------------------------------
20      INTEGER          , INTENT(in   ) ::   kextj       ! extra halo width at north fold, declared before its use in ARRAY_TYPE
21      ARRAY_TYPE(:,1-kextj:,:,:,:)                      ! array or pointer of arrays on which the boundary condition is applied
22      CHARACTER(len=1) , INTENT(in   ) ::   NAT_IN(:)   ! nature of array grid-points
23      REAL(PRECISION)  , INTENT(in   ) ::   SGN_IN(:)   ! sign used across the north fold boundary
24      !
25      INTEGER  ::    ji,  jj,  jk,  jl, jh,  jf   ! dummy loop indices
26      INTEGER  ::   ipi, ipj, ipk, ipl,     ipf   ! dimension of the input array
27      INTEGER  ::   ijt, iju, ipjm1
28      !!----------------------------------------------------------------------
29      !
30      ipk = K_SIZE(ptab)   ! 3rd dimension
31      ipl = L_SIZE(ptab)   ! 4th    -
32      ipf = F_SIZE(ptab)   ! 5th    -      use in "multi" case (array of pointers)
33      !
34      !
35      SELECT CASE ( jpni )
36      CASE ( 1 )     ;   ipj = jpj        ! 1 proc only  along the i-direction
37      CASE DEFAULT   ;   ipj = 4          ! several proc along the i-direction
38      END SELECT
39      !
40      ipjm1 = ipj-1
41
42      !
43      DO jf = 1, ipf                      ! Loop on the number of arrays to be treated
44         !
45         IF( c_NFtype == 'T' ) THEN            ! *  North fold  T-point pivot
46            !
47            SELECT CASE ( NAT_IN(jf)  )
48            CASE ( 'T' , 'W' )                         ! T-, W-point
49               DO jh = 0, kextj
50                  DO ji = 2, jpiglo
51                     ijt = jpiglo-ji+2
52                     ARRAY_IN(ji,ipj+jh,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(ijt,ipj-2-jh,:,:,jf)
53                  END DO
54                  ARRAY_IN(1,ipj+jh,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(3,ipj-2-jh,:,:,jf)
55               END DO
56               DO ji = jpiglo/2+1, jpiglo
57                  ijt = jpiglo-ji+2
58                  ARRAY_IN(ji,ipjm1,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(ijt,ipjm1,:,:,jf)
59               END DO
60            CASE ( 'U' )                               ! U-point
61               DO jh = 0, kextj
62                  DO ji = 2, jpiglo-1
63                     iju = jpiglo-ji+1
64                     ARRAY_IN(ji,ipj+jh,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(iju,ipj-2-jh,:,:,jf)
65                  END DO
66                 ARRAY_IN(   1  ,ipj+jh,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(    2   ,ipj-2-jh,:,:,jf)
67                 ARRAY_IN(jpiglo,ipj+jh,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(jpiglo-1,ipj-2-jh,:,:,jf) 
68               END DO
69               DO ji = jpiglo/2, jpiglo-1
70                  iju = jpiglo-ji+1
71                  ARRAY_IN(ji,ipjm1,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(iju,ipjm1,:,:,jf)
72               END DO
73            CASE ( 'V' )                               ! V-point
74               DO jh = 0, kextj
75                  DO ji = 2, jpiglo
76                     ijt = jpiglo-ji+2
77                     ARRAY_IN(ji,ipj-1+jh,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(ijt,ipj-2-jh,:,:,jf)
78                     ARRAY_IN(ji,ipj+jh  ,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(ijt,ipj-3-jh,:,:,jf)
79                  END DO
80                  ARRAY_IN(1,ipj+jh,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(3,ipj-3-jh,:,:,jf) 
81               END DO
82            CASE ( 'F' )                               ! F-point
83               DO jh = 0, kextj
84                  DO ji = 1, jpiglo-1
85                     iju = jpiglo-ji+1
86                     ARRAY_IN(ji,ipj-1+jh,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(iju,ipj-2-jh,:,:,jf)
87                     ARRAY_IN(ji,ipj+jh  ,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(iju,ipj-3-jh,:,:,jf)
88                  END DO
89               END DO
90               DO jh = 0, kextj
91                  ARRAY_IN(   1  ,ipj+jh,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(    2   ,ipj-3-jh,:,:,jf)
92                  ARRAY_IN(jpiglo,ipj+jh,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(jpiglo-1,ipj-3-jh,:,:,jf)
93               END DO
94            END SELECT
95            !
96         ENDIF   ! c_NFtype == 'T'
97         !
98         IF( c_NFtype == 'F' ) THEN            ! *  North fold  F-point pivot
99            !
100            SELECT CASE ( NAT_IN(jf)  )
101            CASE ( 'T' , 'W' )                         ! T-, W-point
102               DO jh = 0, kextj
103                  DO ji = 1, jpiglo
104                     ijt = jpiglo-ji+1
105                     ARRAY_IN(ji,ipj+jh,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(ijt,ipj-1-jh,:,:,jf)
106                  END DO
107               END DO
108            CASE ( 'U' )                               ! U-point
109               DO jh = 0, kextj
110                  DO ji = 1, jpiglo-1
111                     iju = jpiglo-ji
112                     ARRAY_IN(ji,ipj+jh,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(iju,ipj-1-jh,:,:,jf)
113                  END DO
114                  ARRAY_IN(jpiglo,ipj+jh,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(jpiglo-2,ipj-1-jh,:,:,jf)
115               END DO
116            CASE ( 'V' )                               ! V-point
117               DO jh = 0, kextj
118                  DO ji = 1, jpiglo
119                     ijt = jpiglo-ji+1
120                     ARRAY_IN(ji,ipj+jh,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(ijt,ipj-2-jh,:,:,jf)
121                  END DO
122               END DO
123               DO ji = jpiglo/2+1, jpiglo
124                  ijt = jpiglo-ji+1
125                  ARRAY_IN(ji,ipjm1,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(ijt,ipjm1,:,:,jf)
126               END DO
127            CASE ( 'F' )                               ! F-point
128               DO jh = 0, kextj
129                  DO ji = 1, jpiglo-1
130                     iju = jpiglo-ji
131                     ARRAY_IN(ji,ipj+jh  ,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(iju,ipj-2-jh,:,:,jf)
132                  END DO
133                  ARRAY_IN(jpiglo,ipj+jh,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(jpiglo-2,ipj-2-jh,:,:,jf)
134               END DO
135               DO ji = jpiglo/2+1, jpiglo-1
136                  iju = jpiglo-ji
137                  ARRAY_IN(ji,ipjm1,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(iju,ipjm1,:,:,jf)
138               END DO
139            END SELECT
140            !
141         ENDIF   ! c_NFtype == 'F'
142         !
143      END DO
144      !
145   END SUBROUTINE ROUTINE_NFD
146
147#undef PRECISION
148#undef ARRAY_TYPE
149#undef ARRAY_IN
150#undef NAT_IN
151#undef SGN_IN
152#undef K_SIZE
153#undef L_SIZE
154#undef F_SIZE
Note: See TracBrowser for help on using the repository browser.