source: branches/2017/dev_r8126_ROBUST08_no_ghost/NEMOGCM/NEMO/OPA_SRC/LBC/lbc_nfd_nogather_generic.h90 @ 8196

Last change on this file since 8196 was 8196, checked in by acc, 3 years ago

Branch 2017/dev_r8126_ROBUST08_no_ghost. Add generic routine for the north fold operation without global width arrays or MPI_ALLGATHER operations (lbc_nfd_nogather_generic.h90). Actually the generic form is not strictly neccessary since only the 4d array version is used. Other possibilities are currently commented out. This commit includes fixes to mpp_nfd_generic.h90 which ensure only necessary arrays are allocated depending on ln_nnogather setting. Tested with ORCA2LIMPIS_LONG SETTE test and produces identical results with ln_nnogather true or false.

File size: 14.8 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#   if defined DIM_2d
6#      define ARRAY_TYPE(i,j,k,l,f)    TYPE(PTR_2D),INTENT(inout)::ptab(f)
7#      define ARRAY_IN(i,j,k,l,f)      ptab(f)%pt2d(i,j)
8#      define K_SIZE(ptab)             1
9#      define L_SIZE(ptab)             1
10#      define ARRAY2_TYPE(i,j,k,l,f)   TYPE(PTR_2D),INTENT(inout)::ptab2(f)
11#      define ARRAY2_IN(i,j,k,l,f)     ptab2(f)%pt2d(i,j)
12#   endif
13#   if defined DIM_3d
14#      define ARRAY_TYPE(i,j,k,l,f)    TYPE(PTR_3D),INTENT(inout)::ptab(f)
15#      define ARRAY_IN(i,j,k,l,f)      ptab(f)%pt3d(i,j,k)
16#      define K_SIZE(ptab)             SIZE(ptab(1)%pt3d,3)
17#      define L_SIZE(ptab)             1
18#      define ARRAY2_TYPE(i,j,k,l,f)   TYPE(PTR_3D),INTENT(inout)::ptab2(f)
19#      define ARRAY2_IN(i,j,k,l,f)     ptab2(f)%pt3d(i,j,k)
20#   endif
21#   if defined DIM_4d
22#      define ARRAY_TYPE(i,j,k,l,f)    TYPE(PTR_4D),INTENT(inout)::ptab(f)
23#      define ARRAY_IN(i,j,k,l,f)      ptab(f)%pt4d(i,j,k,l)
24#      define K_SIZE(ptab)             SIZE(ptab(1)%pt4d,3)
25#      define L_SIZE(ptab)             SIZE(ptab(1)%pt4d,4)
26#      define ARRAY2_TYPE(i,j,k,l,f)   TYPE(PTR_4D),INTENT(inout)::ptab2(f)
27#      define ARRAY2_IN(i,j,k,l,f)     ptab2(f)%pt4d(i,j,k,l)
28#   endif
29#else
30!                          !==  IN: ptab is an array  ==!
31#   define NAT_IN(k)                cd_nat
32#   define SGN_IN(k)                psgn
33#   define F_SIZE(ptab)             1
34#   if defined DIM_2d
35#      define ARRAY_IN(i,j,k,l,f)   ptab(i,j)
36#      define K_SIZE(ptab)          1
37#      define L_SIZE(ptab)          1
38#      define ARRAY2_IN(i,j,k,l,f)  ptab2(i,j)
39#   endif
40#   if defined DIM_3d
41#      define ARRAY_IN(i,j,k,l,f)   ptab(i,j,k)
42#      define K_SIZE(ptab)          SIZE(ptab,3)
43#      define L_SIZE(ptab)          1
44#      define ARRAY2_IN(i,j,k,l,f)  ptab2(i,j,k)
45#   endif
46#   if defined DIM_4d
47#      define ARRAY_IN(i,j,k,l,f)   ptab(i,j,k,l)
48#      define K_SIZE(ptab)          SIZE(ptab,3)
49#      define L_SIZE(ptab)          SIZE(ptab,4)
50#      define ARRAY2_IN(i,j,k,l,f)  ptab2(i,j,k,l)
51#   endif
52#   define ARRAY_TYPE(i,j,k,l,f)     REAL(wp),INTENT(inout)::ARRAY_IN(i,j,k,l,f)
53#   define ARRAY2_TYPE(i,j,k,l,f)    REAL(wp),INTENT(inout)::ARRAY2_IN(i,j,k,l,f)
54#endif
55
56   SUBROUTINE ROUTINE_NFD( ptab, ptab2, cd_nat, psgn, kfld )
57      !
58      !!----------------------------------------------------------------------
59      !!
60      !! ** Purpose :   lateral boundary condition : North fold treatment
61      !!                without allgather exchanges.
62      !!
63      !!----------------------------------------------------------------------
64      ARRAY_TYPE(:,:,:,:,:)                             ! array or pointer of arrays on which the boundary condition is applied
65      ARRAY2_TYPE(:,:,:,:,:)                            ! array or pointer of arrays on which the boundary condition is applied
66      CHARACTER(len=1) , INTENT(in   ) ::   NAT_IN(:)   ! nature of array grid-points
67      REAL(wp)         , INTENT(in   ) ::   SGN_IN(:)   ! sign used across the north fold boundary
68      INTEGER, OPTIONAL, INTENT(in   ) ::   kfld        ! number of pt3d arrays
69      !
70      INTEGER  ::    ji,  jj,   jk,     jl,   jh,  jf   ! dummy loop indices
71      INTEGER  ::   ipi, ipj,  ipk,    ipl,  ipf        ! dimension of the input array
72      INTEGER  ::   ijt, iju, ijpj, ijpjm1, ijta, ijua, jia, startloop, endloop
73      !!----------------------------------------------------------------------
74      ipk = K_SIZE(ptab)   ! 3rd dimension
75      ipl = L_SIZE(ptab)   ! 4th    -
76      ipf = F_SIZE(ptab)   ! 5th    -      use in "multi" case (array of pointers)
77      !
78      !
79      SELECT CASE ( jpni )
80      CASE ( 1 )     ;   ijpj = nlcj      ! 1 proc only  along the i-direction
81      CASE DEFAULT   ;   ijpj = 4         ! several proc along the i-direction
82      END SELECT
83      ijpjm1 = ijpj-1
84      !
85      !
86      DO jf = 1, ipf                      ! Loop over the number of arrays to be processed
87         SELECT CASE ( npolj )
88         !
89         CASE ( 3, 4 )                       ! *  North fold  T-point pivot
90            !
91            SELECT CASE ( NAT_IN(jf) )
92               CASE ( 'T' , 'W' )                         ! T-, W-point
93                  IF ( nimpp /= 1 ) THEN   ;   startloop = 1
94                  ELSE                     ;   startloop = 2
95               ENDIF
96                  !
97               DO ji = startloop, nlci
98                 ijt=jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4
99                        ARRAY_IN(ji,ijpj,:,:,jf) = SGN_IN(jf) * ARRAY2_IN(ijt,ijpj-2,:,:,jf)
100               END DO
101               IF(nimpp .eq. 1) THEN
102                 ARRAY_IN(1,ijpj,:,:,jf) = SGN_IN(jf) * ARRAY_IN(3,ijpj-2,:,:,jf)
103               ENDIF
104   
105               IF( nimpp >= jpiglo/2+1 ) THEN
106                  startloop = 1
107               ELSEIF( nimpp+nlci-1 >= jpiglo/2+1 .AND. nimpp < jpiglo/2+1 ) THEN
108                  startloop = jpiglo/2+1 - nimpp + 1
109               ELSE
110                  startloop = nlci + 1
111               ENDIF
112               IF(startloop <= nlci) THEN
113               DO ji = startloop, nlci
114                  ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4
115                  jia = ji + nimpp - 1
116                  ijta = jpiglo - jia + 2
117                  IF( ijta >= startloop+nimpp-1 .AND. ijta < jia ) THEN
118                             ARRAY_IN(ji,ijpjm1,:,:,jf) = SGN_IN(jf) * ARRAY_IN(ijta-nimpp+1,ijpjm1,:,:,jf)
119                  ELSE
120                             ARRAY_IN(ji,ijpjm1,:,:,jf) = SGN_IN(jf) * ARRAY2_IN(ijt,ijpjm1,:,:,jf)
121                  ENDIF
122               END DO
123               ENDIF
124               !
125            CASE ( 'U' )                                     ! U-point
126               IF( nimpp + nlci - 1 /= jpiglo ) THEN
127                  endloop = nlci
128               ELSE
129                  endloop = nlci - 1
130               ENDIF
131               DO ji = 1, endloop
132                  iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3
133                        ARRAY_IN(ji,ijpj,:,:,jf) = SGN_IN(jf) * ARRAY2_IN(iju,ijpj-2,:,:,jf)
134               END DO
135               IF (nimpp .eq. 1) THEN
136                        ARRAY_IN(   1  ,ijpj,:,:,jf) = SGN_IN(jf) * ARRAY_IN(    2   ,ijpj-2,:,:,jf)
137               ENDIF
138               IF((nimpp + nlci - 1) .eq. jpiglo) THEN
139                        ARRAY_IN(nlci,ijpj,:,:,jf) = SGN_IN(jf) * ARRAY_IN(nlci-1,ijpj-2,:,:,jf)
140               ENDIF
141               !
142               IF( nimpp + nlci - 1 /= jpiglo ) THEN
143                  endloop = nlci
144               ELSE
145                  endloop = nlci - 1
146               ENDIF
147               IF( nimpp >= jpiglo/2 ) THEN
148                  startloop = 1
149                  ELSEIF( ( nimpp+nlci-1 >= jpiglo/2 ) .AND. ( nimpp < jpiglo/2 ) ) THEN
150                  startloop = jpiglo/2 - nimpp + 1
151               ELSE
152                  startloop = endloop + 1
153               ENDIF
154               IF( startloop <= endloop ) THEN
155               DO ji = startloop, endloop
156                  iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3
157                  jia = ji + nimpp - 1
158                  ijua = jpiglo - jia + 1
159                  IF( ijua >= startloop+nimpp-1 .AND. ijua < jia ) THEN
160                           ARRAY_IN(ji,ijpjm1,:,:,jf) = SGN_IN(jf) * ARRAY_IN(ijua-nimpp+1,ijpjm1,:,:,jf)
161                  ELSE
162                           ARRAY_IN(ji,ijpjm1,:,:,jf) = SGN_IN(jf) * ARRAY2_IN(iju,ijpjm1,:,:,jf)
163                  ENDIF
164               END DO
165               ENDIF
166               !
167            CASE ( 'V' )                                     ! V-point
168               IF( nimpp /= 1 ) THEN
169                 startloop = 1
170               ELSE
171                 startloop = 2
172               ENDIF
173               DO ji = startloop, nlci
174                 ijt=jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4
175                        ARRAY_IN(ji,ijpj-1,:,:,jf) = SGN_IN(jf) * ARRAY2_IN(ijt,ijpj-2,:,:,jf)
176                        ARRAY_IN(ji,ijpj  ,:,:,jf) = SGN_IN(jf) * ARRAY2_IN(ijt,ijpj-3,:,:,jf)
177               END DO
178               IF (nimpp .eq. 1) THEN
179                        ARRAY_IN(1,ijpj,:,:,jf) = SGN_IN(jf) * ARRAY_IN(3,ijpj-3,:,:,jf)
180               ENDIF
181            CASE ( 'F' )                                     ! F-point
182               IF( nimpp + nlci - 1 /= jpiglo ) THEN
183                  endloop = nlci
184               ELSE
185                  endloop = nlci - 1
186               ENDIF
187               DO ji = 1, endloop
188                  iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3
189                        ARRAY_IN(ji,ijpj-1,:,:,jf) = SGN_IN(jf) * ARRAY2_IN(iju,ijpj-2,:,:,jf)
190                        ARRAY_IN(ji,ijpj  ,:,:,jf) = SGN_IN(jf) * ARRAY2_IN(iju,ijpj-3,:,:,jf)
191               END DO
192               IF (nimpp .eq. 1) THEN
193                        ARRAY_IN(   1  ,ijpj  ,:,:,jf) = SGN_IN(jf) * ARRAY_IN(    2   ,ijpj-3,:,:,jf)
194                        ARRAY_IN(   1  ,ijpj-1,:,:,jf) = SGN_IN(jf) * ARRAY_IN(    2   ,ijpj-2,:,:,jf)
195               ENDIF
196               IF((nimpp + nlci - 1) .eq. jpiglo) THEN
197                        ARRAY_IN(nlci,ijpj  ,:,:,jf) = SGN_IN(jf) * ARRAY_IN(nlci-1,ijpj-3,:,:,jf)
198                        ARRAY_IN(nlci,ijpj-1,:,:,jf) = SGN_IN(jf) * ARRAY_IN(nlci-1,ijpj-2,:,:,jf)
199               ENDIF
200               !
201            CASE ( 'I' )                                     ! ice U-V point (I-point)
202               IF( nimpp /= 1 ) THEN
203                  startloop = 1
204               ELSE
205                  startloop = 3
206                  ARRAY_IN(2,ijpj,:,:,jf) = SGN_IN(jf) * ARRAY2_IN(3,ijpjm1,:,:,jf)
207               ENDIF
208               DO ji = startloop, nlci
209                  iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 5
210                  ARRAY_IN(ji,ijpj,:,:,jf) = SGN_IN(jf) * ARRAY2_IN(iju,ijpjm1,:,:,jf)
211               END DO
212            END SELECT
213            !
214         CASE ( 5, 6 )                        ! *  North fold  F-point pivot
215            !
216            SELECT CASE ( NAT_IN(jf) )
217            CASE ( 'T' , 'W' )                               ! T-, W-point
218               DO ji = 1, nlci
219                  ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3
220                        ARRAY_IN(ji,ijpj,:,:,jf) = SGN_IN(jf) * ARRAY2_IN(ijt,ijpj-1,:,:,jf)
221               END DO
222               !
223            CASE ( 'U' )                                     ! U-point
224               IF( nimpp + nlci - 1 /= jpiglo ) THEN
225                  endloop = nlci
226               ELSE
227                  endloop = nlci - 1
228               ENDIF
229               DO ji = 1, endloop
230                  iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 2
231                        ARRAY_IN(ji,ijpj,:,:,jf) = SGN_IN(jf) * ARRAY2_IN(iju,ijpj-1,:,:,jf)
232               END DO
233               IF((nimpp + nlci - 1) .eq. jpiglo) THEN
234                        ARRAY_IN(nlci,ijpj,:,:,jf) = SGN_IN(jf) * ARRAY2_IN(1,ijpj-1,:,:,jf)
235               ENDIF
236               !
237            CASE ( 'V' )                                     ! V-point
238               DO ji = 1, nlci
239                  ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3
240                        ARRAY_IN(ji,ijpj,:,:,jf) = SGN_IN(jf) * ARRAY2_IN(ijt,ijpj-2,:,:,jf)
241               END DO
242                  !
243               IF( nimpp >= jpiglo/2+1 ) THEN
244                  startloop = 1
245               ELSEIF( nimpp+nlci-1 >= jpiglo/2+1 .AND. nimpp < jpiglo/2+1 ) THEN
246                  startloop = jpiglo/2+1 - nimpp + 1
247               ELSE
248                  startloop = nlci + 1
249               ENDIF
250               IF( startloop <= nlci ) THEN
251               DO ji = startloop, nlci
252                  ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3
253                          ARRAY_IN(ji,ijpjm1,:,:,jf) = SGN_IN(jf) * ARRAY2_IN(ijt,ijpjm1,:,:,jf)
254               END DO
255               ENDIF
256               !
257            CASE ( 'F' )                               ! F-point
258               IF( nimpp + nlci - 1 /= jpiglo ) THEN
259                  endloop = nlci
260               ELSE
261                  endloop = nlci - 1
262               ENDIF
263               DO ji = 1, endloop
264                  iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 2
265                        ARRAY_IN(ji,ijpj ,:,:,jf) = SGN_IN(jf) * ARRAY2_IN(iju,ijpj-2,:,:,jf)
266               END DO
267               IF((nimpp + nlci - 1) .eq. jpiglo) THEN
268                        ARRAY_IN(nlci,ijpj,:,:,jf) = SGN_IN(jf) * ARRAY2_IN(1,ijpj-2,:,:,jf)
269               ENDIF
270               !
271               IF( nimpp + nlci - 1 /= jpiglo ) THEN
272                  endloop = nlci
273               ELSE
274                  endloop = nlci - 1
275               ENDIF
276               IF( nimpp >= jpiglo/2+1 ) THEN
277                  startloop = 1
278               ELSEIF( nimpp+nlci-1 >= jpiglo/2+1 .AND. nimpp < jpiglo/2+1 ) THEN
279                  startloop = jpiglo/2+1 - nimpp + 1
280               ELSE
281                  startloop = endloop + 1
282               ENDIF
283               IF( startloop <= endloop ) THEN
284                  DO ji = startloop, endloop
285                      iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 2
286                      ARRAY_IN(ji,ijpjm1,:,:,jf) = SGN_IN(jf) * ARRAY2_IN(iju,ijpjm1,:,:,jf)
287                  END DO
288               ENDIF
289               !
290            CASE ( 'I' )                                  ! ice U-V point (I-point)
291                  IF( nimpp /= 1 ) THEN
292                     startloop = 1
293                  ELSE
294                     startloop = 2
295                  ENDIF
296                  IF( nimpp + nlci - 1 /= jpiglo ) THEN
297                     endloop = nlci
298                  ELSE
299                     endloop = nlci - 1
300                  ENDIF
301                  DO ji = startloop , endloop
302                     ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4
303                     ARRAY_IN(ji,ijpj,:,:,jf) = 0.5 * (ARRAY_IN(ji,ijpjm1,:,:,jf) + SGN_IN(jf) * ARRAY2_IN(ijt,ijpjm1,:,:,jf))
304                  END DO
305                  !
306            END SELECT
307            !
308         CASE DEFAULT                           ! *  closed : the code probably never go through
309            !
310            SELECT CASE ( NAT_IN(jf))
311            CASE ( 'T' , 'U' , 'V' , 'W' )                 ! T-, U-, V-, W-points
312                  ARRAY_IN(:, 1  ,:,:,jf) = 0._wp
313                  ARRAY_IN(:,ijpj,:,:,jf) = 0._wp
314            CASE ( 'F' )                                   ! F-point
315                  ARRAY_IN(:,ijpj,:,:,jf) = 0._wp
316            CASE ( 'I' )                                   ! ice U-V point
317                  ARRAY_IN(:, 1  ,:,:,jf) = 0._wp
318                  ARRAY_IN(:,ijpj,:,:,jf) = 0._wp
319            END SELECT
320            !
321         END SELECT     !  npolj
322         !
323      END DO            ! End jf loop
324   END SUBROUTINE ROUTINE_NFD
325#undef ARRAY_TYPE
326#undef ARRAY_IN
327#undef NAT_IN
328#undef SGN_IN
329#undef K_SIZE
330#undef L_SIZE
331#undef F_SIZE
332#undef ARRAY2_TYPE
333#undef ARRAY2_IN
Note: See TracBrowser for help on using the repository browser.