CGpop mini-Application (2-sided MPI 1D data structure version) 0.1
simple_blocks.F90
Go to the documentation of this file.
00001 !==============================================================================
00002 ! Copyright (C) 2010, University Corporation for Atmospheric Research,
00003 !                     Colorado State University,
00004 !                     Los Alamos National Security, LLC,
00005 !                     United States Department of Energy
00006 !
00007 ! All rights reserved.  See ../COPYING for copyright details
00008 !==============================================================================
00009 
00010 !|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
00011 
00012 !>
00013 !! Data types and tools for decomposing a global
00014 !! horizontal domain into a set of blocks.  This module contains a data type 
00015 !! for describing each block and contains routines for creating and 
00016 !! querying the block decomposition for a global domain.
00017 !<
00018 module simple_blocks
00019     use kinds_mod, only: i4, r8
00020     use simple_type, only: distrb
00021     use exit_mod, only: sigabort, exit_POP
00022     use domain_size, only: block_size_x, block_size_y
00023 
00024     implicit none
00025     private
00026     save
00027 
00028     ! !PUBLIC TYPES:
00029     type, public :: AppMD_t   ! block data type
00030         integer (i4) :: 
00031             block_id          ,! global block number
00032             ib, ie, jb, je    ,! begin,end indices for physical domain
00033             iblock, jblock      ! cartesian i,j position for bloc
00034         integer (i4) :: 
00035             npoints           ! number of actual ocean points in block
00036         integer (i4), dimension(:), pointer :: 
00037             i_glob, j_glob     ! global domain location for each point
00038     end type
00039 
00040     ! !PUBLIC MEMBER FUNCTIONS:
00041     public :: get_block_id        ,& 
00042         get_proc_id         ,&
00043         set_block_parameter ,&
00044         get_block_parameter
00045     public :: GetNSBlockIndex     ,&
00046         GetEWBlockIndex
00047 
00048     ! !DEFINED PARAMETERS:
00049     integer (i4), parameter, public :: 
00050         nghost = 2       ! number of ghost cells around each block
00051     integer (i4), parameter, public :: ! size of block domain in
00052         nx_block = block_size_x + 2*nghost,   !  x,y dir including ghost
00053         ny_block = block_size_y + 2*nghost     !  cells 
00054 
00055     ! !PUBLIC DATA MEMBERS:
00056     integer (i4), public :: 
00057         nblocks_tot      ,! total number of blocks in decomposition
00058         nblocks_x        ,! tot num blocks in i direction
00059         nblocks_y          ! tot num blocks in j direction
00060 
00061     integer(i4), public, dimension(:),allocatable :: 
00062     ocn_per_block          ! number of ocean points per block 
00063 
00064     !--------------------
00065     !  The neighbor graph
00066     !--------------------
00067     integer(i4), public, dimension(:,:), allocatable :: 
00068         Neigh             ! array of block neighbors
00069 
00070     integer(i4), public, parameter :: 
00071         ieast  = 1, ! index of east neighbor
00072         iwest  = 2, ! index of west neighbor
00073         inorth = 3, ! index of north neighbor
00074         isouth = 4, ! index of south neighbor
00075         iseast = 5, ! index of southeast neighbor
00076         iswest = 6, ! index of southwest neighbor
00077         inwest = 7, ! index of northwest neighbor
00078         ineast = 8   ! index of northeast neighbor
00079 
00080     integer(i4), public, parameter :: NumNeigh = 8  ! Number of neighbors
00081 
00082     !-----------------------------------------------------------------------
00083     !
00084     !  module private data
00085     !
00086     !-----------------------------------------------------------------------
00087         type (AppMD_t), public, pointer, dimension(:) :: 
00088             all_blocks         ! block information for all blocks in domain
00089 
00090         integer (i4), public, pointer, dimension(:,:) :: 
00091             all_blocks_ij   ! The linear block index in 2D array
00092 
00093         integer (i4), dimension(:,:), allocatable, target :: 
00094             i_global,         ! global i index for each point in each block
00095             j_global           ! global j index for each point in each block
00096 
00097     contains
00098 
00099     !>
00100     !! This function sets the number of active ocean points in the all_block
00101     !! variable.
00102     !<
00103     subroutine set_block_parameter(bid,npoints)
00104         ! !INPUT PARAMETERS:
00105 
00106         integer(i4) :: bid                ! global block id
00107         integer(i4), intent(in), optional ::  ! number of valid ocean points 
00108         npoints              ! in a block
00109 
00110         if(present(npoints)) all_blocks(bid)%npoints=npoints
00111         !----------------------------------------------------------------------
00112     end subroutine set_block_parameter
00113 
00114 
00115     !>
00116     !! This function returns the linear index of a block given the global 
00117     !! x,y index of a block.
00118     !<
00119     function get_block_id(ix,iy)
00120         integer(i4), intent(in)  :: 
00121         ix,iy           ! x and y index of block
00122 
00123         ! !OUTPUT PARAMETERS:
00124         integer(i4) :: get_block_id  ! linear block index
00125 
00126         if(ix>0 .and. iy>0) then 
00127             get_block_id=all_blocks_ij(ix,iy)
00128         else
00129             get_block_id=0
00130         endif
00131     end function get_block_id
00132 
00133     !>
00134     !! This routine returns requested parts of the block data type
00135     !! for the block associated with the input block id
00136     !<
00137     subroutine get_block_parameter(block_id, local_id, ib, ie, jb, je, &
00138         iblock, jblock, npoints, i_glob, j_glob)
00139 
00140         ! !INPUT PARAMETERS:
00141             integer (i4), intent(in) :: 
00142                 block_id  ! global block id for which parameters are requested
00143 
00144         ! !OUTPUT PARAMETERS:
00145             !(optional) parts of block data type to extract if requested
00146             integer (i4), intent(out), optional :: 
00147                 local_id      ,! local id assigned to block in current distrb
00148                 ib, ie, jb, je,! begin,end indices for physical domain
00149                 iblock, jblock,! cartesian i,j position for bloc
00150                 npoints
00151             integer (i4), dimension(:), pointer, optional :: 
00152                 i_glob, j_glob     ! global domain location for each point
00153 
00154         !----------------------------------------------------------------------
00155         !
00156         !  extract each component of data type if requested
00157         !
00158         !----------------------------------------------------------------------
00159         if (block_id < 1 .or. block_id > nblocks_tot) then
00160             call exit_POP(sigAbort,'get_block_parameter: invalid block_id')
00161         endif
00162 
00163         if (present(ib      )) ib       = all_blocks(block_id)%ib
00164         if (present(ie      )) ie       = all_blocks(block_id)%ie
00165         if (present(jb      )) jb       = all_blocks(block_id)%jb
00166         if (present(je      )) je       = all_blocks(block_id)%je
00167         if (present(npoints )) npoints  = all_blocks(block_id)%npoints 
00168         if (present(iblock  )) iblock   = all_blocks(block_id)%iblock
00169         if (present(jblock  )) jblock   = all_blocks(block_id)%jblock
00170         if (present(i_glob  )) i_glob   = all_blocks(block_id)%i_glob
00171         if (present(j_glob  )) j_glob   = all_blocks(block_id)%j_glob
00172     end subroutine get_block_parameter
00173 
00174     !>
00175     !! This subroutine deallocates the array with block information.
00176     !<
00177     subroutine destroy_blocks
00178         deallocate(all_blocks,all_blocks_ij)
00179     end subroutine destroy_blocks
00180 
00181     !>
00182     !!  This subroutine determins the i,j index of the east and west neighbors
00183     !!  of a source or current block
00184     !!
00185     !! @param bndy_type    Controls the type of grid boundary.  Either cyclic
00186     !!                     or closed. 
00187     !! @param iblock_src   The 'i' index of the source block.
00188     !! @param jblock_src   The 'j' index of the source block.
00189     !! @param iblock_east  The 'i' index of the block to the east of the source
00190     !!                     block.
00191     !! @param jblock_east  The 'j' index of the block to the east of the source
00192     !!                     block.
00193     !! @param iblock_west  The 'i' index of the block to the west of the source
00194     !!                     block.
00195     !! @param jblock_west  The 'j' index of the block to the west of the source
00196     !!                     block.
00197     !<
00198     subroutine GetEWBlockIndex(bndy_type,iblock_src,jblock_src, &
00199         iblock_east,jblock_east, &
00200         iblock_west,jblock_west)
00201 
00202         character(*), intent(in) :: bndy_type
00203         integer(i4), intent(in)  :: iblock_src,jblock_src
00204         integer(i4), intent(out) :: iblock_east,jblock_east, 
00205             iblock_west,jblock_west
00206 
00207         select case(bndy_type)
00208             case ('cyclic')
00209                 iblock_east = mod(iblock_src,nblocks_x) + 1
00210                 iblock_west = iblock_src - 1
00211                 if (iblock_west == 0) iblock_west = nblocks_x
00212                 jblock_east = jblock_src
00213                 jblock_west = jblock_src
00214             case ('closed')
00215                 iblock_east = iblock_src + 1
00216                 iblock_west = iblock_src - 1
00217                 if (iblock_east > nblocks_x) iblock_east = 0
00218                 if (iblock_west < 1        ) iblock_west = 0
00219                 jblock_east = jblock_src
00220                 jblock_west = jblock_src
00221             case default
00222                 call exit_POP(sigAbort, 'Unknown east-west boundary type')
00223         end select
00224     end subroutine GetEWBlockIndex
00225 
00226     !>
00227     !!  This subroutine determins the i,j index of the north and 
00228     !!  south neighbors of a source or current block
00229     !!
00230     !! @param bndy_type     Controls the type of grid boundary.  Either cyclic
00231     !!                      or closed. 
00232     !! @param iblock_src    The 'i' index of the source block.
00233     !! @param jblock_src    The 'j' index of the source block.
00234     !! @param iblock_north  The 'i' index of the block to the north of the
00235     !!                      source block.
00236     !! @param jblock_north  The 'j' index of the block to the north of the 
00237     !!                      source block.
00238     !! @param iblock_south  The 'i' index of the block to the south of the 
00239     !!                      source block.
00240     !! @param jblock_south  The 'j' index of the block to the south of the 
00241     !!                      source block.
00242     !<
00243     subroutine GetNSBlockIndex(bndy_type, &
00244         iblock_src,jblock_src, &
00245         iblock_north,jblock_north, &
00246         iblock_south,jblock_south)
00247 
00248         character(*), intent(in)       :: bndy_type
00249         integer(i4), intent(in)  :: iblock_src,jblock_src
00250         integer(i4), intent(out) :: iblock_north,jblock_north, 
00251         iblock_south,jblock_south
00252 
00253         select case(bndy_type)
00254             case ('cyclic')
00255                 jblock_north = mod(jblock_src,nblocks_y) + 1
00256                 jblock_south = jblock_src - 1
00257                 if (jblock_south == 0) jblock_south = nblocks_y
00258                 iblock_north = iblock_src
00259                 iblock_south = iblock_src
00260             case ('closed')
00261                 jblock_north = jblock_src + 1
00262                 jblock_south = jblock_src - 1
00263                 if (jblock_north > nblocks_y) jblock_north = 0
00264                 if (jblock_south < 1        ) jblock_south = 0
00265                 iblock_north = iblock_src
00266                 iblock_south = iblock_src
00267             case default
00268                 call exit_POP(sigAbort, 'Unknown north-south boundary type')
00269         end select
00270     end subroutine GetNSBlockIndex
00271 
00272     !>
00273     !! This determins the task or processor id for a neighboring block
00274     !!
00275     !! @param dist      A data structure which stores the distribution of
00276     !!                  blocks.  
00277     !! @param ineigh    An integer indicating the cardinal and ordinal
00278     !!                  directions.
00279     !! @param block_id  The current or source block identifier.
00280     !<
00281     function get_proc_id(dist,ineigh,block_id)
00282         type (distrb) :: dist
00283         integer (i4) :: ineigh
00284         integer (i4) :: block_id
00285         integer (i4) :: get_proc_id
00286         integer (i4) :: nbid
00287 
00288         nbid=Neigh(ineigh,block_id)
00289         if(nbid >0) then 
00290             if(all_blocks(nbid)%npoints>0) then
00291                 get_proc_id = dist%proc(nbid)-1
00292             else
00293                 get_proc_id = 0
00294             endif
00295         else 
00296             get_proc_id = 0
00297         endif
00298     end function get_proc_id
00299 
00300 end module simple_blocks
00301 !|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
 All Classes Namespaces Files Functions Variables