Changeset 4828 for palm/trunk/SOURCE/pmc_parent_mod.f90

Timestamp:

Jan 5, 2021 11:21:41 AM (3 years ago)

Author:

Giersch

Message:

Copyright updated to year 2021, interface pmc_sort removed to accelarate the nesting code

File:

• palm/trunk/SOURCE/pmc_parent_mod.f90 (modified) (15 diffs)

palm/trunk/SOURCE/pmc_parent_mod.f90

@@ -14 +14 @@
 ! <http://www.gnu.org/licenses/>.
 !
-! Copyright 1997-2020 Leibniz Universitaet Hannover
+! Copyright 1997-2021 Leibniz Universitaet Hannover
 !--------------------------------------------------------------------------------------------------!
 !
@@ -25 +25 @@
 ! -----------------
 ! $Id$
+! pmc_s_set_2d_index_list revised for accelerating the code. Subroutine 
+! description added.
+!
+! 4649 2020-08-25 12:11:17Z raasch
 ! File re-formatted to follow the PALM coding standard
 !
@@ -70 +74 @@
               pmc_g_setname,                                                                       &
               pmc_max_array,                                                                       &
-              pmc_max_models,                                                                      &
-              pmc_sort
+              pmc_max_models
 
     USE pmc_handle_communicator,                                                                   &
@@ -166 +169 @@
 ! ------------
 !
-!> @Todo: Missing subroutine description.
+!> If this thread is intended as parent, initialize parent part of parent-client data transfer
 !--------------------------------------------------------------------------------------------------!
  SUBROUTINE pmc_parentinit
@@ -214 +217 @@
 ! ------------
 !
-!> @Todo: Missing subroutine description.
+!> thread 0 transfers the index list, which contains all parent grid cells involved in
+!> parent client data transfer to the thread, on which this grid cell is located
 !--------------------------------------------------------------------------------------------------!
  SUBROUTINE pmc_s_set_2d_index_list( childid, index_list )
@@ -220 +224 @@
      IMPLICIT NONE
 
+     INTEGER(iwp), INTENT(IN) ::  childid  !<
+     INTEGER(iwp), DIMENSION(:,:), INTENT(INOUT) ::  index_list   !<
+
      INTEGER(iwp) ::  ian    !<
-     INTEGER(iwp) ::  ie     !<
+     INTEGER(iwp) ::  i      !<
      INTEGER(iwp) ::  ip     !<
-     INTEGER(iwp) ::  is     !<
      INTEGER(iwp) ::  istat  !<
-
-     INTEGER(iwp), INTENT(IN) ::  childid  !<
-
-     INTEGER(iwp), DIMENSION(:,:), INTENT(INOUT) ::  index_list  !<
+     INTEGER(iwp) ::  max_cells  !<
+
+     INTEGER(iwp), DIMENSION(:), ALLOCATABLE     ::  cells_on_pe  !<
+     INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE   ::  lo_ind_list  !<
 
 
      IF ( m_model_rank == 0 )  THEN
 !
-!--     Sort to ascending parent process order
-        CALL pmc_sort( index_list, 6 )
-        is = 1
+!--     Compute maximum number of grid cells located on one parent thread
+
+        ALLOCATE(cells_on_pe(0:m_model_npes-1))
+        cells_on_pe = 0
+
+        DO i=1,SIZE( index_list, 2 )
+           cells_on_pe(index_list(6,i )) = cells_on_pe(index_list(6,i ))+1
+        END DO
+
+        max_cells = MAXVAL(cells_on_pe)
+!
+!--     Allocate temp array for thread dependent transfer of index_list
+
+        ALLOCATE(lo_ind_list(SIZE(index_list,1),max_cells))
+
         DO  ip = 0, m_model_npes-1
 !
 !--        Split into parent processes
