Index: palm/trunk/SOURCE/pmc_handle_communicator.f90
===================================================================
--- palm/trunk/SOURCE/pmc_handle_communicator.f90	(revision 1787)
+++ palm/trunk/SOURCE/pmc_handle_communicator.f90	(revision 1791)
@@ -20,5 +20,8 @@
 ! Current revisions:
 ! ------------------
-!
+! m_nrofcpl renamed m_ncpl,
+! pmc_get_local_model_info renamed pmc_get_model_info, some keywords also
+! renamed and some added,
+! debug write-statements commented out
 !
 ! Former revisions:
@@ -86,6 +89,7 @@
    INTEGER                                    :: m_my_CPL_id  !Coupler id of this model
    INTEGER                                    :: m_Parent_id  !Coupler id of parent of this model
-   INTEGER                                    :: m_NrOfCpl    !Number of Coupler in layout file
-   TYPE(PMC_layout),DIMENSION(PMC_MAX_MODELL) :: m_couplers   !Information of all coupler
+   INTEGER                                    :: m_ncpl       !Number of Couplers in layout file
+
+   TYPE(PMC_layout),DIMENSION(PMC_MAX_MODELL) :: m_couplers   !Information of all couplers
 
    ! MPI settings
@@ -110,9 +114,9 @@
    END INTERFACE pmc_is_rootmodel
 
-   INTERFACE PMC_get_local_model_info
-      MODULE PROCEDURE PMC_get_local_model_info
-   END INTERFACE PMC_get_local_model_info
-
-   PUBLIC pmc_get_local_model_info, pmc_init_model, pmc_is_rootmodel
+   INTERFACE pmc_get_model_info
+      MODULE PROCEDURE pmc_get_model_info
+   END INTERFACE pmc_get_model_info
+
+   PUBLIC pmc_get_model_info, pmc_init_model, pmc_is_rootmodel
 
  CONTAINS
@@ -160,5 +164,5 @@
 !--         Calculate start PE of every model
             start_pe(1) = 0
-            DO  i = 2, m_nrofcpl+1
+            DO  i = 2, m_ncpl+1
                start_pe(i) = start_pe(i-1) + m_couplers(i-1)%npe_total
             ENDDO
@@ -167,8 +171,8 @@
 !--         The number of cores provided with the run must be the same as the
 !--         total sum of cores required by all nest domains
-            IF ( start_pe(m_nrofcpl+1) /= m_world_npes )  THEN
+            IF ( start_pe(m_ncpl+1) /= m_world_npes )  THEN
                WRITE ( message_string, '(A,I6,A,I6,A)' )                       &
                                'nesting-setup requires more MPI procs (',      &
-                               start_pe(m_nrofcpl+1), ') than provided (',     &
+                               start_pe(m_ncpl+1), ') than provided (',        &
                                m_world_npes,')'
                CALL message( 'pmc_init_model', 'PA0229', 3, 2, 0, 6, 0 )
@@ -202,10 +206,10 @@
       ENDIF
 
-      CALL MPI_BCAST( m_nrofcpl, 1,          MPI_INTEGER, 0, MPI_COMM_WORLD, istat)
-      CALL MPI_BCAST( start_pe, m_nrofcpl+1, MPI_INTEGER, 0, MPI_COMM_WORLD, istat)
+      CALL MPI_BCAST( m_ncpl,          1, MPI_INTEGER, 0, MPI_COMM_WORLD, istat)
+      CALL MPI_BCAST( start_pe, m_ncpl+1, MPI_INTEGER, 0, MPI_COMM_WORLD, istat)
 
 !
 !--   Broadcast coupling layout
-      DO  i = 1, m_nrofcpl
+      DO  i = 1, m_ncpl
          CALL MPI_BCAST( m_couplers(i)%name, LEN( m_couplers(i)%name ), MPI_CHARACTER, 0, MPI_COMM_WORLD, istat )
          CALL MPI_BCAST( m_couplers(i)%id,           1, MPI_INTEGER, 0, MPI_COMM_WORLD, istat )
@@ -219,5 +223,5 @@
 !
 !--   Assign global MPI processes to individual models by setting the couple id
-      DO  i = 1, m_nrofcpl
+      DO  i = 1, m_ncpl
          IF ( m_world_rank >= start_pe(i)  .AND.  m_world_rank < start_pe(i+1) ) &
          THEN
@@ -241,5 +245,5 @@
 !
 !--   Broadcast (from PE 0) the parent id and id of every model
-      DO  i = 1, m_nrofcpl
+      DO  i = 1, m_ncpl
          CALL MPI_BCAST( m_couplers(i)%parent_id, 1, MPI_INTEGER, 0,           &
                          MPI_COMM_WORLD, istat )
@@ -257,5 +261,5 @@
 !--   different colors.
 !--   The grouping was done above with MPI_COMM_SPLIT
-      DO  i = 2, m_nrofcpl
+      DO  i = 2, m_ncpl
 
          IF ( m_couplers(i)%parent_id == m_my_cpl_id )  THEN
@@ -292,5 +296,5 @@
 
       clientcount = 0
-      DO  i = 2, m_nrofcpl
+      DO  i = 2, m_ncpl
          IF ( activeserver(i) == 1 )  THEN
             clientcount = clientcount + 1
@@ -321,7 +325,8 @@
 
 !
-!-- Make module private variables available to palm
-   SUBROUTINE pmc_get_local_model_info( my_cpl_id, my_cpl_parent_id, cpl_name, &
-                                        npe_total, lower_left_x, lower_left_y )
+!-- Provide module private variables of the pmc for PALM
+    SUBROUTINE pmc_get_model_info( cpl_id, cpl_name, cpl_parent_id,            &
+                                   lower_left_x, lower_left_y, ncpl, npe_total,&
+                                   request_for_cpl_id )
 
       USE kinds
