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

source: trunk/NEMOGCM/NEMO/OPA_SRC/CRS/crslbclnk.F90 @ 6140

Last change on this file since 6140 was 6140, checked in by timgraham, 8 years ago

Merge of branches/2015/dev_merge_2015 back into trunk. Merge excludes NEMOGCM/TOOLS/OBSTOOLS/ for now due to issues with the change of file type. Will sort these manually with further commits.

Branch merged as follows:
In the working copy of branch ran:
svn merge ​svn+ssh://forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/trunk@HEAD
Small conflicts due to bug fixes applied to trunk since the dev_merge_2015 was copied. Bug fixes were applied to the branch as well so these were easy to resolve.
Branch committed at this stage

In working copy run:
svn switch ​svn+ssh://forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/trunk
to switch working copy

Run:
svn merge --reintegrate ​svn+ssh://forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/branches/2015/dev_merge_2015
to merge the branch into the trunk and then commit - no conflicts at this stage.
  • Property svn:keywords set to Id
File size: 6.2 KB
RevLine 
[4015]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
[6140]8   !!----------------------------------------------------------------------
9   USE par_kind, ONLY: wp
[4015]10   USE dom_oce
11   USE crs
[6140]12   !
[4015]13   USE lbclnk
14   USE in_out_manager
15   
16   INTERFACE crs_lbc_lnk
17      MODULE PROCEDURE crs_lbc_lnk_3d, crs_lbc_lnk_3d_gather, crs_lbc_lnk_2d
18   END INTERFACE
19   
20   PUBLIC crs_lbc_lnk
21   
[6140]22   !!----------------------------------------------------------------------
23   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
[5215]24   !! $Id$
[6140]25   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
26   !!----------------------------------------------------------------------
[4015]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      !!----------------------------------------------------------------------
[6140]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
[4015]47      !!----------------------------------------------------------------------
[6140]48      !
[4015]49      ll_grid_crs = ( jpi == jpi_crs )
[6140]50      !
[4015]51      IF( PRESENT(pval) ) THEN  ;  zval = pval
[6140]52      ELSE                      ;  zval = 0._wp
[4015]53      ENDIF
[6140]54      !
55      IF( .NOT.ll_grid_crs )   CALL dom_grid_crs   ! Save the parent grid information  & Switch to coarse grid domain
56      !
[4015]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
[6140]60      !
61      IF( .NOT.ll_grid_crs )   CALL dom_grid_glo   ! Return to parent grid domain
62      !
[4015]63   END SUBROUTINE crs_lbc_lnk_3d
64   
[6140]65   
[4015]66   SUBROUTINE crs_lbc_lnk_3d_gather( pt3d1, cd_type1, pt3d2, cd_type2, psgn )
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      !!----------------------------------------------------------------------
[6140]76      CHARACTER(len=1)                        , INTENT(in   ) ::   cd_type1, cd_type2 ! grid type
77      REAL(wp)                                , INTENT(in   ) ::   psgn               ! control of the sign
78      REAL(wp), DIMENSION(jpi_crs,jpj_crs,jpk), INTENT(inout) ::   pt3d1   , pt3d2    ! 3D array on which the lbc is applied
79      !
80      LOGICAL ::   ll_grid_crs
[4015]81      !!----------------------------------------------------------------------
[6140]82      !
[4015]83      ll_grid_crs = ( jpi == jpi_crs )
[6140]84      !
85      IF( .NOT.ll_grid_crs )   CALL dom_grid_crs   ! Save the parent grid information  & Switch to coarse grid domain
86      !
[4015]87      CALL lbc_lnk( pt3d1, cd_type1, pt3d2, cd_type2, psgn  )
[6140]88      !
89      IF( .NOT.ll_grid_crs )   CALL dom_grid_glo   ! Return to parent grid domain
90      !
[4015]91   END SUBROUTINE crs_lbc_lnk_3d_gather
92
93   
94   
95   SUBROUTINE crs_lbc_lnk_2d(pt2d, cd_type, psgn, cd_mpp, pval)
96      !!---------------------------------------------------------------------
97      !!                  ***  SUBROUTINE crs_lbc_lnk  ***
98      !!
99      !! ** Purpose :   set lateral boundary conditions for coarsened grid
100      !!
101      !! ** Method  :   Swap domain indices from full to coarse domain
102      !!                before arguments are passed directly to lbc_lnk.
103      !!                Upon exiting, switch back to full domain indices.
104      !!----------------------------------------------------------------------
[6140]105      CHARACTER(len=1)                    , INTENT(in   ) ::   cd_type  ! grid type
106      REAL(wp)                            , INTENT(in   ) ::   psgn     ! control of the sign
107      REAL(wp), DIMENSION(jpi_crs,jpj_crs), INTENT(inout) ::   pt2d     ! 2D array on which the lbc is applied
108      REAL(wp)                  , OPTIONAL, INTENT(in   ) ::   pval     ! valeur sur les halo
109      CHARACTER(len=3)          , OPTIONAL, INTENT(in   ) ::   cd_mpp   ! MPP only (here do nothing)
110      !     
111      LOGICAL  ::   ll_grid_crs
112      REAL(wp) ::   zval     ! valeur sur les halo
[4015]113      !!----------------------------------------------------------------------
[6140]114      !
[4015]115      ll_grid_crs = ( jpi == jpi_crs )
[6140]116      !
[4015]117      IF( PRESENT(pval) ) THEN  ;  zval = pval
[6140]118      ELSE                      ;  zval = 0._wp
[4015]119      ENDIF
[6140]120      !
121      IF( .NOT.ll_grid_crs )   CALL dom_grid_crs   ! Save the parent grid information  & Switch to coarse grid domain
122      !
[4015]123      IF( PRESENT( cd_mpp ) ) THEN ; CALL lbc_lnk( pt2d, cd_type, psgn, cd_mpp, pval=zval  )
124      ELSE                         ; CALL lbc_lnk( pt2d, cd_type, psgn, pval=zval  )
125      ENDIF
[6140]126      !
127      IF( .NOT.ll_grid_crs )   CALL dom_grid_glo   ! Return to parent grid domain
128      !
[4015]129   END SUBROUTINE crs_lbc_lnk_2d
130
[6140]131   !!======================================================================
[4015]132END MODULE crslbclnk
Note: See TracBrowser for help on using the repository browser.