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 6225 for branches/2014/dev_r4704_NOC5_MPP_BDY_UPDATE/NEMOGCM/NEMO/OPA_SRC/CRS/crslbclnk.F90 – NEMO

Ignore:
Timestamp:
2016-01-08T10:35:19+01:00 (8 years ago)
Author:
jamesharle
Message:

Update MPP_BDY_UPDATE branch to be consistent with head of trunk

File:
1 edited

Legend:

Unmodified
Added
Removed

  • branches/2014/dev_r4704_NOC5_MPP_BDY_UPDATE/NEMOGCM/NEMO/OPA_SRC/CRS/crslbclnk.F90

    • Property svn:keywords set to Id
    r4015 r6225  
    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) 
     24   !! $Id$ 
     25   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     26   !!---------------------------------------------------------------------- 
    2427CONTAINS 
    2528 
    … …  
    3437      !!                Upon exiting, switch back to full domain indices. 
    3538      !!---------------------------------------------------------------------- 
    36       !! Arguments 
    37       CHARACTER(len=1)                , INTENT(in   )           ::   cd_type1 ! grid type 
    38       REAL(wp)                        , INTENT(in   )           ::   psgn     ! control of the sign 
    39  
    40       REAL(wp), DIMENSION(jpi_crs,jpj_crs,jpk), INTENT(inout)   ::   pt3d1 ! 3D array on which the lbc is applied 
    41       REAL(wp)                        , INTENT(in   ), OPTIONAL ::   pval     ! valeur sur les halo 
    42       CHARACTER(len=3)                , INTENT(in   ), OPTIONAL ::   cd_mpp    ! MPP only (here do nothing) 
    43        
    44       !! local vairables 
    45       LOGICAL                                                   ::   ll_grid_crs 
    46       REAL(wp)                                                  ::   zval     ! valeur sur les halo 
    47  
     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 
    4847      !!---------------------------------------------------------------------- 
    49        
     48      ! 
    5049      ll_grid_crs = ( jpi == jpi_crs ) 
    51        
     50      ! 
    5251      IF( PRESENT(pval) ) THEN  ;  zval = pval 
    53       ELSE                      ;  zval = 0.0 
     52      ELSE                      ;  zval = 0._wp 
    5453      ENDIF 
    55        
    56       IF( .NOT. ll_grid_crs )   CALL dom_grid_crs   ! Save the parent grid information  & Switch to coarse grid domain 
    57  
     54      ! 
     55      IF( .NOT.ll_grid_crs )   CALL dom_grid_crs   ! Save the parent grid information  & Switch to coarse grid domain 
     56      ! 
    5857      IF( PRESENT( cd_mpp ) ) THEN ; CALL lbc_lnk( pt3d1, cd_type1, psgn, cd_mpp, pval=zval  ) 
    5958      ELSE                         ; CALL lbc_lnk( pt3d1, cd_type1, psgn, pval=zval  ) 
    6059      ENDIF 
    61  
    62       IF( .NOT. ll_grid_crs )   CALL dom_grid_glo   ! Return to parent grid domain 
    63  
     60      ! 
     61      IF( .NOT.ll_grid_crs )   CALL dom_grid_glo   ! Return to parent grid domain 
     62      ! 
    6463   END SUBROUTINE crs_lbc_lnk_3d 
     64    
    6565    
    6666   SUBROUTINE crs_lbc_lnk_3d_gather( pt3d1, cd_type1, pt3d2, cd_type2, psgn ) 
    … …  
    7474      !!                Upon exiting, switch back to full domain indices. 
    7575      !!---------------------------------------------------------------------- 
    76       !! Arguments 
    77       CHARACTER(len=1)                , INTENT(in   )           ::   cd_type1,cd_type2 ! grid type 
    78       REAL(wp)                        , INTENT(in   )           ::   psgn     ! control of the sign 
    79  
    80       REAL(wp), DIMENSION(jpi_crs,jpj_crs,jpk), INTENT(inout)   ::   pt3d1,pt3d2 ! 3D array on which the lbc is applied 
    81        
    82       !! local vairables 
    83       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 
    8481      !!---------------------------------------------------------------------- 
    85        
     82      ! 
    8683      ll_grid_crs = ( jpi == jpi_crs ) 
    87        
    88       IF( .NOT. ll_grid_crs )   CALL dom_grid_crs   ! Save the parent grid information  & Switch to coarse grid domain 
    89  
     84      ! 
     85      IF( .NOT.ll_grid_crs )   CALL dom_grid_crs   ! Save the parent grid information  & Switch to coarse grid domain 
     86      ! 
    9087      CALL lbc_lnk( pt3d1, cd_type1, pt3d2, cd_type2, psgn  ) 
    91  
    92       IF( .NOT. ll_grid_crs )   CALL dom_grid_glo   ! Return to parent grid domain 
    93  
     88      ! 
     89      IF( .NOT.ll_grid_crs )   CALL dom_grid_glo   ! Return to parent grid domain 
     90      ! 
    9491   END SUBROUTINE crs_lbc_lnk_3d_gather 
    9592 
    … …  
    106103      !!                Upon exiting, switch back to full domain indices. 
    107104      !!---------------------------------------------------------------------- 
    108       !! Arguments 
    109       CHARACTER(len=1)                , INTENT(in   )           ::   cd_type  ! grid type 
    110       REAL(wp)                        , INTENT(in   )           ::   psgn     ! control of the sign 
    111  
    112       REAL(wp), DIMENSION(jpi_crs,jpj_crs),     INTENT(inout)   ::   pt2d     ! 2D array on which the lbc is applied 
    113       REAL(wp)                        , INTENT(in   ), OPTIONAL ::   pval     ! valeur sur les halo 
    114       CHARACTER(len=3)                , INTENT(in   ), OPTIONAL ::   cd_mpp   ! MPP only (here do nothing) 
    115       !! local variables 
    116        
    117       LOGICAL                                                   ::   ll_grid_crs 
    118       REAL(wp)                                                  ::   zval     ! valeur sur les halo 
    119  
     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 
    120113      !!---------------------------------------------------------------------- 
    121        
     114      ! 
    122115      ll_grid_crs = ( jpi == jpi_crs ) 
    123        
     116      ! 
    124117      IF( PRESENT(pval) ) THEN  ;  zval = pval 
    125       ELSE                      ;  zval = 0.0 
     118      ELSE                      ;  zval = 0._wp 
    126119      ENDIF 
    127        
    128       IF( .NOT. ll_grid_crs )   CALL dom_grid_crs   ! Save the parent grid information  & Switch to coarse grid domain 
    129  
     120      ! 
     121      IF( .NOT.ll_grid_crs )   CALL dom_grid_crs   ! Save the parent grid information  & Switch to coarse grid domain 
     122      ! 
    130123      IF( PRESENT( cd_mpp ) ) THEN ; CALL lbc_lnk( pt2d, cd_type, psgn, cd_mpp, pval=zval  ) 
    131124      ELSE                         ; CALL lbc_lnk( pt2d, cd_type, psgn, pval=zval  ) 
    132125      ENDIF 
    133  
    134       IF( .NOT. ll_grid_crs )   CALL dom_grid_glo   ! Return to parent grid domain 
    135  
     126      ! 
     127      IF( .NOT.ll_grid_crs )   CALL dom_grid_glo   ! Return to parent grid domain 
     128      ! 
    136129   END SUBROUTINE crs_lbc_lnk_2d 
    137130 
    138  
     131   !!====================================================================== 
    139132END MODULE crslbclnk 
Note: See TracChangeset for help on using the changeset viewer.