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.
Changeset 6060 for branches/2015/dev_merge_2015/NEMOGCM/NEMO/OPA_SRC/CRS/crslbclnk.F90 – NEMO

Ignore:
Timestamp:
2015-12-16T10:25:22+01:00 (8 years ago)
Author:
timgraham
Message:

Merged dev_r5836_noc2_VVL_BY_DEFAULT into branch

File:
1 edited

Legend:

Unmodified
Added
Removed

  • branches/2015/dev_merge_2015/NEMOGCM/NEMO/OPA_SRC/CRS/crslbclnk.F90

    r5215 r6060  
    11MODULE crslbclnk 
    2  
    32   !!====================================================================== 
    43   !!                       ***  MODULE  crslbclnk  *** 
    … …  
    76   !!===================================================================== 
    87   !! History :   ! 2012-06  (J. Simeon, G. Madec, C. Ethe, C. Calone)     Original code 
    9  
     8   !!---------------------------------------------------------------------- 
     9   USE par_kind, ONLY: wp 
    1010   USE dom_oce 
    1111   USE crs 
     12   ! 
    1213   USE lbclnk 
    13    USE par_kind, ONLY: wp 
    1414   USE in_out_manager 
    15  
    16     
    1715    
    1816   INTERFACE crs_lbc_lnk 
    … …  
    2220   PUBLIC crs_lbc_lnk 
    2321    
     22   !!---------------------------------------------------------------------- 
     23   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    2424   !! $Id$ 
     25   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     26   !!---------------------------------------------------------------------- 
    2527CONTAINS 
    2628 
    … …  
    3537      !!                Upon exiting, switch back to full domain indices. 
    3638      !!---------------------------------------------------------------------- 
    37       !! Arguments 
    38       CHARACTER(len=1)                , INTENT(in   )           ::   cd_type1 ! grid type 
    39       REAL(wp)                        , INTENT(in   )           ::   psgn     ! control of the sign 
    40  
    41       REAL(wp), DIMENSION(jpi_crs,jpj_crs,jpk), INTENT(inout)   ::   pt3d1 ! 3D array on which the lbc is applied 
    42       REAL(wp)                        , INTENT(in   ), OPTIONAL ::   pval     ! valeur sur les halo 
    43       CHARACTER(len=3)                , INTENT(in   ), OPTIONAL ::   cd_mpp    ! MPP only (here do nothing) 
    44        
    45       !! local vairables 
    46       LOGICAL                                                   ::   ll_grid_crs 
    47       REAL(wp)                                                  ::   zval     ! valeur sur les halo 
    48  
     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 
    4947      !!---------------------------------------------------------------------- 
    50        
     48      ! 
    5149      ll_grid_crs = ( jpi == jpi_crs ) 
    52        
     50      ! 
    5351      IF( PRESENT(pval) ) THEN  ;  zval = pval 
    54       ELSE                      ;  zval = 0.0 
     52      ELSE                      ;  zval = 0._wp 
    5553      ENDIF 
    56        
    57       IF( .NOT. ll_grid_crs )   CALL dom_grid_crs   ! Save the parent grid information  & Switch to coarse grid domain 
    58  
     54      ! 
     55      IF( .NOT.ll_grid_crs )   CALL dom_grid_crs   ! Save the parent grid information  & Switch to coarse grid domain 
     56      ! 
    5957      IF( PRESENT( cd_mpp ) ) THEN ; CALL lbc_lnk( pt3d1, cd_type1, psgn, cd_mpp, pval=zval  ) 
    6058      ELSE                         ; CALL lbc_lnk( pt3d1, cd_type1, psgn, pval=zval  ) 
    6159      ENDIF 
    62  
    63       IF( .NOT. ll_grid_crs )   CALL dom_grid_glo   ! Return to parent grid domain 
    64  
     60      ! 
     61      IF( .NOT.ll_grid_crs )   CALL dom_grid_glo   ! Return to parent grid domain 
     62      ! 
    6563   END SUBROUTINE crs_lbc_lnk_3d 
     64    
    6665    
    6766   SUBROUTINE crs_lbc_lnk_3d_gather( pt3d1, cd_type1, pt3d2, cd_type2, psgn ) 
    … …  
    7574      !!                Upon exiting, switch back to full domain indices. 
    7675      !!---------------------------------------------------------------------- 
    77       !! Arguments 
    78       CHARACTER(len=1)                , INTENT(in   )           ::   cd_type1,cd_type2 ! grid type 
    79       REAL(wp)                        , INTENT(in   )           ::   psgn     ! control of the sign 
    80  
    81       REAL(wp), DIMENSION(jpi_crs,jpj_crs,jpk), INTENT(inout)   ::   pt3d1,pt3d2 ! 3D array on which the lbc is applied 
    82        
    83       !! local vairables 
    84       LOGICAL                                                   ::   ll_grid_crs 
     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 
    8581      !!---------------------------------------------------------------------- 
    86        
     82      ! 
    8783      ll_grid_crs = ( jpi == jpi_crs ) 
    88        
    89       IF( .NOT. ll_grid_crs )   CALL dom_grid_crs   ! Save the parent grid information  & Switch to coarse grid domain 
    90  
     84      ! 
     85      IF( .NOT.ll_grid_crs )   CALL dom_grid_crs   ! Save the parent grid information  & Switch to coarse grid domain 
     86      ! 
    9187      CALL lbc_lnk( pt3d1, cd_type1, pt3d2, cd_type2, psgn  ) 
    92  
    93       IF( .NOT. ll_grid_crs )   CALL dom_grid_glo   ! Return to parent grid domain 
    94  
     88      ! 
     89      IF( .NOT.ll_grid_crs )   CALL dom_grid_glo   ! Return to parent grid domain 
     90      ! 
    9591   END SUBROUTINE crs_lbc_lnk_3d_gather 
    9692 
    … …  
    107103      !!                Upon exiting, switch back to full domain indices. 
    108104      !!---------------------------------------------------------------------- 
    109       !! Arguments 
    110       CHARACTER(len=1)                , INTENT(in   )           ::   cd_type  ! grid type 
    111       REAL(wp)                        , INTENT(in   )           ::   psgn     ! control of the sign 
    112  
    113       REAL(wp), DIMENSION(jpi_crs,jpj_crs),     INTENT(inout)   ::   pt2d     ! 2D array on which the lbc is applied 
    114       REAL(wp)                        , INTENT(in   ), OPTIONAL ::   pval     ! valeur sur les halo 
    115       CHARACTER(len=3)                , INTENT(in   ), OPTIONAL ::   cd_mpp   ! MPP only (here do nothing) 
    116       !! local variables 
    117        
    118       LOGICAL                                                   ::   ll_grid_crs 
    119       REAL(wp)                                                  ::   zval     ! valeur sur les halo 
    120  
     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 
    121113      !!---------------------------------------------------------------------- 
    122        
     114      ! 
    123115      ll_grid_crs = ( jpi == jpi_crs ) 
    124        
     116      ! 
    125117      IF( PRESENT(pval) ) THEN  ;  zval = pval 
    126       ELSE                      ;  zval = 0.0 
     118      ELSE                      ;  zval = 0._wp 
    127119      ENDIF 
    128        
    129       IF( .NOT. ll_grid_crs )   CALL dom_grid_crs   ! Save the parent grid information  & Switch to coarse grid domain 
    130  
     120      ! 
     121      IF( .NOT.ll_grid_crs )   CALL dom_grid_crs   ! Save the parent grid information  & Switch to coarse grid domain 
     122      ! 
    131123      IF( PRESENT( cd_mpp ) ) THEN ; CALL lbc_lnk( pt2d, cd_type, psgn, cd_mpp, pval=zval  ) 
    132124      ELSE                         ; CALL lbc_lnk( pt2d, cd_type, psgn, pval=zval  ) 
    133125      ENDIF 
    134  
    135       IF( .NOT. ll_grid_crs )   CALL dom_grid_glo   ! Return to parent grid domain 
    136  
     126      ! 
     127      IF( .NOT.ll_grid_crs )   CALL dom_grid_glo   ! Return to parent grid domain 
     128      ! 
    137129   END SUBROUTINE crs_lbc_lnk_2d 
    138130 
    139  
     131   !!====================================================================== 
    140132END MODULE crslbclnk 
Note: See TracChangeset for help on using the changeset viewer.