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 – NEMO

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

Last change on this file since 2287 was 2287, checked in by smasson, 14 years ago

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