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/2020/r12377_ticket2386/src/OCE/LBC – NEMO

source: NEMO/branches/2020/r12377_ticket2386/src/OCE/LBC/lbc_nfd_generic.h90 @ 13540

Last change on this file since 13540 was 13540, checked in by andmirek, 3 years ago

Ticket #2386: update to latest trunk

  • Property svn:keywords set to Id
  • Property svn:mime-type set to text/x-fortran
File size: 27.6 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#      if defined SINGLE_PRECISION
7#         define ARRAY_TYPE(i,j,k,l,f)    TYPE(PTR_2D_sp),INTENT(inout)::ptab(f)
8#      else
9#         define ARRAY_TYPE(i,j,k,l,f)    TYPE(PTR_2D_dp),INTENT(inout)::ptab(f)
10#      endif
11#      define ARRAY_IN(i,j,k,l,f)      ptab(f)%pt2d(i,j)
12#      define J_SIZE(ptab)             SIZE(ptab(1)%pt2d,2)
13#      define K_SIZE(ptab)             1
14#      define L_SIZE(ptab)             1
15#   endif
16#   if defined DIM_3d
17#      if defined SINGLE_PRECISION
18#         define ARRAY_TYPE(i,j,k,l,f)    TYPE(PTR_3D_sp),INTENT(inout)::ptab(f)
19#      else
20#         define ARRAY_TYPE(i,j,k,l,f)    TYPE(PTR_3D_dp),INTENT(inout)::ptab(f)
21#      endif
22#      define ARRAY_IN(i,j,k,l,f)      ptab(f)%pt3d(i,j,k)
23#      define J_SIZE(ptab)             SIZE(ptab(1)%pt3d,2)
24#      define K_SIZE(ptab)             SIZE(ptab(1)%pt3d,3)
25#      define L_SIZE(ptab)             1
26#   endif
27#   if defined DIM_4d
28#      if defined SINGLE_PRECISION
29#         define ARRAY_TYPE(i,j,k,l,f)    TYPE(PTR_4D_sp),INTENT(inout)::ptab(f)
30#      else
31#         define ARRAY_TYPE(i,j,k,l,f)    TYPE(PTR_4D_dp),INTENT(inout)::ptab(f)
32#      endif
33#      define ARRAY_IN(i,j,k,l,f)      ptab(f)%pt4d(i,j,k,l)
34#      define J_SIZE(ptab)             SIZE(ptab(1)%pt4d,2)
35#      define K_SIZE(ptab)             SIZE(ptab(1)%pt4d,3)
36#      define L_SIZE(ptab)             SIZE(ptab(1)%pt4d,4)
37#   endif
38#else
39!                          !==  IN: ptab is an array  ==!
40#   define NAT_IN(k)                cd_nat
41#   define SGN_IN(k)                psgn
42#   define F_SIZE(ptab)             1
43#   if defined DIM_2d
44#      define ARRAY_IN(i,j,k,l,f)   ptab(i,j)
45#      define J_SIZE(ptab)          SIZE(ptab,2)
46#      define K_SIZE(ptab)          1
47#      define L_SIZE(ptab)          1
48#   endif
49#   if defined DIM_3d
50#      define ARRAY_IN(i,j,k,l,f)   ptab(i,j,k)
51#      define J_SIZE(ptab)          SIZE(ptab,2)
52#      define K_SIZE(ptab)          SIZE(ptab,3)
53#      define L_SIZE(ptab)          1
54#   endif
55#   if defined DIM_4d
56#      define ARRAY_IN(i,j,k,l,f)   ptab(i,j,k,l)
57#      define J_SIZE(ptab)          SIZE(ptab,2)
58#      define K_SIZE(ptab)          SIZE(ptab,3)
59#      define L_SIZE(ptab)          SIZE(ptab,4)
60#   endif
61#   if defined SINGLE_PRECISION
62#      define ARRAY_TYPE(i,j,k,l,f)    REAL(sp),INTENT(inout)::ARRAY_IN(i,j,k,l,f)
63#   else
64#      define ARRAY_TYPE(i,j,k,l,f)    REAL(dp),INTENT(inout)::ARRAY_IN(i,j,k,l,f)
65#   endif
66#endif
67
68#   if defined SINGLE_PRECISION
69#      define PRECISION sp
70#   else
71#      define PRECISION dp
72#   endif
73
74#if defined MULTI
75   SUBROUTINE ROUTINE_NFD( ptab, cd_nat, psgn, kfld )
76      INTEGER          , INTENT(in   ) ::   kfld        ! number of pt3d arrays
77#else
78   SUBROUTINE ROUTINE_NFD( ptab, cd_nat, psgn       )
79#endif
80      ARRAY_TYPE(:,:,:,:,:)                             ! array or pointer of arrays on which the boundary condition is applied
81      CHARACTER(len=1) , INTENT(in   ) ::   NAT_IN(:)   ! nature of array grid-points
82      REAL(wp)         , INTENT(in   ) ::   SGN_IN(:)   ! sign used across the north fold boundary
83      !
84      INTEGER  ::    ji,  jj,  jk,  jl,  jf   ! dummy loop indices
85      INTEGER  ::        ipj, ipk, ipl, ipf   ! dimension of the input array
86      INTEGER  ::   ii1, ii2, ij1, ij2
87      !!----------------------------------------------------------------------
88      !
89      ipj = J_SIZE(ptab)   ! 2nd dimension
90      ipk = K_SIZE(ptab)   ! 3rd    -
91      ipl = L_SIZE(ptab)   ! 4th    -
92      ipf = F_SIZE(ptab)   ! 5th    -      use in "multi" case (array of pointers)
93      !
94      DO jf = 1, ipf                      ! Loop on the number of arrays to be treated
95         !
96         SELECT CASE ( npolj )
97         !
98         CASE ( 3 , 4 )                        ! *  North fold  T-point pivot
99            !
100            SELECT CASE ( NAT_IN(jf)  )
101            CASE ( 'T' , 'W' )                         ! T-, W-point
102               DO jl = 1, ipl; DO jk = 1, ipk
103                  !
104                  ! last nn_hls lines (from ipj to ipj-nn_hls+1) : full
105                    DO jj = 1, nn_hls
106                       ij1 = ipj            - jj + 1       ! ends at: ipj - nn_hls + 1
107                     ij2 = ipj - 2*nn_hls + jj - 1       ! ends at: ipj - 2*nn_hls + nn_hls - 1 = ipj - nn_hls - 1
108                     !
109                     DO ji = 1, nn_hls            ! first nn_hls points
110                        ii1 =                ji          ! ends at: nn_hls
111                        ii2 = 2*nn_hls + 2 - ji          ! ends at: 2*nn_hls + 2 - nn_hls = nn_hls + 2
112                        ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf)
113                     END DO
114                     DO ji = 1, 1                 ! point nn_hls+1
115                        ii1 = nn_hls + ji
116                        ii2 = ii1
117                        ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf)
118                     END DO
119                     DO ji = 1, Ni0glo - 1        ! points from nn_hls+2 to jpiglo - nn_hls   (note: Ni0glo = jpiglo - 2*nn_hls)
120                        ii1 = 2 + nn_hls      + ji - 1   ! ends at: 2 + nn_hls + jpiglo - 2*nn_hls - 1 - 1 = jpiglo - nn_hls
121                        ii2 = jpiglo - nn_hls - ji + 1   ! ends at: jpiglo - nn_hls - ( jpiglo - 2*nn_hls - 1 ) + 1 = nn_hls + 2
122                        ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf)
123                     END DO
124                     DO ji = 1, 1                 ! point jpiglo - nn_hls + 1
125                        ii1 = jpiglo - nn_hls + ji
126                        ii2 =          nn_hls + ji
127                        ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf)
128                     END DO
129                     DO ji = 1, nn_hls-1          ! last nn_hls-1 points
130                        ii1 = jpiglo - nn_hls + 1 + ji   ! ends at: jpiglo - nn_hls + 1 + nn_hls - 1 = jpiglo
131                        ii2 = jpiglo - nn_hls + 1 - ji   ! ends at: jpiglo - nn_hls + 1 - nn_hls + 1 = jpiglo - 2*nn_hls + 2
132                        ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf)
133                     END DO
134                  END DO
135                  !
136                  ! line number ipj-nn_hls : right half
137                    DO jj = 1, 1
138                     ij1 = ipj - nn_hls
139                     ij2 = ij1   ! same line
140                     !
141                     DO ji = 1, Ni0glo/2-1        ! points from jpiglo/2+2 to jpiglo - nn_hls   (note: Ni0glo = jpiglo - 2*nn_hls)
142                        ii1 = jpiglo/2 + ji + 1          ! ends at: jpiglo/2 + (jpiglo/2 - nn_hls - 1) + 1 = jpiglo - nn_hls
143                        ii2 = jpiglo/2 - ji + 1          ! ends at: jpiglo/2 - (jpiglo/2 - nn_hls - 1) + 1 = nn_hls + 2
144                        ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf)
145                     END DO
146                     DO ji = 1, nn_hls            ! first nn_hls points: redo them just in case (if e-w periodocity already done)
147                        !                         ! as we just changed points jpiglo-2nn_hls+1 to jpiglo-nn_hls 
148                        ii1 =                ji          ! ends at: nn_hls
149                        ii2 = 2*nn_hls + 2 - ji          ! ends at: 2*nn_hls + 2 - nn_hls = nn_hls + 2
150                        ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf)
151                     END DO
152                     !                            ! last nn_hls-1 points: have been / will done by e-w periodicity
153                  END DO
154                  !
155               END DO; END DO
156            CASE ( 'U' )                               ! U-point
157               DO jl = 1, ipl; DO jk = 1, ipk
158                  !
159                  ! last nn_hls lines (from ipj to ipj-nn_hls+1) : full
160                    DO jj = 1, nn_hls
161                       ij1 = ipj            - jj + 1       ! ends at: ipj - nn_hls + 1
162                     ij2 = ipj - 2*nn_hls + jj - 1       ! ends at: ipj - 2*nn_hls + nn_hls - 1 = ipj - nn_hls - 1
163                     !
164                     DO ji = 1, nn_hls            ! first nn_hls points
165                        ii1 =                ji          ! ends at: nn_hls
166                        ii2 = 2*nn_hls + 1 - ji          ! ends at: 2*nn_hls + 1 - nn_hls = nn_hls + 1
167                        ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf)
168                     END DO
169                     DO ji = 1, Ni0glo            ! points from nn_hls to jpiglo - nn_hls   (note: Ni0glo = jpiglo - 2*nn_hls)
170                        ii1 = nn_hls          + ji       ! ends at: nn_hls + jpiglo - 2*nn_hls = jpiglo - nn_hls
171                        ii2 = jpiglo - nn_hls - ji + 1   ! ends at: jpiglo - nn_hls - ( jpiglo - 2*nn_hls ) + 1 = nn_hls + 1
172                        ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf)
173                     END DO
174                     DO ji = 1, nn_hls            ! last nn_hls points
175                        ii1 = jpiglo - nn_hls + ji       ! ends at: jpiglo - nn_hls + nn_hls = jpiglo
176                        ii2 = jpiglo - nn_hls + 1 - ji   ! ends at: jpiglo - nn_hls + 1 - nn_hls = jpiglo - 2*nn_hls + 1
177                        ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf)
178                     END DO
179                  END DO
180                  !
181                  ! line number ipj-nn_hls : right half
182                    DO jj = 1, 1
183                     ij1 = ipj - nn_hls
184                     ij2 = ij1   ! same line
185                     !
186                     DO ji = 1, Ni0glo/2          ! points from jpiglo/2+1 to jpiglo - nn_hls   (note: Ni0glo = jpiglo - 2*nn_hls)
187                        ii1 = jpiglo/2 + ji              ! ends at: jpiglo/2 + (jpiglo/2 - nn_hls) = jpiglo - nn_hls
188                        ii2 = jpiglo/2 - ji + 1          ! ends at: jpiglo/2 - (jpiglo/2 - nn_hls) + 1 = nn_hls + 1
189                        ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf)
190                     END DO
191                     DO ji = 1, nn_hls            ! first nn_hls points: redo them just in case (if e-w periodocity already done)
192                        !                         ! as we just changed points jpiglo-2nn_hls+1 to jpiglo-nn_hls 
193                        ii1 =                ji          ! ends at: nn_hls
194                        ii2 = 2*nn_hls + 1 - ji          ! ends at: 2*nn_hls + 1 - nn_hls = nn_hls + 1
195                        ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf)
196                     END DO
197                     !                            ! last nn_hls-1 points: have been / will done by e-w periodicity
198                  END DO
199                  !
200               END DO; END DO
201            CASE ( 'V' )                               ! V-point
202               DO jl = 1, ipl; DO jk = 1, ipk
203                  !
204                  ! last nn_hls+1 lines (from ipj to ipj-nn_hls) : full
205                    DO jj = 1, nn_hls+1
206                       ij1 = ipj            - jj + 1       ! ends at: ipj - ( nn_hls + 1 ) + 1 = ipj - nn_hls
207                     ij2 = ipj - 2*nn_hls + jj - 2       ! ends at: ipj - 2*nn_hls + nn_hls + 1 - 2 = ipj - nn_hls - 1
208                     !
209                     DO ji = 1, nn_hls            ! first nn_hls points
210                        ii1 =                ji          ! ends at: nn_hls
211                        ii2 = 2*nn_hls + 2 - ji          ! ends at: 2*nn_hls + 2 - nn_hls = nn_hls + 2
212                        ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf)
213                     END DO
214                     DO ji = 1, 1                 ! point nn_hls+1
215                        ii1 = nn_hls + ji
216                        ii2 = ii1
217                        ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf)
218                     END DO
219                     DO ji = 1, Ni0glo - 1        ! points from nn_hls+2 to jpiglo - nn_hls   (note: Ni0glo = jpiglo - 2*nn_hls)
220                        ii1 = 2 + nn_hls      + ji - 1   ! ends at: 2 + nn_hls + jpiglo - 2*nn_hls - 1 - 1 = jpiglo - nn_hls
221                        ii2 = jpiglo - nn_hls - ji + 1   ! ends at: jpiglo - nn_hls - ( jpiglo - 2*nn_hls - 1 ) + 1 = nn_hls + 2
222                        ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf)
223                     END DO
224                     DO ji = 1, 1                 ! point jpiglo - nn_hls + 1
225                        ii1 = jpiglo - nn_hls + ji
226                        ii2 =          nn_hls + ji
227                        ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf)
228                     END DO
229                     DO ji = 1, nn_hls-1          ! last nn_hls-1 points
230                        ii1 = jpiglo - nn_hls + 1 + ji   ! ends at: jpiglo - nn_hls + 1 + nn_hls - 1 = jpiglo
231                        ii2 = jpiglo - nn_hls + 1 - ji   ! ends at: jpiglo - nn_hls + 1 - nn_hls + 1 = jpiglo - 2*nn_hls + 2
232                        ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf)
233                     END DO
234                  END DO
235                  !
236               END DO; END DO
237            CASE ( 'F' )                               ! F-point
238               DO jl = 1, ipl; DO jk = 1, ipk
239                  !
240                  ! last nn_hls+1 lines (from ipj to ipj-nn_hls) : full
241                    DO jj = 1, nn_hls+1
242                       ij1 = ipj            - jj + 1       ! ends at: ipj - ( nn_hls + 1 ) + 1 = ipj - nn_hls
243                     ij2 = ipj - 2*nn_hls + jj - 2       ! ends at: ipj - 2*nn_hls + nn_hls + 1 - 2 = ipj - nn_hls - 1
244                     !
245                     DO ji = 1, nn_hls            ! first nn_hls points
246                        ii1 =                ji          ! ends at: nn_hls
247                        ii2 = 2*nn_hls + 1 - ji          ! ends at: 2*nn_hls + 1 - nn_hls = nn_hls + 1
248                        ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf)
249                     END DO
250                     DO ji = 1, Ni0glo            ! points from nn_hls to jpiglo - nn_hls   (note: Ni0glo = jpiglo - 2*nn_hls)
251                        ii1 = nn_hls          + ji       ! ends at: nn_hls + jpiglo - 2*nn_hls = jpiglo - nn_hls
252                        ii2 = jpiglo - nn_hls - ji + 1   ! ends at: jpiglo - nn_hls - ( jpiglo - 2*nn_hls ) + 1 = nn_hls + 1
253                        ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf)
254                     END DO
255                     DO ji = 1, nn_hls            ! last nn_hls points
256                        ii1 = jpiglo - nn_hls + ji       ! ends at: jpiglo - nn_hls + nn_hls = jpiglo
257                        ii2 = jpiglo - nn_hls + 1 - ji   ! ends at: jpiglo - nn_hls + 1 - nn_hls = jpiglo - 2*nn_hls + 1
258                        ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf)
259                     END DO
260                  END DO
261                  !
262               END DO; END DO
263            END SELECT   ! NAT_IN(jf)
264            !
265         CASE ( 5 , 6 )                        ! *  North fold  F-point pivot
266            !
267            SELECT CASE ( NAT_IN(jf)  )
268            CASE ( 'T' , 'W' )                         ! T-, W-point
269               DO jl = 1, ipl; DO jk = 1, ipk
270                  !
271                  ! first: line number ipj-nn_hls : 3 points
272                    DO jj = 1, 1
273                     ij1 = ipj - nn_hls
274                     ij2 = ij1   ! same line
275                     !
276                     DO ji = 1, 1            ! points from jpiglo/2+1
277                        ii1 = jpiglo/2 + ji
278                        ii2 = jpiglo/2 - ji + 1
279                        ARRAY_IN(ii1,ij1,jk,jl,jf) =              ARRAY_IN(ii2,ij2,jk,jl,jf)   ! Warning: pb with sign...
280                     END DO
281                     DO ji = 1, 1            ! points jpiglo - nn_hls
282                        ii1 = jpiglo - nn_hls + ji - 1
283                        ii2 =          nn_hls + ji
284                        ARRAY_IN(ii1,ij1,jk,jl,jf) =              ARRAY_IN(ii2,ij2,jk,jl,jf)   ! Warning: pb with sign...
285                     END DO
286                     DO ji = 1, 1            ! point nn_hls: redo it just in case (if e-w periodocity already done)
287                        !                    ! as we just changed point jpiglo - nn_hls
288                        ii1 = nn_hls + ji - 1
289                        ii2 = nn_hls + ji
290                        ARRAY_IN(ii1,ij1,jk,jl,jf) =              ARRAY_IN(ii2,ij2,jk,jl,jf)   ! Warning: pb with sign...
291                     END DO
292                  END DO
293                  !
294                  ! Second: last nn_hls lines (from ipj to ipj-nn_hls+1) : full
295                    DO jj = 1, nn_hls
296                       ij1 = ipj + 1        - jj           ! ends at: ipj + 1 - nn_hls
297                     ij2 = ipj - 2*nn_hls + jj           ! ends at: ipj - 2*nn_hls + nn_hls = ipj - nn_hls
298                     !
299                     DO ji = 1, nn_hls            ! first nn_hls points
300                        ii1 =                ji          ! ends at: nn_hls
301                        ii2 = 2*nn_hls + 1 - ji          ! ends at: 2*nn_hls + 1 - nn_hls = nn_hls + 1
302                        ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf)
303                     END DO
304                     DO ji = 1, Ni0glo            ! points from nn_hls to jpiglo - nn_hls   (note: Ni0glo = jpiglo - 2*nn_hls)
305                        ii1 = nn_hls          + ji       ! ends at: nn_hls + jpiglo - 2*nn_hls = jpiglo - nn_hls
306                        ii2 = jpiglo - nn_hls - ji + 1   ! ends at: jpiglo - nn_hls - ( jpiglo - 2*nn_hls ) + 1 = nn_hls + 1
307                        ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf)
308                     END DO
309                     DO ji = 1, nn_hls            ! last nn_hls points
310                        ii1 = jpiglo - nn_hls + ji       ! ends at: jpiglo - nn_hls + nn_hls = jpiglo
311                        ii2 = jpiglo - nn_hls + 1 - ji   ! ends at: jpiglo - nn_hls + 1 - nn_hls = jpiglo - 2*nn_hls + 1
312                        ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf)
313                     END DO
314                  END DO
315                  !
316               END DO; END DO
317            CASE ( 'U' )                               ! U-point
318               DO jl = 1, ipl; DO jk = 1, ipk
319                  !
320                  ! last nn_hls lines (from ipj to ipj-nn_hls+1) : full
321                    DO jj = 1, nn_hls
322                       ij1 = ipj + 1        - jj           ! ends at: ipj + 1 - nn_hls
323                     ij2 = ipj - 2*nn_hls + jj           ! ends at: ipj - 2*nn_hls + nn_hls = ipj - nn_hls
324                     !
325                     DO ji = 1, nn_hls-1          ! first nn_hls-1 points
326                        ii1 =            ji              ! ends at: nn_hls-1
327                        ii2 = 2*nn_hls - ji              ! ends at: 2*nn_hls - ( nn_hls - 1 ) = nn_hls + 1
328                        ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf)
329                     END DO
330                     DO ji = 1, 1                 ! point nn_hls
331                        ii1 = nn_hls + ji - 1
332                        ii2 = jpiglo - ii1
333                        ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf)
334                     END DO
335                     DO ji = 1, Ni0glo - 1        ! points from nn_hls+1 to jpiglo - nn_hls - 1  (note: Ni0glo = jpiglo - 2*nn_hls)
336                        ii1 =          nn_hls + ji       ! ends at: nn_hls + ( jpiglo - 2*nn_hls - 1 ) = jpiglo - nn_hls - 1
337                        ii2 = jpiglo - nn_hls - ji       ! ends at: jpiglo - nn_hls - ( jpiglo - 2*nn_hls - 1 ) = nn_hls + 1
338                        ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf)
339                     END DO
340                     DO ji = 1, 1                 ! point jpiglo - nn_hls
341                        ii1 = jpiglo - nn_hls + ji - 1
342                        ii2 = ii1
343                        ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf)
344                     END DO
345                     DO ji = 1, nn_hls            ! last nn_hls points
346                        ii1 = jpiglo - nn_hls + ji       ! ends at: jpiglo - nn_hls + nn_hls = jpiglo
347                        ii2 = jpiglo - nn_hls - ji       ! ends at: jpiglo - nn_hls - nn_hls = jpiglo - 2*nn_hls
348                        ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf)
349                     END DO
350                  END DO
351                  !
352               END DO; END DO
353            CASE ( 'V' )                               ! V-point
354               DO jl = 1, ipl; DO jk = 1, ipk
355                  !
356                  ! last nn_hls lines (from ipj to ipj-nn_hls+1) : full
357                    DO jj = 1, nn_hls
358                       ij1 = ipj            - jj + 1       ! ends at: ipj - nn_hls + 1
359                     ij2 = ipj - 2*nn_hls + jj - 1       ! ends at: ipj - 2*nn_hls + nn_hls - 1 = ipj - nn_hls - 1
360                     !
361                     DO ji = 1, nn_hls            ! first nn_hls points
362                        ii1 =                ji          ! ends at: nn_hls
363                        ii2 = 2*nn_hls + 1 - ji          ! ends at: 2*nn_hls + 1 - nn_hls = nn_hls + 1
364                        ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf)
365                     END DO
366                     DO ji = 1, Ni0glo            ! points from nn_hls to jpiglo - nn_hls   (note: Ni0glo = jpiglo - 2*nn_hls)
367                        ii1 = nn_hls          + ji       ! ends at: nn_hls + jpiglo - 2*nn_hls = jpiglo - nn_hls
368                        ii2 = jpiglo - nn_hls - ji + 1   ! ends at: jpiglo - nn_hls - ( jpiglo - 2*nn_hls ) + 1 = nn_hls + 1
369                        ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf)
370                     END DO
371                     DO ji = 1, nn_hls            ! last nn_hls points
372                        ii1 = jpiglo - nn_hls + ji       ! ends at: jpiglo - nn_hls + nn_hls = jpiglo
373                        ii2 = jpiglo - nn_hls + 1 - ji   ! ends at: jpiglo - nn_hls + 1 - nn_hls = jpiglo - 2*nn_hls + 1
374                        ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf)
375                     END DO
376                  END DO   
377                  !
378                  ! line number ipj-nn_hls : right half
379                    DO jj = 1, 1
380                     ij1 = ipj - nn_hls
381                     ij2 = ij1   ! same line
382                     !
383                     DO ji = 1, Ni0glo/2          ! points from jpiglo/2+1 to jpiglo - nn_hls   (note: Ni0glo = jpiglo - 2*nn_hls)
384                        ii1 = jpiglo/2 + ji              ! ends at: jpiglo/2 + (jpiglo/2 - nn_hls) = jpiglo - nn_hls
385                        ii2 = jpiglo/2 - ji + 1          ! ends at: jpiglo/2 - (jpiglo/2 - nn_hls) + 1 = nn_hls + 1
386                        ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf)
387                     END DO
388                     DO ji = 1, nn_hls            ! first nn_hls points: redo them just in case (if e-w periodocity already done)
389                        !                         ! as we just changed points jpiglo-2nn_hls+1 to jpiglo-nn_hls 
390                        ii1 =                ji          ! ends at: nn_hls
391                        ii2 = 2*nn_hls + 1 - ji          ! ends at: 2*nn_hls + 1 - nn_hls = nn_hls + 1
392                        ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf)
393                     END DO
394                     !                            ! last nn_hls points: have been / will done by e-w periodicity
395                  END DO
396                  !
397               END DO; END DO
398            CASE ( 'F' )                               ! F-point
399               DO jl = 1, ipl; DO jk = 1, ipk
400                  !
401                  ! last nn_hls lines (from ipj to ipj-nn_hls+1) : full
402                    DO jj = 1, nn_hls
403                       ij1 = ipj            - jj + 1       ! ends at: ipj - nn_hls + 1
404                     ij2 = ipj - 2*nn_hls + jj - 1       ! ends at: ipj - 2*nn_hls + nn_hls - 1 = ipj - nn_hls - 1
405                     !
406                     DO ji = 1, nn_hls-1          ! first nn_hls-1 points
407                        ii1 =            ji              ! ends at: nn_hls-1
408                        ii2 = 2*nn_hls - ji              ! ends at: 2*nn_hls - ( nn_hls - 1 ) = nn_hls + 1
409                        ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf)
410                     END DO
411                     DO ji = 1, 1                 ! point nn_hls
412                        ii1 = nn_hls + ji - 1
413                        ii2 = jpiglo - ii1
414                        ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf)
415                     END DO
416                     DO ji = 1, Ni0glo - 1        ! points from nn_hls+1 to jpiglo - nn_hls - 1  (note: Ni0glo = jpiglo - 2*nn_hls)
417                        ii1 =          nn_hls + ji       ! ends at: nn_hls + ( jpiglo - 2*nn_hls - 1 ) = jpiglo - nn_hls - 1
418                        ii2 = jpiglo - nn_hls - ji       ! ends at: jpiglo - nn_hls - ( jpiglo - 2*nn_hls - 1 ) = nn_hls + 1
419                        ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf)
420                     END DO
421                     DO ji = 1, 1                 ! point jpiglo - nn_hls
422                        ii1 = jpiglo - nn_hls + ji - 1
423                        ii2 = ii1
424                        ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf)
425                     END DO
426                     DO ji = 1, nn_hls            ! last nn_hls points
427                        ii1 = jpiglo - nn_hls + ji       ! ends at: jpiglo - nn_hls + nn_hls = jpiglo
428                        ii2 = jpiglo - nn_hls - ji       ! ends at: jpiglo - nn_hls - nn_hls = jpiglo - 2*nn_hls
429                        ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf)
430                     END DO
431                  END DO   
432                  !
433                  ! line number ipj-nn_hls : right half
434                    DO jj = 1, 1
435                     ij1 = ipj - nn_hls
436                     ij2 = ij1   ! same line
437                     !
438                     DO ji = 1, Ni0glo/2-1        ! points from jpiglo/2+1 to jpiglo - nn_hls-1  (note: Ni0glo = jpiglo - 2*nn_hls)
439                        ii1 = jpiglo/2 + ji              ! ends at: jpiglo/2 + (jpiglo/2 - nn_hls) = jpiglo - nn_hls
440                        ii2 = jpiglo/2 - ji              ! ends at: jpiglo/2 - (jpiglo/2 - nn_hls - 1 ) = nn_hls + 1
441                        ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf)
442                     END DO
443                     DO ji = 1, nn_hls-1          ! first nn_hls-1 points: redo them just in case (if e-w periodocity already done)
444                        !                         ! as we just changed points jpiglo-2nn_hls+1 to jpiglo-nn_hl-1 
445                        ii1 =            ji              ! ends at: nn_hls
446                        ii2 = 2*nn_hls - ji              ! ends at: 2*nn_hls - ( nn_hls - 1 ) = nn_hls + 1
447                        ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf)
448                     END DO
449                     !                            ! last nn_hls points: have been / will done by e-w periodicity
450                  END DO
451                  !
452               END DO; END DO
453            END SELECT   ! NAT_IN(jf)
454            !
455         END SELECT   ! npolj
456         !
457      END DO   ! ipf
458      !
459   END SUBROUTINE ROUTINE_NFD
460
461#undef PRECISION
462#undef ARRAY_TYPE
463#undef ARRAY_IN
464#undef NAT_IN
465#undef SGN_IN
466#undef J_SIZE
467#undef K_SIZE
468#undef L_SIZE
469#undef F_SIZE
Note: See TracBrowser for help on using the repository browser.