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 NEMO/trunk/src/OCE/LBC – NEMO

source: NEMO/trunk/src/OCE/LBC/lbclnk.F90 @ 9598

Last change on this file since 9598 was 9598, checked in by nicolasmartin, 6 years ago

Reorganisation plan for NEMO repository: changes to make compilation succeed with new structure
Juste one issue left with AGRIF_NORDIC with AGRIF preprocessing
Standardisation of routines header with version 4.0 and year 2018
Fix for some broken symlinks

  • Property svn:keywords set to Id
File size: 15.1 KB
RevLine 
[3]1MODULE lbclnk
2   !!======================================================================
[232]3   !!                       ***  MODULE  lbclnk  ***
[9019]4   !! NEMO        : lateral boundary conditions
[3]5   !!=====================================================================
[6140]6   !! History :  OPA  ! 1997-06  (G. Madec)  Original code
7   !!   NEMO     1.0  ! 2002-09  (G. Madec)  F90: Free form and module
[2335]8   !!            3.2  ! 2009-03  (R. Benshila)  External north fold treatment 
[9019]9   !!            3.5  ! 2012     (S.Mocavero, I. Epicoco)  optimization of BDY comm. via lbc_bdy_lnk and lbc_obc_lnk
[6140]10   !!            3.4  ! 2012-12  (R. Bourdalle-Badie, G. Reffray)  add a C1D case 
[6490]11   !!            3.6  ! 2015-06  (O. Tintó and M. Castrillo)  add lbc_lnk_multi 
[9019]12   !!            4.0  ! 2017-03  (G. Madec) automatique allocation of array size (use with any 3rd dim size)
13   !!             -   ! 2017-04  (G. Madec) remove duplicated routines (lbc_lnk_2d_9, lbc_lnk_2d_multiple, lbc_lnk_3d_gather)
14   !!             -   ! 2017-05  (G. Madec) create generic.h90 files to generate all lbc and north fold routines
[1344]15   !!----------------------------------------------------------------------
[3764]16#if defined key_mpp_mpi
[3]17   !!----------------------------------------------------------------------
[2335]18   !!   'key_mpp_mpi'             MPI massively parallel processing library
[3]19   !!----------------------------------------------------------------------
[9019]20   !!           define the generic interfaces of lib_mpp routines
[15]21   !!----------------------------------------------------------------------
[9019]22   !!   lbc_lnk       : generic interface for mpp_lnk_3d and mpp_lnk_2d routines defined in lib_mpp
23   !!   lbc_bdy_lnk   : generic interface for mpp_lnk_bdy_2d and mpp_lnk_bdy_3d routines defined in lib_mpp
24   !!----------------------------------------------------------------------
25   USE par_oce        ! ocean dynamics and tracers   
[6140]26   USE lib_mpp        ! distributed memory computing library
[9019]27   USE lbcnfd         ! north fold
[3]28
29   INTERFACE lbc_lnk
[9019]30      MODULE PROCEDURE   mpp_lnk_2d      , mpp_lnk_3d      , mpp_lnk_4d
[3]31   END INTERFACE
[9019]32   INTERFACE lbc_lnk_ptr
33      MODULE PROCEDURE   mpp_lnk_2d_ptr  , mpp_lnk_3d_ptr  , mpp_lnk_4d_ptr
[6140]34   END INTERFACE
[9019]35   INTERFACE lbc_lnk_multi
36      MODULE PROCEDURE   lbc_lnk_2d_multi, lbc_lnk_3d_multi, lbc_lnk_4d_multi
37   END INTERFACE
[6493]38   !
[3680]39   INTERFACE lbc_bdy_lnk
40      MODULE PROCEDURE mpp_lnk_bdy_2d, mpp_lnk_bdy_3d
41   END INTERFACE
[6140]42   !
[4990]43   INTERFACE lbc_lnk_icb
44      MODULE PROCEDURE mpp_lnk_2d_icb
45   END INTERFACE
46
[9019]47   PUBLIC   lbc_lnk       ! ocean/ice lateral boundary conditions
48   PUBLIC   lbc_lnk_multi ! modified ocean/ice lateral boundary conditions
[6140]49   PUBLIC   lbc_bdy_lnk   ! ocean lateral BDY boundary conditions
[9019]50   PUBLIC   lbc_lnk_icb   ! iceberg lateral boundary conditions
[2335]51
[3]52   !!----------------------------------------------------------------------
[9598]53   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
[2335]54   !! $Id$
[9598]55   !! Software governed by the CeCILL licence     (./LICENSE)
[2335]56   !!----------------------------------------------------------------------
[9019]57CONTAINS
58
[3]59#else
60   !!----------------------------------------------------------------------
61   !!   Default option                              shared memory computing
62   !!----------------------------------------------------------------------
[9019]63   !!                routines setting the appropriate values
64   !!         on first and last row and column of the global domain
65   !!----------------------------------------------------------------------
[6140]66   !!   lbc_lnk_sum_3d: compute sum over the halos on a 3D variable on ocean mesh
67   !!   lbc_lnk_sum_3d: compute sum over the halos on a 2D variable on ocean mesh
68   !!   lbc_lnk       : generic interface for lbc_lnk_3d and lbc_lnk_2d
69   !!   lbc_lnk_3d    : set the lateral boundary condition on a 3D variable on ocean mesh
70   !!   lbc_lnk_2d    : set the lateral boundary condition on a 2D variable on ocean mesh
71   !!   lbc_bdy_lnk   : set the lateral BDY boundary condition
[3]72   !!----------------------------------------------------------------------
[9019]73   USE oce            ! ocean dynamics and tracers   
74   USE dom_oce        ! ocean space and time domain
75   USE in_out_manager ! I/O manager
76   USE lbcnfd         ! north fold
[3]77
78   IMPLICIT NONE
79   PRIVATE
80
81   INTERFACE lbc_lnk
[9019]82      MODULE PROCEDURE   lbc_lnk_2d      , lbc_lnk_3d      , lbc_lnk_4d
[3]83   END INTERFACE
[9019]84   INTERFACE lbc_lnk_ptr
85      MODULE PROCEDURE   lbc_lnk_2d_ptr  , lbc_lnk_3d_ptr  , lbc_lnk_4d_ptr
[6140]86   END INTERFACE
[9019]87   INTERFACE lbc_lnk_multi
88      MODULE PROCEDURE   lbc_lnk_2d_multi, lbc_lnk_3d_multi, lbc_lnk_4d_multi
[311]89   END INTERFACE
[6140]90   !
[3680]91   INTERFACE lbc_bdy_lnk
92      MODULE PROCEDURE lbc_bdy_lnk_2d, lbc_bdy_lnk_3d
93   END INTERFACE
[6140]94   !
[4990]95   INTERFACE lbc_lnk_icb
[9019]96      MODULE PROCEDURE lbc_lnk_2d_icb
[4990]97   END INTERFACE
[6490]98   
[2335]99   PUBLIC   lbc_lnk       ! ocean/ice  lateral boundary conditions
[9019]100   PUBLIC   lbc_lnk_multi ! modified ocean/ice lateral boundary conditions
[3680]101   PUBLIC   lbc_bdy_lnk   ! ocean lateral BDY boundary conditions
[9019]102   PUBLIC   lbc_lnk_icb   ! iceberg lateral boundary conditions
[2335]103   
[3]104   !!----------------------------------------------------------------------
[9598]105   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
[2335]106   !! $Id$
[9598]107   !! Software governed by the CeCILL licence     (./LICENSE)
[2335]108   !!----------------------------------------------------------------------
[3]109CONTAINS
110
[3764]111# if defined key_c1d
[9019]112   !!======================================================================
[3764]113   !!   'key_c1d'                                          1D configuration
[9019]114   !!======================================================================
115   !!     central point value replicated over the 8 surrounding points
[3764]116   !!----------------------------------------------------------------------
117
118   SUBROUTINE lbc_lnk_3d( pt3d, cd_type, psgn, cd_mpp, pval )
119      !!---------------------------------------------------------------------
120      !!                  ***  ROUTINE lbc_lnk_3d  ***
121      !!
122      !! ** Purpose :   set lateral boundary conditions on a 3D array (C1D case)
123      !!
124      !! ** Method  :   1D case, the central water column is set everywhere
125      !!----------------------------------------------------------------------
[9019]126      REAL(wp), DIMENSION(:,:,:), INTENT(inout)           ::   pt3d      ! 3D array on which the lbc is applied
127      CHARACTER(len=1)          , INTENT(in   )           ::   cd_type   ! nature of pt3d grid-points
128      REAL(wp)                  , INTENT(in   )           ::   psgn      ! sign used across north fold
129      CHARACTER(len=3)          , INTENT(in   ), OPTIONAL ::   cd_mpp    ! MPP only (here do nothing)
130      REAL(wp)                  , INTENT(in   ), OPTIONAL ::   pval      ! background value (for closed boundaries)
[3764]131      !
132      INTEGER  ::   jk     ! dummy loop index
133      REAL(wp) ::   ztab   ! local scalar
134      !!----------------------------------------------------------------------
135      !
[9019]136      DO jk = 1, SIZE( pt3d, 3 )
[3764]137         ztab = pt3d(2,2,jk)
138         pt3d(:,:,jk) = ztab
139      END DO
140      !
141   END SUBROUTINE lbc_lnk_3d
142
143
144   SUBROUTINE lbc_lnk_2d( pt2d, cd_type, psgn, cd_mpp, pval )
145      !!---------------------------------------------------------------------
146      !!                 ***  ROUTINE lbc_lnk_2d  ***
147      !!
148      !! ** Purpose :   set lateral boundary conditions on a 2D array (non mpp case)
149      !!
150      !! ** Method  :   1D case, the central water column is set everywhere
151      !!----------------------------------------------------------------------
[9019]152      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout)           ::   pt2d      ! 2D array on which the lbc is applied
[3764]153      CHARACTER(len=1)            , INTENT(in   )           ::   cd_type   ! nature of pt3d grid-points
[9019]154      REAL(wp)                    , INTENT(in   )           ::   psgn      ! sign used across north fold
[3764]155      CHARACTER(len=3)            , INTENT(in   ), OPTIONAL ::   cd_mpp    ! MPP only (here do nothing)
156      REAL(wp)                    , INTENT(in   ), OPTIONAL ::   pval      ! background value (for closed boundaries)
157      !
158      REAL(wp) ::   ztab   ! local scalar
159      !!----------------------------------------------------------------------
160      !
161      ztab = pt2d(2,2)
162      pt2d(:,:) = ztab
163      !
164   END SUBROUTINE lbc_lnk_2d
[6490]165   
[3764]166#else
[9019]167   !!======================================================================
[3764]168   !!   Default option                           3D shared memory computing
[9019]169   !!======================================================================
170   !!          routines setting land point, or east-west cyclic,
171   !!             or north-south cyclic, or north fold values
172   !!         on first and last row and column of the global domain
[3764]173   !!----------------------------------------------------------------------
174
[9019]175   !!----------------------------------------------------------------------
176   !!                   ***  routine lbc_lnk_(2,3,4)d  ***
177   !!
178   !!   * Argument : dummy argument use in lbc_lnk_... routines
179   !!                ptab   :   array or pointer of arrays on which the boundary condition is applied
180   !!                cd_nat :   nature of array grid-points
181   !!                psgn   :   sign used across the north fold boundary
182   !!                kfld   :   optional, number of pt3d arrays
183   !!                cd_mpp :   optional, fill the overlap area only
184   !!                pval   :   optional, background value (used at closed boundaries)
185   !!----------------------------------------------------------------------
186   !
187   !                       !==  2D array and array of 2D pointer  ==!
188   !
189#  define DIM_2d
190#     define ROUTINE_LNK           lbc_lnk_2d
191#     include "lbc_lnk_generic.h90"
192#     undef ROUTINE_LNK
193#     define MULTI
194#     define ROUTINE_LNK           lbc_lnk_2d_ptr
195#     include "lbc_lnk_generic.h90"
196#     undef ROUTINE_LNK
197#     undef MULTI
198#  undef DIM_2d
199   !
200   !                       !==  3D array and array of 3D pointer  ==!
201   !
202#  define DIM_3d
203#     define ROUTINE_LNK           lbc_lnk_3d
204#     include "lbc_lnk_generic.h90"
205#     undef ROUTINE_LNK
206#     define MULTI
207#     define ROUTINE_LNK           lbc_lnk_3d_ptr
208#     include "lbc_lnk_generic.h90"
209#     undef ROUTINE_LNK
210#     undef MULTI
211#  undef DIM_3d
212   !
213   !                       !==  4D array and array of 4D pointer  ==!
214   !
215#  define DIM_4d
216#     define ROUTINE_LNK           lbc_lnk_4d
217#     include "lbc_lnk_generic.h90"
218#     undef ROUTINE_LNK
219#     define MULTI
220#     define ROUTINE_LNK           lbc_lnk_4d_ptr
221#     include "lbc_lnk_generic.h90"
222#     undef ROUTINE_LNK
223#     undef MULTI
224#  undef DIM_4d
225   
226#endif
[473]227
[9019]228   !!======================================================================
229   !!   identical routines in both C1D and shared memory computing
230   !!======================================================================
[473]231
[9019]232   !!----------------------------------------------------------------------
233   !!                   ***  routine lbc_bdy_lnk_(2,3)d  ***
234   !!
235   !!   wrapper rountine to 'lbc_lnk_3d'. This wrapper is used
236   !!   to maintain the same interface with regards to the mpp case
237   !!----------------------------------------------------------------------
[6490]238   
[4153]239   SUBROUTINE lbc_bdy_lnk_3d( pt3d, cd_type, psgn, ib_bdy )
240      !!----------------------------------------------------------------------
[9019]241      REAL(wp), DIMENSION(:,:,:), INTENT(inout) ::   pt3d      ! 3D array on which the lbc is applied
242      CHARACTER(len=1)          , INTENT(in   ) ::   cd_type   ! nature of pt3d grid-points
243      REAL(wp)                  , INTENT(in   ) ::   psgn      ! sign used across north fold
244      INTEGER                   , INTENT(in   ) ::   ib_bdy    ! BDY boundary set
[6140]245      !!----------------------------------------------------------------------
[4153]246      CALL lbc_lnk_3d( pt3d, cd_type, psgn)
247   END SUBROUTINE lbc_bdy_lnk_3d
248
[6140]249
[4153]250   SUBROUTINE lbc_bdy_lnk_2d( pt2d, cd_type, psgn, ib_bdy )
251      !!----------------------------------------------------------------------
[9019]252      REAL(wp), DIMENSION(:,:), INTENT(inout) ::   pt2d      ! 3D array on which the lbc is applied
253      CHARACTER(len=1)        , INTENT(in   ) ::   cd_type   ! nature of pt3d grid-points
254      REAL(wp)                , INTENT(in   ) ::   psgn      ! sign used across north fold
255      INTEGER                 , INTENT(in   ) ::   ib_bdy    ! BDY boundary set
[6140]256      !!----------------------------------------------------------------------
[4153]257      CALL lbc_lnk_2d( pt2d, cd_type, psgn)
258   END SUBROUTINE lbc_bdy_lnk_2d
259
260
[9019]261!!gm  This routine should be removed with an optional halos size added in argument of generic routines
262
263   SUBROUTINE lbc_lnk_2d_icb( pt2d, cd_type, psgn, ki, kj )
[3609]264      !!----------------------------------------------------------------------
[9019]265      REAL(wp), DIMENSION(:,:), INTENT(inout) ::   pt2d      ! 2D array on which the lbc is applied
266      CHARACTER(len=1)        , INTENT(in   ) ::   cd_type   ! nature of pt3d grid-points
267      REAL(wp)                , INTENT(in   ) ::   psgn      ! sign used across north fold
268      INTEGER                 , INTENT(in   ) ::   ki, kj    ! sizes of extra halo (not needed in non-mpp)
[3609]269      !!----------------------------------------------------------------------
270      CALL lbc_lnk_2d( pt2d, cd_type, psgn )
[9019]271   END SUBROUTINE lbc_lnk_2d_icb
272!!gm end
[3609]273
[3]274#endif
275
276   !!======================================================================
[9019]277   !!   identical routines in both distributed and shared memory computing
278   !!======================================================================
279
280   !!----------------------------------------------------------------------
281   !!                   ***   load_ptr_(2,3,4)d   ***
282   !!
283   !!   * Dummy Argument :
284   !!       in    ==>   ptab       ! array to be loaded (2D, 3D or 4D)
285   !!                   cd_nat     ! nature of pt2d array grid-points
286   !!                   psgn       ! sign used across the north fold boundary
287   !!       inout <=>   ptab_ptr   ! array of 2D, 3D or 4D pointers
288   !!                   cdna_ptr   ! nature of ptab array grid-points
289   !!                   psgn_ptr   ! sign used across the north fold boundary
290   !!                   kfld       ! number of elements that has been attributed
291   !!----------------------------------------------------------------------
292
293   !!----------------------------------------------------------------------
294   !!                  ***   lbc_lnk_(2,3,4)d_multi   ***
295   !!                     ***   load_ptr_(2,3,4)d   ***
296   !!
297   !!   * Argument : dummy argument use in lbc_lnk_multi_... routines
298   !!
299   !!----------------------------------------------------------------------
300
301#  define DIM_2d
302#     define ROUTINE_MULTI          lbc_lnk_2d_multi
303#     define ROUTINE_LOAD           load_ptr_2d
304#     include "lbc_lnk_multi_generic.h90"
305#     undef ROUTINE_MULTI
306#     undef ROUTINE_LOAD
307#  undef DIM_2d
308
309
310#  define DIM_3d
311#     define ROUTINE_MULTI          lbc_lnk_3d_multi
312#     define ROUTINE_LOAD           load_ptr_3d
313#     include "lbc_lnk_multi_generic.h90"
314#     undef ROUTINE_MULTI
315#     undef ROUTINE_LOAD
316#  undef DIM_3d
317
318
319#  define DIM_4d
320#     define ROUTINE_MULTI          lbc_lnk_4d_multi
321#     define ROUTINE_LOAD           load_ptr_4d
322#     include "lbc_lnk_multi_generic.h90"
323#     undef ROUTINE_MULTI
324#     undef ROUTINE_LOAD
325#  undef DIM_4d
326
327   !!======================================================================
[3]328END MODULE lbclnk
[6490]329
Note: See TracBrowser for help on using the repository browser.