-           ie = is - 1
-!
-!--        There may be no entry for this process
-           IF ( is <= SIZE( index_list, 2 )  .AND.  ie >= 0 )  THEN
-              DO WHILE ( index_list(6,ie+1 ) == ip )
-                 ie = ie + 1
-                 IF ( ie == SIZE( index_list, 2 ) )  EXIT
-              ENDDO
-              ian = ie - is + 1
-           ELSE
-              is  = -1
-              ie  = -2
-              ian =  0
-           ENDIF
+
+           ian = 0
+
+           DO i=1,SIZE( index_list, 2 )
+              IF(index_list(6,i ) == ip )   THEN
+                 ian = ian+1
+                 lo_ind_list(:,ian) = index_list(:,i)
+              END IF
+           END DO
 !
 !--        Send data to other parent processes
@@ -262 +275 @@
               ALLOCATE( indchildren(childid)%index_list_2d(6,1:ian) )
               IF ( ian > 0)  THEN
-                  indchildren(childid)%index_list_2d(:,1:ian) = index_list(:,is:ie)
+                  indchildren(childid)%index_list_2d(:,1:ian) = lo_ind_list(:,1:ian)
               ENDIF
            ELSE
               CALL MPI_SEND( ian, 1, MPI_INTEGER, ip, 1000, m_model_comm, istat )
               IF ( ian > 0)  THEN
-                  CALL MPI_SEND( index_list(1,is), 6*ian, MPI_INTEGER, ip, 1001, m_model_comm,     &
-                                 istat )
+                  CALL MPI_SEND( lo_ind_list, 6*ian, MPI_INTEGER, ip, 1001, m_model_comm, istat )
               ENDIF
            ENDIF
-           is = ie + 1
         ENDDO
+
+        DEALLOCATE(lo_ind_list)
+        DEALLOCATE(cells_on_pe)
      ELSE
         CALL MPI_RECV( indchildren(childid)%nrpoints, 1, MPI_INTEGER, 0, 1000, m_model_comm,       &
@@ -296 +310 @@
 ! ------------
 !
-!> @Todo: Missing subroutine description.
-!--------------------------------------------------------------------------------------------------!
+!> Before creating an array list with arrays schedule for parent client transfer
+!> make sure that the list is empty
+!--------------------------------------------------------------------------------------------------!
+
  SUBROUTINE pmc_s_clear_next_array_list
 
@@ -306 +322 @@
 
  END SUBROUTINE pmc_s_clear_next_array_list
-
 
 
@@ -348 +363 @@
 ! ------------
 !
-!> @Todo: Missing subroutine description.
+!> add 2D real array to list of arrays scheduled for parent-client transfer
 !--------------------------------------------------------------------------------------------------!
  SUBROUTINE pmc_s_set_dataarray_2d( childid, array, array_2 )
@@ -388 +403 @@
 ! ------------
 !
-!> @Todo: Missing subroutine description.
+!> add 2D integer array to list of arrays scheduled for parent-client transfer
 !--------------------------------------------------------------------------------------------------!
  SUBROUTINE pmc_s_set_dataarray_ip2d( childid, array )
@@ -420 +435 @@
 ! ------------
 !
-!> @Todo: Missing subroutine description.
+!> add 3D real array to list of arrays scheduled for parent-client transfer
 !--------------------------------------------------------------------------------------------------!
  SUBROUTINE pmc_s_set_dataarray_3d( childid, array, nz_cl, nz, array_2 )
@@ -645 +660 @@
 ! ------------
 !
-!> @Todo: Missing subroutine description.
+!> Fill buffer in RMA window to enable the client to fetch the dat with MPI_Get
 !--------------------------------------------------------------------------------------------------!
  SUBROUTINE pmc_s_fillbuffer( childid, waittime, particle_transfer )
@@ -747 +762 @@
 ! ------------
 !
-!> @Todo: Missing subroutine description.
+!> Get client data from RMM window
 !--------------------------------------------------------------------------------------------------!
  SUBROUTINE pmc_s_getdata_from_buffer( childid, waittime , particle_transfer, child_process_nr )
@@ -896 +911 @@
 ! ------------
 !
-!> @Todo: Missing subroutine description.
+!> broadcast name of transfer arrays from child thread 0 to parent threads
 !--------------------------------------------------------------------------------------------------!
  SUBROUTINE get_da_names_from_child( childid )