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 3764 for branches/2012/dev_MERGE_2012/NEMOGCM/NEMO/OPA_SRC/LBC/lbclnk.F90 – NEMO

Ignore:
Timestamp:
2013-01-23T15:33:04+01:00 (11 years ago)
Author:
smasson
Message:

dev_MERGE_2012: report bugfixes done in the trunk from r3555 to r3763 into dev_MERGE_2012

File:
1 edited

Legend:

Unmodified
Added
Removed

  • branches/2012/dev_MERGE_2012/NEMOGCM/NEMO/OPA_SRC/LBC/lbclnk.F90

    r3680 r3764  
    1010   !!                            and lbc_obc_lnk' routine to optimize   
    1111   !!                            the BDY/OBC communications 
    12    !!---------------------------------------------------------------------- 
    13 #if   defined key_mpp_mpi 
     12   !!            3.4  ! 2012-12  (R. Bourdalle-Badie and G. Reffray)  add a C1D case   
     13   !!---------------------------------------------------------------------- 
     14#if defined key_mpp_mpi 
    1415   !!---------------------------------------------------------------------- 
    1516   !!   'key_mpp_mpi'             MPI massively parallel processing library 
    … …  
    9394CONTAINS 
    9495 
     96# if defined key_c1d 
     97   !!---------------------------------------------------------------------- 
     98   !!   'key_c1d'                                          1D configuration 
     99   !!---------------------------------------------------------------------- 
     100 
     101   SUBROUTINE lbc_lnk_3d_gather( pt3d1, cd_type1, pt3d2, cd_type2, psgn ) 
     102      !!--------------------------------------------------------------------- 
     103      !!                  ***  ROUTINE lbc_lnk_3d_gather  *** 
     104      !! 
     105      !! ** Purpose :   set lateral boundary conditions on two 3D arrays (C1D case) 
     106      !! 
     107      !! ** Method  :   call lbc_lnk_3d on pt3d1 and pt3d2 
     108      !!---------------------------------------------------------------------- 
     109      CHARACTER(len=1)                , INTENT(in   ) ::   cd_type1, cd_type2   ! nature of pt3d grid-points 
     110      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pt3d1   , pt3d2      ! 3D array on which the lbc is applied 
     111      REAL(wp)                        , INTENT(in   ) ::   psgn                 ! control of the sign  
     112      !!---------------------------------------------------------------------- 
     113      ! 
     114      CALL lbc_lnk_3d( pt3d1, cd_type1, psgn) 
     115      CALL lbc_lnk_3d( pt3d2, cd_type2, psgn) 
     116      ! 
     117   END SUBROUTINE lbc_lnk_3d_gather 
     118 
     119 
     120   SUBROUTINE lbc_lnk_3d( pt3d, cd_type, psgn, cd_mpp, pval ) 
     121      !!--------------------------------------------------------------------- 
     122      !!                  ***  ROUTINE lbc_lnk_3d  *** 
     123      !! 
     124      !! ** Purpose :   set lateral boundary conditions on a 3D array (C1D case) 
     125      !! 
     126      !! ** Method  :   1D case, the central water column is set everywhere 
     127      !!---------------------------------------------------------------------- 
     128      CHARACTER(len=1)                , INTENT(in   )           ::   cd_type   ! nature of pt3d grid-points 
     129      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout)           ::   pt3d      ! 3D array on which the lbc is applied 
     130      REAL(wp)                        , INTENT(in   )           ::   psgn      ! control of the sign  
     131      CHARACTER(len=3)                , INTENT(in   ), OPTIONAL ::   cd_mpp    ! MPP only (here do nothing) 
     132      REAL(wp)                        , INTENT(in   ), OPTIONAL ::   pval      ! background value (for closed boundaries) 
     133      ! 
     134      INTEGER  ::   jk     ! dummy loop index 
     135      REAL(wp) ::   ztab   ! local scalar 
     136      !!---------------------------------------------------------------------- 
     137      ! 
     138      DO jk = 1, jpk 
     139         ztab = pt3d(2,2,jk) 
     140         pt3d(:,:,jk) = ztab 
     141      END DO 
     142      ! 
     143   END SUBROUTINE lbc_lnk_3d 
     144 
     145 
     146   SUBROUTINE lbc_lnk_2d( pt2d, cd_type, psgn, cd_mpp, pval ) 
     147      !!--------------------------------------------------------------------- 
     148      !!                 ***  ROUTINE lbc_lnk_2d  *** 
     149      !! 
     150      !! ** Purpose :   set lateral boundary conditions on a 2D array (non mpp case) 
     151      !! 
     152      !! ** Method  :   1D case, the central water column is set everywhere 
     153      !!---------------------------------------------------------------------- 
     154      CHARACTER(len=1)            , INTENT(in   )           ::   cd_type   ! nature of pt3d grid-points 
     155      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout)           ::   pt2d      ! 2D array on which the lbc is applied 
     156      REAL(wp)                    , INTENT(in   )           ::   psgn      ! control of the sign  
     157      CHARACTER(len=3)            , INTENT(in   ), OPTIONAL ::   cd_mpp    ! MPP only (here do nothing) 
     158      REAL(wp)                    , INTENT(in   ), OPTIONAL ::   pval      ! background value (for closed boundaries) 
     159      ! 
     160      REAL(wp) ::   ztab   ! local scalar 
     161      !!---------------------------------------------------------------------- 
     162      ! 
     163      ztab = pt2d(2,2) 
     164      pt2d(:,:) = ztab 
     165      ! 
     166   END SUBROUTINE lbc_lnk_2d 
     167 
     168#else 
     169   !!---------------------------------------------------------------------- 
     170   !!   Default option                           3D shared memory computing 
     171   !!---------------------------------------------------------------------- 
     172 
    95173   SUBROUTINE lbc_lnk_3d_gather( pt3d1, cd_type1, pt3d2, cd_type2, psgn ) 
    96174      !!--------------------------------------------------------------------- 
    … …  
    138216 
    139217      IF( PRESENT( pval ) ) THEN   ;   zland = pval      ! set land value (zero by default) 
    140       ELSE                         ;   zland = 0.e0 
     218      ELSE                         ;   zland = 0._wp 
    141219      ENDIF 
    142220 
    … …  
    261339 
    262340      IF( PRESENT( pval ) ) THEN   ;   zland = pval      ! set land value (zero by default) 
    263       ELSE                         ;   zland = 0.e0 
     341      ELSE                         ;   zland = 0._wp 
    264342      ENDIF 
    265343 
Note: See TracChangeset for help on using the changeset viewer.