@@ -330,18 +335,53 @@
 
       CHARACTER(LEN=*), INTENT(OUT), OPTIONAL ::  cpl_name
-      INTEGER, INTENT(OUT), OPTIONAL          ::  my_cpl_id
-      INTEGER, INTENT(OUT), OPTIONAL          ::  my_cpl_parent_id
-      INTEGER, INTENT(OUT), OPTIONAL          ::  npe_total
-      REAL(wp), INTENT(OUT), OPTIONAL         ::  lower_left_x
-      REAL(wp), INTENT(OUT), OPTIONAL         ::  lower_left_y
-
-      IF ( PRESENT( my_cpl_id )           )  my_cpl_id        = m_my_cpl_id
-      IF ( PRESENT( my_cpl_parent_id )    )  my_cpl_parent_id = m_couplers(my_cpl_id)%parent_id
-      IF ( PRESENT( cpl_name )            )  cpl_name         = m_couplers(my_cpl_id)%name
-      IF ( PRESENT( npe_total )           )  npe_total        = m_couplers(my_cpl_id)%npe_total
-      IF ( PRESENT( lower_left_x )        )  lower_left_x     = m_couplers(my_cpl_id)%lower_left_x
-      IF ( PRESENT( lower_left_y )        )  lower_left_y     = m_couplers(my_cpl_id)%lower_left_y
-
-   END SUBROUTINE pmc_get_local_model_info
+
+      INTEGER, INTENT(IN), OPTIONAL ::  request_for_cpl_id
+
+      INTEGER, INTENT(OUT), OPTIONAL ::  cpl_id
+      INTEGER, INTENT(OUT), OPTIONAL ::  cpl_parent_id
+      INTEGER, INTENT(OUT), OPTIONAL ::  ncpl
+      INTEGER, INTENT(OUT), OPTIONAL ::  npe_total
+
+      INTEGER ::  requested_cpl_id
+
+      REAL(wp), INTENT(OUT), OPTIONAL ::  lower_left_x
+      REAL(wp), INTENT(OUT), OPTIONAL ::  lower_left_y
+
+!
+!--   Set the requested coupler id
+      IF ( PRESENT( request_for_cpl_id ) )  THEN
+         requested_cpl_id = request_for_cpl_id
+!
+!--      Check for allowed range of values
+         IF ( requested_cpl_id < 1 .OR. requested_cpl_id > m_ncpl )  RETURN
+      ELSE
+         requested_cpl_id = m_my_cpl_id
+      ENDIF
+
+!
+!--   Return the requested information
+      IF ( PRESENT( cpl_id )        )  THEN
+         cpl_id        = requested_cpl_id
+      ENDIF
+      IF ( PRESENT( cpl_parent_id ) )  THEN
+         cpl_parent_id = m_couplers(requested_cpl_id)%parent_id
+      ENDIF
+      IF ( PRESENT( cpl_name )      )  THEN
+         cpl_name      = m_couplers(requested_cpl_id)%name
+      ENDIF
+      IF ( PRESENT( ncpl )          )  THEN
+         ncpl          = m_ncpl
+      ENDIF
+      IF ( PRESENT( npe_total )     )  THEN
+         npe_total     = m_couplers(requested_cpl_id)%npe_total
+      ENDIF
+      IF ( PRESENT( lower_left_x )  )  THEN
+         lower_left_x  = m_couplers(requested_cpl_id)%lower_left_x
+      ENDIF
+      IF ( PRESENT( lower_left_y )  )  THEN
+         lower_left_y  = m_couplers(requested_cpl_id)%lower_left_y
+      ENDIF
+
+   END SUBROUTINE pmc_get_model_info
 
 
@@ -364,5 +404,5 @@
 
     INTEGER, INTENT(INOUT) ::  pmc_status
-    INTEGER                ::  i, istat, iunit
+    INTEGER                ::  i, istat
 
     TYPE(pmc_layout), DIMENSION(pmc_max_modell) ::  domain_layouts
@@ -374,6 +414,5 @@
 !-- Initialize some coupling variables
     domain_layouts(1:pmc_max_modell)%id = -1
-    m_nrofcpl =   0
-    iunit     = 345
+    m_ncpl =   0
 
     pmc_status = pmc_status_ok
@@ -412,17 +451,13 @@
 !-- Get the number of nested models given in the nestpar-NAMELIST
     DO  i = 1, pmc_max_modell
-
-       IF ( m_couplers(i)%id /= -1  .AND.  i <= pmc_max_modell )  THEN
-          WRITE ( 0, '(A,A,1X,3I7,1X,2F10.2)' )  'Set up Model  ',             &
-                             TRIM( m_couplers(i)%name ), m_couplers(i)%id,     &
-                             m_couplers(i)%Parent_id, m_couplers(i)%npe_total, &
-                             m_couplers(i)%lower_left_x,                       &
-                             m_couplers(i)%lower_left_y
-       ELSE
-!
-!--       When id=-1 is found for the first time, the list of domains is
-!--       finished (or latest after pmc_max_modell entries
-          m_nrofcpl = i - 1
-          EXIT
+!
+!--    When id=-1 is found for the first time, the list of domains is finished
+       IF ( m_couplers(i)%id == -1  .OR.  i == pmc_max_modell )  THEN
+          IF ( m_couplers(i)%id == -1 )  THEN
+             m_ncpl = i - 1
+             EXIT
+          ELSE
+             m_ncpl = pmc_max_modell
+          ENDIF
        ENDIF
 
