source: palm/trunk/SOURCE/pmc_handle_communicator_mod.f90

Last change on this file was 4883, checked in by hellstea, 7 months ago

user switch for particle coupling added

  • Property svn:keywords set to Id
File size: 21.8 KB
Line 
1!> @file pmc_handle_communicator_mod.f90
2!--------------------------------------------------------------------------------------------------!
3! This file is part of the PALM model system.
4!
5! PALM is free software: you can redistribute it and/or modify it under the terms of the GNU General
6! Public License as published by the Free Software Foundation, either version 3 of the License, or
7! (at your option) any later version.
8!
9! PALM is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the
10! implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General
11! Public License for more details.
12!
13! You should have received a copy of the GNU General Public License along with PALM. If not, see
14! <http://www.gnu.org/licenses/>.
15!
16! Copyright 1997-2021 Leibniz Universitaet Hannover
17!--------------------------------------------------------------------------------------------------!
18!
19!
20! Current revisions:
21! -----------------
22!
23!
24! Former revisions:
25! -----------------
26! $Id: pmc_handle_communicator_mod.f90 4883 2021-02-23 16:32:41Z banzhafs $
27! User switch for particle coupling added
28!
29! 4843 2021-01-15 15:22:11Z raasch
30! local namelist parameter added to switch off the module although the respective module namelist
31! appears in the namelist file
32!
33! 4828 2021-01-05 11:21:41Z Giersch
34! Canopy-restricted anterpolation introduced. New namelist parameter anterpolation_starting_height
35! introduced for controlling canopy-restricted anterpolation.
36!
37! 4650 2020-08-25 14:35:50Z raasch
38! bugfix for r4649
39!
40! 4649 2020-08-25 12:11:17Z raasch
41! File re-formatted to follow the PALM coding standard
42!
43!
44! 4629 2020-07-29 09:37:56Z raasch
45! Support for MPI Fortran77 interface (mpif.h) removed
46!
47! 4360 2020-01-07 11:25:50Z suehring
48! Corrected "Former revisions" section
49!
50! 3888 2019-04-12 09:18:10Z hellstea
51! Missing MPI_BCAST of anterpolation_buffer_width added.
52!
53! 3885 2019-04-11 11:29:34Z kanani
54! Changes related to global restructuring of location messages and introduction of additional debug
55! messages
56!
57! 3819 2019-03-27 11:01:36Z hellstea
58! Adjustable anterpolation buffer introduced on all nest boundaries, it is controlled by the new
59! nesting_parameters parameter anterpolation_buffer_width.
60!
61! 3655 2019-01-07 16:51:22Z knoop
62! nestpar renamed to nesting_parameters
63!
64! 1762 2016-02-25 12:31:13Z hellstea
65! Initial revision by K. Ketelsen
66!
67! Description:
68! ------------
69! Handle MPI communicator in PALM model coupler
70!--------------------------------------------------------------------------------------------------!
71 MODULE PMC_handle_communicator
72#if defined( __parallel )
73    USE kinds
74
75    USE MPI
76
77    USE pmc_general,                                                                               &
78        ONLY: pmc_max_models,                                                                      &
79              pmc_status_error,                                                                    &
80              pmc_status_ok
81
82
83    USE control_parameters,                                                                        &
84        ONLY: message_string
85
86    IMPLICIT NONE
87
88!
89!-- ATTENTION: Do not change the order of variable declarations in the following TYPE definition,
90!-- because the order must follow the order in which the layout data is given in the NAMELIST file.
91    TYPE pmc_layout
92
93       CHARACTER(LEN=32) ::  name  !<
94
95       INTEGER ::  id            !<
96       INTEGER ::  parent_id     !<
97       INTEGER ::  npe_total     !<
98
99       REAL(wp) ::  lower_left_x  !<
100       REAL(wp) ::  lower_left_y  !<
101
102    END TYPE pmc_layout
103
104    PUBLIC  pmc_status_ok, pmc_status_error  !<
105
106    INTEGER, PARAMETER, PUBLIC ::  pmc_error_npes        = 1  !< illegal number of processes
107    INTEGER, PARAMETER, PUBLIC ::  pmc_namelist_error    = 2  !< error(s) in nesting_parameters namelist
108    INTEGER, PARAMETER, PUBLIC ::  pmc_no_namelist_found = 3  !< no couple layout namelist found
109
110    INTEGER ::  m_my_cpl_id   !< coupler id of this model
111    INTEGER ::  m_ncpl        !< number of couplers given in nesting_parameters namelist
112    INTEGER ::  m_parent_id   !< coupler id of parent of this model
113    INTEGER ::  m_world_comm  !< global nesting communicator
114
115    TYPE(pmc_layout), PUBLIC, DIMENSION(pmc_max_models) ::  m_couplers  !< information of all couplers
116
117    INTEGER, PUBLIC ::  m_model_comm          !< communicator of this model
118    INTEGER, PUBLIC ::  m_model_npes          !<
119    INTEGER, PUBLIC ::  m_model_rank          !<
120    INTEGER, PUBLIC ::  m_to_parent_comm      !< communicator to the parent
121    INTEGER, PUBLIC ::  m_world_rank          !<
122    INTEGER         ::  m_parent_remote_size  !< number of processes in the parent model
123    INTEGER         ::  m_world_npes          !<
124    INTEGER         ::  peer_comm             !< peer_communicator for inter communicators
125
126    INTEGER, DIMENSION(pmc_max_models), PUBLIC ::  m_to_child_comm   !< communicator to the child(ren)
127    INTEGER, DIMENSION(:), POINTER, PUBLIC ::  pmc_parent_for_child  !<
128
129
130    INTERFACE pmc_get_model_info
131       MODULE PROCEDURE pmc_get_model_info
132    END INTERFACE pmc_get_model_info
133
134    INTERFACE pmc_is_rootmodel
135       MODULE PROCEDURE pmc_is_rootmodel
136    END INTERFACE pmc_is_rootmodel
137
138    PUBLIC pmc_get_model_info, pmc_init_model, pmc_is_rootmodel   !<
139
140
141
142 CONTAINS
143
144
145!--------------------------------------------------------------------------------------------------!
146! Description:
147! ------------
148!> @Todo: Missing subroutine description.
149!--------------------------------------------------------------------------------------------------!
150 SUBROUTINE pmc_init_model( comm, nesting_datatransfer_mode, nesting_mode,                         &
151                            anterpolation_buffer_width, anterpolation_starting_height,             &
152                            particle_coupling, pmc_status )
153
154    USE control_parameters,                                                                        &
155        ONLY:  message_string
156
157    USE pegrid,                                                                                    &
158        ONLY:  myid
159
160    IMPLICIT NONE
161
162    CHARACTER(LEN=7), INTENT(INOUT) ::  nesting_datatransfer_mode  !<
163    CHARACTER(LEN=8), INTENT(INOUT) ::  nesting_mode               !<
164
165    INTEGER, INTENT(INOUT) ::  anterpolation_buffer_width  !< Boundary buffer width for anterpolation
166    INTEGER, INTENT(INOUT) ::  comm                        !<
167    INTEGER, INTENT(INOUT) ::  pmc_status                  !<
168
169    REAL(wp), INTENT(INOUT) ::  anterpolation_starting_height  !< steering parameter for canopy restricted anterpolation
170    LOGICAL, INTENT(INOUT)  ::  particle_coupling              !< switch for particle coupling (default .TRUE.)
171   
172    INTEGER ::  childcount     !<
173    INTEGER ::  i              !<
174    INTEGER ::  ierr           !<
175    INTEGER ::  istat          !<
176    INTEGER ::  m_my_cpl_rank  !<
177    INTEGER ::  tag            !<
178
179    INTEGER, DIMENSION(pmc_max_models)   ::  activeparent  !< I am active parent for this child ID
180    INTEGER, DIMENSION(pmc_max_models+1) ::  start_pe      !<
181
182    pmc_status   = pmc_status_ok
183    comm         = -1
184    m_world_comm = MPI_COMM_WORLD
185    m_my_cpl_id  = -1
186    childcount   =  0
187    activeparent = -1
188    start_pe(:)  =  0
189
190    CALL MPI_COMM_RANK( MPI_COMM_WORLD, m_world_rank, istat )
191    CALL MPI_COMM_SIZE( MPI_COMM_WORLD, m_world_npes, istat )
192!
193!-- Only process 0 of root model reads
194    IF ( m_world_rank == 0 )  THEN
195
196       CALL read_coupling_layout( nesting_datatransfer_mode, nesting_mode,                         &
197            anterpolation_buffer_width, anterpolation_starting_height, particle_coupling,          &
198            pmc_status )
199
200       IF ( pmc_status /= pmc_no_namelist_found  .AND.                                             &
201            pmc_status /= pmc_namelist_error )                                                     &
202       THEN
203!
204!--       Calculate start PE of every model
205          start_pe(1) = 0
206          DO  i = 2, m_ncpl+1
207             start_pe(i) = start_pe(i-1) + m_couplers(i-1)%npe_total
208          ENDDO
209
210!
211!--       The sum of numbers of processes requested by all the domains must be equal to the total
212!--       number of processes of the run
213          IF ( start_pe(m_ncpl+1) /= m_world_npes )  THEN
214             WRITE( message_string, '(2A,I6,2A,I6,A)' )                                            &
215                                                'nesting-setup requires different number of ',     &
216                                                'MPI procs (', start_pe(m_ncpl+1), ') than ',      &
217                                                'provided (', m_world_npes,')'
218             CALL message( 'pmc_init_model', 'PA0229', 3, 2, 0, 6, 0 )
219          ENDIF
220
221       ENDIF
222
223    ENDIF
224!
225!-- Broadcast the read status. This synchronises all other processes with process 0 of the root
226!-- model. Without synchronisation, they would not behave in the correct way (e.g. they would not
227!-- return in case of a missing NAMELIST).
228    CALL MPI_BCAST( pmc_status, 1, MPI_INTEGER, 0, MPI_COMM_WORLD, istat )
229
230    IF ( pmc_status == pmc_no_namelist_found )  THEN
231!
232!--    Not a nested run; return the MPI_WORLD communicator
233       comm = MPI_COMM_WORLD
234       RETURN
235
236    ELSEIF ( pmc_status == pmc_namelist_error )  THEN
237!
238!--    Only the root model gives the error message. Others are aborted by the message-routine with
239!--    MPI_ABORT. Must be done this way since myid and comm2d have not yet been assigned at this
240!--    point.
241       IF ( m_world_rank == 0 )  THEN
242          message_string = 'errors in \$nesting_parameters'
243          CALL message( 'pmc_init_model', 'PA0223', 3, 2, 0, 6, 0 )
244       ENDIF
245
246    ENDIF
247
248    CALL MPI_BCAST( m_ncpl,          1, MPI_INTEGER, 0, MPI_COMM_WORLD, istat )
249    CALL MPI_BCAST( start_pe, m_ncpl+1, MPI_INTEGER, 0, MPI_COMM_WORLD, istat )
250!
251!-- Broadcast coupling layout
252    DO  i = 1, m_ncpl
253       CALL MPI_BCAST( m_couplers(i)%name, LEN( m_couplers(i)%name ),                              &
254                       MPI_CHARACTER, 0, MPI_COMM_WORLD, istat )
255       CALL MPI_BCAST( m_couplers(i)%id,           1, MPI_INTEGER, 0,                              &
256                       MPI_COMM_WORLD, istat )
257       CALL MPI_BCAST( m_couplers(i)%Parent_id,    1, MPI_INTEGER, 0,                              &
258                       MPI_COMM_WORLD, istat )
259       CALL MPI_BCAST( m_couplers(i)%npe_total,    1, MPI_INTEGER, 0,                              &
260                       MPI_COMM_WORLD, istat )
261       CALL MPI_BCAST( m_couplers(i)%lower_left_x, 1, MPI_REAL,    0,                              &
262                       MPI_COMM_WORLD, istat )
263       CALL MPI_BCAST( m_couplers(i)%lower_left_y, 1, MPI_REAL,    0,                              &
264                       MPI_COMM_WORLD, istat )
265    ENDDO
266    CALL MPI_BCAST( nesting_mode, LEN( nesting_mode ), MPI_CHARACTER, 0, MPI_COMM_WORLD, istat )
267    CALL MPI_BCAST( nesting_datatransfer_mode, LEN(nesting_datatransfer_mode), MPI_CHARACTER, 0,   &
268                    MPI_COMM_WORLD, istat )
269    CALL MPI_BCAST( anterpolation_buffer_width, 1, MPI_INT, 0, MPI_COMM_WORLD, istat )
270    CALL MPI_BCAST( anterpolation_starting_height, 1, MPI_REAL, 0, MPI_COMM_WORLD, istat )
271    CALL MPI_BCAST( particle_coupling, 1, MPI_LOGICAL, 0, MPI_COMM_WORLD, istat )
272!
273!-- Assign global MPI processes to individual models by setting the couple id
274    DO  i = 1, m_ncpl
275       IF ( m_world_rank >= start_pe(i)  .AND.  m_world_rank < start_pe(i+1) )  THEN
276          m_my_cpl_id = i
277          EXIT
278       ENDIF
279    ENDDO
280    m_my_cpl_rank = m_world_rank - start_pe(i)
281!
282!-- MPI_COMM_WORLD is the communicator for ALL models (MPI-1 approach). The communictors for the
283!-- individual models as created by MPI_COMM_SPLIT. The color of the model is represented by the
284!-- coupler id
285    CALL MPI_COMM_SPLIT( MPI_COMM_WORLD, m_my_cpl_id, m_my_cpl_rank, comm, istat )
286!
287!-- Get size and rank of the model running on this process
288    CALL  MPI_COMM_RANK( comm, m_model_rank, istat )
289    CALL  MPI_COMM_SIZE( comm, m_model_npes, istat )
290!
291!-- Broadcast (from process 0) the parent id and id of every model
292    DO  i = 1, m_ncpl
293       CALL MPI_BCAST( m_couplers(i)%parent_id, 1, MPI_INTEGER, 0, MPI_COMM_WORLD, istat )
294       CALL MPI_BCAST( m_couplers(i)%id,        1, MPI_INTEGER, 0, MPI_COMM_WORLD, istat )
295    ENDDO
296!
297!-- Save the current model communicator for pmc internal use
298    m_model_comm = comm
299
300!
301!-- Create intercommunicator between the parent and children.
302!-- MPI_INTERCOMM_CREATE creates an intercommunicator between 2 groups of different colors. The
303!-- grouping was done above with MPI_COMM_SPLIT. A duplicate of MPI_COMM_WORLD is created and used
304!-- as peer communicator (peer_comm) for MPI_INTERCOMM_CREATE.
305    CALL MPI_COMM_DUP( MPI_COMM_WORLD, peer_comm, ierr )
306    DO  i = 2, m_ncpl
307       IF ( m_couplers(i)%parent_id == m_my_cpl_id )  THEN
308!
309!--       Identify all children models of the current model and create inter-communicators to
310!--       connect between the current model and its children models.
311          tag = 500 + i
312          CALL MPI_INTERCOMM_CREATE( comm, 0, peer_comm, start_pe(i), tag, m_to_child_comm(i),     &
313                                     istat )
314          childcount = childcount + 1
315          activeparent(i) = 1
316       ELSEIF ( i == m_my_cpl_id)  THEN
317!
318!--       Create an inter-communicator to connect between the current model and its parent model.
319          tag = 500 + i
320          CALL MPI_INTERCOMM_CREATE( comm, 0, peer_comm, start_pe(m_couplers(i)%parent_id), tag,   &
321                                     m_to_parent_comm, istat )
322       ENDIF
323    ENDDO
324!
325!-- If I am a parent, count the number of children I have. Although this loop is symmetric on all
326!-- processes, the "activeparent" flag is true (==1) on the respective individual process only.
327    ALLOCATE( pmc_parent_for_child(childcount+1) )
328
329    childcount = 0
330    DO  i = 2, m_ncpl
331       IF ( activeparent(i) == 1 )  THEN
332          childcount = childcount + 1
333          pmc_parent_for_child(childcount) = i
334       ENDIF
335    ENDDO
336!
337!-- Get the size of the parent model
338    IF ( m_my_cpl_id > 1 )  THEN
339       CALL MPI_COMM_REMOTE_SIZE( m_to_parent_comm, m_parent_remote_size, istat )
340    ELSE
341!
342!--    The root model does not have a parent
343       m_parent_remote_size = -1
344    ENDIF
345!
346!-- Set myid to non-zero value except for the root domain. This is a setting for the message routine
347!-- which is called at the end of pmci_init. That routine outputs messages for myid = 0, only.
348!-- However, myid has not been assigened so far, so that all processes of the root model would
349!-- output a message. To avoid this, set myid to some other value except for process 0 of the root
350!-- domain.
351    IF ( m_world_rank /= 0 )  myid = 1
352
353 END SUBROUTINE PMC_init_model
354
355
356!--------------------------------------------------------------------------------------------------!
357! Description:
358! ------------
359!> @Todo: Missing subroutine description.
360!--------------------------------------------------------------------------------------------------!
361 SUBROUTINE pmc_get_model_info( comm_world_nesting, cpl_id, cpl_name, cpl_parent_id, lower_left_x, &
362                                lower_left_y, ncpl, npe_total, request_for_cpl_id )
363!
364!-- Provide module private variables of the pmc for PALM
365
366    USE kinds
367
368    IMPLICIT NONE
369
370    CHARACTER(LEN=*), INTENT(OUT), OPTIONAL ::  cpl_name   !<
371
372    INTEGER, INTENT(IN), OPTIONAL ::  request_for_cpl_id   !<
373
374    INTEGER, INTENT(OUT), OPTIONAL ::  comm_world_nesting  !<
375    INTEGER, INTENT(OUT), OPTIONAL ::  cpl_id              !<
376    INTEGER, INTENT(OUT), OPTIONAL ::  cpl_parent_id       !<
377    INTEGER, INTENT(OUT), OPTIONAL ::  ncpl                !<
378    INTEGER, INTENT(OUT), OPTIONAL ::  npe_total           !<
379
380    INTEGER ::  requested_cpl_id                           !<
381
382    REAL(wp), INTENT(OUT), OPTIONAL ::  lower_left_x       !<
383    REAL(wp), INTENT(OUT), OPTIONAL ::  lower_left_y       !<
384
385!
386!-- Set the requested coupler id
387    IF ( PRESENT( request_for_cpl_id ) )  THEN
388       requested_cpl_id = request_for_cpl_id
389!
390!--    Check for allowed range of values
391       IF ( requested_cpl_id < 1  .OR.  requested_cpl_id > m_ncpl )  RETURN
392    ELSE
393       requested_cpl_id = m_my_cpl_id
394    ENDIF
395!
396!-- Return the requested information
397    IF ( PRESENT( comm_world_nesting )  )  THEN
398       comm_world_nesting = m_world_comm
399    ENDIF
400    IF ( PRESENT( cpl_id )        )  THEN
401       cpl_id = requested_cpl_id
402    ENDIF
403    IF ( PRESENT( cpl_parent_id ) )  THEN
404       cpl_parent_id = m_couplers(requested_cpl_id)%parent_id
405    ENDIF
406    IF ( PRESENT( cpl_name )      )  THEN
407       cpl_name = m_couplers(requested_cpl_id)%name
408    ENDIF
409    IF ( PRESENT( ncpl )          )  THEN
410       ncpl = m_ncpl
411    ENDIF
412    IF ( PRESENT( npe_total )     )  THEN
413       npe_total = m_couplers(requested_cpl_id)%npe_total
414    ENDIF
415    IF ( PRESENT( lower_left_x )  )  THEN
416       lower_left_x = m_couplers(requested_cpl_id)%lower_left_x
417    ENDIF
418    IF ( PRESENT( lower_left_y )  )  THEN
419       lower_left_y = m_couplers(requested_cpl_id)%lower_left_y
420    ENDIF
421
422 END SUBROUTINE pmc_get_model_info
423
424
425
426 LOGICAL function pmc_is_rootmodel( )
427
428    IMPLICIT NONE
429
430    pmc_is_rootmodel = ( m_my_cpl_id == 1 )
431
432 END FUNCTION pmc_is_rootmodel
433
434
435
436!--------------------------------------------------------------------------------------------------!
437! Description:
438! ------------
439!> @Todo: Missing subroutine description.
440!--------------------------------------------------------------------------------------------------!
441 SUBROUTINE read_coupling_layout( nesting_datatransfer_mode, nesting_mode,                         &
442                                  anterpolation_buffer_width, anterpolation_starting_height,       &
443                                  particle_coupling, pmc_status )
444
445    IMPLICIT NONE
446
447    CHARACTER(LEN=7), INTENT(INOUT) ::  nesting_datatransfer_mode  !<
448    CHARACTER(LEN=8), INTENT(INOUT) ::  nesting_mode               !<
449
450    INTEGER, INTENT(INOUT)      ::  anterpolation_buffer_width  !< Boundary buffer width for anterpolation
451    INTEGER(iwp), INTENT(INOUT) ::  pmc_status                  !<
452
453    REAL(wp), INTENT(INOUT) ::  anterpolation_starting_height   !< steering parameter for canopy restricted anterpolation
454    LOGICAL, INTENT(INOUT)  ::  particle_coupling               !< switch for particle coupling (default .TRUE.)
455
456    INTEGER(iwp) ::  bad_llcorner  !<
457    INTEGER(iwp) ::  i             !<
458    INTEGER(iwp) ::  io_status     !<
459
460    LOGICAL ::  switch_off_module = .FALSE.  !< local namelist parameter to switch off the module
461                                             !< although the respective module namelist appears in
462                                             !< the namelist file
463
464    TYPE(pmc_layout), DIMENSION(pmc_max_models) ::  domain_layouts  !<
465
466    NAMELIST /nesting_parameters/  anterpolation_buffer_width,                                     &
467                                   anterpolation_starting_height,                                  &
468                                   domain_layouts,                                                 &
469                                   nesting_datatransfer_mode,                                      &
470                                   nesting_mode,                                                   &
471                                   switch_off_module,                                              &
472                                   particle_coupling
473
474
475!
476!-- Initialize some coupling variables
477    domain_layouts(1:pmc_max_models)%id = -1
478    m_ncpl =   0
479
480    pmc_status = pmc_no_namelist_found
481!
482!-- Open the NAMELIST-file and read the nesting layout
483    CALL check_open( 11 )
484    READ ( 11, nesting_parameters, IOSTAT = io_status )
485!
486!-- Set filepointer to the beginning of the file. Otherwise process 0 will later be unable to read
487!-- the inipar-NAMELIST
488    REWIND ( 11 )
489
490    IF ( io_status == 0 )  THEN
491!
492!--    nesting_parameters namelist was found and read correctly. Enable the nesting by setting
493!--    the palm model coupler status respectively.
494       IF ( .NOT. switch_off_module )  THEN
495          pmc_status = pmc_status_ok
496       ELSE
497          RETURN
498       ENDIF
499    ELSEIF ( io_status < 0 )  THEN
500!
501!--    No nesting_parameters-NAMELIST found
502       RETURN
503    ELSEIF ( io_status > 0 )  THEN
504!
505!--    Errors in reading nesting_parameters-NAMELIST
506       pmc_status = pmc_namelist_error
507       RETURN
508    ENDIF
509
510!
511!-- Output location message
512    CALL location_message( 'initialize communicators for nesting', 'start' )
513!
514!-- Assign the layout to the corresponding internally used variable m_couplers
515    m_couplers = domain_layouts
516!
517!-- Get the number of nested models given in the nesting_parameters-NAMELIST
518    DO  i = 1, pmc_max_models
519!
520!--    When id=-1 is found for the first time, the list of domains is finished
521       IF ( m_couplers(i)%id == -1  .OR.  i == pmc_max_models )  THEN
522          IF ( m_couplers(i)%id == -1 )  THEN
523             m_ncpl = i - 1
524             EXIT
525          ELSE
526             m_ncpl = pmc_max_models
527          ENDIF
528       ENDIF
529    ENDDO
530!
531!-- Make sure that all domains have equal lower left corner in case of vertical nesting
532    IF ( nesting_mode == 'vertical' )  THEN
533       bad_llcorner = 0
534       DO  i = 1, m_ncpl
535          IF ( domain_layouts(i)%lower_left_x /= 0.0_wp .OR.                                       &
536               domain_layouts(i)%lower_left_y /= 0.0_wp )  THEN
537             bad_llcorner = bad_llcorner + 1
538             domain_layouts(i)%lower_left_x = 0.0_wp
539             domain_layouts(i)%lower_left_y = 0.0_wp
540          ENDIF
541       ENDDO
542       IF ( bad_llcorner /= 0)  THEN
543          WRITE( message_string, *)  'at least one dimension of lower ',                           &
544                                     'left corner of one domain is not 0. ',                       &
545                                     'All lower left corners were set to (0, 0)'
546          CALL message( 'read_coupling_layout', 'PA0427', 0, 0, 0, 6, 0 )
547       ENDIF
548    ENDIF
549
550    CALL location_message( 'initialize communicators for nesting', 'finished' )
551
552 END SUBROUTINE read_coupling_layout
553
554#endif
555 END MODULE pmc_handle_communicator
Note: See TracBrowser for help on using the repository browser.