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.
lbcnfd.F90 in branches/2013/dev_r3940_CNRS4_IOCRS/NEMOGCM/NEMO/OPA_SRC/LBC – NEMO

source: branches/2013/dev_r3940_CNRS4_IOCRS/NEMOGCM/NEMO/OPA_SRC/LBC/lbcnfd.F90 @ 4015

Last change on this file since 4015 was 4015, checked in by cetlod, 11 years ago

2013/dev_r3940_CNRS4_IOCRS: 1st step, add new routines for outputs coarsening
  • Property svn:keywords set to Id
File size: 15.4 KB
Line 
1MODULE lbcnfd
2   !!======================================================================
3   !!                       ***  MODULE  lbcnfd  ***
4   !! Ocean        : north fold  boundary conditions
5   !!======================================================================
6   !! History :  3.2  ! 2009-03  (R. Benshila)  Original code
7   !!----------------------------------------------------------------------
8
9   !!----------------------------------------------------------------------
10   !!   lbc_nfd       : generic interface for lbc_nfd_3d and lbc_nfd_2d routines
11   !!   lbc_nfd_3d    : lateral boundary condition: North fold treatment for a 3D arrays   (lbc_nfd)
12   !!   lbc_nfd_2d    : lateral boundary condition: North fold treatment for a 2D arrays   (lbc_nfd)
13   !!----------------------------------------------------------------------
14   USE dom_oce        ! ocean space and time domain
15   USE in_out_manager ! I/O manager
16
17   IMPLICIT NONE
18   PRIVATE
19
20   INTERFACE lbc_nfd
21      MODULE PROCEDURE   lbc_nfd_3d, lbc_nfd_2d
22   END INTERFACE
23
24   PUBLIC   lbc_nfd   ! north fold conditions
25
26   !!----------------------------------------------------------------------
27   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
28   !! $Id$
29   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
30   !!----------------------------------------------------------------------
31CONTAINS
32
33   SUBROUTINE lbc_nfd_3d( pt3d, cd_type, psgn )
34      !!----------------------------------------------------------------------
35      !!                  ***  routine lbc_nfd_3d  ***
36      !!
37      !! ** Purpose :   3D lateral boundary condition : North fold treatment
38      !!              without processor exchanges.
39      !!
40      !! ** Method  :   
41      !!
42      !! ** Action  :   pt3d with updated values along the north fold
43      !!----------------------------------------------------------------------
44      CHARACTER(len=1)          , INTENT(in   ) ::   cd_type   ! define the nature of ptab array grid-points
45      !                                                        !   = T , U , V , F , W points
46      REAL(wp)                  , INTENT(in   ) ::   psgn      ! control of the sign change
47      !                                                        !   = -1. , the sign is changed if north fold boundary
48      !                                                        !   =  1. , the sign is kept  if north fold boundary
49      REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   pt3d      ! 3D array on which the boundary condition is applied
50      !
51      INTEGER  ::   ji, jk
52      INTEGER  ::   ijt, iju, ijpj, ijpjm1
53      !!----------------------------------------------------------------------
54
55      SELECT CASE ( jpni )
56      CASE ( 1 )     ;   ijpj = nlcj      ! 1 proc only  along the i-direction
57      CASE DEFAULT   ;   ijpj = 4         ! several proc along the i-direction
58      END SELECT
59      ijpjm1 = ijpj-1
60
61      DO jk = 1, jpk
62         !
63         SELECT CASE ( npolj )
64         !
65         CASE ( 3 , 4 )                        ! *  North fold  T-point pivot
66            !
67            SELECT CASE ( cd_type )
68            CASE ( 'T' , 'W' )                         ! T-, W-point
69               DO ji = 2, jpiglo
70                  ijt = jpiglo-ji+2
71                  pt3d(ji,ijpj,jk) = psgn * pt3d(ijt,ijpj-2,jk)
72               END DO
73               pt3d(1,ijpj,jk) = psgn * pt3d(3,ijpj-2,jk)
74               DO ji = jpiglo/2+1, jpiglo
75                  ijt = jpiglo-ji+2
76                  pt3d(ji,ijpjm1,jk) = psgn * pt3d(ijt,ijpjm1,jk)
77               END DO
78            CASE ( 'U' )                               ! U-point
79               DO ji = 1, jpiglo-1
80                  iju = jpiglo-ji+1
81                  pt3d(ji,ijpj,jk) = psgn * pt3d(iju,ijpj-2,jk)
82               END DO
83               pt3d(   1  ,ijpj,jk) = psgn * pt3d(    2   ,ijpj-2,jk)
84               pt3d(jpiglo,ijpj,jk) = psgn * pt3d(jpiglo-1,ijpj-2,jk) 
85               DO ji = jpiglo/2, jpiglo-1
86                  iju = jpiglo-ji+1
87                  pt3d(ji,ijpjm1,jk) = psgn * pt3d(iju,ijpjm1,jk)
88               END DO
89            CASE ( 'V' )                               ! V-point
90               DO ji = 2, jpiglo
91                  ijt = jpiglo-ji+2
92                  pt3d(ji,ijpj-1,jk) = psgn * pt3d(ijt,ijpj-2,jk)
93                  pt3d(ji,ijpj  ,jk) = psgn * pt3d(ijt,ijpj-3,jk)
94               END DO
95               pt3d(1,ijpj,jk) = psgn * pt3d(3,ijpj-3,jk) 
96            CASE ( 'F' )                               ! F-point
97               DO ji = 1, jpiglo-1
98                  iju = jpiglo-ji+1
99                  pt3d(ji,ijpj-1,jk) = psgn * pt3d(iju,ijpj-2,jk)
100                  pt3d(ji,ijpj  ,jk) = psgn * pt3d(iju,ijpj-3,jk)
101               END DO
102               pt3d(   1  ,ijpj,jk) = psgn * pt3d(    2   ,ijpj-3,jk)
103               pt3d(jpiglo,ijpj,jk) = psgn * pt3d(jpiglo-1,ijpj-3,jk) 
104            END SELECT
105            !
106         CASE ( 5 , 6 )                        ! *  North fold  F-point pivot
107            !
108            SELECT CASE ( cd_type )
109            CASE ( 'T' , 'W' )                         ! T-, W-point
110               DO ji = 1, jpiglo
111                  ijt = jpiglo-ji+1
112                  pt3d(ji,ijpj,jk) = psgn * pt3d(ijt,ijpj-1,jk)
113               END DO
114            CASE ( 'U' )                               ! U-point
115               DO ji = 1, jpiglo-1
116                  iju = jpiglo-ji
117                  pt3d(ji,ijpj,jk) = psgn * pt3d(iju,ijpj-1,jk)
118               END DO
119               pt3d(jpiglo,ijpj,jk) = psgn * pt3d(1,ijpj-1,jk)
120            CASE ( 'V' )                               ! V-point
121               DO ji = 1, jpiglo
122                  ijt = jpiglo-ji+1
123                  pt3d(ji,ijpj,jk) = psgn * pt3d(ijt,ijpj-2,jk)
124               END DO
125               DO ji = jpiglo/2+1, jpiglo
126                  ijt = jpiglo-ji+1
127                  pt3d(ji,ijpjm1,jk) = psgn * pt3d(ijt,ijpjm1,jk)
128               END DO
129            CASE ( 'F' )                               ! F-point
130               DO ji = 1, jpiglo-1
131                  iju = jpiglo-ji
132                  pt3d(ji,ijpj  ,jk) = psgn * pt3d(iju,ijpj-2,jk)
133               END DO
134               pt3d(jpiglo,ijpj,jk) = psgn * pt3d(1,ijpj-2,jk)
135               DO ji = jpiglo/2+1, jpiglo-1
136                  iju = jpiglo-ji
137                  pt3d(ji,ijpjm1,jk) = psgn * pt3d(iju,ijpjm1,jk)
138               END DO
139            END SELECT
140            !
141         CASE DEFAULT                           ! *  closed : the code probably never go through
142            !
143            SELECT CASE ( cd_type)
144            CASE ( 'T' , 'U' , 'V' , 'W' )             ! T-, U-, V-, W-points
145               pt3d(:, 1  ,jk) = 0.e0
146               pt3d(:,ijpj,jk) = 0.e0
147            CASE ( 'F' )                               ! F-point
148               pt3d(:,ijpj,jk) = 0.e0
149            END SELECT
150            !
151         END SELECT     !  npolj
152         !
153      END DO
154      !
155   END SUBROUTINE lbc_nfd_3d
156
157
158   SUBROUTINE lbc_nfd_2d( pt2d, cd_type, psgn, pr2dj )
159      !!----------------------------------------------------------------------
160      !!                  ***  routine lbc_nfd_2d  ***
161      !!
162      !! ** Purpose :   2D lateral boundary condition : North fold treatment
163      !!       without processor exchanges.
164      !!
165      !! ** Method  :   
166      !!
167      !! ** Action  :   pt2d with updated values along the north fold
168      !!----------------------------------------------------------------------
169      CHARACTER(len=1)        , INTENT(in   ) ::   cd_type   ! define the nature of ptab array grid-points
170      !                                                      ! = T , U , V , F , W points
171      REAL(wp)                , INTENT(in   ) ::   psgn      ! control of the sign change
172      !                                                      !   = -1. , the sign is changed if north fold boundary
173      !                                                      !   =  1. , the sign is kept  if north fold boundary
174      REAL(wp), DIMENSION(:,:), INTENT(inout) ::   pt2d      ! 2D array on which the boundary condition is applied
175      INTEGER , OPTIONAL      , INTENT(in   ) ::   pr2dj     ! number of additional halos
176      !
177      INTEGER  ::   ji, jl, ipr2dj
178      INTEGER  ::   ijt, iju, ijpj, ijpjm1
179      !!----------------------------------------------------------------------
180
181      SELECT CASE ( jpni )
182      CASE ( 1 )     ;   ijpj = nlcj      ! 1 proc only  along the i-direction
183      CASE DEFAULT   ;   ijpj = 4         ! several proc along the i-direction
184      END SELECT
185      !
186      IF( PRESENT(pr2dj) ) THEN           ! use of additional halos
187         ipr2dj = pr2dj
188         IF( jpni > 1 )   ijpj = ijpj + ipr2dj
189      ELSE
190         ipr2dj = 0 
191      ENDIF
192      !
193      ijpjm1 = ijpj-1
194
195
196      SELECT CASE ( npolj )
197      !
198      CASE ( 3, 4 )                       ! *  North fold  T-point pivot
199         !
200         SELECT CASE ( cd_type )
201         !
202         CASE ( 'T' , 'W' )                               ! T- , W-points
203            DO jl = 0, ipr2dj
204               DO ji = 2, jpiglo
205                  ijt=jpiglo-ji+2
206                  pt2d(ji,ijpj+jl) = psgn * pt2d(ijt,ijpj-2-jl)
207               END DO
208            END DO
209            pt2d(1,ijpj)   = psgn * pt2d(3,ijpj-2)
210            DO ji = jpiglo/2+1, jpiglo
211               ijt=jpiglo-ji+2
212               pt2d(ji,ijpj-1) = psgn * pt2d(ijt,ijpj-1)
213            END DO
214         CASE ( 'U' )                                     ! U-point
215            DO jl = 0, ipr2dj
216               DO ji = 1, jpiglo-1
217                  iju = jpiglo-ji+1
218                  pt2d(ji,ijpj+jl) = psgn * pt2d(iju,ijpj-2-jl)
219               END DO
220            END DO
221            pt2d(   1  ,ijpj  ) = psgn * pt2d(    2   ,ijpj-2)
222            pt2d(jpiglo,ijpj  ) = psgn * pt2d(jpiglo-1,ijpj-2)
223            pt2d(1     ,ijpj-1) = psgn * pt2d(jpiglo  ,ijpj-1)   
224            DO ji = jpiglo/2, jpiglo-1
225               iju = jpiglo-ji+1
226               pt2d(ji,ijpjm1) = psgn * pt2d(iju,ijpjm1)
227            END DO
228         CASE ( 'V' )                                     ! V-point
229            DO jl = -1, ipr2dj
230               DO ji = 2, jpiglo
231                  ijt = jpiglo-ji+2
232                  pt2d(ji,ijpj+jl) = psgn * pt2d(ijt,ijpj-3-jl)
233               END DO
234            END DO
235            pt2d( 1 ,ijpj)   = psgn * pt2d( 3 ,ijpj-3) 
236         CASE ( 'F' )                                     ! F-point
237            DO jl = -1, ipr2dj
238               DO ji = 1, jpiglo-1
239                  iju = jpiglo-ji+1
240                  pt2d(ji,ijpj+jl) = psgn * pt2d(iju,ijpj-3-jl)
241               END DO
242            END DO
243            pt2d(   1  ,ijpj)   = psgn * pt2d(    2   ,ijpj-3)
244            pt2d(jpiglo,ijpj)   = psgn * pt2d(jpiglo-1,ijpj-3)
245            pt2d(jpiglo,ijpj-1) = psgn * pt2d(jpiglo-1,ijpj-2)     
246            pt2d(   1  ,ijpj-1) = psgn * pt2d(    2   ,ijpj-2)     
247         CASE ( 'I' )                                     ! ice U-V point (I-point)
248            DO jl = 0, ipr2dj
249               pt2d(2,ijpj+jl) = psgn * pt2d(3,ijpj-1+jl)
250               DO ji = 3, jpiglo
251                  iju = jpiglo - ji + 3
252                  pt2d(ji,ijpj+jl) = psgn * pt2d(iju,ijpj-1-jl)
253               END DO
254            END DO
255         CASE ( 'J' )                                     ! first ice U-V point
256            DO jl =0, ipr2dj
257               pt2d(2,ijpj+jl) = psgn * pt2d(3,ijpj-1+jl)
258               DO ji = 3, jpiglo
259                  iju = jpiglo - ji + 3
260                  pt2d(ji,ijpj+jl) = psgn * pt2d(iju,ijpj-1-jl)
261               END DO
262            END DO
263         CASE ( 'K' )                                     ! second ice U-V point
264            DO jl =0, ipr2dj
265               pt2d(2,ijpj+jl) = psgn * pt2d(3,ijpj-1+jl)
266               DO ji = 3, jpiglo
267                  iju = jpiglo - ji + 3
268                  pt2d(ji,ijpj+jl) = psgn * pt2d(iju,ijpj-1-jl)
269               END DO
270            END DO
271         END SELECT
272         !
273      CASE ( 5, 6 )                        ! *  North fold  F-point pivot
274         !
275         SELECT CASE ( cd_type )
276         CASE ( 'T' , 'W' )                               ! T-, W-point
277            DO jl = 0, ipr2dj
278               DO ji = 1, jpiglo
279                  ijt = jpiglo-ji+1
280                  pt2d(ji,ijpj+jl) = psgn * pt2d(ijt,ijpj-1-jl)
281               END DO
282            END DO
283         CASE ( 'U' )                                     ! U-point
284            DO jl = 0, ipr2dj
285               DO ji = 1, jpiglo-1
286                  iju = jpiglo-ji
287                  pt2d(ji,ijpj+jl) = psgn * pt2d(iju,ijpj-1-jl)
288               END DO
289            END DO
290            pt2d(jpiglo,ijpj) = psgn * pt2d(1,ijpj-1)
291         CASE ( 'V' )                                     ! V-point
292            DO jl = 0, ipr2dj
293               DO ji = 1, jpiglo
294                  ijt = jpiglo-ji+1
295                  pt2d(ji,ijpj+jl) = psgn * pt2d(ijt,ijpj-2-jl)
296               END DO
297            END DO
298            DO ji = jpiglo/2+1, jpiglo
299               ijt = jpiglo-ji+1
300               pt2d(ji,ijpjm1) = psgn * pt2d(ijt,ijpjm1)
301            END DO
302         CASE ( 'F' )                               ! F-point
303            DO jl = 0, ipr2dj
304               DO ji = 1, jpiglo-1
305                  iju = jpiglo-ji
306                  pt2d(ji,ijpj+jl) = psgn * pt2d(iju,ijpj-2-jl)
307               END DO
308            END DO
309            pt2d(jpiglo,ijpj) = psgn * pt2d(1,ijpj-2)
310            DO ji = jpiglo/2+1, jpiglo-1
311               iju = jpiglo-ji
312               pt2d(ji,ijpjm1) = psgn * pt2d(iju,ijpjm1)
313            END DO
314         CASE ( 'I' )                                  ! ice U-V point (I-point)
315            pt2d( 2 ,ijpj:ijpj+ipr2dj) = 0.e0
316            DO jl = 0, ipr2dj
317               DO ji = 2 , jpiglo-1
318                  ijt = jpiglo - ji + 2
319                  pt2d(ji,ijpj+jl)= 0.5 * ( pt2d(ji,ijpj-1-jl) + psgn * pt2d(ijt,ijpj-1-jl) )
320               END DO
321            END DO
322         CASE ( 'J' )                                  ! first ice U-V point
323            pt2d( 2 ,ijpj:ijpj+ipr2dj) = 0.e0
324            DO jl = 0, ipr2dj
325               DO ji = 2 , jpiglo-1
326                  ijt = jpiglo - ji + 2
327                  pt2d(ji,ijpj+jl)= pt2d(ji,ijpj-1-jl)
328               END DO
329            END DO
330         CASE ( 'K' )                                  ! second ice U-V point
331            pt2d( 2 ,ijpj:ijpj+ipr2dj) = 0.e0
332            DO jl = 0, ipr2dj
333               DO ji = 2 , jpiglo-1
334                  ijt = jpiglo - ji + 2
335                  pt2d(ji,ijpj+jl)= pt2d(ijt,ijpj-1-jl)
336               END DO
337            END DO
338         END SELECT
339         !
340      CASE DEFAULT                           ! *  closed : the code probably never go through
341         !
342         SELECT CASE ( cd_type)
343         CASE ( 'T' , 'U' , 'V' , 'W' )                 ! T-, U-, V-, W-points
344            pt2d(:, 1:1-ipr2dj     ) = 0.e0
345            pt2d(:,ijpj:ijpj+ipr2dj) = 0.e0
346         CASE ( 'F' )                                   ! F-point
347            pt2d(:,ijpj:ijpj+ipr2dj) = 0.e0
348         CASE ( 'I' )                                   ! ice U-V point
349            pt2d(:, 1:1-ipr2dj     ) = 0.e0
350            pt2d(:,ijpj:ijpj+ipr2dj) = 0.e0
351         CASE ( 'J' )                                   ! first ice U-V point
352            pt2d(:, 1:1-ipr2dj     ) = 0.e0
353            pt2d(:,ijpj:ijpj+ipr2dj) = 0.e0
354         CASE ( 'K' )                                   ! second ice U-V point
355            pt2d(:, 1:1-ipr2dj     ) = 0.e0
356            pt2d(:,ijpj:ijpj+ipr2dj) = 0.e0
357         END SELECT
358         !
359      END SELECT
360      !
361   END SUBROUTINE lbc_nfd_2d
362
363   !!======================================================================
364END MODULE lbcnfd
Note: See TracBrowser for help on using the repository browser.