source: branches/2017/dev_r8126_ROBUST08_no_ghost/NEMOGCM/NEMO/OPA_SRC/LBC/mpp_bdy_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.5 KB
Line 
1#if defined MULTI
2#   define NAT_IN(k)                cd_nat(k)   
3#   define SGN_IN(k)                psgn(k)
4#   define IBD_IN(k)                kb_bdy(k)
5#   define F_SIZE(ptab)             kfld
6#   define OPT_K(k)                 ,ipf
7#   if defined DIM_2d
8#      define ARRAY_TYPE(i,j,k,l,f)    TYPE(PTR_2D)                , INTENT(inout) ::   ptab(f)
9#      define ARRAY_IN(i,j,k,l,f)      ptab(f)%pt2d(i,j)
10#      define K_SIZE(ptab)             1
11#      define L_SIZE(ptab)             1
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#   endif
19#   if defined DIM_4d
20#      define ARRAY_TYPE(i,j,k,l,f)    TYPE(PTR_4D)                , INTENT(inout) ::   ptab(f)
21#      define ARRAY_IN(i,j,k,l,f)      ptab(f)%pt4d(i,j,k,l)
22#      define K_SIZE(ptab)             SIZE(ptab(1)%pt4d,3)
23#      define L_SIZE(ptab)             SIZE(ptab(1)%pt4d,4)
24#   endif
25#else
26#   define ARRAY_TYPE(i,j,k,l,f)    REAL(wp)                    , INTENT(inout) ::   ARRAY_IN(i,j,k,l,f)
27#   define NAT_IN(k)                cd_nat
28#   define SGN_IN(k)                psgn
29#   define IBD_IN(k)                kb_bdy
30#   define F_SIZE(ptab)             1
31#   define OPT_K(k)                 
32#   if defined DIM_2d
33#      define ARRAY_IN(i,j,k,l,f)   ptab(i,j)
34#      define K_SIZE(ptab)          1
35#      define L_SIZE(ptab)          1
36#   endif
37#   if defined DIM_3d
38#      define ARRAY_IN(i,j,k,l,f)   ptab(i,j,k)
39#      define K_SIZE(ptab)          SIZE(ptab,3)
40#      define L_SIZE(ptab)          1
41#   endif
42#   if defined DIM_4d
43#      define ARRAY_IN(i,j,k,l,f)   ptab(i,j,k,l)
44#      define K_SIZE(ptab)          SIZE(ptab,3)
45#      define L_SIZE(ptab)          SIZE(ptab,4)
46#   endif
47#endif
48
49#if defined MULTI
50   SUBROUTINE ROUTINE_BDY( ptab, cd_nat, psgn, kfld, kb_bdy )
51      INTEGER                     , INTENT(in   ) ::   kfld        ! number of pt3d arrays
52#else
53   SUBROUTINE ROUTINE_BDY( ptab, cd_nat, psgn      , kb_bdy )
54#endif
55      !!----------------------------------------------------------------------
56      !!                  ***  routine mpp_lnk_bdy_3d  ***
57      !!
58      !! ** Purpose :   Message passing management
59      !!
60      !! ** Method  :   Use mppsend and mpprecv function for passing BDY boundaries
61      !!      between processors following neighboring subdomains.
62      !!            domain parameters
63      !!                    nlci   : first dimension of the local subdomain
64      !!                    nlcj   : second dimension of the local subdomain
65      !!                    nbondi_bdy : mark for "east-west local boundary"
66      !!                    nbondj_bdy : mark for "north-south local boundary"
67      !!                    noea   : number for local neighboring processors
68      !!                    nowe   : number for local neighboring processors
69      !!                    noso   : number for local neighboring processors
70      !!                    nono   : number for local neighboring processors
71      !!
72      !! ** Action  :   ptab with update value at its periphery
73      !!
74      !!----------------------------------------------------------------------
75      ARRAY_TYPE(:,:,:,:,:)   ! array or pointer of arrays on which the boundary condition is applied
76      CHARACTER(len=1)            , INTENT(in   ) ::   NAT_IN(:)   ! nature of array grid-points
77      REAL(wp)                    , INTENT(in   ) ::   SGN_IN(:)   ! sign used across the north fold boundary
78      INTEGER                     , INTENT(in   ) ::   IBD_IN(:)   ! BDY boundary set
79      !
80      INTEGER  ::   ji, jj, jk, jl, jh, jf     ! dummy loop indices
81      INTEGER  ::   ipk, ipl, ipf              ! 3dimension of the input array
82      INTEGER  ::   imigr, iihom, ijhom        ! local integers
83      INTEGER  ::   ml_req1, ml_req2, ml_err   ! for key_mpi_isend
84      REAL(wp) ::   zland                      ! local scalar
85      INTEGER, DIMENSION(MPI_STATUS_SIZE) ::   ml_stat   ! for key_mpi_isend
86      !
87      REAL(wp), DIMENSION(:,:,:,:,:,:), ALLOCATABLE ::   zt3ns, zt3sn   ! 3d for north-south & south-north
88      REAL(wp), DIMENSION(:,:,:,:,:,:), ALLOCATABLE ::   zt3ew, zt3we   ! 3d for east-west & west-east
89      !!----------------------------------------------------------------------
90      !
91      ipk = K_SIZE(ptab)   ! 3rd dimension
92      ipl = L_SIZE(ptab)   ! 4th    -
93      ipf = F_SIZE(ptab)   ! 5th    -      use in "multi" case (array of pointers)
94      !     
95      ALLOCATE( zt3ns(jpi,nn_hls,ipk,ipl,ipf,2), zt3sn(jpi,nn_hls,ipk,ipl,ipf,2),   &
96         &      zt3ew(jpj,nn_hls,ipk,ipl,ipf,2), zt3we(jpj,nn_hls,ipk,ipl,ipf,2)  )
97
98      zland = 0._wp
99
100      ! 1. standard boundary treatment
101      ! ------------------------------
102      !
103      DO jf = 1, ipf                   ! number of arrays to be treated
104         !
105         !                                ! East-West boundaries
106         !                   
107         IF( nbondi == 2) THEN                  ! neither subdomain to the east nor to the west
108            !                                      !* Cyclic
109            IF( nperio == 1 .OR. nperio == 4 .OR. nperio == 6 ) THEN
110               ARRAY_IN( 1 ,:,:,:,jf) = ARRAY_IN(jpim1,:,:,:,jf)
111               ARRAY_IN(jpi,:,:,:,jf) = ARRAY_IN(  2  ,:,:,:,jf)
112            ELSE                                   !* Closed
113               IF( .NOT. NAT_IN(jf) == 'F' )   ARRAY_IN(     1       :nn_hls,:,:,:,jf) = zland  ! east except F-point
114                                               ARRAY_IN(nlci-nn_hls+1:jpi   ,:,:,:,jf) = zland  ! west
115            ENDIF
116         ELSEIF(nbondi == -1) THEN              ! subdomain to the east only
117            IF( .NOT. NAT_IN(jf) == 'F' )   ARRAY_IN(1:nn_hls,:,:,:,jf) = zland     ! south except F-point
118            !
119         ELSEIF(nbondi == 1) THEN               ! subdomain to the west only
120            ARRAY_IN(nlci-nn_hls+1:jpi,:,:,:,jf) = zland    ! north
121         ENDIF
122         !                                ! North-South boundaries
123         !
124         IF (nbondj == 2 .OR. nbondj == -1) THEN      !* closed
125           IF( .NOT. NAT_IN(jf) == 'F' )   ARRAY_IN(:,1:nn_hls,:,:,jf) = zland            ! south except F-point
126         ELSEIF (nbondj == 2 .OR. nbondj == 1) THEN
127                                           ARRAY_IN(:,nlcj-nn_hls+1:jpj,:,:,jf) = zland   ! north
128         ENDIF
129      END DO
130
131      ! 2. East and west directions exchange
132      ! ------------------------------------
133      ! we play with the neigbours AND the row number because of the periodicity
134      !
135      !
136      DO jf = 1, ipf
137         SELECT CASE ( nbondi_bdy(IBD_IN(jf)) )      ! Read Dirichlet lateral conditions
138         CASE ( -1, 0, 1 )                ! all exept 2 (i.e. close case)
139            iihom = nlci-nreci
140               DO jl = 1, ipl
141                  DO jk = 1, ipk
142                     DO jh = 1, nn_hls
143                        zt3ew(:,jh,jk,jl,jf,1) = ARRAY_IN(nn_hls+jh,:,jk,jl,jf)
144                        zt3we(:,jh,jk,jl,jf,1) = ARRAY_IN(iihom +jh,:,jk,jl,jf)
145                     END DO
146                  END DO
147               END DO
148         END SELECT
149         !
150         !                           ! Migrations
151!!gm      imigr = nn_hls * jpj * ipk * ipl * ipf
152         imigr = nn_hls * jpj * ipk * ipl
153         !
154         SELECT CASE ( nbondi_bdy(IBD_IN(jf)) )
155         CASE ( -1 )
156            CALL mppsend( 2, zt3we(1,1,1,1,1,1), imigr, noea, ml_req1 )
157            CALL mpprecv( 1, zt3ew(1,1,1,1,1,2), imigr, noea )
158            IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
159         CASE ( 0 )
160            CALL mppsend( 1, zt3ew(1,1,1,1,1,1), imigr, nowe, ml_req1 )
161            CALL mppsend( 2, zt3we(1,1,1,1,1,1), imigr, noea, ml_req2 )
162            CALL mpprecv( 1, zt3ew(1,1,1,1,1,2), imigr, noea )
163            CALL mpprecv( 2, zt3we(1,1,1,1,1,2), imigr, nowe )
164            IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
165            IF(l_isend) CALL mpi_wait(ml_req2, ml_stat, ml_err)
166         CASE ( 1 )
167            CALL mppsend( 1, zt3ew(1,1,1,1,1,1), imigr, nowe, ml_req1 )
168            CALL mpprecv( 2, zt3we(1,1,1,1,1,2), imigr, nowe )
169            IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
170         END SELECT
171         !
172         !                           ! Write Dirichlet lateral conditions
173         iihom = nlci-nn_hls
174         !
175         !
176         SELECT CASE ( nbondi_bdy_b(IBD_IN(jf)) )
177         CASE ( -1 )
178            DO jl = 1, ipl
179               DO jk = 1, ipk
180                  DO jh = 1, nn_hls
181                     ARRAY_IN(iihom+jh,:,jk,jl,jf) = zt3ew(:,jh,jk,jl,jf,2)
182                  END DO
183               END DO
184            END DO
185         CASE ( 0 )
186            DO jl = 1, ipl
187               DO jk = 1, ipk
188                  DO jh = 1, nn_hls
189                     ARRAY_IN(jh      ,:,jk,jl,jf) = zt3we(:,jh,jk,jl,jf,2)
190                     ARRAY_IN(iihom+jh,:,jk,jl,jf) = zt3ew(:,jh,jk,jl,jf,2)
191                  END DO
192               END DO
193            END DO
194         CASE ( 1 )
195            DO jl = 1, ipl
196               DO jk = 1, ipk
197                  DO jh = 1, nn_hls
198                     ARRAY_IN(jh      ,:,jk,jl,jf) = zt3we(:,jh,jk,jl,jf,2)
199                  END DO
200               END DO
201            END DO
202         END SELECT
203         !
204      END DO
205
206      ! 3. North and south directions
207      ! -----------------------------
208      ! always closed : we play only with the neigbours
209      !
210      DO jf = 1, ipf
211         IF( nbondj_bdy(IBD_IN(jf)) /= 2 ) THEN      ! Read Dirichlet lateral conditions
212            ijhom = nlcj-nrecj
213            DO jl = 1, ipl
214               DO jk = 1, ipk
215                  DO jh = 1, nn_hls
216                     zt3sn(:,jh,jk,jl,jf,1) = ARRAY_IN(:,ijhom +jh,jk,jl,jf)
217                     zt3ns(:,jh,jk,jl,jf,1) = ARRAY_IN(:,nn_hls+jh,jk,jl,jf)
218                  END DO
219               END DO
220            END DO
221         ENDIF
222         !
223         !                           ! Migrations
224!!gm      imigr = nn_hls * jpi * ipk * ipl * ipf
225         imigr = nn_hls * jpi * ipk * ipl
226         !
227         SELECT CASE ( nbondj_bdy(IBD_IN(jf)) )
228         CASE ( -1 )
229            CALL mppsend( 4, zt3sn(1,1,1,1,1,1), imigr, nono, ml_req1 )
230            CALL mpprecv( 3, zt3ns(1,1,1,1,1,2), imigr, nono )
231            IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
232         CASE ( 0 )
233            CALL mppsend( 3, zt3ns(1,1,1,1,1,1), imigr, noso, ml_req1 )
234            CALL mppsend( 4, zt3sn(1,1,1,1,1,1), imigr, nono, ml_req2 )
235            CALL mpprecv( 3, zt3ns(1,1,1,1,1,2), imigr, nono )
236            CALL mpprecv( 4, zt3sn(1,1,1,1,1,2), imigr, noso )
237            IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)
238            IF(l_isend) CALL mpi_wait(ml_req2, ml_stat, ml_err)
239         CASE ( 1 )
240            CALL mppsend( 3, zt3ns(1,1,1,1,1,1), imigr, noso, ml_req1 )
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         END SELECT
244         !
245         !                           ! Write Dirichlet lateral conditions
246         ijhom = nlcj-nn_hls
247         !
248         SELECT CASE ( nbondj_bdy_b(IBD_IN(jf)) )
249         CASE ( -1 )
250            DO jl = 1, ipl
251               DO jk = 1, ipk
252                  DO jh = 1, nn_hls
253                     ARRAY_IN(:,ijhom+jh,jk,jl,jf) = zt3ns(:,jh,jk,jl,jf,2)
254                  END DO
255               END DO
256            END DO
257         CASE ( 0 )
258            DO jl = 1, ipl
259               DO jk = 1, ipk
260                  DO jh = 1, nn_hls
261                     ARRAY_IN(:,      jh,jk,jl,jf) = zt3sn(:,jh,jk,jl,jf,2)
262                     ARRAY_IN(:,ijhom+jh,jk,jl,jf) = zt3ns(:,jh,jk,jl,jf,2)
263                  END DO
264               END DO
265            END DO
266         CASE ( 1 )
267            DO jl = 1, ipl
268               DO jk = 1, ipk
269                  DO jh = 1, nn_hls
270                     ARRAY_IN(:,jh,jk,jl,jf) = zt3sn(:,jh,jk,jl,jf,2)
271                  END DO
272               END DO
273            END DO
274         END SELECT
275      END DO
276
277      ! 4. north fold treatment
278      ! -----------------------
279      !
280      IF( npolj /= 0) THEN
281         !
282         SELECT CASE ( jpni )
283         CASE ( 1 )     ;   CALL lbc_nfd( ptab, NAT_IN(:), SGN_IN(:) OPT_K(:) )   ! only 1 northern proc, no mpp
284         CASE DEFAULT   ;   CALL mpp_nfd( ptab, NAT_IN(:), SGN_IN(:) OPT_K(:) )   ! for all northern procs.
285         END SELECT
286         !
287      ENDIF
288      !
289      DEALLOCATE( zt3ns, zt3sn, zt3ew, zt3we  )
290      !
291   END SUBROUTINE ROUTINE_BDY
292
293#undef ARRAY_TYPE
294#undef NAT_IN
295#undef SGN_IN
296#undef IBD_IN
297#undef ARRAY_IN
298#undef K_SIZE
299#undef L_SIZE
300#undef F_SIZE
301#undef OPT_K
Note: See TracBrowser for help on using the repository browser.