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

source: branches/nemo_v3_3_beta/NEMOGCM/NEMO/OPA_SRC/lbclnk.F90 @ 2371

Last change on this file since 2371 was 2339, checked in by rblod, 14 years ago

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