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.
lbclnk.F90 in branches/NERC/dev_r3874_FASTNEt/NEMOGCM/NEMO/OPA_SRC/LBC – NEMO

source: branches/NERC/dev_r3874_FASTNEt/NEMOGCM/NEMO/OPA_SRC/LBC/lbclnk.F90 @ 6736

Last change on this file since 6736 was 6736, checked in by jamesharle, 8 years ago

FASTNEt code modifications
  • Property svn:keywords set to Id
File size: 16.7 KB
Line 
1MODULE lbclnk
2   !!======================================================================
3   !!                       ***  MODULE  lbclnk  ***
4   !! Ocean        : lateral boundary conditions
5   !!=====================================================================
6   !! History :  OPA  ! 1997-06  (G. Madec)     Original code
7   !!   NEMO     1.0  ! 2002-09  (G. Madec)     F90: Free form and module
8   !!            3.2  ! 2009-03  (R. Benshila)  External north fold treatment 
9   !!            3.4  ! 2012-12  (R. Bourdalle-Badie and G. Reffray)  add a C1D case 
10   !!----------------------------------------------------------------------
11#if defined key_mpp_mpi
12   !!----------------------------------------------------------------------
13   !!   'key_mpp_mpi'             MPI massively parallel processing library
14   !!----------------------------------------------------------------------
15   !!   lbc_lnk      : generic interface for mpp_lnk_3d and mpp_lnk_2d routines defined in lib_mpp
16   !!   lbc_lnk_e    : generic interface for mpp_lnk_2d_e routine defined in lib_mpp
17   !!----------------------------------------------------------------------
18   USE lib_mpp          ! distributed memory computing library
19
20   INTERFACE lbc_lnk
21      MODULE PROCEDURE mpp_lnk_3d_gather, mpp_lnk_3d, mpp_lnk_2d
22   END INTERFACE
23
24   INTERFACE lbc_lnk_e
25      MODULE PROCEDURE mpp_lnk_2d_e
26   END INTERFACE
27
28   PUBLIC lbc_lnk       ! ocean lateral boundary conditions
29   PUBLIC lbc_lnk_e
30
31   !!----------------------------------------------------------------------
32   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
33   !! $Id$
34   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
35   !!----------------------------------------------------------------------
36
37#else
38   !!----------------------------------------------------------------------
39   !!   Default option                              shared memory computing
40   !!----------------------------------------------------------------------
41   !!   lbc_lnk      : generic interface for lbc_lnk_3d and lbc_lnk_2d
42   !!   lbc_lnk_3d   : set the lateral boundary condition on a 3D variable on ocean mesh
43   !!   lbc_lnk_2d   : set the lateral boundary condition on a 2D variable on ocean mesh
44   !!----------------------------------------------------------------------
45   USE oce             ! ocean dynamics and tracers   
46   USE dom_oce         ! ocean space and time domain
47   USE in_out_manager  ! I/O manager
48   USE lbcnfd          ! north fold
49
50   IMPLICIT NONE
51   PRIVATE
52
53   INTERFACE lbc_lnk
54      MODULE PROCEDURE lbc_lnk_3d_gather, lbc_lnk_3d, lbc_lnk_2d
55   END INTERFACE
56
57   INTERFACE lbc_lnk_e
58      MODULE PROCEDURE lbc_lnk_2d
59   END INTERFACE
60
61   PUBLIC   lbc_lnk       ! ocean/ice  lateral boundary conditions
62   PUBLIC   lbc_lnk_e 
63   
64   !!----------------------------------------------------------------------
65   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
66   !! $Id$
67   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
68   !!----------------------------------------------------------------------
69CONTAINS
70
71# if defined key_c1d
72   !!----------------------------------------------------------------------
73   !!   'key_c1d'                                          1D configuration
74   !!----------------------------------------------------------------------
75
76   SUBROUTINE lbc_lnk_3d_gather( pt3d1, cd_type1, pt3d2, cd_type2, psgn )
77      !!---------------------------------------------------------------------
78      !!                  ***  ROUTINE lbc_lnk_3d_gather  ***
79      !!
80      !! ** Purpose :   set lateral boundary conditions on two 3D arrays (C1D case)
81      !!
82      !! ** Method  :   call lbc_lnk_3d on pt3d1 and pt3d2
83      !!----------------------------------------------------------------------
84      CHARACTER(len=1)                , INTENT(in   ) ::   cd_type1, cd_type2   ! nature of pt3d grid-points
85      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pt3d1   , pt3d2      ! 3D array on which the lbc is applied
86      REAL(wp)                        , INTENT(in   ) ::   psgn                 ! control of the sign
87      !!----------------------------------------------------------------------
88      !
89      CALL lbc_lnk_3d( pt3d1, cd_type1, psgn)
90      CALL lbc_lnk_3d( pt3d2, cd_type2, psgn)
91      !
92   END SUBROUTINE lbc_lnk_3d_gather
93
94
95   SUBROUTINE lbc_lnk_3d( pt3d, cd_type, psgn, cd_mpp, pval )
96      !!---------------------------------------------------------------------
97      !!                  ***  ROUTINE lbc_lnk_3d  ***
98      !!
99      !! ** Purpose :   set lateral boundary conditions on a 3D array (C1D case)
100      !!
101      !! ** Method  :   1D case, the central water column is set everywhere
102      !!----------------------------------------------------------------------
103      CHARACTER(len=1)                , INTENT(in   )           ::   cd_type   ! nature of pt3d grid-points
104      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout)           ::   pt3d      ! 3D array on which the lbc is applied
105      REAL(wp)                        , INTENT(in   )           ::   psgn      ! control of the sign
106      CHARACTER(len=3)                , INTENT(in   ), OPTIONAL ::   cd_mpp    ! MPP only (here do nothing)
107      REAL(wp)                        , INTENT(in   ), OPTIONAL ::   pval      ! background value (for closed boundaries)
108      !
109      INTEGER  ::   jk     ! dummy loop index
110      REAL(wp) ::   ztab   ! local scalar
111      !!----------------------------------------------------------------------
112      !
113      DO jk = 1, jpk
114         ztab = pt3d(2,2,jk)
115         pt3d(:,:,jk) = ztab
116      END DO
117      !
118   END SUBROUTINE lbc_lnk_3d
119
120
121   SUBROUTINE lbc_lnk_2d( pt2d, cd_type, psgn, cd_mpp, pval )
122      !!---------------------------------------------------------------------
123      !!                 ***  ROUTINE lbc_lnk_2d  ***
124      !!
125      !! ** Purpose :   set lateral boundary conditions on a 2D array (non mpp case)
126      !!
127      !! ** Method  :   1D case, the central water column is set everywhere
128      !!----------------------------------------------------------------------
129      CHARACTER(len=1)            , INTENT(in   )           ::   cd_type   ! nature of pt3d grid-points
130      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout)           ::   pt2d      ! 2D array on which the lbc is applied
131      REAL(wp)                    , INTENT(in   )           ::   psgn      ! control of the sign
132      CHARACTER(len=3)            , INTENT(in   ), OPTIONAL ::   cd_mpp    ! MPP only (here do nothing)
133      REAL(wp)                    , INTENT(in   ), OPTIONAL ::   pval      ! background value (for closed boundaries)
134      !
135      REAL(wp) ::   ztab   ! local scalar
136      !!----------------------------------------------------------------------
137      !
138      ztab = pt2d(2,2)
139      pt2d(:,:) = ztab
140      !
141   END SUBROUTINE lbc_lnk_2d
142
143#else
144   !!----------------------------------------------------------------------
145   !!   Default option                           3D shared memory computing
146   !!----------------------------------------------------------------------
147
148   SUBROUTINE lbc_lnk_3d_gather( pt3d1, cd_type1, pt3d2, cd_type2, psgn )
149      !!---------------------------------------------------------------------
150      !!                  ***  ROUTINE lbc_lnk_3d_gather  ***
151      !!
152      !! ** Purpose :   set lateral boundary conditions on two 3D arrays (non mpp case)
153      !!
154      !! ** Method  :   psign = -1 :    change the sign across the north fold
155      !!                      =  1 : no change of the sign across the north fold
156      !!                      =  0 : no change of the sign across the north fold and
157      !!                             strict positivity preserved: use inner row/column
158      !!                             for closed boundaries.
159      !!----------------------------------------------------------------------
160      CHARACTER(len=1)                , INTENT(in   ) ::   cd_type1, cd_type2   ! nature of pt3d grid-points
161      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pt3d1   , pt3d2      ! 3D array on which the lbc is applied
162      REAL(wp)                        , INTENT(in   ) ::   psgn                 ! control of the sign
163      !!----------------------------------------------------------------------
164      !
165      CALL lbc_lnk_3d( pt3d1, cd_type1, psgn)
166      CALL lbc_lnk_3d( pt3d2, cd_type2, psgn)
167      !
168   END SUBROUTINE lbc_lnk_3d_gather
169
170
171   SUBROUTINE lbc_lnk_3d( pt3d, cd_type, psgn, cd_mpp, pval )
172      !!---------------------------------------------------------------------
173      !!                  ***  ROUTINE lbc_lnk_3d  ***
174      !!
175      !! ** Purpose :   set lateral boundary conditions on a 3D array (non mpp case)
176      !!
177      !! ** Method  :   psign = -1 :    change the sign across the north fold
178      !!                      =  1 : no change of the sign across the north fold
179      !!                      =  0 : no change of the sign across the north fold and
180      !!                             strict positivity preserved: use inner row/column
181      !!                             for closed boundaries.
182      !!----------------------------------------------------------------------
183      CHARACTER(len=1)                , INTENT(in   )           ::   cd_type   ! nature of pt3d grid-points
184      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout)           ::   pt3d      ! 3D array on which the lbc is applied
185      REAL(wp)                        , INTENT(in   )           ::   psgn      ! control of the sign
186      CHARACTER(len=3)                , INTENT(in   ), OPTIONAL ::   cd_mpp    ! MPP only (here do nothing)
187      REAL(wp)                        , INTENT(in   ), OPTIONAL ::   pval      ! background value (for closed boundaries)
188      !!
189      REAL(wp) ::   zland
190      !!----------------------------------------------------------------------
191
192      IF( PRESENT( pval ) ) THEN   ;   zland = pval      ! set land value (zero by default)
193      ELSE                         ;   zland = 0._wp
194      ENDIF
195
196
197      IF( PRESENT( cd_mpp ) ) THEN
198         ! only fill the overlap area and extra allows
199         ! this is in mpp case. In this module, just do nothing
200      ELSE
201         !
202         !                                     !  East-West boundaries
203         !                                     ! ======================
204         SELECT CASE ( nperio )
205         !
206         CASE ( 1 , 4 , 6 )                       !**  cyclic east-west
207            pt3d( 1 ,:,:) = pt3d(jpim1,:,:)            ! all points
208            pt3d(jpi,:,:) = pt3d(  2  ,:,:)
209            !
210         CASE DEFAULT                             !**  East closed  --  West closed
211            SELECT CASE ( cd_type )
212            CASE ( 'T' , 'U' , 'V' , 'W' )             ! T-, U-, V-, W-points
213               pt3d( 1 ,:,:) = zland
214               pt3d(jpi,:,:) = zland
215            CASE ( 'F' )                               ! F-point
216               pt3d(jpi,:,:) = zland
217            END SELECT
218            !
219         END SELECT
220         !
221         !                                     ! North-South boundaries
222         !                                     ! ======================
223         SELECT CASE ( nperio )
224         !
225         CASE ( 2 )                               !**  South symmetric  --  North closed
226            SELECT CASE ( cd_type )
227            CASE ( 'T' , 'U' , 'W' )                   ! T-, U-, W-points
228               pt3d(:, 1 ,:) = pt3d(:,3,:)
229               pt3d(:,jpj,:) = zland
230            CASE ( 'V' , 'F' )                         ! V-, F-points
231               pt3d(:, 1 ,:) = psgn * pt3d(:,2,:)
232               pt3d(:,jpj,:) = zland
233            END SELECT
234            !
235         CASE ( 3 , 4 , 5 , 6 )                   !**  North fold  T or F-point pivot  --  South closed
236            SELECT CASE ( cd_type )                    ! South : closed
237            CASE ( 'T' , 'U' , 'V' , 'W' , 'I' )             ! all points except F-point
238               pt3d(:, 1 ,:) = zland
239            END SELECT
240            !                                          ! North fold
241            pt3d( 1 ,jpj,:) = zland
242            pt3d(jpi,jpj,:) = zland
243            CALL lbc_nfd( pt3d(:,:,:), cd_type, psgn )
244            !
245         CASE DEFAULT                             !**  North closed  --  South closed
246            SELECT CASE ( cd_type )
247            CASE ( 'T' , 'U' , 'V' , 'W' )             ! T-, U-, V-, W-points
248               pt3d(:, 1 ,:) = zland
249               pt3d(:,jpj,:) = zland
250            CASE ( 'F' )                               ! F-point
251               pt3d(:,jpj,:) = zland
252            END SELECT
253            !
254         END SELECT
255         !
256      ENDIF
257      !
258   END SUBROUTINE lbc_lnk_3d
259
260
261   SUBROUTINE lbc_lnk_2d( pt2d, cd_type, psgn, cd_mpp, pval )
262      !!---------------------------------------------------------------------
263      !!                 ***  ROUTINE lbc_lnk_2d  ***
264      !!
265      !! ** Purpose :   set lateral boundary conditions on a 2D array (non mpp case)
266      !!
267      !! ** Method  :   psign = -1 :    change the sign across the north fold
268      !!                      =  1 : no change of the sign across the north fold
269      !!                      =  0 : no change of the sign across the north fold and
270      !!                             strict positivity preserved: use inner row/column
271      !!                             for closed boundaries.
272      !!----------------------------------------------------------------------
273      CHARACTER(len=1)            , INTENT(in   )           ::   cd_type   ! nature of pt3d grid-points
274      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout)           ::   pt2d      ! 2D array on which the lbc is applied
275      REAL(wp)                    , INTENT(in   )           ::   psgn      ! control of the sign
276      CHARACTER(len=3)            , INTENT(in   ), OPTIONAL ::   cd_mpp    ! MPP only (here do nothing)
277      REAL(wp)                    , INTENT(in   ), OPTIONAL ::   pval      ! background value (for closed boundaries)
278      !!
279      REAL(wp) ::   zland
280      !!----------------------------------------------------------------------
281
282      IF( PRESENT( pval ) ) THEN   ;   zland = pval      ! set land value (zero by default)
283      ELSE                         ;   zland = 0._wp
284      ENDIF
285
286      IF (PRESENT(cd_mpp)) THEN
287         ! only fill the overlap area and extra allows
288         ! this is in mpp case. In this module, just do nothing
289      ELSE     
290         !
291         !                                     ! East-West boundaries
292         !                                     ! ====================
293         SELECT CASE ( nperio )
294         !
295         CASE ( 1 , 4 , 6 )                       !** cyclic east-west
296            pt2d( 1 ,:) = pt2d(jpim1,:)               ! all points
297            pt2d(jpi,:) = pt2d(  2  ,:)
298            !
299         CASE DEFAULT                             !** East closed  --  West closed
300            SELECT CASE ( cd_type )
301            CASE ( 'T' , 'U' , 'V' , 'W' )            ! T-, U-, V-, W-points
302               pt2d( 1 ,:) = zland
303               pt2d(jpi,:) = zland
304            CASE ( 'F' )                              ! F-point
305               pt2d(jpi,:) = zland
306            END SELECT
307            !
308         END SELECT
309         !
310         !                                     ! North-South boundaries
311         !                                     ! ======================
312         SELECT CASE ( nperio )
313         !
314         CASE ( 2 )                               !**  South symmetric  --  North closed
315            SELECT CASE ( cd_type )
316            CASE ( 'T' , 'U' , 'W' )                   ! T-, U-, W-points
317               pt2d(:, 1 ) = pt2d(:,3)
318               pt2d(:,jpj) = zland
319            CASE ( 'V' , 'F' )                         ! V-, F-points
320               pt2d(:, 1 ) = psgn * pt2d(:,2)
321               pt2d(:,jpj) = zland
322            END SELECT
323            !
324         CASE ( 3 , 4 , 5 , 6 )                   !**  North fold  T or F-point pivot  --  South closed
325            SELECT CASE ( cd_type )                    ! South : closed
326            CASE ( 'T' , 'U' , 'V' , 'W' , 'I' )             ! all points except F-point
327               pt2d(:, 1 ) = zland
328            END SELECT
329            !                                          ! North fold
330            pt2d( 1 ,1  ) = zland 
331            pt2d( 1 ,jpj) = zland 
332            pt2d(jpi,jpj) = zland
333            CALL lbc_nfd( pt2d(:,:), cd_type, psgn )
334            !
335         CASE DEFAULT                             !**  North closed  --  South closed
336            SELECT CASE ( cd_type )
337            CASE ( 'T' , 'U' , 'V' , 'W' )             ! T-, U-, V-, W-points
338               pt2d(:, 1 ) = zland
339               pt2d(:,jpj) = zland
340            CASE ( 'F' )                               ! F-point
341               pt2d(:,jpj) = zland
342            END SELECT
343            !
344         END SELECT
345         !
346      ENDIF
347      !   
348   END SUBROUTINE lbc_lnk_2d
349
350# endif
351#endif
352
353   !!======================================================================
354END MODULE lbclnk
Note: See TracBrowser for help on using the repository browser.