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/trunk/NEMOGCM/NEMO/OCE_SRC/CRS – NEMO

source: NEMO/trunk/NEMOGCM/NEMO/OCE_SRC/CRS/crslbclnk.F90 @ 9594

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

Global renaming for core routines (./NEMO)

  • Folders
    • LIM_SRC_3 -> ICE_SRC
    • OPA_SRC -> OCE_SRC
  • CPP key: key_lim3 -> key_si3
  • Modules, (sub)routines and variables names
    • MPI: mpi_comm_opa -> mpi_comm_oce, MPI_COMM_OPA -> MPI_COMM_OCE, mpi_init_opa -> mpi_init_oce
    • AGRIF: agrif_opa_* -> agrif_oce_*, agrif_lim3_* -> agrif_si3_* and few more
    • TOP-PISCES: p.zlim -> p.zice, namp.zlim -> namp.zice
  • Comments
    • NEMO/OPA -> NEMO/OCE
    • ESIM|LIM3 -> SI3
  • Property svn:keywords set to Id
File size: 4.8 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 3.3 , NEMO Consortium (2010)
24   !! $Id$
25   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
26   !!----------------------------------------------------------------------
27CONTAINS
28
29   SUBROUTINE crs_lbc_lnk_3d( pt3d1, cd_type1, psgn, cd_mpp, pval )
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      REAL(wp)                      , OPTIONAL, INTENT(in   ) ::   pval     ! valeur sur les halo
43      CHARACTER(len=3)              , OPTIONAL, INTENT(in   ) ::   cd_mpp   ! MPP only (here do nothing)
44      !
45      LOGICAL  ::   ll_grid_crs
46      REAL(wp) ::   zval   ! valeur sur les halo
47      !!----------------------------------------------------------------------
48      !
49      ll_grid_crs = ( jpi == jpi_crs )
50      !
51      IF( PRESENT(pval) ) THEN   ;   zval = pval
52      ELSE                       ;   zval = 0._wp
53      ENDIF
54      !
55      IF( .NOT.ll_grid_crs )   CALL dom_grid_crs   ! Save the parent grid information  & Switch to coarse grid domain
56      !
57      IF( PRESENT( cd_mpp ) ) THEN   ;   CALL lbc_lnk( pt3d1, cd_type1, psgn, cd_mpp, pval=zval  )
58      ELSE                           ;   CALL lbc_lnk( pt3d1, cd_type1, psgn        , pval=zval  )
59      ENDIF
60      !
61      IF( .NOT.ll_grid_crs )   CALL dom_grid_glo   ! Return to parent grid domain
62      !
63   END SUBROUTINE crs_lbc_lnk_3d
64   
65   
66   SUBROUTINE crs_lbc_lnk_2d(pt2d, cd_type, psgn, cd_mpp, pval)
67      !!---------------------------------------------------------------------
68      !!                  ***  SUBROUTINE crs_lbc_lnk  ***
69      !!
70      !! ** Purpose :   set lateral boundary conditions for coarsened grid
71      !!
72      !! ** Method  :   Swap domain indices from full to coarse domain
73      !!                before arguments are passed directly to lbc_lnk.
74      !!                Upon exiting, switch back to full domain indices.
75      !!----------------------------------------------------------------------
76      CHARACTER(len=1)                    , INTENT(in   ) ::   cd_type  ! grid type
77      REAL(wp)                            , INTENT(in   ) ::   psgn     ! control of the sign
78      REAL(wp), DIMENSION(jpi_crs,jpj_crs), INTENT(inout) ::   pt2d     ! 2D array on which the lbc is applied
79      REAL(wp)                  , OPTIONAL, INTENT(in   ) ::   pval     ! valeur sur les halo
80      CHARACTER(len=3)          , OPTIONAL, INTENT(in   ) ::   cd_mpp   ! MPP only (here do nothing)
81      !     
82      LOGICAL  ::   ll_grid_crs
83      REAL(wp) ::   zval     ! valeur sur les halo
84      !!----------------------------------------------------------------------
85      !
86      ll_grid_crs = ( jpi == jpi_crs )
87      !
88      IF( PRESENT(pval) ) THEN   ;   zval = pval
89      ELSE                       ;   zval = 0._wp
90      ENDIF
91      !
92      IF( .NOT.ll_grid_crs )   CALL dom_grid_crs   ! Save the parent grid information  & Switch to coarse grid domain
93      !
94      IF( PRESENT( cd_mpp ) ) THEN   ;   CALL lbc_lnk( pt2d, cd_type, psgn, cd_mpp, pval=zval  )
95      ELSE                           ;   CALL lbc_lnk( pt2d, cd_type, psgn        , pval=zval  )
96      ENDIF
97      !
98      IF( .NOT.ll_grid_crs )   CALL dom_grid_glo   ! Return to parent grid domain
99      !
100   END SUBROUTINE crs_lbc_lnk_2d
101
102   !!======================================================================
103END MODULE crslbclnk
Note: See TracBrowser for help on using the repository browser.