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_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_generic.h90 @ 14363

Last change on this file since 14363 was 14363, checked in by smasson, 4 years ago

dev_r14312_MPI_Interface: suppress communications involving only land points, #2598
  • Property svn:keywords set to Id
  • Property svn:mime-type set to text/x-fortran
File size: 24.1 KB
Line 
1
2   SUBROUTINE lbc_nfd_/**/PRECISION( ptab, cd_nat, psgn, khls, kfld )
3      TYPE(PTR_4d_/**/PRECISION),  DIMENSION(:), INTENT(inout) ::   ptab        ! pointer of arrays on which apply the b.c.
4      CHARACTER(len=1), DIMENSION(:), INTENT(in   ) ::   cd_nat      ! nature of array grid-points
5      REAL(PRECISION),  DIMENSION(:), INTENT(in   ) ::   psgn        ! sign used across the north fold boundary
6      INTEGER                       , INTENT(in   ) ::   khls        ! halo size, default = nn_hls
7      INTEGER                       , INTENT(in   ) ::   kfld        ! number of pt3d arrays
8      !
9      INTEGER  ::    ji,  jj,  jk,  jl,  jf   ! dummy loop indices
10      INTEGER  ::   ipi, ipj, ipk, ipl, ipf   ! dimension of the input array
11      INTEGER  ::   ii1, ii2, ij1, ij2
12      !!----------------------------------------------------------------------
13      !
14      ipi = SIZE(ptab(1)%pt4d,1)
15      ipj = SIZE(ptab(1)%pt4d,2)
16      ipk = SIZE(ptab(1)%pt4d,3)
17      ipl = SIZE(ptab(1)%pt4d,4)
18      ipf = kfld
19      !
20      IF( ipi /= Ni0glo+2*khls ) THEN
21         WRITE(ctmp1,*) 'lbc_nfd input array does not match khls', ipi, khls, Ni0glo
22         CALL ctl_stop( 'STOP', ctmp1 )
23      ENDIF
24      !
25      DO jf = 1, ipf                      ! Loop on the number of arrays to be treated
26         !
27         IF( c_NFtype == 'T' ) THEN            ! *  North fold  T-point pivot
28            !
29            SELECT CASE ( cd_nat(jf) )
30            CASE ( 'T' , 'W' )                         ! T-, W-point
31               DO jl = 1, ipl; DO jk = 1, ipk
32                  !
33                  ! last khls lines (from ipj to ipj-khls+1) : full
34                    DO jj = 1, khls
35                       ij1 = ipj          - jj + 1         ! ends at: ipj - khls + 1
36                     ij2 = ipj - 2*khls + jj - 1         ! ends at: ipj - 2*khls + khls - 1 = ipj - khls - 1
37                     !
38                     DO ji = 1, khls              ! first khls points
39                        ii1 =              ji            ! ends at: khls
40                        ii2 = 2*khls + 2 - ji            ! ends at: 2*khls + 2 - khls = khls + 2
41                        ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl)
42                     END DO
43                     DO ji = 1, 1                 ! point khls+1
44                        ii1 = khls + ji
45                        ii2 = ii1
46                        ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl)
47                     END DO
48                     DO ji = 1, Ni0glo - 1        ! points from khls+2 to ipi - khls   (note: Ni0glo = ipi - 2*khls)
49                        ii1 =   2 + khls + ji - 1        ! ends at: 2 + khls + ipi - 2*khls - 1 - 1 = ipi - khls
50                        ii2 = ipi - khls - ji + 1        ! ends at: ipi - khls - ( ipi - 2*khls - 1 ) + 1 = khls + 2
51                        ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl)
52                     END DO
53                     DO ji = 1, 1                 ! point ipi - khls + 1
54                        ii1 = ipi - khls + ji
55                        ii2 =          khls + ji
56                        ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl)
57                     END DO
58                     DO ji = 1, khls-1            ! last khls-1 points
59                        ii1 = ipi - khls + 1 + ji        ! ends at: ipi - khls + 1 + khls - 1 = ipi
60                        ii2 = ipi - khls + 1 - ji        ! ends at: ipi - khls + 1 - khls + 1 = ipi - 2*khls + 2
61                        ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl)
62                     END DO
63                  END DO
64                  !
65                  ! line number ipj-khls : right half
66                    DO jj = 1, 1
67                     ij1 = ipj - khls
68                     ij2 = ij1   ! same line
69                     !
70                     DO ji = 1, Ni0glo/2-1        ! points from ipi/2+2 to ipi - khls   (note: Ni0glo = ipi - 2*khls)
71                        ii1 = ipi/2 + ji + 1             ! ends at: ipi/2 + (ipi/2 - khls - 1) + 1 = ipi - khls
72                        ii2 = ipi/2 - ji + 1             ! ends at: ipi/2 - (ipi/2 - khls - 1) + 1 = khls + 2
73                        ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl)
74                     END DO
75                     DO ji = 1, khls              ! first khls points: redo them just in case (if e-w periodocity already done)
76                        !                         ! as we just changed points ipi-2khls+1 to ipi-khls 
77                        ii1 =              ji            ! ends at: khls
78                        ii2 = 2*khls + 2 - ji            ! ends at: 2*khls + 2 - khls = khls + 2
79                        ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl)
80                     END DO
81                     !                            ! last khls-1 points: have been / will done by e-w periodicity
82                  END DO
83                  !
84               END DO; END DO
85            CASE ( 'U' )                               ! U-point
86               DO jl = 1, ipl; DO jk = 1, ipk
87                  !
88                  ! last khls lines (from ipj to ipj-khls+1) : full
89                    DO jj = 1, khls
90                       ij1 = ipj          - jj + 1         ! ends at: ipj - khls + 1
91                     ij2 = ipj - 2*khls + jj - 1         ! ends at: ipj - 2*khls + khls - 1 = ipj - khls - 1
92                     !
93                     DO ji = 1, khls              ! first khls points
94                        ii1 =              ji            ! ends at: khls
95                        ii2 = 2*khls + 1 - ji            ! ends at: 2*khls + 1 - khls = khls + 1
96                        ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl)
97                     END DO
98                     DO ji = 1, Ni0glo            ! points from khls to ipi - khls   (note: Ni0glo = ipi - 2*khls)
99                        ii1 =       khls + ji            ! ends at: khls + ipi - 2*khls = ipi - khls
100                        ii2 = ipi - khls - ji + 1        ! ends at: ipi - khls - ( ipi - 2*khls ) + 1 = khls + 1
101                        ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl)
102                     END DO
103                     DO ji = 1, khls              ! last khls points
104                        ii1 = ipi - khls + ji            ! ends at: ipi - khls + khls = ipi
105                        ii2 = ipi - khls + 1 - ji        ! ends at: ipi - khls + 1 - khls = ipi - 2*khls + 1
106                        ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl)
107                     END DO
108                  END DO
109                  !
110                  ! line number ipj-khls : right half
111                    DO jj = 1, 1
112                     ij1 = ipj - khls
113                     ij2 = ij1   ! same line
114                     !
115                     DO ji = 1, Ni0glo/2          ! points from ipi/2+1 to ipi - khls   (note: Ni0glo = ipi - 2*khls)
116                        ii1 = ipi/2 + ji                 ! ends at: ipi/2 + (ipi/2 - khls) = ipi - khls
117                        ii2 = ipi/2 - ji + 1             ! ends at: ipi/2 - (ipi/2 - khls) + 1 = khls + 1
118                        ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl)
119                     END DO
120                     DO ji = 1, khls              ! first khls points: redo them just in case (if e-w periodocity already done)
121                        !                         ! as we just changed points ipi-2khls+1 to ipi-khls 
122                        ii1 =              ji            ! ends at: khls
123                        ii2 = 2*khls + 1 - ji            ! ends at: 2*khls + 1 - khls = khls + 1
124                        ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl)
125                     END DO
126                     !                            ! last khls-1 points: have been / will done by e-w periodicity
127                  END DO
128                  !
129               END DO; END DO
130            CASE ( 'V' )                               ! V-point
131               DO jl = 1, ipl; DO jk = 1, ipk
132                  !
133                  ! last khls+1 lines (from ipj to ipj-khls) : full
134                    DO jj = 1, khls+1
135                       ij1 = ipj          - jj + 1         ! ends at: ipj - ( khls + 1 ) + 1 = ipj - khls
136                     ij2 = ipj - 2*khls + jj - 2         ! ends at: ipj - 2*khls + khls + 1 - 2 = ipj - khls - 1
137                     !
138                     DO ji = 1, khls              ! first khls points
139                        ii1 =              ji            ! ends at: khls
140                        ii2 = 2*khls + 2 - ji            ! ends at: 2*khls + 2 - khls = khls + 2
141                        ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl)
142                     END DO
143                     DO ji = 1, 1                 ! point khls+1
144                        ii1 = khls + ji
145                        ii2 = ii1
146                        ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl)
147                     END DO
148                     DO ji = 1, Ni0glo - 1        ! points from khls+2 to ipi - khls   (note: Ni0glo = ipi - 2*khls)
149                        ii1 =   2 + khls + ji - 1        ! ends at: 2 + khls + ipi - 2*khls - 1 - 1 = ipi - khls
150                        ii2 = ipi - khls - ji + 1        ! ends at: ipi - khls - ( ipi - 2*khls - 1 ) + 1 = khls + 2
151                        ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl)
152                     END DO
153                     DO ji = 1, 1                 ! point ipi - khls + 1
154                        ii1 = ipi - khls + ji
155                        ii2 =          khls + ji
156                        ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl)
157                     END DO
158                     DO ji = 1, khls-1            ! last khls-1 points
159                        ii1 = ipi - khls + 1 + ji        ! ends at: ipi - khls + 1 + khls - 1 = ipi
160                        ii2 = ipi - khls + 1 - ji        ! ends at: ipi - khls + 1 - khls + 1 = ipi - 2*khls + 2
161                        ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl)
162                     END DO
163                  END DO
164                  !
165               END DO; END DO
166            CASE ( 'F' )                               ! F-point
167               DO jl = 1, ipl; DO jk = 1, ipk
168                  !
169                  ! last khls+1 lines (from ipj to ipj-khls) : full
170                    DO jj = 1, khls+1
171                       ij1 = ipj          - jj + 1         ! ends at: ipj - ( khls + 1 ) + 1 = ipj - khls
172                     ij2 = ipj - 2*khls + jj - 2         ! ends at: ipj - 2*khls + khls + 1 - 2 = ipj - khls - 1
173                     !
174                     DO ji = 1, khls              ! first khls points
175                        ii1 =              ji            ! ends at: khls
176                        ii2 = 2*khls + 1 - ji            ! ends at: 2*khls + 1 - khls = khls + 1
177                        ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl)
178                     END DO
179                     DO ji = 1, Ni0glo            ! points from khls to ipi - khls   (note: Ni0glo = ipi - 2*khls)
180                        ii1 =       khls + ji            ! ends at: khls + ipi - 2*khls = ipi - khls
181                        ii2 = ipi - khls - ji + 1        ! ends at: ipi - khls - ( ipi - 2*khls ) + 1 = khls + 1
182                        ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl)
183                     END DO
184                     DO ji = 1, khls              ! last khls points
185                        ii1 = ipi - khls + ji            ! ends at: ipi - khls + khls = ipi
186                        ii2 = ipi - khls + 1 - ji        ! ends at: ipi - khls + 1 - khls = ipi - 2*khls + 1
187                        ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl)
188                     END DO
189                  END DO
190                  !
191               END DO; END DO
192            END SELECT   ! cd_nat(jf)
193            !
194         ENDIF   ! c_NFtype == 'T'
195         !
196         IF( c_NFtype == 'F' ) THEN            ! *  North fold  F-point pivot
197            !
198            SELECT CASE ( cd_nat(jf) )
199            CASE ( 'T' , 'W' )                         ! T-, W-point
200               DO jl = 1, ipl; DO jk = 1, ipk
201                  !
202                  ! first: line number ipj-khls : 3 points
203                    DO jj = 1, 1
204                     ij1 = ipj - khls
205                     ij2 = ij1   ! same line
206                     !
207                     DO ji = 1, 1                 ! points from ipi/2+1
208                        ii1 = ipi/2 + ji
209                        ii2 = ipi/2 - ji + 1
210                        ptab(jf)%pt4d(ii1,ij1,jk,jl) =            ptab(jf)%pt4d(ii2,ij2,jk,jl)   ! Warning: pb with sign...
211                     END DO
212                     DO ji = 1, 1                 ! points ipi - khls
213                        ii1 = ipi - khls + ji - 1
214                        ii2 =          khls + ji
215                        ptab(jf)%pt4d(ii1,ij1,jk,jl) =            ptab(jf)%pt4d(ii2,ij2,jk,jl)   ! Warning: pb with sign...
216                     END DO
217                     DO ji = 1, 1                 ! point khls: redo it just in case (if e-w periodocity already done)
218                        !                         ! as we just changed point ipi - khls
219                        ii1 = khls + ji - 1
220                        ii2 = khls + ji
221                        ptab(jf)%pt4d(ii1,ij1,jk,jl) =            ptab(jf)%pt4d(ii2,ij2,jk,jl)   ! Warning: pb with sign...
222                     END DO
223                  END DO
224                  !
225                  ! Second: last khls lines (from ipj to ipj-khls+1) : full
226                    DO jj = 1, khls
227                       ij1 = ipj + 1      - jj             ! ends at: ipj + 1 - khls
228                     ij2 = ipj - 2*khls + jj             ! ends at: ipj - 2*khls + khls = ipj - khls
229                     !
230                     DO ji = 1, khls              ! first khls points
231                        ii1 =              ji            ! ends at: khls
232                        ii2 = 2*khls + 1 - ji            ! ends at: 2*khls + 1 - khls = khls + 1
233                        ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl)
234                     END DO
235                     DO ji = 1, Ni0glo            ! points from khls to ipi - khls   (note: Ni0glo = ipi - 2*khls)
236                        ii1 =       khls + ji            ! ends at: khls + ipi - 2*khls = ipi - khls
237                        ii2 = ipi - khls - ji + 1        ! ends at: ipi - khls - ( ipi - 2*khls ) + 1 = khls + 1
238                        ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl)
239                     END DO
240                     DO ji = 1, khls              ! last khls points
241                        ii1 = ipi - khls + ji            ! ends at: ipi - khls + khls = ipi
242                        ii2 = ipi - khls + 1 - ji        ! ends at: ipi - khls + 1 - khls = ipi - 2*khls + 1
243                        ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl)
244                     END DO
245                  END DO
246                  !
247               END DO; END DO
248            CASE ( 'U' )                               ! U-point
249               DO jl = 1, ipl; DO jk = 1, ipk
250                  !
251                  ! last khls lines (from ipj to ipj-khls+1) : full
252                    DO jj = 1, khls
253                       ij1 = ipj + 1      - jj             ! ends at: ipj + 1 - khls
254                     ij2 = ipj - 2*khls + jj             ! ends at: ipj - 2*khls + khls = ipj - khls
255                     !
256                     DO ji = 1, khls-1            ! first khls-1 points
257                        ii1 =          ji                ! ends at: khls-1
258                        ii2 = 2*khls - ji                ! ends at: 2*khls - ( khls - 1 ) = khls + 1
259                        ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl)
260                     END DO
261                     DO ji = 1, 1                 ! point khls
262                        ii1 = khls + ji - 1
263                        ii2 = ipi - ii1
264                        ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl)
265                     END DO
266                     DO ji = 1, Ni0glo - 1        ! points from khls+1 to ipi - khls - 1  (note: Ni0glo = ipi - 2*khls)
267                        ii1 =       khls + ji            ! ends at: khls + ( ipi - 2*khls - 1 ) = ipi - khls - 1
268                        ii2 = ipi - khls - ji            ! ends at: ipi - khls - ( ipi - 2*khls - 1 ) = khls + 1
269                        ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl)
270                     END DO
271                     DO ji = 1, 1                 ! point ipi - khls
272                        ii1 = ipi - khls + ji - 1
273                        ii2 = ii1
274                        ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl)
275                     END DO
276                     DO ji = 1, khls              ! last khls points
277                        ii1 = ipi - khls + ji            ! ends at: ipi - khls + khls = ipi
278                        ii2 = ipi - khls - ji            ! ends at: ipi - khls - khls = ipi - 2*khls
279                        ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl)
280                     END DO
281                  END DO
282                  !
283               END DO; END DO
284            CASE ( 'V' )                               ! V-point
285               DO jl = 1, ipl; DO jk = 1, ipk
286                  !
287                  ! last khls lines (from ipj to ipj-khls+1) : full
288                    DO jj = 1, khls
289                       ij1 = ipj          - jj + 1         ! ends at: ipj - khls + 1
290                     ij2 = ipj - 2*khls + jj - 1         ! ends at: ipj - 2*khls + khls - 1 = ipj - khls - 1
291                     !
292                     DO ji = 1, khls              ! first khls points
293                        ii1 =              ji            ! ends at: khls
294                        ii2 = 2*khls + 1 - ji            ! ends at: 2*khls + 1 - khls = khls + 1
295                        ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl)
296                     END DO
297                     DO ji = 1, Ni0glo            ! points from khls to ipi - khls   (note: Ni0glo = ipi - 2*khls)
298                        ii1 =       khls + ji          ! ends at: khls + ipi - 2*khls = ipi - khls
299                        ii2 = ipi - khls - ji + 1      ! ends at: ipi - khls - ( ipi - 2*khls ) + 1 = khls + 1
300                        ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl)
301                     END DO
302                     DO ji = 1, khls            ! last khls points
303                        ii1 = ipi - khls + ji          ! ends at: ipi - khls + khls = ipi
304                        ii2 = ipi - khls + 1 - ji      ! ends at: ipi - khls + 1 - khls = ipi - 2*khls + 1
305                        ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl)
306                     END DO
307                  END DO   
308                  !
309                  ! line number ipj-khls : right half
310                    DO jj = 1, 1
311                     ij1 = ipj - khls
312                     ij2 = ij1   ! same line
313                     !
314                     DO ji = 1, Ni0glo/2          ! points from ipi/2+1 to ipi - khls   (note: Ni0glo = ipi - 2*khls)
315                        ii1 = ipi/2 + ji                 ! ends at: ipi/2 + (ipi/2 - khls) = ipi - khls
316                        ii2 = ipi/2 - ji + 1             ! ends at: ipi/2 - (ipi/2 - khls) + 1 = khls + 1
317                        ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl)
318                     END DO
319                     DO ji = 1, khls              ! first khls points: redo them just in case (if e-w periodocity already done)
320                        !                         ! as we just changed points ipi-2khls+1 to ipi-khls 
321                        ii1 =              ji            ! ends at: khls
322                        ii2 = 2*khls + 1 - ji            ! ends at: 2*khls + 1 - khls = khls + 1
323                        ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl)
324                     END DO
325                     !                            ! last khls points: have been / will done by e-w periodicity
326                  END DO
327                  !
328               END DO; END DO
329            CASE ( 'F' )                               ! F-point
330               DO jl = 1, ipl; DO jk = 1, ipk
331                  !
332                  ! last khls lines (from ipj to ipj-khls+1) : full
333                    DO jj = 1, khls
334                       ij1 = ipj          - jj + 1         ! ends at: ipj - khls + 1
335                     ij2 = ipj - 2*khls + jj - 1         ! ends at: ipj - 2*khls + khls - 1 = ipj - khls - 1
336                     !
337                     DO ji = 1, khls-1            ! first khls-1 points
338                        ii1 =          ji                ! ends at: khls-1
339                        ii2 = 2*khls - ji                ! ends at: 2*khls - ( khls - 1 ) = khls + 1
340                        ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl)
341                     END DO
342                     DO ji = 1, 1                 ! point khls
343                        ii1 = khls + ji - 1
344                        ii2 = ipi - ii1
345                        ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl)
346                     END DO
347                     DO ji = 1, Ni0glo - 1        ! points from khls+1 to ipi - khls - 1  (note: Ni0glo = ipi - 2*khls)
348                        ii1 =       khls + ji            ! ends at: khls + ( ipi - 2*khls - 1 ) = ipi - khls - 1
349                        ii2 = ipi - khls - ji            ! ends at: ipi - khls - ( ipi - 2*khls - 1 ) = khls + 1
350                        ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl)
351                     END DO
352                     DO ji = 1, 1                 ! point ipi - khls
353                        ii1 = ipi - khls + ji - 1
354                        ii2 = ii1
355                        ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl)
356                     END DO
357                     DO ji = 1, khls              ! last khls points
358                        ii1 = ipi - khls + ji            ! ends at: ipi - khls + khls = ipi
359                        ii2 = ipi - khls - ji            ! ends at: ipi - khls - khls = ipi - 2*khls
360                        ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl)
361                     END DO
362                  END DO   
363                  !
364                  ! line number ipj-khls : right half
365                    DO jj = 1, 1
366                     ij1 = ipj - khls
367                     ij2 = ij1   ! same line
368                     !
369                     DO ji = 1, Ni0glo/2-1        ! points from ipi/2+1 to ipi - khls-1  (note: Ni0glo = ipi - 2*khls)
370                        ii1 = ipi/2 + ji                 ! ends at: ipi/2 + (ipi/2 - khls) = ipi - khls
371                        ii2 = ipi/2 - ji                 ! ends at: ipi/2 - (ipi/2 - khls - 1 ) = khls + 1
372                        ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl)
373                     END DO
374                     DO ji = 1, khls-1            ! first khls-1 points: redo them just in case (if e-w periodocity already done)
375                        !                         ! as we just changed points ipi-2khls+1 to ipi-nn_hl-1 
376                        ii1 =          ji                ! ends at: khls
377                        ii2 = 2*khls - ji                ! ends at: 2*khls - ( khls - 1 ) = khls + 1
378                        ptab(jf)%pt4d(ii1,ij1,jk,jl) = psgn(jf) * ptab(jf)%pt4d(ii2,ij2,jk,jl)
379                     END DO
380                     !                            ! last khls points: have been / will done by e-w periodicity
381                  END DO
382                  !
383               END DO; END DO
384            END SELECT   ! cd_nat(jf)
385            !
386         ENDIF   ! c_NFtype == 'F'
387         !
388      END DO   ! ipf
389      !
390   END SUBROUTINE lbc_nfd_/**/PRECISION
391
Note: See TracBrowser for help on using the repository browser.