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 11380 for NEMO/branches/2019/dev_r10984_HPC-13_IRRMANN_DYN_optimization/src/OCE/BDY/bdy_oce.F90 – NEMO

Ignore:
Timestamp:
2019-07-31T15:56:02+02:00 (5 years ago)
Author:
girrmann
Message:

dev_r10984_HPC-13 : adding extra halos in dyn_spg_ts is now possible, only works with a single halo when used with tide or bdy, see #2308

File:
1 edited

Legend:

Unmodified
Added
Removed
  • NEMO/branches/2019/dev_r10984_HPC-13_IRRMANN_DYN_optimization/src/OCE/BDY/bdy_oce.F90

    r11223 r11380  
    1515   IMPLICIT NONE 
    1616   PUBLIC 
     17 
    1718 
    1819   INTEGER, PUBLIC, PARAMETER ::   jp_bdy  = 10       !: Maximum number of bdy sets 
     
    122123                                                                          !: =1 => some data to be read in from data files 
    123124!$AGRIF_DO_NOT_TREAT 
    124    TYPE(OBC_INDEX), DIMENSION(jp_bdy), TARGET      ::   idx_bdy           !: bdy indices (local process) 
    125    TYPE(OBC_DATA) , DIMENSION(jp_bdy), TARGET      ::   dta_bdy           !: bdy external data (local process) 
     125   ! regular :  interior domain + global halo || extended : interior domain + global halo + halo extension for time-splitting 
     126   TYPE(OBC_INDEX), DIMENSION(jp_bdy), TARGET      ::   idx_bdy_reg, idx_bdy_xtd    !: bdy indices (local process) 
     127   TYPE(OBC_DATA) , DIMENSION(jp_bdy), TARGET      ::   dta_bdy_reg, dta_bdy_xtd    !: bdy external data (local process) 
     128   ! pointers to switch between regular and extended, _save for the OBC_INDEX not currently used 
     129   TYPE(OBC_INDEX), DIMENSION(:)     , POINTER     ::   idx_bdy, idx_bdy_save       !: bdy indices (local process) 
     130   TYPE(OBC_DATA) , DIMENSION(:)     , POINTER     ::   dta_bdy, dta_bdy_save       !: bdy external data (local process) 
    126131!$AGRIF_END_DO_NOT_TREAT 
    127    LOGICAL, ALLOCATABLE, DIMENSION(:,:,:,:) ::   lsend_bdy      !: mark needed communication for given boundary, grid and neighbour 
    128    LOGICAL, ALLOCATABLE, DIMENSION(:,:,:,:) ::   lrecv_bdy      !:  when searching in any direction 
    129    LOGICAL, ALLOCATABLE, DIMENSION(:,:,:,:) ::   lsend_bdyint   !: mark needed communication for given boundary, grid and neighbour 
    130    LOGICAL, ALLOCATABLE, DIMENSION(:,:,:,:) ::   lrecv_bdyint   !:  when searching towards the interior of the computational domain 
    131    LOGICAL, ALLOCATABLE, DIMENSION(:,:,:,:) ::   lsend_bdyext   !: mark needed communication for given boundary, grid and neighbour 
    132    LOGICAL, ALLOCATABLE, DIMENSION(:,:,:,:) ::   lrecv_bdyext   !:  when searching towards the exterior of the computational domain 
     132   ! regular :  interior domain + global halo 
     133   LOGICAL, ALLOCATABLE, TARGET, DIMENSION(:,:,:,:) :: lsend_bdy_reg      !: mark com for given boundary, grid, neighbour and rim 
     134   LOGICAL, ALLOCATABLE, TARGET, DIMENSION(:,:,:,:) :: lrecv_bdy_reg      !:  when searching in any direction 
     135   LOGICAL, ALLOCATABLE, TARGET, DIMENSION(:,:,:,:) :: lsend_bdyint_reg   !: mark com for given boundary, grid, neighbour and rim 
     136   LOGICAL, ALLOCATABLE, TARGET, DIMENSION(:,:,:,:) :: lrecv_bdyint_reg   !:  when searching towards the interior of the domain 
     137   LOGICAL, ALLOCATABLE, TARGET, DIMENSION(:,:,:,:) :: lsend_bdyext_reg   !: mark com for given boundary, grid, neighbour and rim 
     138   LOGICAL, ALLOCATABLE, TARGET, DIMENSION(:,:,:,:) :: lrecv_bdyext_reg   !:  when searching towards the exterior of the domain 
     139   ! extended : interior domain + global halo + halo extension for time-splitting 
     140   LOGICAL, ALLOCATABLE, TARGET, DIMENSION(:,:,:,:) :: lsend_bdy_xtd      !: mark com for given boundary, grid, neighbour and rim 
     141   LOGICAL, ALLOCATABLE, TARGET, DIMENSION(:,:,:,:) :: lrecv_bdy_xtd      !:  when searching in any direction 
     142   LOGICAL, ALLOCATABLE, TARGET, DIMENSION(:,:,:,:) :: lsend_bdyint_xtd   !: mark com for given boundary, grid, neighbour and rim 
     143   LOGICAL, ALLOCATABLE, TARGET, DIMENSION(:,:,:,:) :: lrecv_bdyint_xtd   !:  when searching towards the interior of the domain 
     144   LOGICAL, ALLOCATABLE, TARGET, DIMENSION(:,:,:,:) :: lsend_bdyext_xtd   !: mark com for given boundary, grid, neighbour and rim 
     145   LOGICAL, ALLOCATABLE, TARGET, DIMENSION(:,:,:,:) :: lrecv_bdyext_xtd   !:  when searching towards the exterior of the domain 
     146   ! pointers to switch between regular and extended, _save for the logical array not currently used 
     147   LOGICAL,             POINTER, DIMENSION(:,:,:,:) :: lsend_bdy   , lsend_bdy_save 
     148   LOGICAL,             POINTER, DIMENSION(:,:,:,:) :: lrecv_bdy   , lrecv_bdy_save 
     149   LOGICAL,             POINTER, DIMENSION(:,:,:,:) :: lsend_bdyint, lsend_bdyint_save 
     150   LOGICAL,             POINTER, DIMENSION(:,:,:,:) :: lrecv_bdyint, lrecv_bdyint_save 
     151   LOGICAL,             POINTER, DIMENSION(:,:,:,:) :: lsend_bdyext, lsend_bdyext_save 
     152   LOGICAL,             POINTER, DIMENSION(:,:,:,:) :: lrecv_bdyext, lrecv_bdyext_save 
    133153   !!---------------------------------------------------------------------- 
    134154   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
     
    158178   END FUNCTION bdy_oce_alloc 
    159179 
     180 
     181   SUBROUTINE swap_bdyptr 
     182      !!---------------------------------------------------------------------- 
     183      !!                 ***  ROUTINE  swap_bdyptr  *** 
     184      !!          
     185      !! ** Purpose :   swap all pointers for bdy treatment 
     186      !!---------------------------------------------------------------------- 
     187      CALL swap_obciptr(idx_bdy     , idx_bdy_save     ) 
     188      CALL swap_obcdptr(dta_bdy     , dta_bdy_save     ) 
     189      CALL swap_lptr   (lsend_bdy   , lsend_bdy_save   ) 
     190      CALL swap_lptr   (lrecv_bdy   , lrecv_bdy_save   ) 
     191      CALL swap_lptr   (lsend_bdyint, lsend_bdyint_save) 
     192      CALL swap_lptr   (lrecv_bdyint, lrecv_bdyint_save) 
     193      CALL swap_lptr   (lsend_bdyext, lsend_bdyext_save) 
     194      CALL swap_lptr   (lrecv_bdyext, lrecv_bdyext_save) 
     195      ! 
     196   END SUBROUTINE swap_bdyptr 
     197 
     198 
     199   SUBROUTINE swap_lptr( ptr1, ptr2 ) 
     200      !!---------------------------------------------------------------------- 
     201      !!                 ***  ROUTINE swap_lptr  *** 
     202      !!          
     203      !! ** Purpose :   swap logical pointers 
     204      !! ** Method  :   use temporary pointer to save the target 
     205      !!----------------------------------------------------------------------       
     206      LOGICAL, DIMENSION(:,:,:,:), POINTER, INTENT(inout)   :: ptr1, ptr2 
     207      LOGICAL, DIMENSION(:,:,:,:), POINTER                  :: ptrtmp 
     208      !!---------------------------------------------------------------------- 
     209      ptrtmp => ptr1 
     210      ptr1 => ptr2 
     211      ptr2 => ptrtmp 
     212   END SUBROUTINE swap_lptr 
     213 
     214 
     215   SUBROUTINE swap_obciptr( ptr1, ptr2 ) 
     216      !!---------------------------------------------------------------------- 
     217      !!                 ***  ROUTINE swap_obciptr  *** 
     218      !!          
     219      !! ** Purpose :   swap pointers on OBC_INDEX types 
     220      !! ** Method  :   use temporary pointer to save the target 
     221      !!----------------------------------------------------------------------       
     222      TYPE(OBC_INDEX), DIMENSION(:), POINTER, INTENT(inout)   :: ptr1, ptr2 
     223      TYPE(OBC_INDEX), DIMENSION(:), POINTER                  :: ptrtmp 
     224      !!---------------------------------------------------------------------- 
     225      ptrtmp => ptr1 
     226      ptr1 => ptr2 
     227      ptr2 => ptrtmp 
     228   END SUBROUTINE swap_obciptr 
     229 
     230 
     231   SUBROUTINE swap_obcdptr( ptr1, ptr2 ) 
     232      !!---------------------------------------------------------------------- 
     233      !!                 ***  ROUTINE swap_obcdptr  *** 
     234      !!          
     235      !! ** Purpose :   swap pointers on OBC_DATA types 
     236      !! ** Method  :   use temporary pointer to save the target 
     237      !!----------------------------------------------------------------------       
     238      TYPE(OBC_DATA), DIMENSION(:), POINTER, INTENT(inout)   :: ptr1, ptr2 
     239      TYPE(OBC_DATA), DIMENSION(:), POINTER                  :: ptrtmp 
     240      !!---------------------------------------------------------------------- 
     241      ptrtmp => ptr1 
     242      ptr1 => ptr2 
     243      ptr2 => ptrtmp 
     244   END SUBROUTINE swap_obcdptr 
     245 
    160246   !!====================================================================== 
    161247END MODULE bdy_oce 
Note: See TracChangeset for help on using the changeset viewer.