Ignore:
Timestamp:
Mar 11, 2016 10:41:25 AM (6 years ago)
Author:
raasch
Message:

output of nesting informations of all domains; filling up redundant ghost points; renaming of variables, etc.; formatting cleanup

File:
1 edited

Legend:

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

    r1787 r1791  
    2020! Current revisions:
    2121! ------------------
    22 !
     22! m_nrofcpl renamed m_ncpl,
     23! pmc_get_local_model_info renamed pmc_get_model_info, some keywords also
     24! renamed and some added,
     25! debug write-statements commented out
    2326!
    2427! Former revisions:
     
    8689   INTEGER                                    :: m_my_CPL_id  !Coupler id of this model
    8790   INTEGER                                    :: m_Parent_id  !Coupler id of parent of this model
    88    INTEGER                                    :: m_NrOfCpl    !Number of Coupler in layout file
    89    TYPE(PMC_layout),DIMENSION(PMC_MAX_MODELL) :: m_couplers   !Information of all coupler
     91   INTEGER                                    :: m_ncpl       !Number of Couplers in layout file
     92
     93   TYPE(PMC_layout),DIMENSION(PMC_MAX_MODELL) :: m_couplers   !Information of all couplers
    9094
    9195   ! MPI settings
     
    110114   END INTERFACE pmc_is_rootmodel
    111115
    112    INTERFACE PMC_get_local_model_info
    113       MODULE PROCEDURE PMC_get_local_model_info
    114    END INTERFACE PMC_get_local_model_info
    115 
    116    PUBLIC pmc_get_local_model_info, pmc_init_model, pmc_is_rootmodel
     116   INTERFACE pmc_get_model_info
     117      MODULE PROCEDURE pmc_get_model_info
     118   END INTERFACE pmc_get_model_info
     119
     120   PUBLIC pmc_get_model_info, pmc_init_model, pmc_is_rootmodel
    117121
    118122 CONTAINS
     
    160164!--         Calculate start PE of every model
    161165            start_pe(1) = 0
    162             DO  i = 2, m_nrofcpl+1
     166            DO  i = 2, m_ncpl+1
    163167               start_pe(i) = start_pe(i-1) + m_couplers(i-1)%npe_total
    164168            ENDDO
     
    167171!--         The number of cores provided with the run must be the same as the
    168172!--         total sum of cores required by all nest domains
    169             IF ( start_pe(m_nrofcpl+1) /= m_world_npes )  THEN
     173            IF ( start_pe(m_ncpl+1) /= m_world_npes )  THEN
    170174               WRITE ( message_string, '(A,I6,A,I6,A)' )                       &
    171175                               'nesting-setup requires more MPI procs (',      &
    172                                start_pe(m_nrofcpl+1), ') than provided (',     &
     176                               start_pe(m_ncpl+1), ') than provided (',        &
    173177                               m_world_npes,')'
    174178               CALL message( 'pmc_init_model', 'PA0229', 3, 2, 0, 6, 0 )
     
    202206      ENDIF
    203207
    204       CALL MPI_BCAST( m_nrofcpl, 1,          MPI_INTEGER, 0, MPI_COMM_WORLD, istat)
    205       CALL MPI_BCAST( start_pe, m_nrofcpl+1, MPI_INTEGER, 0, MPI_COMM_WORLD, istat)
     208      CALL MPI_BCAST( m_ncpl,          1, MPI_INTEGER, 0, MPI_COMM_WORLD, istat)
     209      CALL MPI_BCAST( start_pe, m_ncpl+1, MPI_INTEGER, 0, MPI_COMM_WORLD, istat)
    206210
    207211!
    208212!--   Broadcast coupling layout
    209       DO  i = 1, m_nrofcpl
     213      DO  i = 1, m_ncpl
    210214         CALL MPI_BCAST( m_couplers(i)%name, LEN( m_couplers(i)%name ), MPI_CHARACTER, 0, MPI_COMM_WORLD, istat )
    211215         CALL MPI_BCAST( m_couplers(i)%id,           1, MPI_INTEGER, 0, MPI_COMM_WORLD, istat )
     
    219223!
    220224!--   Assign global MPI processes to individual models by setting the couple id
    221       DO  i = 1, m_nrofcpl
     225      DO  i = 1, m_ncpl
    222226         IF ( m_world_rank >= start_pe(i)  .AND.  m_world_rank < start_pe(i+1) ) &
    223227         THEN
     
    241245!
    242246!--   Broadcast (from PE 0) the parent id and id of every model
    243       DO  i = 1, m_nrofcpl
     247      DO  i = 1, m_ncpl
    244248         CALL MPI_BCAST( m_couplers(i)%parent_id, 1, MPI_INTEGER, 0,           &
    245249                         MPI_COMM_WORLD, istat )
     
    257261!--   different colors.
    258262!--   The grouping was done above with MPI_COMM_SPLIT
    259       DO  i = 2, m_nrofcpl
     263      DO  i = 2, m_ncpl
    260264
    261265         IF ( m_couplers(i)%parent_id == m_my_cpl_id )  THEN
     
    292296
    293297      clientcount = 0
    294       DO  i = 2, m_nrofcpl
     298      DO  i = 2, m_ncpl
    295299         IF ( activeserver(i) == 1 )  THEN
    296300            clientcount = clientcount + 1
     
    321325
    322326!
    323 !-- Make module private variables available to palm
    324    SUBROUTINE pmc_get_local_model_info( my_cpl_id, my_cpl_parent_id, cpl_name, &
    325                                         npe_total, lower_left_x, lower_left_y )
     327!-- Provide module private variables of the pmc for PALM
     328    SUBROUTINE pmc_get_model_info( cpl_id, cpl_name, cpl_parent_id,            &
     329                                   lower_left_x, lower_left_y, ncpl, npe_total,&
     330                                   request_for_cpl_id )
    326331
    327332      USE kinds
     
    330335
    331336      CHARACTER(LEN=*), INTENT(OUT), OPTIONAL ::  cpl_name
    332       INTEGER, INTENT(OUT), OPTIONAL          ::  my_cpl_id
    333       INTEGER, INTENT(OUT), OPTIONAL          ::  my_cpl_parent_id
    334       INTEGER, INTENT(OUT), OPTIONAL          ::  npe_total
    335       REAL(wp), INTENT(OUT), OPTIONAL         ::  lower_left_x
    336       REAL(wp), INTENT(OUT), OPTIONAL         ::  lower_left_y
    337 
    338       IF ( PRESENT( my_cpl_id )           )  my_cpl_id        = m_my_cpl_id
    339       IF ( PRESENT( my_cpl_parent_id )    )  my_cpl_parent_id = m_couplers(my_cpl_id)%parent_id
    340       IF ( PRESENT( cpl_name )            )  cpl_name         = m_couplers(my_cpl_id)%name
    341       IF ( PRESENT( npe_total )           )  npe_total        = m_couplers(my_cpl_id)%npe_total
    342       IF ( PRESENT( lower_left_x )        )  lower_left_x     = m_couplers(my_cpl_id)%lower_left_x
    343       IF ( PRESENT( lower_left_y )        )  lower_left_y     = m_couplers(my_cpl_id)%lower_left_y
    344 
    345    END SUBROUTINE pmc_get_local_model_info
     337
     338      INTEGER, INTENT(IN), OPTIONAL ::  request_for_cpl_id
     339
     340      INTEGER, INTENT(OUT), OPTIONAL ::  cpl_id
     341      INTEGER, INTENT(OUT), OPTIONAL ::  cpl_parent_id
     342      INTEGER, INTENT(OUT), OPTIONAL ::  ncpl
     343      INTEGER, INTENT(OUT), OPTIONAL ::  npe_total
     344
     345      INTEGER ::  requested_cpl_id
     346
     347      REAL(wp), INTENT(OUT), OPTIONAL ::  lower_left_x
     348      REAL(wp), INTENT(OUT), OPTIONAL ::  lower_left_y
     349
     350!
     351!--   Set the requested coupler id
     352      IF ( PRESENT( request_for_cpl_id ) )  THEN
     353         requested_cpl_id = request_for_cpl_id
     354!
     355!--      Check for allowed range of values
     356         IF ( requested_cpl_id < 1 .OR. requested_cpl_id > m_ncpl )  RETURN
     357      ELSE
     358         requested_cpl_id = m_my_cpl_id
     359      ENDIF
     360
     361!
     362!--   Return the requested information
     363      IF ( PRESENT( cpl_id )        )  THEN
     364         cpl_id        = requested_cpl_id
     365      ENDIF
     366      IF ( PRESENT( cpl_parent_id ) )  THEN
     367         cpl_parent_id = m_couplers(requested_cpl_id)%parent_id
     368      ENDIF
     369      IF ( PRESENT( cpl_name )      )  THEN
     370         cpl_name      = m_couplers(requested_cpl_id)%name
     371      ENDIF
     372      IF ( PRESENT( ncpl )          )  THEN
     373         ncpl          = m_ncpl
     374      ENDIF
     375      IF ( PRESENT( npe_total )     )  THEN
     376         npe_total     = m_couplers(requested_cpl_id)%npe_total
     377      ENDIF
     378      IF ( PRESENT( lower_left_x )  )  THEN
     379         lower_left_x  = m_couplers(requested_cpl_id)%lower_left_x
     380      ENDIF
     381      IF ( PRESENT( lower_left_y )  )  THEN
     382         lower_left_y  = m_couplers(requested_cpl_id)%lower_left_y
     383      ENDIF
     384
     385   END SUBROUTINE pmc_get_model_info
    346386
    347387
     
    364404
    365405    INTEGER, INTENT(INOUT) ::  pmc_status
    366     INTEGER                ::  i, istat, iunit
     406    INTEGER                ::  i, istat
    367407
    368408    TYPE(pmc_layout), DIMENSION(pmc_max_modell) ::  domain_layouts
     
    374414!-- Initialize some coupling variables
    375415    domain_layouts(1:pmc_max_modell)%id = -1
    376     m_nrofcpl =   0
    377     iunit     = 345
     416    m_ncpl =   0
    378417
    379418    pmc_status = pmc_status_ok
     
    412451!-- Get the number of nested models given in the nestpar-NAMELIST
    413452    DO  i = 1, pmc_max_modell
    414 
    415        IF ( m_couplers(i)%id /= -1  .AND.  i <= pmc_max_modell )  THEN
    416           WRITE ( 0, '(A,A,1X,3I7,1X,2F10.2)' )  'Set up Model  ',             &
    417                              TRIM( m_couplers(i)%name ), m_couplers(i)%id,     &
    418                              m_couplers(i)%Parent_id, m_couplers(i)%npe_total, &
    419                              m_couplers(i)%lower_left_x,                       &
    420                              m_couplers(i)%lower_left_y
    421        ELSE
    422 !
    423 !--       When id=-1 is found for the first time, the list of domains is
    424 !--       finished (or latest after pmc_max_modell entries
    425           m_nrofcpl = i - 1
    426           EXIT
     453!
     454!--    When id=-1 is found for the first time, the list of domains is finished
     455       IF ( m_couplers(i)%id == -1  .OR.  i == pmc_max_modell )  THEN
     456          IF ( m_couplers(i)%id == -1 )  THEN
     457             m_ncpl = i - 1
     458             EXIT
     459          ELSE
     460             m_ncpl = pmc_max_modell
     461          ENDIF
    427462       ENDIF
    428463
Note: See TracChangeset for help on using the changeset viewer.