Home


About us
PALM
PALM-4U
Installation
Release notes
Documentation
Getting Help
Gallery
Developers area

Changeset 4830 for palm/trunk/SOURCE


Ignore:
Timestamp:
Jan 6, 2021 11:25:45 AM (4 years ago)
Author:
Giersch
Message:

Reformatted to follow PALM coding standard

Location:
palm/trunk/SOURCE
Files:
2 edited

Legend:

Unmodified
Added
Removed

  • palm/trunk/SOURCE/pmc_general_mod.f90

    r4828 r4830  
    1  MODULE pmc_general
    2 
     1!> @file pmc_general_mod.f90
    32!--------------------------------------------------------------------------------------------------!
    43! This file is part of the PALM model system.
    … …  
    1817!--------------------------------------------------------------------------------------------------!
    1918!
    20 !
    2119! Current revisions:
    2220! -----------------
    … …  
    2624! -----------------
    2725! $Id$
     26! Reformatted to follow PALM coding standard
     27!
     28! 4828 2021-01-05 11:21:41Z Giersch
    2829! Interface pmc_sort removed. Subroutine description added.
    2930!
    … …  
    4849! Initial revision by K. Ketelsen
    4950!
     51! Authors:
     52! --------
     53!> @author Klaus Ketelsen (no affiliation)
     54!
    5055! Description:
    5156! ------------
    52 !
    53 ! Structure definition and utilities of Palm Model Coupler
     57!> Structure definition and utilities of Palm Model Coupler
    5458!--------------------------------------------------------------------------------------------------!
     59 MODULE pmc_general
    5560
    5661#if defined( __parallel )
    … …  
    6166    USE MPI
    6267
     68
    6369    IMPLICIT NONE
    6470
    65 
    66     PRIVATE
    67     SAVE
    68 
    69     INTEGER(iwp), PARAMETER, PUBLIC :: da_desclen       =  8  !<
    70     INTEGER(iwp), PARAMETER, PUBLIC :: da_namelen       = 16  !<
    71     INTEGER(iwp), PARAMETER, PUBLIC :: pmc_da_name_err  = 10  !<
    72     INTEGER(iwp), PARAMETER, PUBLIC :: pmc_max_models   = 64  !<
    73     INTEGER(iwp), PARAMETER, PUBLIC :: pmc_status_ok    =  0  !<
    74     INTEGER(iwp), PARAMETER, PUBLIC :: pmc_status_error = -1  !<
    75 
    76     INTEGER(iwp), PUBLIC ::  pmc_max_array  !< max # of arrays which can be coupled
    77                                             !< - will be determined dynamically in pmc_interface
    78 
    79 
    80     TYPE, PUBLIC :: xy_ind  !< pair of indices in horizontal plane
    81        INTEGER(iwp) ::  i
    82        INTEGER(iwp) ::  j
     71    INTEGER(iwp) ::  pmc_max_array  !< max # of arrays which can be coupled
     72                                    !< - will be determined dynamically in pmc_interface
     73
     74    INTEGER(iwp), PARAMETER ::  da_desclen       =  8  !<
     75    INTEGER(iwp), PARAMETER ::  da_namelen       = 16  !<
     76    INTEGER(iwp), PARAMETER ::  pmc_da_name_err  = 10  !<
     77    INTEGER(iwp), PARAMETER ::  pmc_max_models   = 64  !<
     78    INTEGER(iwp), PARAMETER ::  pmc_status_ok    =  0  !<
     79    INTEGER(iwp), PARAMETER ::  pmc_status_error = -1  !<
     80
     81    TYPE ::  xy_ind  !< pair of indices in horizontal plane
     82       INTEGER(iwp) ::  i  !<
     83       INTEGER(iwp) ::  j  !<
    8384    END TYPE
    8485
    85     TYPE, PUBLIC ::  arraydef
     86    TYPE ::  arraydef
    8687       CHARACTER(LEN=da_namelen) ::  Name  !< name of array
    8788
    … …  
    9192       INTEGER(iwp) ::  RecvSize     !< size in receive buffer
    9293       INTEGER(iwp) ::  SendSize     !< size in send buffer
    93 
    94        INTEGER(idp) ::  RecvIndex  !< index in receive buffer
    95        INTEGER(idp) ::  SendIndex  !< index in send buffer
     94       INTEGER(idp) ::  RecvIndex    !< index in receive buffer
     95       INTEGER(idp) ::  SendIndex    !< index in send buffer
    9696
    9797       INTEGER(iwp), DIMENSION(4) ::  a_dim  !< size of dimensions
    … …  
    107107    END TYPE arraydef
    108108
    109 
    110     TYPE(arraydef), PUBLIC, POINTER  :: next  !<
    111 
    112 
    113     TYPE, PUBLIC ::  pedef
    114        INTEGER(iwp) :: nr_arrays = 0  !< number of arrays which will be transfered
    115        INTEGER(iwp) :: nrele          !< number of elements, same for all arrays
     109    TYPE ::  pedef
     110       INTEGER(iwp) ::  nr_arrays = 0  !< number of arrays which will be transfered
     111       INTEGER(iwp) ::  nrele          !< number of elements, same for all arrays
    116112
    117113       TYPE(arraydef), POINTER, DIMENSION(:) ::  array_list  !< list of data arrays to be transfered
    118        TYPE(xy_ind), POINTER, DIMENSION(:)   ::  locInd      !< xy index local array for remote PE
     114
     115       TYPE(xy_ind), POINTER, DIMENSION(:) ::  locInd  !< xy index local array for remote PE
    119116    END TYPE pedef
    120117
    121 
    122     TYPE, PUBLIC ::  childdef
    123        INTEGER(iwp) ::  inter_comm         !< inter communicator model and child
    124        INTEGER(iwp) ::  inter_npes         !< number of PEs child model
    125        INTEGER(iwp) ::  intra_comm         !< intra communicator model and child
    126        INTEGER(iwp) ::  intra_rank         !< rank within intra_comm
    127        INTEGER(iwp) ::  model_comm         !< communicator of this model
    128        INTEGER(iwp) ::  model_npes         !< number of PEs this model
    129        INTEGER(iwp) ::  model_rank         !< rank of this model
    130        INTEGER(idp) ::  totalbuffersize    !<
    131        INTEGER(iwp) ::  win_parent_child   !< MPI RMA for preparing data on parent AND child side
     118    TYPE ::  childdef
     119       INTEGER(iwp) ::  inter_comm        !< inter communicator model and child
     120       INTEGER(iwp) ::  inter_npes        !< number of PEs child model
     121       INTEGER(iwp) ::  intra_comm        !< intra communicator model and child
     122       INTEGER(iwp) ::  intra_rank        !< rank within intra_comm
     123       INTEGER(iwp) ::  model_comm        !< communicator of this model
     124       INTEGER(iwp) ::  model_npes        !< number of PEs this model
     125       INTEGER(iwp) ::  model_rank        !< rank of this model
     126       INTEGER(idp) ::  totalbuffersize   !<
     127       INTEGER(iwp) ::  win_parent_child  !< MPI RMA for preparing data on parent AND child side
     128
    132129       TYPE(pedef), DIMENSION(:), POINTER ::  pes  !< list of all child PEs
    133130    END TYPE childdef
    134131
    135 
    136     TYPE, PUBLIC ::  da_namedef  !< data array name definition
     132    TYPE ::  da_namedef  !< data array name definition
    137133       CHARACTER(LEN=da_desclen) ::  childdesc     !< child array description
    138134       CHARACTER(LEN=da_namelen) ::  nameonchild   !< name of array within child
    139135       CHARACTER(LEN=da_namelen) ::  nameonparent  !< name of array within parent
    140136       CHARACTER(LEN=da_desclen) ::  parentdesc    !< parent array description
    141        INTEGER(iwp)              ::  couple_index  !< unique number of array
     137
     138       INTEGER(iwp) ::  couple_index  !< unique number of array
    142139    END TYPE da_namedef
     140
     141    TYPE(arraydef), POINTER ::  next  !<
     142
     143    SAVE
     144
     145    PRIVATE
     146
     147!
     148!-- Public functions
     149    PUBLIC pmc_g_setname
     150
     151!
     152!-- Public variables, constants and types
     153    PUBLIC arraydef,                                                                               &
     154           childdef,                                                                               &
     155           da_desclen,                                                                             &
     156           da_namedef,                                                                             &
     157           da_namelen,                                                                             &
     158           next,                                                                                   &
     159           pedef,                                                                                  &
     160           pmc_da_name_err,                                                                        &
     161           pmc_max_array,                                                                          &
     162           pmc_max_models,                                                                         &
     163           pmc_status_error,                                                                       &
     164           pmc_status_ok,                                                                          &
     165           xy_ind
    143166
    144167    INTERFACE pmc_g_setname
    … …  
    146169    END INTERFACE pmc_g_setname
    147170
    148     PUBLIC pmc_g_setname
    149171
    150172 CONTAINS
     173
    151174
    152175!---------------------------------------------------------------------------------------------------!
    … …  
    157180 SUBROUTINE pmc_g_setname( mychild, couple_index, aname )
    158181
    159     IMPLICIT NONE
    160 
    161     CHARACTER(LEN=*)              ::  aname         !<
    162 
    163     INTEGER(iwp), INTENT(IN)      ::  couple_index  !<
     182    CHARACTER(LEN=*), INTENT(IN) ::  aname  !<
    164183
    165184    INTEGER(iwp) ::  i  !<
    166185
    167     TYPE(childdef), INTENT(INOUT) ::  mychild       !<
    168 
    169     TYPE(pedef), POINTER    ::  ape  !<
     186    INTEGER(iwp), INTENT(IN) ::  couple_index  !<
     187
     188    TYPE(childdef), INTENT(INOUT) ::  mychild  !<
     189
     190    TYPE(pedef), POINTER ::  ape  !<
     191
    170192
    171193!
    … …  
    180202
    181203 END SUBROUTINE pmc_g_setname
    182 
    183204#endif
     205
     206
    184207 END MODULE pmc_general

  • palm/trunk/SOURCE/pmc_parent_mod.f90

    r4828 r4830  
    1  MODULE pmc_parent
     1!> @file pmc_parent_mod.f90
    22!--------------------------------------------------------------------------------------------------!
    33! This file is part of the PALM model system.
    … …  
    2525! -----------------
    2626! $Id$
    27 ! pmc_s_set_2d_index_list revised for accelerating the code. Subroutine
     27! Reformatted to follow PALM coding standard
     28!
     29! 4828 2021-01-05 11:21:41Z Giersch
     30! pmc_s_set_2d_index_list revised for accelerating the code. Subroutine
    2831! description added.
    2932!
    … …  
    5457! Initial revision by K. Ketelsen
    5558!
    56 !--------------------------------------------------------------------------------------------------!
     59! Authors:
     60! --------
     61!> @author Klaus Ketelsen (no affiliation)
     62!
    5763! Description:
    5864! ------------
    5965!> Parent part of Palm Model Coupler
    6066!--------------------------------------------------------------------------------------------------!
     67 MODULE pmc_parent
    6168
    6269#if defined( __parallel )
    … …  
    6673
    6774    USE kinds
     75
    6876    USE pmc_general,                                                                               &
    6977        ONLY: arraydef,                                                                            &
    … …  
    8997              pmc_time
    9098
    91    IMPLICIT NONE
    92 
    93 
    94    PRIVATE
    95    SAVE
    96 
    97    INTEGER ::  next_array_in_list = 0  !<
    98 
    99    TYPE childindexdef
    100       INTEGER                              ::  nrpoints       !<
    101       INTEGER, DIMENSION(:,:), ALLOCATABLE ::  index_list_2d  !<
    102    END TYPE childindexdef
    103 
    104    TYPE(childdef), DIMENSION(pmc_max_models),PUBLIC ::  children     !<
    105    TYPE(childindexdef), DIMENSION(pmc_max_models)   ::  indchildren  !<
    106 
    107 
    108    PUBLIC pmc_parent_for_child
    109 
    110 
    111    INTERFACE pmc_parentinit
    112       MODULE PROCEDURE  pmc_parentinit
    113    END INTERFACE pmc_parentinit
    114 
    115     INTERFACE pmc_s_set_2d_index_list
    116         MODULE PROCEDURE pmc_s_set_2d_index_list
    117     END INTERFACE pmc_s_set_2d_index_list
    118 
    119     INTERFACE pmc_s_clear_next_array_list
    120         MODULE PROCEDURE pmc_s_clear_next_array_list
    121     END INTERFACE pmc_s_clear_next_array_list
    122 
    123     INTERFACE pmc_s_getnextarray
    124         MODULE PROCEDURE pmc_s_getnextarray
    125     END INTERFACE pmc_s_getnextarray
    126 
    127     INTERFACE pmc_s_set_dataarray
    128         MODULE PROCEDURE pmc_s_set_dataarray_2d
    129         MODULE PROCEDURE pmc_s_set_dataarray_3d
    130         MODULE PROCEDURE pmc_s_set_dataarray_ip2d
    131     END INTERFACE pmc_s_set_dataarray
    132 
    133     INTERFACE pmc_s_setind_and_allocmem
    134         MODULE PROCEDURE pmc_s_setind_and_allocmem
    135     END INTERFACE pmc_s_setind_and_allocmem
    136 
    137     INTERFACE pmc_s_fillbuffer
    138         MODULE PROCEDURE pmc_s_fillbuffer
    139     END INTERFACE pmc_s_fillbuffer
    140 
    141     INTERFACE pmc_s_getdata_from_buffer
    142         MODULE PROCEDURE pmc_s_getdata_from_buffer
    143     END INTERFACE pmc_s_getdata_from_buffer
    144 
    145     INTERFACE pmc_s_set_active_data_array
    146         MODULE PROCEDURE pmc_s_set_active_data_array
    147     END INTERFACE pmc_s_set_active_data_array
    148 
    149     INTERFACE pmc_s_get_child_npes
    150         MODULE PROCEDURE pmc_s_get_child_npes
    151     END INTERFACE pmc_s_get_child_npes
    152 
    153     PUBLIC pmc_parentinit,                                                                         &
     99
     100    IMPLICIT NONE
     101
     102    INTEGER ::  next_array_in_list = 0  !<
     103
     104    TYPE childindexdef
     105       INTEGER ::  nrpoints  !<
     106
     107       INTEGER, DIMENSION(:,:), ALLOCATABLE ::  index_list_2d  !<
     108    END TYPE childindexdef
     109
     110    TYPE(childdef), DIMENSION(pmc_max_models) ::  children  !<
     111
     112    TYPE(childindexdef), DIMENSION(pmc_max_models) ::  indchildren  !<
     113
     114    SAVE
     115
     116    PRIVATE
     117
     118!
     119!-- Public functions
     120    PUBLIC pmc_parent_for_child
     121
     122!
     123!-- Public variables, constants and types
     124    PUBLIC children,                                                                               &
     125           pmc_parentinit,                                                                         &
    154126           pmc_s_clear_next_array_list,                                                            &
    155127           pmc_s_fillbuffer,                                                                       &
    … …  
    162134           pmc_s_get_child_npes
    163135
     136    INTERFACE pmc_parentinit
     137       MODULE PROCEDURE  pmc_parentinit
     138    END INTERFACE pmc_parentinit
     139
     140    INTERFACE pmc_s_set_2d_index_list
     141       MODULE PROCEDURE pmc_s_set_2d_index_list
     142    END INTERFACE pmc_s_set_2d_index_list
     143
     144    INTERFACE pmc_s_clear_next_array_list
     145       MODULE PROCEDURE pmc_s_clear_next_array_list
     146    END INTERFACE pmc_s_clear_next_array_list
     147
     148    INTERFACE pmc_s_getnextarray
     149       MODULE PROCEDURE pmc_s_getnextarray
     150    END INTERFACE pmc_s_getnextarray
     151
     152    INTERFACE pmc_s_set_dataarray
     153       MODULE PROCEDURE pmc_s_set_dataarray_2d
     154       MODULE PROCEDURE pmc_s_set_dataarray_3d
     155       MODULE PROCEDURE pmc_s_set_dataarray_ip2d
     156    END INTERFACE pmc_s_set_dataarray
     157
     158    INTERFACE pmc_s_setind_and_allocmem
     159       MODULE PROCEDURE pmc_s_setind_and_allocmem
     160    END INTERFACE pmc_s_setind_and_allocmem
     161
     162    INTERFACE pmc_s_fillbuffer
     163       MODULE PROCEDURE pmc_s_fillbuffer
     164    END INTERFACE pmc_s_fillbuffer
     165
     166    INTERFACE pmc_s_getdata_from_buffer
     167       MODULE PROCEDURE pmc_s_getdata_from_buffer
     168    END INTERFACE pmc_s_getdata_from_buffer
     169
     170    INTERFACE pmc_s_set_active_data_array
     171       MODULE PROCEDURE pmc_s_set_active_data_array
     172    END INTERFACE pmc_s_set_active_data_array
     173
     174    INTERFACE pmc_s_get_child_npes
     175       MODULE PROCEDURE pmc_s_get_child_npes
     176    END INTERFACE pmc_s_get_child_npes
     177
     178
    164179 CONTAINS
    165180
    … …  
    168183! Description:
    169184! ------------
    170 !
    171185!> If this thread is intended as parent, initialize parent part of parent-client data transfer
    172186!--------------------------------------------------------------------------------------------------!
    173187 SUBROUTINE pmc_parentinit
    174 
    175     IMPLICIT NONE
    176188
    177189    INTEGER(iwp) ::  childid  !<
    … …  
    182194
    183195    DO  i = 1, SIZE( pmc_parent_for_child ) - 1
    184 
    185196       childid = pmc_parent_for_child( i )
    186197
    … …  
    194205       CALL MPI_COMM_REMOTE_SIZE( children(childid)%inter_comm, children(childid)%inter_npes,      &
    195206                                  istat )
     207
    196208!
    197209!--    Intra communicator is used for MPI_GET
    … …  
    201213
    202214       ALLOCATE( children(childid)%pes(children(childid)%inter_npes) )
     215
    203216!
    204217!--    Allocate array of TYPE arraydef for all child PEs to store information of the transfer array
    … …  
    208221
    209222       CALL get_da_names_from_child( childid )
    210 
    211223    ENDDO
    212224
    213225 END SUBROUTINE pmc_parentinit
    214226
    215 !--------------------------------------------------------------------------------------------------!
    216 ! Description:
    217 ! ------------
    218 !
     227
     228!--------------------------------------------------------------------------------------------------!
     229! Description:
     230! ------------
    219231!> thread 0 transfers the index list, which contains all parent grid cells involved in
    220232!> parent client data transfer to the thread, on which this grid cell is located
    … …  
    222234 SUBROUTINE pmc_s_set_2d_index_list( childid, index_list )
    223235
    224      IMPLICIT NONE
     236     INTEGER(iwp) ::  ian        !<
     237     INTEGER(iwp) ::  i          !<
     238     INTEGER(iwp) ::  ip         !<
     239     INTEGER(iwp) ::  istat      !<
     240     INTEGER(iwp) ::  max_cells  !<
    225241
    226242     INTEGER(iwp), INTENT(IN) ::  childid  !<
    227      INTEGER(iwp), DIMENSION(:,:), INTENT(INOUT) ::  index_list   !<
    228 
    229      INTEGER(iwp) ::  ian    !<
    230      INTEGER(iwp) ::  i      !<
    231      INTEGER(iwp) ::  ip     !<
    232      INTEGER(iwp) ::  istat  !<
    233      INTEGER(iwp) ::  max_cells  !<
    234 
    235      INTEGER(iwp), DIMENSION(:), ALLOCATABLE     ::  cells_on_pe  !<
    236      INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE   ::  lo_ind_list  !<
     243
     244     INTEGER(iwp), DIMENSION(:,:), INTENT(INOUT) ::  index_list  !<
     245
     246     INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  cells_on_pe  !<
     247
     248     INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE ::  lo_ind_list  !<
    237249
    238250
    … …  
    240252!
    241253!--     Compute maximum number of grid cells located on one parent thread
    242 
    243         ALLOCATE(cells_on_pe(0:m_model_npes-1))
     254        ALLOCATE( cells_on_pe(0:m_model_npes-1) )
    244255        cells_on_pe = 0
    245256
    246         DO i=1,SIZE( index_list, 2 )
     257        DO  i = 1, SIZE( index_list, 2 )
    247258           cells_on_pe(index_list(6,i )) = cells_on_pe(index_list(6,i ))+1
    248         END DO
    249 
    250         max_cells = MAXVAL(cells_on_pe)
     259        ENDDO
     260
     261        max_cells = MAXVAL( cells_on_pe )
     262
    251263!
    252264!--     Allocate temp array for thread dependent transfer of index_list
    253 
    254         ALLOCATE(lo_ind_list(SIZE(index_list,1),max_cells))
     265        ALLOCATE( lo_ind_list(SIZE( index_list,1 ),max_cells) )
    255266
    256267        DO  ip = 0, m_model_npes-1
    257268!
    258269!--        Split into parent processes
    259 
    260270           ian = 0
    261271
    262            DO i=1,SIZE( index_list, 2 )
    263               IF(index_list(6,i ) == ip )   THEN
     272           DO  i = 1, SIZE( index_list, 2 )
     273              IF ( index_list(6,i) == ip )  THEN
    264274                 ian = ian+1
    265275                 lo_ind_list(:,ian) = index_list(:,i)
    266               END IF
    267            END DO
     276              ENDIF
     277           ENDDO
     278
    268279!
    269280!--        Send data to other parent processes
    … …  
    274285!--           ian = 0, in order to avoid errors when array bounds are checked.
    275286              ALLOCATE( indchildren(childid)%index_list_2d(6,1:ian) )
    276               IF ( ian > 0)  THEN
     287              IF ( ian > 0 )  THEN
    277288                  indchildren(childid)%index_list_2d(:,1:ian) = lo_ind_list(:,1:ian)
    278289              ENDIF
    279290           ELSE
    280291              CALL MPI_SEND( ian, 1, MPI_INTEGER, ip, 1000, m_model_comm, istat )
    281               IF ( ian > 0)  THEN
     292              IF ( ian > 0 )  THEN
    282293                  CALL MPI_SEND( lo_ind_list, 6*ian, MPI_INTEGER, ip, 1001, m_model_comm, istat )
    283294              ENDIF
    … …  
    285296        ENDDO
    286297
    287         DEALLOCATE(lo_ind_list)
    288         DEALLOCATE(cells_on_pe)
     298        DEALLOCATE( lo_ind_list )
     299        DEALLOCATE( cells_on_pe )
    289300     ELSE
    290301        CALL MPI_RECV( indchildren(childid)%nrpoints, 1, MPI_INTEGER, 0, 1000, m_model_comm,       &
    … …  
    300311        ENDIF
    301312     ENDIF
     313
    302314     CALL set_pe_index_list( children(childid), indchildren(childid)%index_list_2d,                &
    303315                             indchildren(childid)%nrpoints )
    … …  
    309321! Description:
    310322! ------------
    311 !
    312323!> Before creating an array list with arrays schedule for parent client transfer
    313324!> make sure that the list is empty
    314325!--------------------------------------------------------------------------------------------------!
    315 
    316326 SUBROUTINE pmc_s_clear_next_array_list
    317327
    318 
    319     IMPLICIT NONE
    320 
    321328    next_array_in_list = 0
    322329
    … …  
    328335!
    329336!-- Althoug there are no linked lists any more in PMC, this call still looks like working with a list
    330 
    331337    CHARACTER(LEN=*), INTENT(OUT) ::  myname  !<
    332338
    … …  
    334340
    335341    TYPE(pedef),    POINTER ::  ape  !<
    336     TYPE(arraydef), POINTER ::  ar   !<
     342
     343    TYPE(arraydef), POINTER ::  ar  !<
     344
    337345
    338346    next_array_in_list = next_array_in_list + 1
     347
    339348!
    340349!-- Array names are the same on all children processes, so take first process to get the name
    … …  
    350359    ar => ape%array_list(next_array_in_list)
    351360    myname = ar%name
     361
    352362!
    353363!-- Return true if there is still an array in the list
    354 
    355364    pmc_s_getnextarray = .TRUE.
    356365
    … …  
    358367
    359368
    360 
    361 !--------------------------------------------------------------------------------------------------!
    362 ! Description:
    363 ! ------------
    364 !
     369!--------------------------------------------------------------------------------------------------!
     370! Description:
     371! ------------
    365372!> add 2D real array to list of arrays scheduled for parent-client transfer
    366373!--------------------------------------------------------------------------------------------------!
    367374 SUBROUTINE pmc_s_set_dataarray_2d( childid, array, array_2 )
    368375
    369     IMPLICIT NONE
    370 
    371376    INTEGER(iwp) ::  nrdims  !<
    372377
    373378    INTEGER(iwp), INTENT(IN) ::  childid  !<
    374379
    375     INTEGER(iwp), DIMENSION(4) :: dims  !<
     380    INTEGER(iwp), DIMENSION(4) ::  dims  !<
    376381
    377382    REAL(wp), INTENT(IN), DIMENSION(:,:), POINTER ::  array  !<
    … …  
    402407! Description:
    403408! ------------
    404 !
    405409!> add 2D integer array to list of arrays scheduled for parent-client transfer
    406410!--------------------------------------------------------------------------------------------------!
    407411 SUBROUTINE pmc_s_set_dataarray_ip2d( childid, array )
    408412
    409     IMPLICIT NONE
    410 
    411413    INTEGER(iwp) ::  nrdims  !<
    412414
    413     INTEGER(iwp),INTENT(IN) ::  childid  !<
     415    INTEGER(iwp), DIMENSION(4) ::  dims  !<
     416
     417    INTEGER(iwp), INTENT(IN) ::  childid  !<
    414418
    415419    INTEGER(idp), INTENT(IN), DIMENSION(:,:), POINTER ::  array  !<
    416 
    417     INTEGER(iwp), DIMENSION(4) ::  dims  !<
    418420
    419421    TYPE(C_PTR) ::  array_adr  !<
    … …  
    434436! Description:
    435437! ------------
    436 !
    437438!> add 3D real array to list of arrays scheduled for parent-client transfer
    438439!--------------------------------------------------------------------------------------------------!
    439440 SUBROUTINE pmc_s_set_dataarray_3d( childid, array, nz_cl, nz, array_2 )
    440 
    441     IMPLICIT NONE
    442441
    443442    INTEGER(iwp) ::  nrdims  !<
    … …  
    455454    TYPE(C_PTR) ::  array_adr   !<
    456455    TYPE(C_PTR) ::  second_adr  !<
     456
    457457
    458458    nrdims  = 3
    … …  
    479479! Description:
    480480! ------------
    481 !
    482 !> @Todo: Missing subroutine description.
     481!> Naming convention for appendices:   _pc  -> parent to child transfer
     482!>                                     _cp  -> child to parent transfer
     483!>                                     send -> parent to child transfer
     484!>                                     recv -> child to parent transfer
     485!>
     486!> @todo: Missing subroutine description.
    483487!--------------------------------------------------------------------------------------------------!
    484488 SUBROUTINE pmc_s_setind_and_allocmem( childid )
    … …  
    486490    USE control_parameters,                                                                        &
    487491        ONLY:  message_string
    488 
    489     IMPLICIT NONE
    490 
    491 !
    492 !-- Naming convention for appendices:   _pc  -> parent to child transfer
    493 !--                                     _cp  -> child to parent transfer
    494 !--                                     send -> parent to child transfer
    495 !--                                     recv -> child to parent transfer
    496492
    497493    INTEGER(iwp) ::  arlen         !<
    … …  
    502498    INTEGER(iwp) ::  myindex       !<
    503499    INTEGER(iwp) ::  total_npes    !< Total Number of PEs Parent and Child
    504 
    505500    INTEGER(idp) ::  bufsize       !< size of MPI data window
    506501
    … …  
    517512    TYPE(C_PTR) ::  base_ptr  !<
    518513
    519     TYPE(pedef),    POINTER ::  ape  !<
     514    TYPE(pedef), POINTER ::  ape  !<
     515
    520516    TYPE(arraydef), POINTER ::  ar   !<
    521517
    … …  
    526522    myindex = 1
    527523    bufsize = 8
     524
    528525!
    529526!-- All Child processes get the same number of arrays.
    … …  
    539536!-- First stride: compute size and set index
    540537    DO  i = 1, children(childid)%inter_npes
    541 
    542538       ape => children(childid)%pes(i)
    543 
    544539       DO  j = 1, ape%nr_arrays
    545 
    546540          ar  => ape%array_list(j)
    547541          IF ( ar%nrdims == 2 )  THEN
    … …  
    553547          ENDIF
    554548          ar%sendindex = myindex
     549
    555550!
    556551!--       Using intra communicator for MPU_Alltoall, the numbers of the child processes are after
    557552!--       the parent ones.
    558 
    559553          myindex_s(j,i-1+children(childid)%model_npes) = myindex
    560554
    … …  
    563557          ar%sendsize = arlen
    564558       ENDDO
    565 
    566     ENDDO
     559    ENDDO
     560
    567561!
    568562!-- Using MPI_Alltoall to send indices from  Parent to Child
    569563!-- The data comming back from the child processes are ignored.
    570 
    571564    CALL MPI_ALLTOALL( myindex_s, lo_nr_arrays, MPI_INTEGER, myindex_r, lo_nr_arrays, MPI_INTEGER, &
    572565                       children(childid)%intra_comm, ierr )
    … …  
    579572    CALL MPI_ALLTOALL( myindex_s, lo_nr_arrays, MPI_INTEGER, myindex_r, lo_nr_arrays, MPI_INTEGER, &
    580573                       children(childid)%intra_comm, ierr )
     574
    581575!
    582576!-- Create RMA (One Sided Communication) window for data buffer parent to child transfer.
    … …  
    592586    CALL MPI_WIN_CREATE( base_array_pc, winsize, wp, MPI_INFO_NULL, children(childid)%intra_comm,  &
    593587                         children(childid)%win_parent_child, ierr )
     588
    594589!
    595590!-- Open window to set data
    596591    CALL MPI_WIN_FENCE( 0, children(childid)%win_parent_child, ierr )
     592
    597593!
    598594!-- Second stride: set buffer pointer
    599595    DO  i = 1, children(childid)%inter_npes
    600 
    601596       ape => children(childid)%pes(i)
    602 
    603597       DO  j = 1, ape%nr_arrays
    604 
    605598          ar => ape%array_list(j)
    606599          ar%sendbuf = C_LOC( base_array_pc(ar%sendindex) )
    607 
    608600          IF ( ar%sendindex + ar%sendsize > bufsize )  THEN
    609601             WRITE( message_string, '(a,i4,4i7,1x,a)' ) 'parent buffer too small ',i ,             &
    … …  
    613605       ENDDO
    614606    ENDDO
     607
    615608!
    616609!-- Child to parent direction
    617610    bufsize = 8
     611
    618612!
    619613!-- First stride: compute size and set index
    … …  
    643637
    644638    CALL MPI_BARRIER( children(childid)%intra_comm, ierr )
     639
    645640!
    646641!-- Second stride: set buffer pointer
    … …  
    659654! Description:
    660655! ------------
    661 !
    662656!> Fill buffer in RMA window to enable the client to fetch the dat with MPI_Get
    663657!--------------------------------------------------------------------------------------------------!
    664658 SUBROUTINE pmc_s_fillbuffer( childid, waittime, particle_transfer )
    665 
    666     IMPLICIT NONE
    667659
    668660    INTEGER(iwp) ::  ierr     !<
    … …  
    687679    REAL(wp) ::  t2  !<
    688680
    689     REAL(wp), INTENT(OUT), OPTIONAL ::  waittime           !<
     681    REAL(wp), INTENT(OUT), OPTIONAL ::  waittime  !<
    690682
    691683    REAL(wp), POINTER, DIMENSION(:) ::  buf  !<
    … …  
    695687    REAL(wp), POINTER, DIMENSION(:,:,:) ::  data_3d  !<
    696688
    697     TYPE(pedef),    POINTER ::  ape  !<
     689    TYPE(pedef), POINTER ::  ape  !<
     690
    698691    TYPE(arraydef), POINTER ::  ar   !<
    699692
    … …  
    702695!-- without sychronization at this point and a barrier is not necessary.
    703696!-- Please note that waittime has to be set in pmc_s_fillbuffer AND pmc_c_getbuffer.
    704     IF ( PRESENT( waittime) )  THEN
     697    IF ( PRESENT( waittime ) )  THEN
    705698      t1 = pmc_time()
    706699      CALL MPI_BARRIER( children(childid)%intra_comm, ierr )
    … …  
    717710          ar => ape%array_list(j)
    718711          myindex = 1
    719 
    720712          IF ( ar%dimkey == 2 .AND. .NOT.lo_ptrans  )  THEN         ! PALM 2D REAL*8 Array
    721 
    722713             buf_shape(1) = ape%nrele
    723714             CALL C_F_POINTER( ar%sendbuf, buf, buf_shape )
    … …  
    727718                myindex = myindex + 1
    728719             ENDDO
    729 
    730720          ELSEIF ( ar%dimkey == 3  .AND. .NOT.lo_ptrans  )  THEN      ! PALM 3D REAL*8 Array
    731 
    732721             buf_shape(1) = ape%nrele*ar%a_dim(4)
    733722             CALL C_F_POINTER( ar%sendbuf, buf, buf_shape )
    … …  
    739728             ENDDO
    740729          ELSEIF ( ar%dimkey == 22 .AND. lo_ptrans  )  THEN  ! 2D INTEGER*8 Array for particle Transfer
    741 
    742730             buf_shape(1) = ape%nrele
    743731             CALL C_F_POINTER( ar%sendbuf, ibuf, buf_shape )
    … …  
    750738        ENDDO
    751739    ENDDO
     740
    752741!
    753742!-- Buffer is filled
    … …  
    757746
    758747
    759 
    760 !--------------------------------------------------------------------------------------------------!
    761 ! Description:
    762 ! ------------
    763 !
     748!--------------------------------------------------------------------------------------------------!
     749! Description:
     750! ------------
    764751!> Get client data from RMM window
    765752!--------------------------------------------------------------------------------------------------!
    766753 SUBROUTINE pmc_s_getdata_from_buffer( childid, waittime , particle_transfer, child_process_nr )
    767 
    768     IMPLICIT NONE
    769754
    770755    INTEGER(iwp) ::  ierr       !<
    … …  
    805790    REAL(wp), POINTER, DIMENSION(:,:,:) ::  data_3d  !<
    806791
    807     TYPE(pedef),   POINTER  ::  ape  !<
     792    TYPE(pedef), POINTER  ::  ape  !<
     793
    808794    TYPE(arraydef), POINTER ::  ar   !<
    809795
    … …  
    832818    ENDIF
    833819
    834     DO  ip = ip_start,ip_end
     820    DO  ip = ip_start, ip_end
    835821       ape => children(childid)%pes(ip)
    836822       DO  j = 1, ape%nr_arrays
    … …  
    848834             CYCLE            ! Particle arrays are not transfered here
    849835          ENDIF
     836
    850837          buf_shape(1) = nr
     838
    851839          IF(lo_ptrans)   THEN
    852840             CALL C_F_POINTER( ar%recvbuf, ibuf, buf_shape )
    … …  
    874862             CALL MPI_WIN_UNLOCK( target_pe, children(childid)%win_parent_child, ierr )
    875863          ENDIF
     864
    876865          myindex = 1
     866
    877867          IF ( ar%dimkey == 2  .AND.  .NOT. lo_ptrans )  THEN
    878 
    879868             CALL C_F_POINTER( ar%data, data_2d, ar%a_dim(1:2) )
    880869             DO  ij = 1, ape%nrele
    … …  
    882871                myindex = myindex + 1
    883872             ENDDO
    884 
    885873          ELSE IF ( ar%dimkey == 3  .AND.  .NOT. lo_ptrans )  THEN
    886 
    887874             CALL C_F_POINTER( ar%data, data_3d, ar%a_dim(1:3) )
    888875             DO  ij = 1, ape%nrele
    … …  
    891878                myindex = myindex + ar%a_dim(4)
    892879             ENDDO
    893 
    894880          ELSE IF ( ar%dimkey == 22 .AND. lo_ptrans)  THEN
    895 
    896881             CALL C_F_POINTER( ar%data, idata_2d, ar%a_dim(1:2) )
    897882             DO  ij = 1, ape%nrele
    … …  
    899884                myindex = myindex + 1
    900885             ENDDO
    901 
    902886          ENDIF
    903887       ENDDO
    … …  
    910894! Description:
    911895! ------------
    912 !
    913896!> broadcast name of transfer arrays from child thread 0 to parent threads
    914897!--------------------------------------------------------------------------------------------------!
    … …  
    917900!
    918901!-- Get data array description and name from child
    919     IMPLICIT NONE
    920 
    921902    INTEGER(iwp), INTENT(IN) ::  childid  !<
    922903
    923904    TYPE(da_namedef) ::  myname  !<
     905
    924906
    925907    DO
    … …  
    939921
    940922
    941 
    942 !--------------------------------------------------------------------------------------------------!
    943 ! Description:
    944 ! ------------
    945 !
    946 !> @Todo: Missing subroutine description.
     923!--------------------------------------------------------------------------------------------------!
     924! Description:
     925! ------------
     926!> @todo: Missing subroutine description.
    947927!--------------------------------------------------------------------------------------------------!
    948928 SUBROUTINE pmc_s_setarray( childid, nrdims, dims, array_adr, second_adr, dimkey )
    … …  
    950930!
    951931!-- Set array for child inter process 0
    952     IMPLICIT NONE
    953 
    954932    INTEGER(iwp) ::  i  !< local counter
    955933
    … …  
    965943    TYPE(C_PTR), INTENT(IN), OPTIONAL ::  second_adr  !<
    966944
    967     TYPE(pedef),    POINTER ::  ape  !<
     945    TYPE(pedef), POINTER ::  ape  !<
     946
    968947    TYPE(arraydef), POINTER ::  ar   !<
    969948
    … …  
    985964          ar%po_data(2) = C_NULL_PTR
    986965       ENDIF
    987 
    988966    ENDDO
    989967
    … …  
    991969
    992970
    993 
    994 !--------------------------------------------------------------------------------------------------!
    995 ! Description:
    996 ! ------------
    997 !
    998 !> @Todo: Missing subroutine description.
     971!--------------------------------------------------------------------------------------------------!
     972! Description:
     973! ------------
     974!> @todo: Missing subroutine description.
    999975!--------------------------------------------------------------------------------------------------!
    1000976 SUBROUTINE pmc_s_set_active_data_array( childid, iactive )
    1001 
    1002     IMPLICIT NONE
    1003977
    1004978    INTEGER(iwp) :: ip  !<
    … …  
    1008982    INTEGER(iwp), INTENT(IN) ::  iactive  !<
    1009983
    1010     TYPE(pedef),    POINTER ::  ape  !<
     984    TYPE(pedef), POINTER ::  ape  !<
     985
    1011986    TYPE(arraydef), POINTER ::  ar   !<
    1012987
    … …  
    1024999 END SUBROUTINE pmc_s_set_active_data_array
    10251000
     1001
     1002 !--------------------------------------------------------------------------------------------------!
     1003 ! Description:
     1004 ! ------------
     1005 !> @todo: Missing function description.
     1006 !--------------------------------------------------------------------------------------------------!
    10261007 INTEGER FUNCTION pmc_s_get_child_npes( child_id )
    1027    IMPLICIT NONE
    10281008
    10291009   INTEGER(iwp),INTENT(IN) ::  child_id  !<
    … …  
    10321012
    10331013   RETURN
     1014
    10341015 END FUNCTION pmc_s_get_child_npes
    10351016
    10361017
    1037 
    1038 !--------------------------------------------------------------------------------------------------!
    1039 ! Description:
    1040 ! ------------
    1041 !
    1042 !> @Todo: Missing subroutine description.
     1018!--------------------------------------------------------------------------------------------------!
     1019! Description:
     1020! ------------
     1021!> @todo: Missing subroutine description.
    10431022!--------------------------------------------------------------------------------------------------!
    10441023 SUBROUTINE set_pe_index_list( mychild, index_list, nrp )
    1045 
    1046     IMPLICIT NONE
    10471024
    10481025    INTEGER(iwp) :: i        !<
    … …  
    10701047    TYPE(pedef), POINTER ::  ape  !<
    10711048
     1049
    10721050!
    10731051!-- First, count entries for every remote child process
    … …  
    10761054       ape%nrele = 0
    10771055    ENDDO
     1056
    10781057!
    10791058!-- Loop over number of coarse grid cells
    … …  
    10901069
    10911070    remind = 0
     1071
    10921072!
    10931073!-- Second, create lists
    … …  
    11011081       ape%locind(ind)%j = index_list(2,j)
    11021082    ENDDO
     1083
    11031084!
    11041085!-- Prepare number of elements for children processes
    11051086    CALL pmc_alloc_mem( rldef, mychild%inter_npes * 2 )
     1087
    11061088!
    11071089!-- Number of child processes * size of INTEGER (i just arbitrary INTEGER)
    … …  
    11091091
    11101092    CALL MPI_WIN_CREATE( rldef, winsize, iwp, MPI_INFO_NULL, mychild%intra_comm, indwin, ierr )
     1093
    11111094!
    11121095!-- Open window to set data
    … …  
    11151098    rldef(1) = 0            ! Index on remote process 0
    11161099    rldef(2) = remind(1)    ! Number of elements on remote process 0
     1100
    11171101!
    11181102!-- Reserve buffer for index array
    … …  
    11221106       rldef(i2+1) = remind(i)                      ! Number of elements on remote process
    11231107    ENDDO
     1108
    11241109!
    11251110!-- Close window to allow child to access data
    11261111    CALL MPI_WIN_FENCE( 0, indwin, ierr )
     1112
    11271113!
    11281114!-- Child has retrieved data
    … …  
    11311117    i2 = 2 * mychild%inter_npes - 1
    11321118    winsize = ( rldef(i2) + rldef(i2+1) ) * 2
     1119
    11331120!
    11341121!-- Make sure, MPI_ALLOC_MEM works
    … …  
    11401127    CALL MPI_WIN_CREATE( remindw, winsize * STORAGE_SIZE( i ) / 8, iwp, MPI_INFO_NULL,             &
    11411128                         mychild%intra_comm, indwin2, ierr )
     1129
    11421130!
    11431131!-- Open window to set data
    11441132    CALL MPI_WIN_FENCE( 0, indwin2, ierr )
     1133
    11451134!
    11461135!-- Create the 2D index list
    … …  
    11541143       rldef(i2)      = rldef(i2)+2
    11551144    ENDDO
     1145
    11561146!
    11571147!-- All data are set
    11581148    CALL MPI_WIN_FENCE( 0, indwin2, ierr )
     1149
    11591150!
    11601151!-- Don't know why, but this barrier is necessary before windows can be freed
    … …  
    11671158!
    11681159!-- TODO: check if the following idea needs to be done
    1169 !-- Sollte funktionieren, Problem mit MPI implementation
     1160!-- Should work, Problem with MPI implementation
    11701161!-- https://www.lrz.de/services/software/parallel/mpi/onesided
    11711162!-- CALL MPI_Free_mem (remindw, ierr)
    11721163
    11731164 END SUBROUTINE set_pe_index_list
    1174 
    11751165#endif
     1166
     1167
    11761168 END MODULE pmc_parent
Note: See TracChangeset for help on using the changeset viewer.
                                                                                                                                                                                                                                                                                                                                                                               
  | Impressum | ©Leibniz Universität Hannover |