Changeset 3888 for palm/trunk/SOURCE/pmc_interface_mod.f90
- Timestamp:
- Apr 12, 2019 9:18:10 AM (6 years ago)
- File:
-
- 1 edited
-
palm/trunk/SOURCE/pmc_interface_mod.f90 (modified) (4 diffs)
Legend:
- Unmodified
- Added
- Removed
-
palm/trunk/SOURCE/pmc_interface_mod.f90
r3885 r3888 25 25 ! ----------------- 26 26 ! $Id$ 27 ! Variables renamed, commenting improved etc. 28 ! 29 ! 3885 2019-04-11 11:29:34Z kanani 27 30 ! Changes related to global restructuring of location messages and introduction 28 31 ! of additional debug messages … … 1114 1117 CALL MPI_BCAST( childgrid(m), STORAGE_SIZE(childgrid(1))/8, MPI_BYTE, 0, comm2d, ierr ) 1115 1118 ! 1116 !-- TO_DO: Klaus: please give a comment what is done here1117 ! DO IT YOURSELF1119 !-- Set up the index-list which is an integer array that maps the child index space on 1120 !-- the parent index- and subdomain spaces. 1118 1121 CALL pmci_create_index_list 1119 1122 ! … … 1166 1169 IMPLICIT NONE 1167 1170 1168 INTEGER(iwp) :: i !< 1169 INTEGER(iwp) :: ic !< 1170 INTEGER(iwp) :: ierr !< 1171 INTEGER(iwp) :: j !< 1172 INTEGER(iwp) :: k !< 1173 INTEGER(iwp) :: npx !< 1174 INTEGER(iwp) :: npy !< 1175 INTEGER(iwp) :: nrx !< 1176 INTEGER(iwp) :: nry !< 1177 INTEGER(iwp) :: px !< 1178 INTEGER(iwp) :: py !< 1179 INTEGER(iwp) :: parent_pe !< 1180 1181 INTEGER(iwp), DIMENSION(2) :: scoord !< 1182 INTEGER(iwp), DIMENSION(2) :: size_of_array !< 1183 1184 INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE :: coarse_bound_all !< 1185 INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE :: index_list !< 1186 1171 INTEGER(iwp) :: ilist !< Index-list index running over the child's parent-grid jc,ic-space 1172 INTEGER(iwp) :: index_list_size !< Dimension 2 of the array index_list 1173 INTEGER(iwp) :: ierr !< MPI error code 1174 INTEGER(iwp) :: ip !< Running parent-grid index on the child domain in the x-direction 1175 INTEGER(iwp) :: jp !< Running parent-grid index on the child domain in the y-direction 1176 INTEGER(iwp) :: n !< Running index over child subdomains 1177 INTEGER(iwp) :: nrx !< Parent subdomain dimension in the x-direction 1178 INTEGER(iwp) :: nry !< Parent subdomain dimension in the y-direction 1179 INTEGER(iwp) :: pex !< Two-dimensional subdomain (pe) index in the x-direction 1180 INTEGER(iwp) :: pey !< Two-dimensional subdomain (pe) index in the y-direction 1181 INTEGER(iwp) :: parent_pe !< Parent subdomain index (one-dimensional) 1182 1183 INTEGER(iwp), DIMENSION(2) :: pe_indices_2d !< Array for two-dimensional subdomain (pe) 1184 !< indices needed for MPI_CART_RANK 1185 INTEGER(iwp), DIMENSION(2) :: size_of_childs_parent_grid_bounds_all !< Dimensions of childs_parent_grid_bounds_all 1186 INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE :: childs_parent_grid_bounds_all !< Array that contains the child's 1187 !< parent-grid index bounds for all its 1188 !< subdomains (pes) 1189 INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE :: index_list !< Array that maps the child index space on 1190 !< the parent index- and subdomain spaces 1187 1191 1188 1192 IF ( myid == 0 ) THEN 1189 ! 1190 !-- TO_DO: Klaus: give more specific comment what size_of_array stands for 1191 CALL pmc_recv_from_child( child_id, size_of_array, 2, 0, 40, ierr ) 1192 ALLOCATE( coarse_bound_all(size_of_array(1),size_of_array(2)) ) 1193 CALL pmc_recv_from_child( child_id, coarse_bound_all, & 1194 SIZE( coarse_bound_all ), 0, 41, ierr ) 1195 ! 1196 !-- Compute size of index_list. 1197 ic = 0 1198 DO k = 1, size_of_array(2) ! Replace k by some other letter 1199 ic = ic + ( coarse_bound_all(4,k) - coarse_bound_all(3,k) + 1 ) * & 1200 ( coarse_bound_all(2,k) - coarse_bound_all(1,k) + 1 ) 1193 1194 CALL pmc_recv_from_child( child_id, size_of_childs_parent_grid_bounds_all, & 1195 2, 0, 40, ierr ) 1196 ALLOCATE( childs_parent_grid_bounds_all(size_of_childs_parent_grid_bounds_all(1), & 1197 size_of_childs_parent_grid_bounds_all(2)) ) 1198 CALL pmc_recv_from_child( child_id, childs_parent_grid_bounds_all, & 1199 SIZE( childs_parent_grid_bounds_all ), 0, 41, ierr ) 1200 ! 1201 !-- Compute size (dimension) of the index_list. 1202 index_list_size = 0 1203 DO n = 1, size_of_childs_parent_grid_bounds_all(2) 1204 index_list_size = index_list_size + & 1205 ( childs_parent_grid_bounds_all(4,n) - childs_parent_grid_bounds_all(3,n) + 1 ) * & 1206 ( childs_parent_grid_bounds_all(2,n) - childs_parent_grid_bounds_all(1,n) + 1 ) 1201 1207 ENDDO 1202 1208 1203 ALLOCATE( index_list(6,ic) ) 1204 1205 CALL MPI_COMM_SIZE( comm1dx, npx, ierr ) 1206 CALL MPI_COMM_SIZE( comm1dy, npy, ierr ) 1207 ! 1208 !-- Nrx is the same for all PEs and so is nry, thus there is no need to compute 1209 !-- them separately for each PE. 1209 ALLOCATE( index_list(6,index_list_size) ) 1210 1210 1211 nrx = nxr - nxl + 1 1211 1212 nry = nyn - nys + 1 1212 i c= 01213 ilist = 0 1213 1214 ! 1214 1215 !-- Loop over all children PEs 1215 DO k = 1, size_of_array(2) ! Replace k by some other letter1216 ! 1217 !-- Areaalong y required by actual child PE1218 DO j = coarse_bound_all(3,k), coarse_bound_all(4,k) !: j = jps, jpn of PE# k1219 ! 1220 !-- Areaalong x required by actual child PE1221 DO i = coarse_bound_all(1,k), coarse_bound_all(2,k) !: i = ipl, ipr of PE# k1222 1223 p x = i/ nrx1224 p y = j/ nry1225 scoord(1) = px1226 scoord(2) = py1227 CALL MPI_CART_RANK( comm2d, scoord, parent_pe, ierr )1216 DO n = 1, size_of_childs_parent_grid_bounds_all(2) ! 1217 ! 1218 !-- Subspace along y required by actual child PE 1219 DO jp = childs_parent_grid_bounds_all(3,n), childs_parent_grid_bounds_all(4,n) ! jp = jps, jpn of child PE# n 1220 ! 1221 !-- Subspace along x required by actual child PE 1222 DO ip = childs_parent_grid_bounds_all(1,n), childs_parent_grid_bounds_all(2,n) ! ip = ipl, ipr of child PE# n 1223 1224 pex = ip / nrx 1225 pey = jp / nry 1226 pe_indices_2d(1) = pex 1227 pe_indices_2d(2) = pey 1228 CALL MPI_CART_RANK( comm2d, pe_indices_2d, parent_pe, ierr ) 1228 1229 1229 i c = ic+ 11230 ! 1231 !-- First index in parent array 1232 index_list(1,i c) = i - ( px * nrx ) + 1 + nbgp1233 ! 1234 !-- Second index in parent array 1235 index_list(2,i c) = j - ( py * nry ) + 1 + nbgp1236 ! 1237 !-- x index of child coarsegrid1238 index_list(3,i c) = i - coarse_bound_all(1,k) + 11239 ! 1240 !-- y index of child coarsegrid1241 index_list(4,i c) = j - coarse_bound_all(3,k) + 11230 ilist = ilist + 1 1231 ! 1232 !-- First index in parent array ! TO_DO: IMPROVE THIS COMMENT 1233 index_list(1,ilist) = ip - ( pex * nrx ) + 1 + nbgp 1234 ! 1235 !-- Second index in parent array ! TO_DO: IMPROVE THIS COMMENT 1236 index_list(2,ilist) = jp - ( pey * nry ) + 1 + nbgp 1237 ! 1238 !-- x index of child's parent grid 1239 index_list(3,ilist) = ip - childs_parent_grid_bounds_all(1,n) + 1 1240 ! 1241 !-- y index of child's parent grid 1242 index_list(4,ilist) = jp - childs_parent_grid_bounds_all(3,n) + 1 1242 1243 ! 1243 1244 !-- PE number of child 1244 index_list(5,i c) = k- 11245 index_list(5,ilist) = n - 1 1245 1246 ! 1246 1247 !-- PE number of parent 1247 index_list(6,i c) = parent_pe1248 index_list(6,ilist) = parent_pe 1248 1249 1249 1250 ENDDO … … 1252 1253 ! 1253 1254 !-- TO_DO: Klaus: comment what is done here 1254 CALL pmc_s_set_2d_index_list( child_id, index_list(:,1:i c) )1255 CALL pmc_s_set_2d_index_list( child_id, index_list(:,1:ilist) ) 1255 1256 1256 1257 ELSE
Note: See TracChangeset
for help on using the changeset viewer.
