Changeset 3888 for palm/trunk/SOURCE


Ignore:
Timestamp:
Apr 12, 2019 9:18:10 AM (6 years ago)
Author:
hellstea
Message:

bugfix in pmc_handle_communicator_mod

Location:
palm/trunk/SOURCE
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • palm/trunk/SOURCE/pmc_handle_communicator_mod.f90

    r3885 r3888  
    2525! -----------------
    2626! $Id$
     27! Missing MPI_BCAST of anterpolation_buffer_width added.
     28!
     29! 3885 2019-04-11 11:29:34Z kanani
    2730! Changes related to global restructuring of location messages and introduction
    2831! of additional debug messages
     
    308311    CALL MPI_BCAST( nesting_datatransfer_mode, LEN(nesting_datatransfer_mode),  &
    309312                    MPI_CHARACTER, 0, MPI_COMM_WORLD, istat )
     313    CALL MPI_BCAST( anterpolation_buffer_width, 1, MPI_INT, 0, MPI_COMM_WORLD,  &
     314                    istat )
    310315!
    311316!-- Assign global MPI processes to individual models by setting the couple id
  • palm/trunk/SOURCE/pmc_interface_mod.f90

    r3885 r3888  
    2525! -----------------
    2626! $Id$
     27! Variables renamed, commenting improved etc.
     28!
     29! 3885 2019-04-11 11:29:34Z kanani
    2730! Changes related to global restructuring of location messages and introduction
    2831! of additional debug messages
     
    11141117       CALL MPI_BCAST( childgrid(m), STORAGE_SIZE(childgrid(1))/8, MPI_BYTE, 0, comm2d, ierr )
    11151118!
    1116 !--    TO_DO: Klaus: please give a comment what is done here
    1117 !  DO IT YOURSELF       
     1119!--    Set up the index-list which is an integer array that maps the child index space on
     1120!--    the parent index- and subdomain spaces.
    11181121       CALL pmci_create_index_list
    11191122!
     
    11661169       IMPLICIT NONE
    11671170
    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
    11871191       
    11881192       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 )
    12011207          ENDDO
    12021208
    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
    12101211          nrx = nxr - nxl + 1
    12111212          nry = nyn - nys + 1
    1212           ic = 0
     1213          ilist = 0
    12131214!
    12141215!--       Loop over all children PEs
    1215           DO  k = 1, size_of_array(2)           ! Replace k by some other letter
    1216 !
    1217 !--          Area along y required by actual child PE
    1218              DO  j = coarse_bound_all(3,k), coarse_bound_all(4,k)  !: j = jps, jpn of PE# k
    1219 !
    1220 !--             Area along x required by actual child PE
    1221                 DO  i = coarse_bound_all(1,k), coarse_bound_all(2,k)  !: i = ipl, ipr of PE# k
    1222 
    1223                    px = i / nrx
    1224                    py = j / nry
    1225                    scoord(1) = px
    1226                    scoord(2) = py
    1227                    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 )
    12281229                 
    1229                    ic = ic + 1
    1230 !
    1231 !--                First index in parent array
    1232                    index_list(1,ic) = i - ( px * nrx ) + 1 + nbgp
    1233 !
    1234 !--                Second index in parent array
    1235                    index_list(2,ic) = j - ( py * nry ) + 1 + nbgp
    1236 !
    1237 !--                x index of child coarse grid
    1238                    index_list(3,ic) = i - coarse_bound_all(1,k) + 1
    1239 !
    1240 !--                y index of child coarse grid
    1241                    index_list(4,ic) = j - coarse_bound_all(3,k) + 1
     1230                   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
    12421243!
    12431244!--                PE number of child
    1244                    index_list(5,ic) = k - 1
     1245                   index_list(5,ilist) = n - 1
    12451246!
    12461247!--                PE number of parent
    1247                    index_list(6,ic) = parent_pe
     1248                   index_list(6,ilist) = parent_pe
    12481249
    12491250                ENDDO
     
    12521253!
    12531254!--       TO_DO: Klaus: comment what is done here
    1254           CALL pmc_s_set_2d_index_list( child_id, index_list(:,1:ic) )
     1255          CALL pmc_s_set_2d_index_list( child_id, index_list(:,1:ilist) )
    12551256
    12561257       ELSE
Note: See TracChangeset for help on using the changeset viewer.