Ignore:
Timestamp:
Mar 3, 2016 8:01:28 AM (6 years ago)
Author:
raasch
Message:

pmc array management changed from linked list to sequential loop; further small changes and cosmetics for the pmc

File:
1 edited

Legend:

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

    r1765 r1779  
    2020! Current revisions:
    2121! ------------------
    22 !
     22! kind=dp replaced by wp
    2323!
    2424! Former revisions:
     
    5353   SAVE
    5454
    55 !-- TO_DO: what is the meaning of this? Could variables declared in this module
    56 !--        also have single precision?
    57 !   INTEGER, PARAMETER :: dp = wp
    58 
    59 
    60    ! INTERFACE section
    61 
    6255   INTERFACE PMC_Send_to_Server
    6356      MODULE PROCEDURE PMC_Send_to_Server_INTEGER
     
    159152
    160153   SUBROUTINE  PMC_Send_to_Server_real_r1 (buf, n, Server_rank, tag, ierr)
    161       IMPLICIT     none
    162 !--   TO_DO: has buf always to be of dp-kind, or can wp used here
    163 !--          this effects all respective declarations in this file
    164       REAL(kind=dp), DIMENSION(:), INTENT(IN)   :: buf
    165       INTEGER, INTENT(IN)                       :: n
    166       INTEGER, INTENT(IN)                       :: Server_rank
    167       INTEGER, INTENT(IN)                       :: tag
    168       INTEGER, INTENT(OUT)                      :: ierr
    169 
    170       ierr = 0
    171       CALL MPI_Send (buf, n, MPI_DOUBLE_PRECISION, Server_rank, tag, m_to_server_comm, ierr)
     154
     155      IMPLICIT     none
     156
     157      REAL(wp), DIMENSION(:), INTENT(IN) :: buf
     158      INTEGER, INTENT(IN)                :: n
     159      INTEGER, INTENT(IN)                :: Server_rank
     160      INTEGER, INTENT(IN)                :: tag
     161      INTEGER, INTENT(OUT)               :: ierr
     162
     163      ierr = 0
     164      CALL MPI_Send (buf, n, MPI_REAL, Server_rank, tag, m_to_server_comm, ierr)
    172165
    173166      return
     
    175168
    176169   SUBROUTINE  PMC_Recv_from_Server_real_r1 (buf, n, Server_rank, tag, ierr)
    177       IMPLICIT     none
    178       REAL(kind=dp), DIMENSION(:), INTENT(OUT)  :: buf
    179       INTEGER, INTENT(IN)                       :: n
    180       INTEGER, INTENT(IN)                       :: Server_rank
    181       INTEGER, INTENT(IN)                       :: tag
    182       INTEGER, INTENT(OUT)                      :: ierr
    183 
    184       ierr = 0
    185       CALL MPI_Recv (buf, n, MPI_DOUBLE_PRECISION, Server_rank, tag, m_to_server_comm, &
    186          MPI_STATUS_IGNORE, ierr)
     170
     171      IMPLICIT     none
     172
     173      REAL(wp), DIMENSION(:), INTENT(OUT) ::  buf
     174      INTEGER, INTENT(IN)                 ::  n
     175      INTEGER, INTENT(IN)                 ::  Server_rank
     176      INTEGER, INTENT(IN)                 ::  tag
     177      INTEGER, INTENT(OUT)                ::  ierr
     178
     179      ierr = 0
     180      CALL MPI_Recv (buf, n, MPI_REAL, Server_rank, tag, m_to_server_comm,     &
     181                     MPI_STATUS_IGNORE, ierr)
    187182
    188183      return
     
    190185
    191186   SUBROUTINE  PMC_Send_to_Server_real_r2 (buf, n, Server_rank, tag, ierr)
    192       IMPLICIT     none
    193       REAL(kind=dp), DIMENSION(:,:), INTENT(IN) :: buf
    194       INTEGER, INTENT(IN)                       :: n
    195       INTEGER, INTENT(IN)                       :: Server_rank
    196       INTEGER, INTENT(IN)                       :: tag
    197       INTEGER, INTENT(OUT)                      :: ierr
    198 
    199       ierr = 0
    200       CALL MPI_Send (buf, n, MPI_DOUBLE_PRECISION, Server_rank, tag, m_to_server_comm, ierr)
     187
     188      IMPLICIT     none
     189
     190      REAL(wp), DIMENSION(:,:), INTENT(IN) ::  buf
     191      INTEGER, INTENT(IN)                  ::  n
     192      INTEGER, INTENT(IN)                  ::  Server_rank
     193      INTEGER, INTENT(IN)                  ::  tag
     194      INTEGER, INTENT(OUT)                 ::  ierr
     195
     196      ierr = 0
     197      CALL MPI_Send (buf, n, MPI_REAL, Server_rank, tag, m_to_server_comm, ierr)
    201198
    202199      return
     
    204201
    205202   SUBROUTINE  PMC_Recv_from_Server_real_r2 (buf, n, Server_rank, tag, ierr)
    206       IMPLICIT     none
    207       REAL(kind=dp), DIMENSION(:,:),INTENT(OUT) :: buf
    208       INTEGER, INTENT(IN)                       :: n
    209       INTEGER, INTENT(IN)                       :: Server_rank
    210       INTEGER, INTENT(IN)                       :: tag
    211       INTEGER, INTENT(OUT)                      :: ierr
    212 
    213       ierr = 0
    214       CALL MPI_Recv (buf, n, MPI_DOUBLE_PRECISION, Server_rank, tag, m_to_server_comm, &
     203
     204      IMPLICIT     none
     205
     206      REAL(wp), DIMENSION(:,:), INTENT(OUT) ::  buf
     207      INTEGER, INTENT(IN)                   ::  n
     208      INTEGER, INTENT(IN)                   ::  Server_rank
     209      INTEGER, INTENT(IN)                   ::  tag
     210      INTEGER, INTENT(OUT)                  ::  ierr
     211
     212      ierr = 0
     213      CALL MPI_Recv (buf, n, MPI_REAL, Server_rank, tag, m_to_server_comm, &
    215214         MPI_STATUS_IGNORE, ierr)
    216215
     
    219218
    220219   SUBROUTINE  PMC_Send_to_Server_real_r3 (buf, n, Server_rank, tag, ierr)
    221       IMPLICIT     none
    222       REAL(kind=dp), DIMENSION(:,:,:), INTENT(IN) :: buf
    223       INTEGER, INTENT(IN)                         :: n
    224       INTEGER, INTENT(IN)                         :: Server_rank
    225       INTEGER, INTENT(IN)                         :: tag
    226       INTEGER, INTENT(OUT)                        :: ierr
    227 
    228       ierr = 0
    229       CALL MPI_Send (buf, n, MPI_DOUBLE_PRECISION, Server_rank, tag, m_to_server_comm, ierr)
     220
     221      IMPLICIT     none
     222
     223      REAL(wp), DIMENSION(:,:,:), INTENT(IN) ::  buf
     224      INTEGER, INTENT(IN)                    ::  n
     225      INTEGER, INTENT(IN)                    ::  Server_rank
     226      INTEGER, INTENT(IN)                    ::  tag
     227      INTEGER, INTENT(OUT)                   ::  ierr
     228
     229      ierr = 0
     230      CALL MPI_Send (buf, n, MPI_REAL, Server_rank, tag, m_to_server_comm, ierr)
    230231
    231232      return
     
    233234
    234235   SUBROUTINE  PMC_Recv_from_Server_real_r3 (buf, n, Server_rank, tag, ierr)
    235       IMPLICIT     none
    236       REAL(kind=dp), DIMENSION(:,:,:),INTENT(OUT) :: buf
    237       INTEGER, INTENT(IN)                         :: n
    238       INTEGER, INTENT(IN)                         :: Server_rank
    239       INTEGER, INTENT(IN)                         :: tag
    240       INTEGER, INTENT(OUT)                        :: ierr
    241 
    242       ierr = 0
    243       CALL MPI_Recv (buf, n, MPI_DOUBLE_PRECISION, Server_rank, tag, m_to_server_comm, &
     236
     237      IMPLICIT     none
     238
     239      REAL(wp), DIMENSION(:,:,:), INTENT(OUT) ::  buf
     240      INTEGER, INTENT(IN)                     ::  n
     241      INTEGER, INTENT(IN)                     ::  Server_rank
     242      INTEGER, INTENT(IN)                     ::  tag
     243      INTEGER, INTENT(OUT)                    ::  ierr
     244
     245      ierr = 0
     246      CALL MPI_Recv (buf, n, MPI_REAL, Server_rank, tag, m_to_server_comm, &
    244247         MPI_STATUS_IGNORE, ierr)
    245248
     
    296299
    297300   SUBROUTINE  PMC_Send_to_Client_real_r1 (Client_id, buf, n, Client_rank, tag, ierr)
    298       IMPLICIT     none
    299       INTEGER, INTENT(IN)                       :: Client_id
    300       REAL(kind=dp), DIMENSION(:), INTENT(IN)   :: buf
    301       INTEGER, INTENT(IN)                       :: n
    302       INTEGER, INTENT(IN)                       :: Client_rank
    303       INTEGER, INTENT(IN)                       :: tag
    304       INTEGER, INTENT(OUT)                      :: ierr
    305 
    306       ierr = 0
    307       CALL MPI_Send (buf, n, MPI_DOUBLE_PRECISION, Client_rank, tag, m_to_client_comm(Client_id), &
     301
     302      IMPLICIT     none
     303
     304      INTEGER, INTENT(IN)                ::  Client_id
     305      REAL(wp), DIMENSION(:), INTENT(IN) ::  buf
     306      INTEGER, INTENT(IN)                ::  n
     307      INTEGER, INTENT(IN)                ::  Client_rank
     308      INTEGER, INTENT(IN)                ::  tag
     309      INTEGER, INTENT(OUT)               ::  ierr
     310
     311      ierr = 0
     312      CALL MPI_Send (buf, n, MPI_REAL, Client_rank, tag, m_to_client_comm(Client_id), &
    308313         ierr)
    309314
     
    312317
    313318   SUBROUTINE  PMC_Recv_from_Client_real_r1 (Client_id, buf, n, Client_rank, tag, ierr)
    314       IMPLICIT     none
    315       INTEGER, INTENT(IN)                       :: Client_id
    316       REAL(kind=dp), DIMENSION(:), INTENT(INOUT):: buf
    317       INTEGER, INTENT(IN)                       :: n
    318       INTEGER, INTENT(IN)                       :: Client_rank
    319       INTEGER, INTENT(IN)                       :: tag
    320       INTEGER, INTENT(OUT)                      :: ierr
    321 
    322       ierr = 0
    323       CALL MPI_Recv (buf, n, MPI_DOUBLE_PRECISION, Client_rank, tag, m_to_client_comm(Client_id), &
     319
     320      IMPLICIT     none
     321
     322      INTEGER, INTENT(IN)                   ::  Client_id
     323      REAL(wp), DIMENSION(:), INTENT(INOUT) ::  buf
     324      INTEGER, INTENT(IN)                   ::  n
     325      INTEGER, INTENT(IN)                   ::  Client_rank
     326      INTEGER, INTENT(IN)                   ::  tag
     327      INTEGER, INTENT(OUT)                  ::  ierr
     328
     329      ierr = 0
     330      CALL MPI_Recv (buf, n, MPI_REAL, Client_rank, tag, m_to_client_comm(Client_id), &
    324331         MPI_STATUS_IGNORE, ierr)
    325332
     
    328335
    329336   SUBROUTINE  PMC_Send_to_Client_real_r2 (Client_id, buf, n, Client_rank, tag, ierr)
    330       IMPLICIT     none
    331       INTEGER, INTENT(IN)                       :: Client_id
    332       REAL(kind=dp), DIMENSION(:,:), INTENT(IN) :: buf
    333       INTEGER, INTENT(IN)                       :: n
    334       INTEGER, INTENT(IN)                       :: Client_rank
    335       INTEGER, INTENT(IN)                       :: tag
    336       INTEGER, INTENT(OUT)                      :: ierr
    337 
    338       ierr = 0
    339       CALL MPI_Send (buf, n, MPI_DOUBLE_PRECISION, Client_rank, tag, m_to_client_comm(Client_id), &
     337
     338      IMPLICIT     none
     339
     340      INTEGER, INTENT(IN)                  ::  Client_id
     341      REAL(wp), DIMENSION(:,:), INTENT(IN) ::  buf
     342      INTEGER, INTENT(IN)                  ::  n
     343      INTEGER, INTENT(IN)                  ::  Client_rank
     344      INTEGER, INTENT(IN)                  ::  tag
     345      INTEGER, INTENT(OUT)                 ::  ierr
     346
     347      ierr = 0
     348      CALL MPI_Send (buf, n, MPI_REAL, Client_rank, tag, m_to_client_comm(Client_id), &
    340349         ierr)
    341350
     
    344353
    345354   SUBROUTINE  PMC_Recv_from_Client_real_r2 (Client_id, buf, n, Client_rank, tag, ierr)
    346       IMPLICIT     none
    347       INTEGER, INTENT(IN)                       :: Client_id
    348       REAL(kind=dp), DIMENSION(:,:), INTENT(OUT):: buf
    349       INTEGER, INTENT(IN)                       :: n
    350       INTEGER, INTENT(IN)                       :: Client_rank
    351       INTEGER, INTENT(IN)                       :: tag
    352       INTEGER, INTENT(OUT)                      :: ierr
    353 
    354       ierr = 0
    355       CALL MPI_Recv (buf, n, MPI_DOUBLE_PRECISION, Client_rank, tag, m_to_client_comm(Client_id), &
     355
     356      IMPLICIT     none
     357
     358      INTEGER, INTENT(IN)                   ::  Client_id
     359      REAL(wp), DIMENSION(:,:), INTENT(OUT) ::  buf
     360      INTEGER, INTENT(IN)                   ::  n
     361      INTEGER, INTENT(IN)                   ::  Client_rank
     362      INTEGER, INTENT(IN)                   ::  tag
     363      INTEGER, INTENT(OUT)                  ::  ierr
     364
     365      ierr = 0
     366      CALL MPI_Recv (buf, n, MPI_REAL, Client_rank, tag, m_to_client_comm(Client_id), &
    356367         MPI_STATUS_IGNORE, ierr)
    357368
     
    360371
    361372   SUBROUTINE  PMC_Send_to_Client_real_r3 (Client_id, buf, n, Client_rank, tag, ierr)
    362       IMPLICIT     none
    363       INTEGER, INTENT(IN)                         :: Client_id
    364       REAL(kind=dp), DIMENSION(:,:,:), INTENT(IN) :: buf
    365       INTEGER, INTENT(IN)                         :: n
    366       INTEGER, INTENT(IN)                         :: Client_rank
    367       INTEGER, INTENT(IN)                         :: tag
    368       INTEGER, INTENT(OUT)                        :: ierr
    369 
    370       ierr = 0
    371       CALL MPI_Send (buf, n, MPI_DOUBLE_PRECISION, Client_rank, tag, m_to_client_comm(Client_id), &
     373
     374      IMPLICIT     none
     375
     376      INTEGER, INTENT(IN)                    ::  Client_id
     377      REAL(wp), DIMENSION(:,:,:), INTENT(IN) ::  buf
     378      INTEGER, INTENT(IN)                    ::  n
     379      INTEGER, INTENT(IN)                    ::  Client_rank
     380      INTEGER, INTENT(IN)                    ::  tag
     381      INTEGER, INTENT(OUT)                   ::  ierr
     382
     383      ierr = 0
     384      CALL MPI_Send (buf, n, MPI_REAL, Client_rank, tag, m_to_client_comm(Client_id), &
    372385         ierr)
    373386
     
    376389
    377390   SUBROUTINE  PMC_Recv_from_Client_real_r3 (Client_id, buf, n, Client_rank, tag, ierr)
    378       IMPLICIT     none
    379       INTEGER, INTENT(IN)                         :: Client_id
    380       REAL(kind=dp), DIMENSION(:,:,:), INTENT(OUT):: buf
    381       INTEGER, INTENT(IN)                         :: n
    382       INTEGER, INTENT(IN)                         :: Client_rank
    383       INTEGER, INTENT(IN)                         :: tag
    384       INTEGER, INTENT(OUT)                        :: ierr
    385 
    386       ierr = 0
    387       CALL MPI_Recv (buf, n, MPI_DOUBLE_PRECISION, Client_rank, tag, m_to_client_comm(Client_id), &
     391
     392      IMPLICIT     none
     393
     394      INTEGER, INTENT(IN)                     ::  Client_id
     395      REAL(wp), DIMENSION(:,:,:), INTENT(OUT) ::  buf
     396      INTEGER, INTENT(IN)                     :: n
     397      INTEGER, INTENT(IN)                     :: Client_rank
     398      INTEGER, INTENT(IN)                     :: tag
     399      INTEGER, INTENT(OUT)                    :: ierr
     400
     401      ierr = 0
     402      CALL MPI_Recv (buf, n, MPI_REAL, Client_rank, tag, m_to_client_comm(Client_id), &
    388403         MPI_STATUS_IGNORE, ierr)
    389404
Note: See TracChangeset for help on using the changeset viewer.