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.
crslbclnk.F90 in NEMO/branches/UKMO/NEMO_4.0.2_ENHANCE-02_ISF_nemo/src/OCE/CRS – NEMO

source: NEMO/branches/UKMO/NEMO_4.0.2_ENHANCE-02_ISF_nemo/src/OCE/CRS/crslbclnk.F90 @ 12709

Last change on this file since 12709 was 12709, checked in by mathiot, 4 years ago

NEMO_4.0.2_ENHANCE-02_ISF_nemo: remove svn keywords

File size: 4.4 KB
Line 
1MODULE crslbclnk
2   !!======================================================================
3   !!                       ***  MODULE  crslbclnk  ***
4   !!               A temporary solution for lbclnk for coarsened grid.
5   !! Ocean        : lateral boundary conditions for grid coarsening
6   !!=====================================================================
7   !! History :   ! 2012-06  (J. Simeon, G. Madec, C. Ethe, C. Calone)     Original code
8   !!----------------------------------------------------------------------
9   USE par_kind, ONLY: wp
10   USE dom_oce
11   USE crs
12   !
13   USE lbclnk
14   USE in_out_manager
15   
16   INTERFACE crs_lbc_lnk
17      MODULE PROCEDURE crs_lbc_lnk_3d, crs_lbc_lnk_2d
18   END INTERFACE
19   
20   PUBLIC crs_lbc_lnk
21   
22   !!----------------------------------------------------------------------
23   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
24   !! $Id$
25   !! Software governed by the CeCILL license (see ./LICENSE)
26   !!----------------------------------------------------------------------
27CONTAINS
28
29   SUBROUTINE crs_lbc_lnk_3d( pt3d1, cd_type1, psgn, kfillmode, pfillval  )
30      !!---------------------------------------------------------------------
31      !!                  ***  SUBROUTINE crs_lbc_lnk  ***
32      !!
33      !! ** Purpose :   set lateral boundary conditions for coarsened grid
34      !!
35      !! ** Method  :   Swap domain indices from full to coarse domain
36      !!                before arguments are passed directly to lbc_lnk.
37      !!                Upon exiting, switch back to full domain indices.
38      !!----------------------------------------------------------------------
39      CHARACTER(len=1)                        , INTENT(in   ) ::   cd_type1 ! grid type
40      REAL(wp)                                , INTENT(in   ) ::   psgn     ! control of the sign
41      REAL(wp), DIMENSION(jpi_crs,jpj_crs,jpk), INTENT(inout) ::   pt3d1    ! 3D array on which the lbc is applied
42      INTEGER                     , OPTIONAL  , INTENT(in   ) ::   kfillmode   ! filling method for halo over land (default = cst)
43      REAL(wp)                    , OPTIONAL  , INTENT(in   ) ::   pfillval    ! background value (used at closed boundaries)
44      !
45      LOGICAL  ::   ll_grid_crs
46      !!----------------------------------------------------------------------
47      !
48      ll_grid_crs = ( jpi == jpi_crs )
49      !
50      IF( .NOT.ll_grid_crs )   CALL dom_grid_crs   ! Save the parent grid information  & Switch to coarse grid domain
51      !
52      CALL lbc_lnk( 'crslbclnk', pt3d1, cd_type1, psgn, kfillmode, pfillval )
53      !
54      IF( .NOT.ll_grid_crs )   CALL dom_grid_glo   ! Return to parent grid domain
55      !
56   END SUBROUTINE crs_lbc_lnk_3d
57   
58   
59   SUBROUTINE crs_lbc_lnk_2d(pt2d, cd_type, psgn, kfillmode, pfillval )
60      !!---------------------------------------------------------------------
61      !!                  ***  SUBROUTINE crs_lbc_lnk  ***
62      !!
63      !! ** Purpose :   set lateral boundary conditions for coarsened grid
64      !!
65      !! ** Method  :   Swap domain indices from full to coarse domain
66      !!                before arguments are passed directly to lbc_lnk.
67      !!                Upon exiting, switch back to full domain indices.
68      !!----------------------------------------------------------------------
69      CHARACTER(len=1)                    , INTENT(in   ) ::   cd_type  ! grid type
70      REAL(wp)                            , INTENT(in   ) ::   psgn     ! control of the sign
71      REAL(wp), DIMENSION(jpi_crs,jpj_crs), INTENT(inout) ::   pt2d     ! 2D array on which the lbc is applied
72      INTEGER                 , OPTIONAL  , INTENT(in   ) ::   kfillmode   ! filling method for halo over land (default = constant)
73      REAL(wp)                , OPTIONAL  , INTENT(in   ) ::   pfillval    ! background value (used at closed boundaries)
74      !     
75      LOGICAL  ::   ll_grid_crs
76      !!----------------------------------------------------------------------
77      !
78      ll_grid_crs = ( jpi == jpi_crs )
79      !
80      IF( .NOT.ll_grid_crs )   CALL dom_grid_crs   ! Save the parent grid information  & Switch to coarse grid domain
81      !
82      CALL lbc_lnk( 'crslbclnk', pt2d, cd_type, psgn, kfillmode, pfillval )
83      !
84      IF( .NOT.ll_grid_crs )   CALL dom_grid_glo   ! Return to parent grid domain
85      !
86   END SUBROUTINE crs_lbc_lnk_2d
87
88   !!======================================================================
89END MODULE crslbclnk
Note: See TracBrowser for help on using the repository browser.