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/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS/MY_SRC – NEMO

source: branches/2013/dev_r3411_CNRS4_IOCRS/NEMOGCM/CONFIG/ORCA2_LIM_CRS/MY_SRC/lbclnk.F90 @ 3778

Last change on this file since 3778 was 3778, checked in by cetlod, 11 years ago

2013/dev_r3411_CNRS4_IOCRS/NEMOGCM : improvment of outputs coarsening
File size: 12.6 KB
Line 
1MODULE lbclnk
2   !! jes. Remove this from MY_SRC no mods done.
3   !!======================================================================
4   !!                       ***  MODULE  lbclnk  ***
5   !! Ocean        : lateral boundary conditions
6   !!=====================================================================
7   !! History :  OPA  ! 1997-06  (G. Madec)     Original code
8   !!   NEMO     1.0  ! 2002-09  (G. Madec)     F90: Free form and module
9   !!            3.2  ! 2009-03  (R. Benshila)  External north fold treatment 
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: lbclnk.F90 2442 2010-11-27 18:05:38Z gm $
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: lbclnk.F90 2442 2010-11-27 18:05:38Z gm $
67   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
68   !!----------------------------------------------------------------------
69CONTAINS
70
71   SUBROUTINE lbc_lnk_3d_gather( pt3d1, cd_type1, pt3d2, cd_type2, psgn )
72      !!---------------------------------------------------------------------
73      !!                  ***  ROUTINE lbc_lnk_3d_gather  ***
74      !!
75      !! ** Purpose :   set lateral boundary conditions on two 3D arrays (non mpp case)
76      !!
77      !! ** Method  :   psign = -1 :    change the sign across the north fold
78      !!                      =  1 : no change of the sign across the north fold
79      !!                      =  0 : no change of the sign across the north fold and
80      !!                             strict positivity preserved: use inner row/column
81      !!                             for closed boundaries.
82      !!----------------------------------------------------------------------
83      CHARACTER(len=1)                , INTENT(in   ) ::   cd_type1, cd_type2   ! nature of pt3d grid-points
84      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pt3d1   , pt3d2      ! 3D array on which the lbc is applied
85      REAL(wp)                        , INTENT(in   ) ::   psgn                 ! control of the sign
86      !!----------------------------------------------------------------------
87      !
88      CALL lbc_lnk_3d( pt3d1, cd_type1, psgn)
89      CALL lbc_lnk_3d( pt3d2, cd_type2, psgn)
90      !
91   END SUBROUTINE lbc_lnk_3d_gather
92
93
94   SUBROUTINE lbc_lnk_3d( pt3d, cd_type, psgn, cd_mpp, pval )
95      !!---------------------------------------------------------------------
96      !!                  ***  ROUTINE lbc_lnk_3d  ***
97      !!
98      !! ** Purpose :   set lateral boundary conditions on a 3D array (non mpp case)
99      !!
100      !! ** Method  :   psign = -1 :    change the sign across the north fold
101      !!                      =  1 : no change of the sign across the north fold
102      !!                      =  0 : no change of the sign across the north fold and
103      !!                             strict positivity preserved: use inner row/column
104      !!                             for closed boundaries.
105      !!----------------------------------------------------------------------
106      CHARACTER(len=1)                , INTENT(in   )           ::   cd_type   ! nature of pt3d grid-points
107      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout)           ::   pt3d      ! 3D array on which the lbc is applied
108      REAL(wp)                        , INTENT(in   )           ::   psgn      ! control of the sign
109      CHARACTER(len=3)                , INTENT(in   ), OPTIONAL ::   cd_mpp    ! MPP only (here do nothing)
110      REAL(wp)                        , INTENT(in   ), OPTIONAL ::   pval      ! background value (for closed boundaries)
111      !!
112      REAL(wp) ::   zland
113      !!----------------------------------------------------------------------
114
115      IF( PRESENT( pval ) ) THEN   ;   zland = pval      ! set land value (zero by default)
116      ELSE                         ;   zland = 0.e0
117      ENDIF
118
119      IF( PRESENT( cd_mpp ) ) THEN
120         ! only fill the overlap area and extra allows
121         ! this is in mpp case. In this module, just do nothing
122      ELSE
123         !
124         !                                     !  East-West boundaries
125         !                                     ! ======================
126         SELECT CASE ( nperio )
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
133            SELECT CASE ( cd_type )
134            CASE ( 'T' , 'U' , 'V' , 'W' )             ! T-, U-, V-, W-points
135               pt3d( 1 ,:,:) = zland
136               pt3d(jpi,:,:) = zland
137            CASE ( 'F' )                               ! F-point
138               pt3d(jpi,:,:) = zland
139            END SELECT
140            !
141         END SELECT
142         !
143         !                                     ! North-South boundaries
144         !                                     ! ======================
145         SELECT CASE ( nperio )
146         !
147         CASE ( 2 )                               !**  South symmetric  --  North closed
148            SELECT CASE ( cd_type )
149            CASE ( 'T' , 'U' , 'W' )                   ! T-, U-, W-points
150               pt3d(:, 1 ,:) = pt3d(:,3,:)
151               pt3d(:,jpj,:) = zland
152            CASE ( 'V' , 'F' )                         ! V-, F-points
153               pt3d(:, 1 ,:) = psgn * pt3d(:,2,:)
154               pt3d(:,jpj,:) = zland
155            END SELECT
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
161            END SELECT
162            !                                          ! North fold
163         
164            CALL lbc_nfd( pt3d(:,:,:), cd_type, psgn )
165            !
166         CASE DEFAULT                             !**  North closed  --  South closed
167            SELECT CASE ( cd_type )
168            CASE ( 'T' , 'U' , 'V' , 'W' )             ! T-, U-, V-, W-points
169               pt3d(:, 1 ,:) = zland
170               pt3d(:,jpj,:) = zland
171            CASE ( 'F' )                               ! F-point
172               pt3d(:,jpj,:) = zland
173            END SELECT
174            !
175         END SELECT
176         !
177      ENDIF
178      !
179   END SUBROUTINE lbc_lnk_3d
180
181
182   SUBROUTINE lbc_lnk_2d( pt2d, cd_type, psgn, cd_mpp, pval )
183      !!---------------------------------------------------------------------
184      !!                 ***  ROUTINE lbc_lnk_2d  ***
185      !!
186      !! ** Purpose :   set lateral boundary conditions on a 2D array (non mpp case)
187      !!
188      !! ** Method  :   psign = -1 :    change the sign across the north fold
189      !!                      =  1 : no change of the sign across the north fold
190      !!                      =  0 : no change of the sign across the north fold and
191      !!                             strict positivity preserved: use inner row/column
192      !!                             for closed boundaries.
193      !!----------------------------------------------------------------------
194      CHARACTER(len=1)            , INTENT(in   )           ::   cd_type   ! nature of pt3d grid-points
195      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout)           ::   pt2d      ! 2D array on which the lbc is applied
196      REAL(wp)                    , INTENT(in   )           ::   psgn      ! control of the sign
197      CHARACTER(len=3)            , INTENT(in   ), OPTIONAL ::   cd_mpp    ! MPP only (here do nothing)
198      REAL(wp)                    , INTENT(in   ), OPTIONAL ::   pval      ! background value (for closed boundaries)
199      !!
200      REAL(wp) ::   zland
201      !!----------------------------------------------------------------------
202
203      IF( PRESENT( pval ) ) THEN   ;   zland = pval      ! set land value (zero by default)
204      ELSE                         ;   zland = 0.e0
205      ENDIF
206
207      IF (PRESENT(cd_mpp)) THEN
208         ! only fill the overlap area and extra allows
209         ! this is in mpp case. In this module, just do nothing
210      ELSE     
211         !
212         !                                     ! East-West boundaries
213         !                                     ! ====================
214         SELECT CASE ( nperio )
215         !
216         CASE ( 1 , 4 , 6 )                       !** cyclic east-west
217            pt2d( 1 ,:) = pt2d(jpim1,:)               ! all points
218            pt2d(jpi,:) = pt2d(  2  ,:)
219            !
220         CASE DEFAULT                             !** East closed  --  West closed
221            SELECT CASE ( cd_type )
222            CASE ( 'T' , 'U' , 'V' , 'W' )            ! T-, U-, V-, W-points
223               pt2d( 1 ,:) = zland
224               pt2d(jpi,:) = zland
225            CASE ( 'F' )                              ! F-point
226               pt2d(jpi,:) = zland
227            END SELECT
228            !
229         END SELECT
230         !
231         !                                     ! North-South boundaries
232         !                                     ! ======================
233         SELECT CASE ( nperio )
234         !
235         CASE ( 2 )                               !**  South symmetric  --  North closed
236            SELECT CASE ( cd_type )
237            CASE ( 'T' , 'U' , 'W' )                   ! T-, U-, W-points
238               pt2d(:, 1 ) = pt2d(:,3)
239               pt2d(:,jpj) = zland
240            CASE ( 'V' , 'F' )                         ! V-, F-points
241               pt2d(:, 1 ) = psgn * pt2d(:,2)
242               pt2d(:,jpj) = zland
243            END SELECT
244            !
245         CASE ( 3 , 4 , 5 , 6 )                   !**  North fold  T or F-point pivot  --  South closed
246            SELECT CASE ( cd_type )                    ! South : closed
247            CASE ( 'T' , 'U' , 'V' , 'W' , 'I' )             ! all points except F-point
248               pt2d(:, 1 ) = zland
249            END SELECT
250           
251            CALL lbc_nfd( pt2d(:,:), cd_type, psgn )
252            !
253         CASE DEFAULT                             !**  North closed  --  South closed
254            SELECT CASE ( cd_type )
255            CASE ( 'T' , 'U' , 'V' , 'W' )             ! T-, U-, V-, W-points
256               pt2d(:, 1 ) = zland
257               pt2d(:,jpj) = zland
258            CASE ( 'F' )                               ! F-point
259               pt2d(:,jpj) = zland
260            END SELECT
261            !
262         END SELECT
263         !
264      ENDIF
265      !   
266   END SUBROUTINE lbc_lnk_2d
267
268#endif
269
270   !!======================================================================
271END MODULE lbclnk
Note: See TracBrowser for help on using the repository browser.