|
CGpop mini-Application (2-sided MPI 1D data structure version) 0.1
|
|
CGpop mini-Application (2-sided MPI 1D data structure version) 0.1
|
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 !|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
1.7.4
