source: branches/2017/dev_r8126_ROBUST08_no_ghost/NEMOGCM/NEMO/OPA_SRC/LBC/mpp_lnk_generic.h90 @ 8758

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

Branch 2017/dev_r8126_ROBUST08_no_ghost. Changes to eliminate ghost rows and columns. Currently the halo width is still fixed as 1 but a single variable (nn_hls) has been introduced for the halo-size in preparation for allowing this to vary. nn_hls replaces jpreci and jprecj. These changes have passed full SETTE tests but iceberg exchanges across the north-fold remain untested (SETTE tests only release bergs in the SO) and will require further attention. Note layout.dat now reports the jpi and jpj values for the reporting processor only.

File size: 12.7 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( ptab, cd_nat, psgn, kfld, cd_mpp, pval )
49      INTEGER                     , INTENT(in   ) ::   kfld        ! number of pt3d arrays
50#else
51   SUBROUTINE ROUTINE_LNK( ptab, cd_nat, psgn      , cd_mpp, pval )
52#endif
53      ARRAY_TYPE(:,:,:,:,:)                                        ! array or pointer of arrays on which the boundary condition is applied
54      CHARACTER(len=1)            , INTENT(in   ) ::   NAT_IN(:)   ! nature of array grid-points
55      REAL(wp)                    , INTENT(in   ) ::   SGN_IN(:)   ! sign used across the north fold boundary
56      CHARACTER(len=3), OPTIONAL  , INTENT(in   ) ::   cd_mpp      ! fill the overlap area only
57      REAL(wp)        , OPTIONAL  , INTENT(in   ) ::   pval        ! background value (used at closed boundaries)
58      !
59      INTEGER  ::    ji,  jj,  jk,  jl, jh, jf   ! dummy loop indices
60      INTEGER  ::   ipi, ipj, ipk, ipl, ipf      ! dimension of the input array
61      INTEGER  ::   imigr, iihom, ijhom          ! local integers
62      INTEGER  ::   ml_req1, ml_req2, ml_err     ! for key_mpi_isend
63      REAL(wp) ::   zland
64      LOGICAL  ::   ll_Iperio, ll_Jperio
65      INTEGER , DIMENSION(MPI_STATUS_SIZE)      ::   ml_stat        ! for key_mpi_isend
66      REAL(wp), DIMENSION(:,:,:,:,:,:), ALLOCATABLE ::   zt3ns, zt3sn   ! north-south & south-north  halos
67      REAL(wp), DIMENSION(:,:,:,:,:,:), ALLOCATABLE ::   zt3ew, zt3we   ! east -west  & west - east  halos
68      !!----------------------------------------------------------------------
69      !
70      ipk = K_SIZE(ptab)   ! 3rd dimension
71      ipl = L_SIZE(ptab)   ! 4th    -
72      ipf = F_SIZE(ptab)   ! 5th    -      use in "multi" case (array of pointers)
73      !
74      ALLOCATE( zt3ns(jpi,nn_hls,ipk,ipl,ipf,2), zt3sn(jpi,nn_hls,ipk,ipl,ipf,2),   &
75         &      zt3ew(jpj,nn_hls,ipk,ipl,ipf,2), zt3we(jpj,nn_hls,ipk,ipl,ipf,2)  )
76      !
77      ll_Iperio = nbondi == 2 .AND. (nperio == 1 .OR. nperio == 4 .OR. nperio == 6)
78      ll_Jperio = nbondj == 2 .AND.  jperio == 7
79      !
80      IF( PRESENT( pval ) ) THEN   ;   zland = pval      ! set land value
81      ELSE                         ;   zland = 0._wp     ! zero by default
82      ENDIF
83
84      ! ------------------------------- !
85      !   standard boundary treatment   !    ! CAUTION: semi-column notation is often impossible
86      ! ------------------------------- !
87      !
88      IF( PRESENT( cd_mpp ) ) THEN     !==  halos filled with inner values  ==!
89         !
90         DO jf = 1, ipf                      ! number of arrays to be treated
91            !
92            DO jl = 1, ipl                   ! CAUTION: ptab is defined only between nld and nle
93               DO jk = 1, ipk
94                  DO jj = nlcj+1, jpj                 ! added line(s)   (inner only)
95                     ARRAY_IN(nldi  :nlei  ,jj,jk,jl,jf) = ARRAY_IN(nldi:nlei,nlej,jk,jl,jf)
96                     ARRAY_IN(1     :nldi-1,jj,jk,jl,jf) = ARRAY_IN(nldi     ,nlej,jk,jl,jf)
97                     ARRAY_IN(nlei+1:nlci  ,jj,jk,jl,jf) = ARRAY_IN(     nlei,nlej,jk,jl,jf)
98                  END DO
99                  DO ji = nlci+1, jpi                 ! added column(s) (full)
100                     ARRAY_IN(ji,nldj  :nlej  ,jk,jl,jf) = ARRAY_IN(nlei,nldj:nlej,jk,jl,jf)
101                     ARRAY_IN(ji,1     :nldj-1,jk,jl,jf) = ARRAY_IN(nlei,nldj     ,jk,jl,jf)
102                     ARRAY_IN(ji,nlej+1:jpj   ,jk,jl,jf) = ARRAY_IN(nlei,     nlej,jk,jl,jf)
103                  END DO
104               END DO
105            END DO
106            !
107         END DO
108         !
109      ELSE                              !==  standard close or cyclic treatment  ==!
110         !
111         DO jf = 1, ipf                      ! number of arrays to be treated
112            !
113            !                             ! East-West boundaries
114            IF( ll_Iperio ) THEN                   !* cyclic
115               ARRAY_IN( 1 ,:,:,:,jf) = ARRAY_IN(jpim1,:,:,:,jf)
116               ARRAY_IN(jpi,:,:,:,jf) = ARRAY_IN(  2  ,:,:,:,jf)
117            ELSE                                   !* closed
118               IF( .NOT. NAT_IN(jf) == 'F' )   ARRAY_IN(     1       :nn_hls,:,:,:,jf) = zland    ! east except F-point
119                                               ARRAY_IN(nlci-nn_hls+1:jpi   ,:,:,:,jf) = zland    ! west
120            ENDIF
121            !                                ! North-South boundaries
122            IF( ll_Jperio ) THEN                   !* cyclic (only with no mpp j-split)
123               ARRAY_IN(:, 1 ,:,:,jf) = ARRAY_IN(:, jpjm1,:,:,jf)
124               ARRAY_IN(:,jpj,:,:,jf) = ARRAY_IN(:,   2  ,:,:,jf)
125            ELSE                                   !* closed
126               IF( .NOT. NAT_IN(jf) == 'F' )   ARRAY_IN(:,     1       :nn_hls,:,:,jf) = zland    ! south except F-point
127                                               ARRAY_IN(:,nlcj-nn_hls+1:jpj   ,:,:,jf) = zland    ! north
128            ENDIF
129         END DO
130         !
131      ENDIF
132
133      ! ------------------------------- !
134      !      East and west exchange     !
135      ! ------------------------------- !
136      ! we play with the neigbours AND the row number because of the periodicity
137      !
138      SELECT CASE ( nbondi )      ! Read Dirichlet lateral conditions
139      CASE ( -1, 0, 1 )                ! all exept 2 (i.e. close case)
140         iihom = nlci-nreci
141         DO jf = 1, ipf
142            DO jl = 1, ipl
143               DO jk = 1, ipk
144                  DO jh = 1, nn_hls
145                     zt3ew(:,jh,jk,jl,jf,1) = ARRAY_IN(nn_hls+jh,:,jk,jl,jf)
146                     zt3we(:,jh,jk,jl,jf,1) = ARRAY_IN(iihom +jh,:,jk,jl,jf)
147                  END DO
148               END DO
149            END DO
150         END DO
151      END SELECT
152      !
153      !                           ! Migrations
154      imigr = nn_hls * jpj * ipk * ipl * ipf
155      !
156      SELECT CASE ( nbondi )
157      CASE ( -1 )
158         CALL mppsend( 2, zt3we(1,1,1,1,1,1), imigr, noea, ml_req1 )
159         CALL mpprecv( 1, zt3ew(1,1,1,1,1,2), imigr, noea )
160         IF(l_isend)   CALL mpi_wait(ml_req1, ml_stat, ml_err)
161      CASE ( 0 )
162         CALL mppsend( 1, zt3ew(1,1,1,1,1,1), imigr, nowe, ml_req1 )
163         CALL mppsend( 2, zt3we(1,1,1,1,1,1), imigr, noea, ml_req2 )
164         CALL mpprecv( 1, zt3ew(1,1,1,1,1,2), imigr, noea )
165         CALL mpprecv( 2, zt3we(1,1,1,1,1,2), imigr, nowe )
166         IF(l_isend)   CALL mpi_wait(ml_req1, ml_stat, ml_err)
167         IF(l_isend)   CALL mpi_wait(ml_req2, ml_stat, ml_err)
168      CASE ( 1 )
169         CALL mppsend( 1, zt3ew(1,1,1,1,1,1), imigr, nowe, ml_req1 )
170         CALL mpprecv( 2, zt3we(1,1,1,1,1,2), imigr, nowe )
171         IF(l_isend)   CALL mpi_wait(ml_req1, ml_stat, ml_err )
172      END SELECT
173      !
174      !                           ! Write Dirichlet lateral conditions
175      iihom = nlci-nn_hls
176      !
177      SELECT CASE ( nbondi )
178      CASE ( -1 )
179         DO jf = 1, ipf
180            DO jl = 1, ipl
181               DO jk = 1, ipk
182                  DO jh = 1, nn_hls
183                     ARRAY_IN(iihom+jh,:,jk,jl,jf) = zt3ew(:,jh,jk,jl,jf,2)
184                  END DO
185               END DO
186            END DO
187         END DO
188      CASE ( 0 )
189         DO jf = 1, ipf
190            DO jl = 1, ipl
191               DO jk = 1, ipk
192                  DO jh = 1, nn_hls
193                     ARRAY_IN(jh      ,:,jk,jl,jf) = zt3we(:,jh,jk,jl,jf,2)
194                     ARRAY_IN(iihom+jh,:,jk,jl,jf) = zt3ew(:,jh,jk,jl,jf,2)
195                  END DO
196               END DO
197            END DO
198         END DO
199      CASE ( 1 )
200         DO jf = 1, ipf
201            DO jl = 1, ipl
202               DO jk = 1, ipk
203                  DO jh = 1, nn_hls
204                     ARRAY_IN(jh      ,:,jk,jl,jf) = zt3we(:,jh,jk,jl,jf,2)
205                  END DO
206               END DO
207            END DO
208         END DO
209      END SELECT
210
211      ! 3. North and south directions
212      ! -----------------------------
213      ! always closed : we play only with the neigbours
214      !
215      IF( nbondj /= 2 ) THEN      ! Read Dirichlet lateral conditions
216         ijhom = nlcj-nrecj
217         DO jf = 1, ipf
218            DO jl = 1, ipl
219               DO jk = 1, ipk
220                  DO jh = 1, nn_hls
221                     zt3sn(:,jh,jk,jl,jf,1) = ARRAY_IN(:,ijhom +jh,jk,jl,jf)
222                     zt3ns(:,jh,jk,jl,jf,1) = ARRAY_IN(:,nn_hls+jh,jk,jl,jf)
223                  END DO
224               END DO
225            END DO
226         END DO
227      ENDIF
228      !
229      !                           ! Migrations
230      imigr = nn_hls * jpi * ipk * ipl * ipf
231      !
232      SELECT CASE ( nbondj )
233      CASE ( -1 )
234         CALL mppsend( 4, zt3sn(1,1,1,1,1,1), imigr, nono, ml_req1 )
235         CALL mpprecv( 3, zt3ns(1,1,1,1,1,2), imigr, nono )
236         IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err )
237      CASE ( 0 )
238         CALL mppsend( 3, zt3ns(1,1,1,1,1,1), imigr, noso, ml_req1 )
239         CALL mppsend( 4, zt3sn(1,1,1,1,1,1), imigr, nono, ml_req2 )
240         CALL mpprecv( 3, zt3ns(1,1,1,1,1,2), imigr, nono )
241         CALL mpprecv( 4, zt3sn(1,1,1,1,1,2), imigr, noso )
242         IF(l_isend)   CALL mpi_wait(ml_req1, ml_stat, ml_err )
243         IF(l_isend)   CALL mpi_wait(ml_req2, ml_stat, ml_err )
244      CASE ( 1 )
245         CALL mppsend( 3, zt3ns(1,1,1,1,1,1), imigr, noso, ml_req1 )
246         CALL mpprecv( 4, zt3sn(1,1,1,1,1,2), imigr, noso )
247         IF(l_isend)   CALL mpi_wait(ml_req1, ml_stat, ml_err )
248      END SELECT
249      !
250      !                           ! Write Dirichlet lateral conditions
251      ijhom = nlcj-nn_hls
252      !
253      SELECT CASE ( nbondj )
254      CASE ( -1 )
255         DO jf = 1, ipf
256            DO jl = 1, ipl
257               DO jk = 1, ipk
258                  DO jh = 1, nn_hls
259                     ARRAY_IN(:,ijhom+jh,jk,jl,jf) = zt3ns(:,jh,jk,jl,jf,2)
260                  END DO
261               END DO
262            END DO
263         END DO
264      CASE ( 0 )
265         DO jf = 1, ipf
266            DO jl = 1, ipl
267               DO jk = 1, ipk
268                  DO jh = 1, nn_hls
269                     ARRAY_IN(:,      jh,jk,jl,jf) = zt3sn(:,jh,jk,jl,jf,2)
270                     ARRAY_IN(:,ijhom+jh,jk,jl,jf) = zt3ns(:,jh,jk,jl,jf,2)
271                  END DO
272               END DO
273            END DO
274         END DO
275      CASE ( 1 )
276         DO jf = 1, ipf
277            DO jl = 1, ipl
278               DO jk = 1, ipk
279                  DO jh = 1, nn_hls
280                     ARRAY_IN(:,jh,jk,jl,jf) = zt3sn(:,jh,jk,jl,jf,2)
281                  END DO
282               END DO
283            END DO
284         END DO
285      END SELECT
286
287      ! 4. north fold treatment
288      ! -----------------------
289      !
290      IF( npolj /= 0 .AND. .NOT. PRESENT(cd_mpp) ) THEN
291         !
292         SELECT CASE ( jpni )
293         CASE ( 1 )     ;   CALL lbc_nfd( ptab, NAT_IN(:), SGN_IN(:) OPT_K(:) )   ! only 1 northern proc, no mpp
294         CASE DEFAULT   ;   CALL mpp_nfd( ptab, NAT_IN(:), SGN_IN(:) OPT_K(:) )   ! for all northern procs.
295         END SELECT
296         !
297      ENDIF
298      !
299      DEALLOCATE( zt3ns, zt3sn, zt3ew, zt3we )
300      !
301   END SUBROUTINE ROUTINE_LNK
302
303#undef ARRAY_TYPE
304#undef NAT_IN
305#undef SGN_IN
306#undef ARRAY_IN
307#undef K_SIZE
308#undef L_SIZE
309#undef F_SIZE
310#undef OPT_K
Note: See TracBrowser for help on using the repository browser.