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/nemo_v3_3_beta/NEMOGCM/NEMO/OPA_SRC/LBC – NEMO

source: branches/nemo_v3_3_beta/NEMOGCM/NEMO/OPA_SRC/LBC/lbcnfd.F90 @ 2442

Last change on this file since 2442 was 2442, checked in by gm, 13 years ago

v3.3beta: #765 Creation of LBC directory, move of istate.F90 in DOM
  • Property svn:keywords set to Id
File size: 12.6 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 oce            ! ocean dynamics and tracers   
15   USE dom_oce        ! ocean space and time domain
16   USE in_out_manager ! I/O manager
17
18   IMPLICIT NONE
19   PRIVATE
20
21   INTERFACE lbc_nfd
22      MODULE PROCEDURE   lbc_nfd_3d, lbc_nfd_2d
23   END INTERFACE
24
25   PUBLIC   lbc_nfd   ! north fold conditions
26
27   !!----------------------------------------------------------------------
28   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
29   !! $Id$
30   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
31   !!----------------------------------------------------------------------
32CONTAINS
33
34   SUBROUTINE lbc_nfd_3d( pt3d, cd_type, psgn )
35      !!----------------------------------------------------------------------
36      !!                  ***  routine lbc_nfd_3d  ***
37      !!
38      !! ** Purpose :   3D lateral boundary condition : North fold treatment
39      !!              without processor exchanges.
40      !!
41      !! ** Method  :   
42      !!
43      !! ** Action  :   pt3d with updated values along the north fold
44      !!----------------------------------------------------------------------
45      CHARACTER(len=1)          , INTENT(in   ) ::   cd_type   ! define the nature of ptab array grid-points
46      !                                                        !   = T , U , V , F , W points
47      REAL(wp)                  , INTENT(in   ) ::   psgn      ! control of the sign change
48      !                                                        !   = -1. , the sign is changed if north fold boundary
49      !                                                        !   =  1. , the sign is kept  if north fold boundary
50      REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   pt3d      ! 3D array on which the boundary condition is applied
51      !
52      INTEGER  ::   ji, jk
53      INTEGER  ::   ijt, iju, ijpj, ijpjm1
54      !!----------------------------------------------------------------------
55
56      SELECT CASE ( jpni )
57      CASE ( 1 )     ;   ijpj = nlcj      ! 1 proc only  along the i-direction
58      CASE DEFAULT   ;   ijpj = 4         ! several proc along the i-direction
59      END SELECT
60      ijpjm1 = ijpj-1
61
62      DO jk = 1, jpk
63         !
64         SELECT CASE ( npolj )
65         !
66         CASE ( 3 , 4 )                        ! *  North fold  T-point pivot
67            !
68            SELECT CASE ( cd_type )
69            CASE ( 'T' , 'W' )                         ! T-, W-point
70               DO ji = 2, jpiglo
71                  ijt = jpiglo-ji+2
72                  pt3d(ji,ijpj,jk) = psgn * pt3d(ijt,ijpj-2,jk)
73               END DO
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               DO ji = jpiglo/2, jpiglo-1
84                  iju = jpiglo-ji+1
85                  pt3d(ji,ijpjm1,jk) = psgn * pt3d(iju,ijpjm1,jk)
86               END DO
87            CASE ( 'V' )                               ! V-point
88               DO ji = 2, jpiglo
89                  ijt = jpiglo-ji+2
90                  pt3d(ji,ijpj-1,jk) = psgn * pt3d(ijt,ijpj-2,jk)
91                  pt3d(ji,ijpj  ,jk) = psgn * pt3d(ijt,ijpj-3,jk)
92               END DO
93            CASE ( 'F' )                               ! F-point
94               DO ji = 1, jpiglo-1
95                  iju = jpiglo-ji+1
96                  pt3d(ji,ijpj-1,jk) = psgn * pt3d(iju,ijpj-2,jk)
97                  pt3d(ji,ijpj  ,jk) = psgn * pt3d(iju,ijpj-3,jk)
98               END DO
99            END SELECT
100            !
101         CASE ( 5 , 6 )                        ! *  North fold  F-point pivot
102            !
103            SELECT CASE ( cd_type )
104            CASE ( 'T' , 'W' )                         ! T-, W-point
105               DO ji = 1, jpiglo
106                  ijt = jpiglo-ji+1
107                  pt3d(ji,ijpj,jk) = psgn * pt3d(ijt,ijpj-1,jk)
108               END DO
109            CASE ( 'U' )                               ! U-point
110               DO ji = 1, jpiglo-1
111                  iju = jpiglo-ji
112                  pt3d(ji,ijpj,jk) = psgn * pt3d(iju,ijpj-1,jk)
113               END DO
114            CASE ( 'V' )                               ! V-point
115               DO ji = 1, jpiglo
116                  ijt = jpiglo-ji+1
117                  pt3d(ji,ijpj,jk) = psgn * pt3d(ijt,ijpj-2,jk)
118               END DO
119               DO ji = jpiglo/2+1, jpiglo
120                  ijt = jpiglo-ji+1
121                  pt3d(ji,ijpjm1,jk) = psgn * pt3d(ijt,ijpjm1,jk)
122               END DO
123            CASE ( 'F' )                               ! F-point
124               DO ji = 1, jpiglo-1
125                  iju = jpiglo-ji
126                  pt3d(ji,ijpj  ,jk) = psgn * pt3d(iju,ijpj-2,jk)
127               END DO
128               DO ji = jpiglo/2+1, jpiglo-1
129                  iju = jpiglo-ji
130                  pt3d(ji,ijpjm1,jk) = psgn * pt3d(iju,ijpjm1,jk)
131               END DO
132            END SELECT
133            !
134         CASE DEFAULT                           ! *  closed : the code probably never go through
135            !
136            SELECT CASE ( cd_type)
137            CASE ( 'T' , 'U' , 'V' , 'W' )             ! T-, U-, V-, W-points
138               pt3d(:, 1  ,jk) = 0.e0
139               pt3d(:,ijpj,jk) = 0.e0
140            CASE ( 'F' )                               ! F-point
141               pt3d(:,ijpj,jk) = 0.e0
142            END SELECT
143            !
144         END SELECT     !  npolj
145         !
146      END DO
147      !
148   END SUBROUTINE lbc_nfd_3d
149
150
151   SUBROUTINE lbc_nfd_2d( pt2d, cd_type, psgn, pr2dj )
152      !!----------------------------------------------------------------------
153      !!                  ***  routine lbc_nfd_2d  ***
154      !!
155      !! ** Purpose :   2D lateral boundary condition : North fold treatment
156      !!       without processor exchanges.
157      !!
158      !! ** Method  :   
159      !!
160      !! ** Action  :   pt2d with updated values along the north fold
161      !!----------------------------------------------------------------------
162      CHARACTER(len=1)        , INTENT(in   ) ::   cd_type   ! define the nature of ptab array grid-points
163      !                                                      ! = T , U , V , F , W points
164      REAL(wp)                , INTENT(in   ) ::   psgn      ! control of the sign change
165      !                                                      !   = -1. , the sign is changed if north fold boundary
166      !                                                      !   =  1. , the sign is kept  if north fold boundary
167      REAL(wp), DIMENSION(:,:), INTENT(inout) ::   pt2d      ! 2D array on which the boundary condition is applied
168      INTEGER , OPTIONAL      , INTENT(in   ) ::   pr2dj     ! number of additional halos
169      !
170      INTEGER  ::   ji, jl, ipr2dj
171      INTEGER  ::   ijt, iju, ijpj, ijpjm1
172      !!----------------------------------------------------------------------
173
174      SELECT CASE ( jpni )
175      CASE ( 1 )     ;   ijpj = nlcj      ! 1 proc only  along the i-direction
176      CASE DEFAULT   ;   ijpj = 4         ! several proc along the i-direction
177      END SELECT
178      !
179      IF( PRESENT(pr2dj) ) THEN           ! use of additional halos
180         ipr2dj = pr2dj
181         IF( jpni > 1 )   ijpj = ijpj + ipr2dj
182      ELSE
183         ipr2dj = 0 
184      ENDIF
185      !
186      ijpjm1 = ijpj-1
187
188
189      SELECT CASE ( npolj )
190      !
191      CASE ( 3, 4 )                       ! *  North fold  T-point pivot
192         !
193         SELECT CASE ( cd_type )
194         !
195         CASE ( 'T' , 'W' )                               ! T- , W-points
196            DO jl = 0, ipr2dj
197               DO ji = 2, jpiglo
198                  ijt=jpiglo-ji+2
199                  pt2d(ji,ijpj+jl) = psgn * pt2d(ijt,ijpj-2-jl)
200               END DO
201            END DO
202            DO ji = jpiglo/2+1, jpiglo
203               ijt=jpiglo-ji+2
204               pt2d(ji,ijpj-1) = psgn * pt2d(ijt,ijpj-1)
205            END DO
206         CASE ( 'U' )                                     ! U-point
207            DO jl = 0, ipr2dj
208               DO ji = 1, jpiglo-1
209                  iju = jpiglo-ji+1
210                  pt2d(ji,ijpj+jl) = psgn * pt2d(iju,ijpj-2-jl)
211               END DO
212            END DO
213            DO ji = jpiglo/2, jpiglo-1
214               iju = jpiglo-ji+1
215               pt2d(ji,ijpjm1) = psgn * pt2d(iju,ijpjm1)
216            END DO
217         CASE ( 'V' )                                     ! V-point
218            DO jl = -1, ipr2dj
219               DO ji = 2, jpiglo
220                  ijt = jpiglo-ji+2
221                  pt2d(ji,ijpj+jl) = psgn * pt2d(ijt,ijpj-3-jl)
222               END DO
223            END DO
224         CASE ( 'F' )                                     ! F-point
225            DO jl = -1, ipr2dj
226               DO ji = 1, jpiglo-1
227                  iju = jpiglo-ji+1
228                  pt2d(ji,ijpj+jl) = psgn * pt2d(iju,ijpj-3-jl)
229               END DO
230            END DO
231         CASE ( 'I' )                                     ! ice U-V point (I-point)
232            DO jl = 0, ipr2dj
233               pt2d(2,ijpj+jl) = psgn * pt2d(3,ijpj-1+jl)
234               DO ji = 3, jpiglo
235                  iju = jpiglo - ji + 3
236                  pt2d(ji,ijpj+jl) = psgn * pt2d(iju,ijpj-1-jl)
237               END DO
238            END DO
239         END SELECT
240         !
241      CASE ( 5, 6 )                        ! *  North fold  F-point pivot
242         !
243         SELECT CASE ( cd_type )
244         CASE ( 'T' , 'W' )                               ! T-, W-point
245            DO jl = 0, ipr2dj
246               DO ji = 1, jpiglo
247                  ijt = jpiglo-ji+1
248                  pt2d(ji,ijpj+jl) = psgn * pt2d(ijt,ijpj-1-jl)
249               END DO
250            END DO
251         CASE ( 'U' )                                     ! U-point
252            DO jl = 0, ipr2dj
253               DO ji = 1, jpiglo-1
254                  iju = jpiglo-ji
255                  pt2d(ji,ijpj+jl) = psgn * pt2d(iju,ijpj-1-jl)
256               END DO
257            END DO
258         CASE ( 'V' )                                     ! V-point
259            DO jl = 0, ipr2dj
260               DO ji = 1, jpiglo
261                  ijt = jpiglo-ji+1
262                  pt2d(ji,ijpj+jl) = psgn * pt2d(ijt,ijpj-2-jl)
263               END DO
264            END DO
265            DO ji = jpiglo/2+1, jpiglo
266               ijt = jpiglo-ji+1
267               pt2d(ji,ijpjm1) = psgn * pt2d(ijt,ijpjm1)
268            END DO
269         CASE ( 'F' )                               ! F-point
270            DO jl = 0, ipr2dj
271               DO ji = 1, jpiglo-1
272                  iju = jpiglo-ji
273                  pt2d(ji,ijpj+jl) = psgn * pt2d(iju,ijpj-2-jl)
274               END DO
275            END DO
276            DO ji = jpiglo/2+1, jpiglo-1
277               iju = jpiglo-ji
278               pt2d(ji,ijpjm1) = psgn * pt2d(iju,ijpjm1)
279            END DO
280         CASE ( 'I' )                                  ! ice U-V point (I-point)
281            pt2d( 2 ,ijpj:ijpj+ipr2dj) = 0.e0
282            DO jl = 0, ipr2dj
283               DO ji = 2 , jpiglo-1
284                  ijt = jpiglo - ji + 2
285                  pt2d(ji,ijpj+jl)= 0.5 * ( pt2d(ji,ijpj-1-jl) + psgn * pt2d(ijt,ijpj-1-jl) )
286               END DO
287            END DO
288         END SELECT
289         !
290      CASE DEFAULT                           ! *  closed : the code probably never go through
291         !
292         SELECT CASE ( cd_type)
293         CASE ( 'T' , 'U' , 'V' , 'W' )                 ! T-, U-, V-, W-points
294            pt2d(:, 1:1-ipr2dj     ) = 0.e0
295            pt2d(:,ijpj:ijpj+ipr2dj) = 0.e0
296         CASE ( 'F' )                                   ! F-point
297            pt2d(:,ijpj:ijpj+ipr2dj) = 0.e0
298         CASE ( 'I' )                                   ! ice U-V point
299            pt2d(:, 1:1-ipr2dj     ) = 0.e0
300            pt2d(:,ijpj:ijpj+ipr2dj) = 0.e0
301         END SELECT
302         !
303      END SELECT
304      !
305   END SUBROUTINE lbc_nfd_2d
306
307   !!======================================================================
308END MODULE lbcnfd
Note: See TracBrowser for help on using the repository browser.