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 tags/nemo_v3_2/nemo_v3_2/NEMO/OPA_SRC – NEMO

source: tags/nemo_v3_2/nemo_v3_2/NEMO/OPA_SRC/lbcnfd.F90 @ 1878

Last change on this file since 1878 was 1878, checked in by flavoni, 14 years ago

initial test for nemogcm
File size: 11.5 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
23CONTAINS
24
25   SUBROUTINE lbc_nfd_3d( pt3d, cd_type, psgn )
26      !!----------------------------------------------------------------------
27      !!                  ***  routine lbc_nfd_3d  ***
28      !!
29      !! ** Purpose :   3D lateral boundary condition : North fold treatment
30      !!       without processor exchanges.
31      !!
32      !! ** Method  :   
33      !!
34      !! ** Action  :   pt3d with update value at its periphery
35      !!
36      !!----------------------------------------------------------------------
37      !! * Arguments
38      CHARACTER(len=1) , INTENT( in ) ::   &
39         cd_type       ! define the nature of ptab array grid-points
40      !             ! = T , U , V , F , W points
41      !             ! = S : T-point, north fold treatment ???
42      !             ! = G : F-point, north fold treatment ???
43      REAL(wp), INTENT( in ) ::   &
44         psgn          ! control of the sign change
45      !             !   = -1. , the sign is changed if north fold boundary
46      !             !   =  1. , the sign is kept  if north fold boundary
47      REAL(wp), DIMENSION(:,:,:), INTENT( inout ) ::   &
48         pt3d          ! 3D array on which the boundary condition is applied
49
50      !! * Local declarations
51      INTEGER  ::   ji, jk
52      INTEGER  ::   ijt, iju, ijpj, ijpjm1
53
54
55      SELECT CASE ( jpni )
56      CASE ( 1 )  ! only one proc along I
57         ijpj = nlcj
58      CASE DEFAULT 
59         ijpj   = 4
60      END SELECT
61      ijpjm1 = ijpj-1
62
63      DO jk = 1, jpk
64
65         SELECT CASE ( npolj )
66
67         CASE ( 3 , 4 )                        ! *  North fold  T-point pivot
68
69            SELECT CASE ( cd_type )
70            CASE ( 'T' , 'W' )                         ! T-, W-point
71               DO ji = 2, jpiglo
72                  ijt = jpiglo-ji+2
73                  pt3d(ji,ijpj,jk) = psgn * pt3d(ijt,ijpj-2,jk)
74               END DO
75               DO ji = jpiglo/2+1, jpiglo
76                  ijt = jpiglo-ji+2
77                  pt3d(ji,ijpjm1,jk) = psgn * pt3d(ijt,ijpjm1,jk)
78               END DO
79            CASE ( 'U' )                               ! U-point
80               DO ji = 1, jpiglo-1
81                  iju = jpiglo-ji+1
82                  pt3d(ji,ijpj,jk) = psgn * pt3d(iju,ijpj-2,jk)
83               END DO
84               DO ji = jpiglo/2, jpiglo-1
85                  iju = jpiglo-ji+1
86                  pt3d(ji,ijpjm1,jk) = psgn * pt3d(iju,ijpjm1,jk)
87               END DO
88            CASE ( 'V' )                               ! V-point
89               DO ji = 2, jpiglo
90                  ijt = jpiglo-ji+2
91                  pt3d(ji,ijpj-1,jk) = psgn * pt3d(ijt,ijpj-2,jk)
92                  pt3d(ji,ijpj  ,jk) = psgn * pt3d(ijt,ijpj-3,jk)
93               END DO
94            CASE ( 'F' )                               ! F-point
95               DO ji = 1, jpiglo-1
96                  iju = jpiglo-ji+1
97                  pt3d(ji,ijpj-1,jk) = psgn * pt3d(iju,ijpj-2,jk)
98                  pt3d(ji,ijpj  ,jk) = psgn * pt3d(iju,ijpj-3,jk)
99               END DO
100            END SELECT
101
102         CASE ( 5 , 6 )                        ! *  North fold  F-point pivot
103
104            SELECT CASE ( cd_type )
105            CASE ( 'T' , 'W' )                         ! T-, W-point
106               DO ji = 1, jpiglo
107                  ijt = jpiglo-ji+1
108                  pt3d(ji,ijpj,jk) = psgn * pt3d(ijt,ijpj-1,jk)
109               END DO
110            CASE ( 'U' )                               ! U-point
111               DO ji = 1, jpiglo-1
112                  iju = jpiglo-ji
113                  pt3d(ji,ijpj,jk) = psgn * pt3d(iju,ijpj-1,jk)
114               END DO
115            CASE ( 'V' )                               ! V-point
116               DO ji = 1, jpiglo
117                  ijt = jpiglo-ji+1
118                  pt3d(ji,ijpj,jk) = psgn * pt3d(ijt,ijpj-2,jk)
119               END DO
120               DO ji = jpiglo/2+1, jpiglo
121                  ijt = jpiglo-ji+1
122                  pt3d(ji,ijpjm1,jk) = psgn * pt3d(ijt,ijpjm1,jk)
123               END DO
124            CASE ( 'F' )                               ! F-point
125               DO ji = 1, jpiglo-1
126                  iju = jpiglo-ji
127                  pt3d(ji,ijpj  ,jk) = psgn * pt3d(iju,ijpj-2,jk)
128               END DO
129               DO ji = jpiglo/2+1, jpiglo-1
130                  iju = jpiglo-ji
131                  pt3d(ji,ijpjm1,jk) = psgn * pt3d(iju,ijpjm1,jk)
132               END DO
133            END SELECT
134
135         CASE DEFAULT                           ! *  closed : the code probably never go through
136
137            SELECT CASE ( cd_type)
138            CASE ( 'T' , 'U' , 'V' , 'W' )             ! T-, U-, V-, W-points
139               pt3d(:, 1  ,jk) = 0.e0
140               pt3d(:,ijpj,jk) = 0.e0
141            CASE ( 'F' )                               ! F-point
142               pt3d(:,ijpj,jk) = 0.e0
143            END SELECT
144
145         END SELECT     !  npolj
146
147      END DO
148
149   END SUBROUTINE lbc_nfd_3d
150
151
152   SUBROUTINE lbc_nfd_2d( pt2d, cd_type, psgn, pr2dj )
153      !!----------------------------------------------------------------------
154      !!                  ***  routine lbc_nfd_2d  ***
155      !!
156      !! ** Purpose :   2D lateral boundary condition : North fold treatment
157      !!       without processor exchanges.
158      !!
159      !! ** Method  :   
160      !!
161      !! ** Action  :   pt2d with update value at its periphery
162      !!
163      !!----------------------------------------------------------------------
164      !! * Arguments
165      CHARACTER(len=1) , INTENT( in ) ::   &
166         cd_type       ! define the nature of ptab array grid-points
167      !             ! = T , U , V , F , W points
168      !             ! = S : T-point, north fold treatment ???
169      !             ! = G : F-point, north fold treatment ???
170      REAL(wp), INTENT( in ) ::   &
171         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 ) ::   &
175         pt2d          ! 3D array on which the boundary condition is applied
176      INTEGER, OPTIONAL, INTENT(in) :: pr2dj
177
178      !! * Local declarations
179      INTEGER  ::   ji, jl, ipr2dj
180      INTEGER  ::   ijt, iju, ijpj, ijpjm1
181
182      SELECT CASE ( jpni )
183      CASE ( 1 )  ! only one proc along I
184         ijpj = nlcj
185      CASE DEFAULT 
186         ijpj = 4
187      END SELECT
188
189
190      IF( PRESENT(pr2dj) ) THEN
191         ipr2dj = pr2dj
192         IF (jpni .GT. 1) ijpj = ijpj + ipr2dj
193      ELSE
194         ipr2dj = 0 
195      ENDIF
196
197      ijpjm1 = ijpj-1
198
199
200      SELECT CASE ( npolj )
201
202      CASE ( 3, 4 )                       ! *  North fold  T-point pivot
203
204         SELECT CASE ( cd_type )
205
206         CASE ( 'T', 'S', 'W' )
207            DO jl = 0, ipr2dj
208               DO ji = 2, jpiglo
209                  ijt=jpiglo-ji+2
210                  pt2d(ji,ijpj+jl) = psgn * pt2d(ijt,ijpj-2-jl)
211               END DO
212            END DO
213            DO ji = jpiglo/2+1, jpiglo
214               ijt=jpiglo-ji+2
215               pt2d(ji,ijpj-1) = psgn * pt2d(ijt,ijpj-1)
216            END DO
217         CASE ( 'U' )                                     ! U-point
218            DO jl =0, ipr2dj
219               DO ji = 1, jpiglo-1
220                  iju = jpiglo-ji+1
221                  pt2d(ji,ijpj+jl) = psgn * pt2d(iju,ijpj-2-jl)
222               END DO
223            END DO
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         CASE ( 'F' , 'G' )                               ! F-point
236            DO jl =-1, ipr2dj
237               DO ji = 1, jpiglo-1
238                  iju = jpiglo-ji+1
239                  pt2d(ji,ijpj+jl) = psgn * pt2d(iju,ijpj-3-jl)
240               END DO
241            END DO
242         CASE ( 'I' )                                     ! ice U-V point
243            DO jl =0, ipr2dj
244               pt2d(2,ijpj+jl) = psgn * pt2d(3,ijpj-1+jl)
245               DO ji = 3, jpiglo
246                  iju = jpiglo - ji + 3
247                  pt2d(ji,ijpj+jl) = psgn * pt2d(iju,ijpj-1-jl)
248               END DO
249            END DO
250         END SELECT
251
252      CASE ( 5, 6 )                        ! *  North fold  F-point pivot
253
254         SELECT CASE ( cd_type )
255         CASE ( 'T' , 'W' ,'S' )                          ! T-, W-point
256            DO jl = 0, ipr2dj
257               DO ji = 1, jpiglo
258                  ijt = jpiglo-ji+1
259                  pt2d(ji,ijpj+jl) = psgn * pt2d(ijt,ijpj-1-jl)
260               END DO
261            END DO
262         CASE ( 'U' )                                     ! U-point
263            DO jl = 0, ipr2dj
264               DO ji = 1, jpiglo-1
265                  iju = jpiglo-ji
266                  pt2d(ji,ijpj+jl) = psgn * pt2d(iju,ijpj-1-jl)
267               END DO
268            END DO
269         CASE ( 'V' )                                     ! V-point
270            DO jl = 0, ipr2dj
271               DO ji = 1, jpiglo
272                  ijt = jpiglo-ji+1
273                  pt2d(ji,ijpj+jl) = psgn * pt2d(ijt,ijpj-2-jl)
274               END DO
275            END DO
276            DO ji = jpiglo/2+1, jpiglo
277               ijt = jpiglo-ji+1
278               pt2d(ji,ijpjm1) = psgn * pt2d(ijt,ijpjm1)
279            END DO
280         CASE ( 'F' , 'G' )                               ! F-point
281            DO jl = 0, ipr2dj
282               DO ji = 1, jpiglo-1
283                  iju = jpiglo-ji
284                  pt2d(ji,ijpj+jl) = psgn * pt2d(iju,ijpj-2-jl)
285               END DO
286            END DO
287            DO ji = jpiglo/2+1, jpiglo-1
288               iju = jpiglo-ji
289               pt2d(ji,ijpjm1) = psgn * pt2d(iju,ijpjm1)
290            END DO
291         CASE ( 'I' )                                  ! ice U-V point
292            pt2d( 2 ,ijpj:ijpj+ipr2dj) = 0.e0
293            DO jl = 0, ipr2dj
294               DO ji = 2 , jpiglo-1
295                  ijt = jpiglo - ji + 2
296                  pt2d(ji,ijpj+jl)= 0.5 * ( pt2d(ji,ijpj-1-jl) + psgn * pt2d(ijt,ijpj-1-jl) )
297               END DO
298            END DO
299         END SELECT
300
301      CASE DEFAULT                           ! *  closed : the code probably never go through
302
303         SELECT CASE ( cd_type)
304         CASE ( 'T' , 'U' , 'V' , 'W' )                 ! T-, U-, V-, W-points
305            pt2d(:, 1:1-ipr2dj     ) = 0.e0
306            pt2d(:,ijpj:ijpj+ipr2dj) = 0.e0
307         CASE ( 'F' )                                   ! F-point
308            pt2d(:,ijpj:ijpj+ipr2dj) = 0.e0
309         CASE ( 'I' )                                   ! ice U-V point
310            pt2d(:, 1:1-ipr2dj     ) = 0.e0
311            pt2d(:,ijpj:ijpj+ipr2dj) = 0.e0
312         END SELECT
313
314      END SELECT
315
316   END SUBROUTINE lbc_nfd_2d
317
318   !!======================================================================
319END MODULE lbcnfd
Note: See TracBrowser for help on using the repository browser.