source: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/LBC/lbclnk.F90 @ 3837

Last change on this file since 3837 was 3837, checked in by trackstand2, 8 years ago

Merge of finiss

  • Property svn:keywords set to Id
File size: 13.9 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   !!----------------------------------------------------------------------
10#if   defined key_mpp_mpi
11   !!----------------------------------------------------------------------
12   !!   'key_mpp_mpi'             MPI massively parallel processing library
13   !!----------------------------------------------------------------------
14   !!   lbc_lnk      : generic interface for mpp_lnk_3d and mpp_lnk_2d routines defined in lib_mpp
15   !!   lbc_lnk_e    : generic interface for mpp_lnk_2d_e routine defined in lib_mpp
16   !!----------------------------------------------------------------------
17   USE lib_mpp          ! distributed memory computing library
18   USE exchmod          ! Comms for irregular domain decomposition
19
20   ! This is important - it determines which set of comms routines are
21   ! called when lbc_lnk() is invoked.
22   INTERFACE lbc_lnk
23#if  defined key_mpp_rkpart
24      MODULE PROCEDURE lbc_exch2, lbc_exch3 !, lbc_exch2i, lbc_exch3i
25#else
26      MODULE PROCEDURE mpp_lnk_3d_gather, mpp_lnk_3d, mpp_lnk_2d
27#endif
28   END INTERFACE
29
30   INTERFACE lbc_lnk_e
31      MODULE PROCEDURE mpp_lnk_2d_e
32   END INTERFACE
33
34   PUBLIC lbc_lnk       ! ocean lateral boundary conditions
35   PUBLIC lbc_lnk_e
36
37   !!----------------------------------------------------------------------
38   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
39   !! $Id$
40   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
41   !!----------------------------------------------------------------------
42
43#else
44   !!----------------------------------------------------------------------
45   !!   Default option                              shared memory computing
46   !!----------------------------------------------------------------------
47   !!   lbc_lnk      : generic interface for lbc_lnk_3d and lbc_lnk_2d
48   !!   lbc_lnk_3d   : set the lateral boundary condition on a 3D variable on ocean mesh
49   !!   lbc_lnk_2d   : set the lateral boundary condition on a 2D variable on ocean mesh
50   !!----------------------------------------------------------------------
51   USE oce             ! ocean dynamics and tracers   
52   USE dom_oce         ! ocean space and time domain
53   USE in_out_manager  ! I/O manager
54   USE lbcnfd          ! north fold
55
56   IMPLICIT NONE
57   PRIVATE
58
59   INTERFACE lbc_lnk
60      MODULE PROCEDURE lbc_lnk_3d_gather, lbc_lnk_3d, lbc_lnk_2d
61   END INTERFACE
62
63   INTERFACE lbc_lnk_e
64      MODULE PROCEDURE lbc_lnk_2d
65   END INTERFACE
66
67   PUBLIC   lbc_lnk       ! ocean/ice  lateral boundary conditions
68   PUBLIC   lbc_lnk_e 
69
70   !! * Control permutation of array indices
71#  include "oce_ftrans.h90"
72#  include "dom_oce_ftrans.h90"
73
74   !!----------------------------------------------------------------------
75   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
76   !! $Id$
77   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
78   !!----------------------------------------------------------------------
79CONTAINS
80
81   SUBROUTINE lbc_lnk_3d_gather( pt3d1, cd_type1, pt3d2, cd_type2, psgn )
82      !!---------------------------------------------------------------------
83      !!                  ***  ROUTINE lbc_lnk_3d_gather  ***
84      !!
85      !! ** Purpose :   set lateral boundary conditions on two 3D arrays (non mpp case)
86      !!
87      !! ** Method  :   psign = -1 :    change the sign across the north fold
88      !!                      =  1 : no change of the sign across the north fold
89      !!                      =  0 : no change of the sign across the north fold and
90      !!                             strict positivity preserved: use inner row/column
91      !!                             for closed boundaries.
92      !!----------------------------------------------------------------------
93      CHARACTER(len=1)                , INTENT(in   ) ::   cd_type1, cd_type2   ! nature of pt3d grid-points
94!FTRANS pt3d1 :I :I :z
95!FTRANS pt3d2 :I :I :z
96! DCSE_NEMO: work around a deficiency in ftrans
97!     REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pt3d1   , pt3d2      ! 3D array on which the lbc is applied
98      REAL(wp), INTENT(inout)   ::   pt3d1(jpi,jpj,jpk)   , pt3d2(jpi,jpj,jpk)
99      REAL(wp), INTENT(in   )   ::   psgn                 ! control of the sign
100      !!----------------------------------------------------------------------
101      !
102      CALL lbc_lnk_3d( pt3d1, cd_type1, psgn)
103      CALL lbc_lnk_3d( pt3d2, cd_type2, psgn)
104      !
105   END SUBROUTINE lbc_lnk_3d_gather
106
107
108   SUBROUTINE lbc_lnk_3d( pt3d, cd_type, psgn, cd_mpp, pval, lzero )
109      USE lib_mpp, ONLY: ctl_stop
110      !!---------------------------------------------------------------------
111      !!                  ***  ROUTINE lbc_lnk_3d  ***
112      !!
113      !! ** Purpose :   set lateral boundary conditions on a 3D array (non mpp case)
114      !!
115      !! ** Method  :   psign = -1 :    change the sign across the north fold
116      !!                      =  1 : no change of the sign across the north fold
117      !!                      =  0 : no change of the sign across the north fold and
118      !!                             strict positivity preserved: use inner row/column
119      !!                             for closed boundaries.
120      !!----------------------------------------------------------------------
121      CHARACTER(len=1)                , INTENT(in   )           ::   cd_type   ! nature of pt3d grid-points
122!FTRANS pt3d :I :I :z
123!! DCSE_NEMO: work around a deficiency in ftrans
124!     REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout)           ::   pt3d      ! 3D array on which the lbc is applied
125      REAL(wp), INTENT(inout)                                   ::   pt3d(jpi,jpj,jpk)
126      REAL(wp)                        , INTENT(in   )           ::   psgn      ! control of the sign
127      CHARACTER(len=3)                , INTENT(in   ), OPTIONAL ::   cd_mpp    ! MPP only (here do nothing)
128      REAL(wp)                        , INTENT(in   ), OPTIONAL ::   pval      ! background value (for closed boundaries)
129      LOGICAL                         , INTENT(in   ), OPTIONAL ::   lzero     ! Whether to zero halos on closed boundaries
130
131      !!
132      REAL(wp) ::   zland
133      !!----------------------------------------------------------------------
134
135      IF( PRESENT( pval ) ) THEN   ;   zland = pval      ! set land value (zero by default)
136      ELSE                         ;   zland = 0.e0
137      ENDIF
138
139      IF( PRESENT( lzero ) )THEN
140         CALL ctl_stop('STOP','lbc_lnk_3d: IMPLEMENT lzero option!')
141      ENDIF
142
143      IF( PRESENT( cd_mpp ) ) THEN
144         ! only fill the overlap area and extra allows
145         ! this is in mpp case. In this module, just do nothing
146      ELSE
147         !
148         !                                     !  East-West boundaries
149         !                                     ! ======================
150         SELECT CASE ( nperio )
151         !
152         CASE ( 1 , 4 , 6 )                       !**  cyclic east-west
153            pt3d( 1 ,:,:) = pt3d(jpim1,:,:)            ! all points
154            pt3d(jpi,:,:) = pt3d(  2  ,:,:)
155            !
156         CASE DEFAULT                             !**  East closed  --  West closed
157            SELECT CASE ( cd_type )
158            CASE ( 'T' , 'U' , 'V' , 'W' )             ! T-, U-, V-, W-points
159               pt3d( 1 ,:,:) = zland
160               pt3d(jpi,:,:) = zland
161            CASE ( 'F' )                               ! F-point
162               pt3d(jpi,:,:) = zland
163            END SELECT
164            !
165         END SELECT
166         !
167         !                                     ! North-South boundaries
168         !                                     ! ======================
169         SELECT CASE ( nperio )
170         !
171         CASE ( 2 )                               !**  South symmetric  --  North closed
172            SELECT CASE ( cd_type )
173            CASE ( 'T' , 'U' , 'W' )                   ! T-, U-, W-points
174               pt3d(:, 1 ,:) = pt3d(:,3,:)
175               pt3d(:,jpj,:) = zland
176            CASE ( 'V' , 'F' )                         ! V-, F-points
177               pt3d(:, 1 ,:) = psgn * pt3d(:,2,:)
178               pt3d(:,jpj,:) = zland
179            END SELECT
180            !
181         CASE ( 3 , 4 , 5 , 6 )                   !**  North fold  T or F-point pivot  --  South closed
182            SELECT CASE ( cd_type )                    ! South : closed
183            CASE ( 'T' , 'U' , 'V' , 'W' , 'I' )             ! all points except F-point
184               pt3d(:, 1 ,:) = zland
185            END SELECT
186            !                                          ! North fold
187            pt3d( 1 ,jpj,:) = zland
188            pt3d(jpi,jpj,:) = zland
189            CALL lbc_nfd( pt3d(:,:,:), cd_type, psgn )
190            !
191         CASE DEFAULT                             !**  North closed  --  South closed
192            SELECT CASE ( cd_type )
193            CASE ( 'T' , 'U' , 'V' , 'W' )             ! T-, U-, V-, W-points
194               pt3d(:, 1 ,:) = zland
195               pt3d(:,jpj,:) = zland
196            CASE ( 'F' )                               ! F-point
197               pt3d(:,jpj,:) = zland
198            END SELECT
199            !
200         END SELECT
201         !
202      ENDIF
203      !
204   END SUBROUTINE lbc_lnk_3d
205
206
207   SUBROUTINE lbc_lnk_2d( pt2d, cd_type, psgn, cd_mpp, pval, lzero )
208      USE lib_mpp, ONLY: ctl_stop
209      !!---------------------------------------------------------------------
210      !!                 ***  ROUTINE lbc_lnk_2d  ***
211      !!
212      !! ** Purpose :   set lateral boundary conditions on a 2D array (non mpp case)
213      !!
214      !! ** Method  :   psign = -1 :    change the sign across the north fold
215      !!                      =  1 : no change of the sign across the north fold
216      !!                      =  0 : no change of the sign across the north fold and
217      !!                             strict positivity preserved: use inner row/column
218      !!                             for closed boundaries.
219      !!----------------------------------------------------------------------
220      CHARACTER(len=1)            , INTENT(in   )           ::   cd_type   ! nature of pt3d grid-points
221      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout)           ::   pt2d      ! 2D array on which the lbc is applied
222      REAL(wp)                    , INTENT(in   )           ::   psgn      ! control of the sign
223      CHARACTER(len=3)            , INTENT(in   ), OPTIONAL ::   cd_mpp    ! MPP only (here do nothing)
224      REAL(wp)                    , INTENT(in   ), OPTIONAL ::   pval      ! background value (for closed boundaries)
225      LOGICAL                     , INTENT(in   ), OPTIONAL ::   lzero    ! Whether to zero halos on closed boundaries
226      !!
227      REAL(wp) ::   zland
228      !!----------------------------------------------------------------------
229
230      IF( PRESENT( pval ) ) THEN   ;   zland = pval      ! set land value (zero by default)
231      ELSE                         ;   zland = 0.e0
232      ENDIF
233
234      IF( PRESENT( lzero ) )THEN
235         CALL ctl_stop('STOP','lbc_lnk_2d: IMPLEMENT lzero option!')
236      ENDIF
237
238      IF (PRESENT(cd_mpp)) THEN
239         ! only fill the overlap area and extra allows
240         ! this is in mpp case. In this module, just do nothing
241      ELSE     
242         !
243         !                                     ! East-West boundaries
244         !                                     ! ====================
245         SELECT CASE ( nperio )
246         !
247         CASE ( 1 , 4 , 6 )                       !** cyclic east-west
248            pt2d( 1 ,:) = pt2d(jpim1,:)               ! all points
249            pt2d(jpi,:) = pt2d(  2  ,:)
250            !
251         CASE DEFAULT                             !** East closed  --  West closed
252            SELECT CASE ( cd_type )
253            CASE ( 'T' , 'U' , 'V' , 'W' )            ! T-, U-, V-, W-points
254               pt2d( 1 ,:) = zland
255               pt2d(jpi,:) = zland
256            CASE ( 'F' )                              ! F-point
257               pt2d(jpi,:) = zland
258            END SELECT
259            !
260         END SELECT
261         !
262         !                                     ! North-South boundaries
263         !                                     ! ======================
264         SELECT CASE ( nperio )
265         !
266         CASE ( 2 )                               !**  South symmetric  --  North closed
267            SELECT CASE ( cd_type )
268            CASE ( 'T' , 'U' , 'W' )                   ! T-, U-, W-points
269               pt2d(:, 1 ) = pt2d(:,3)
270               pt2d(:,jpj) = zland
271            CASE ( 'V' , 'F' )                         ! V-, F-points
272               pt2d(:, 1 ) = psgn * pt2d(:,2)
273               pt2d(:,jpj) = zland
274            END SELECT
275            !
276         CASE ( 3 , 4 , 5 , 6 )                   !**  North fold  T or F-point pivot  --  South closed
277            SELECT CASE ( cd_type )                    ! South : closed
278            CASE ( 'T' , 'U' , 'V' , 'W' , 'I' )             ! all points except F-point
279               pt2d(:, 1 ) = zland
280            END SELECT
281            !                                          ! North fold
282            pt2d( 1 ,1  ) = zland 
283            pt2d( 1 ,jpj) = zland 
284            pt2d(jpi,jpj) = zland
285            CALL lbc_nfd( pt2d(:,:), cd_type, psgn )
286            !
287         CASE DEFAULT                             !**  North closed  --  South closed
288            SELECT CASE ( cd_type )
289            CASE ( 'T' , 'U' , 'V' , 'W' )             ! T-, U-, V-, W-points
290               pt2d(:, 1 ) = zland
291               pt2d(:,jpj) = zland
292            CASE ( 'F' )                               ! F-point
293               pt2d(:,jpj) = zland
294            END SELECT
295            !
296         END SELECT
297         !
298      ENDIF
299      !   
300   END SUBROUTINE lbc_lnk_2d
301
302#endif
303
304   !!======================================================================
305END MODULE lbclnk
Note: See TracBrowser for help on using the repository browser.