prism_get_localcomm.F90

Go to the documentation of this file.

!-----------------------------------------------------------------------
! Copyright 2006-2010, CERFACS, Toulouse, France.
! Copyright 2006-2010, SGI Germany, Munich, Germany.
! Copyright 2006-2010, NEC Europe Ltd., London, UK.
! All rights reserved. Use is subject to OASIS4 license terms.
!-----------------------------------------------------------------------
!BOP
!
! !ROUTINE: PRISM_Get_localcomm
!
! !INTERFACE:

      subroutine prism_get_localcomm ( comp_id, local_comm, ierror )
!
! !USES:
!
      use PRISM, dummy_interface => PRISM_Get_localcomm
      use PSMILe

      implicit none

!
! !INPUT PARAMETERS:
!
      integer, intent(In)                 :: comp_id
!
! !OUTPUT PARAMETERS:
!
      integer, intent(Out)                :: ierror, local_comm

! ---------------------------------------------------------------------

! !LOCAL VARIABLES

      integer, parameter                  :: nerrp = 2
      integer, dimension (nerrp)          :: ierrp (nerrp)
!
! !DESCRIPTION:
!
!     Provide Communicator - for component or application local communication
!     This routine needs to be called only by MPI parallel codes to retrieve
!     a local communicator 'local_comm' for internal MPI communication.

!     If 'comp_id' argument is the component Id returned by routine
!     prism_init_comp, 'local_comm' is a communicator gathering all
!     component processes which called prism_init_comp with the same
!     'comp_name' argument.
!
!     If instead of comp_id a predefined named integer PRISM_appl_id
!     is provided, the returned local_comm is a communicator gathering
!     all processes of the application.
!
! !REVISION HISTORY:
!
!   Date      Programmer    Description
! ----------  -----------   -----------
! 03.12.01    H. Ritzdorf   created
!
!EOP
!----------------------------------------------------------------------
!
! $Id: prism_get_localcomm.F90 2687 2010-10-28 15:15:52Z coquart $
! $Author: coquart $
!
  Character(len=len_cvs_string), save :: mycvs = 
      '$Id: prism_get_localcomm.F90 2687 2010-10-28 15:15:52Z coquart $'
!
!----------------------------------------------------------------------

#ifdef VERBOSE
      print *, trim(ch_id), ': prism_get_localcomm: start'
      print *, trim(ch_id), ': prism_get_localcomm: comp_id =', comp_id
      call psmile_flushstd
#endif /* VERBOSE */

      if ( .not. PRISM_is_initialized ) then

         ierror = PRISM_Error_Initialized
         ierrp (1) = comp_id

         call psmile_error (ierror, 'PRISM_Get_MPI_Comm', &
                            ierrp, 1, __FILE__, __LINE__)
         return
      endif

      ierror = 0

      if (comp_id == PRISM_Appl_id) then
         local_comm = Appl%comm_user
      else
!
!  Control Component id
!
         if (comp_id < 1 .or. &
             comp_id > Number_of_Comps_allocated) then

            ierrp (1) = comp_id
            ierrp (2) = Number_of_Comps_allocated

            ierror = PRISM_Error_Arg

            call psmile_error ( ierror, 'comp_id', &
                                ierrp, 2, __FILE__, __LINE__ )
            return
         endif
!
         if (Comps(comp_id)%status == PSMILe_status_free) then

            ierrp (1) = comp_id

            ierror = PRISM_Error_Arg

            call psmile_error ( PRISM_Error_Arg, 'comp_id (not active)', &
                                ierrp, 1, __FILE__, __LINE__ )
            return
         endif
!
         local_comm = Comps(comp_id)%comm_user
      endif

#ifdef PRISM_ASSERTION
      if (  local_comm == MPI_Comm_NULL ) then
        call psmile_assert ( __FILE__, __LINE__, &
          'returned communicator should be not MPI_COMM_NULL')
      endif
#endif

#ifdef VERBOSE
      print *, trim(ch_id), ': prism_get_localcomm: eof ierror =', &
               ierror, '; local_comm =', local_comm

      call psmile_flushstd
#endif /* VERBOSE */

      end subroutine prism_get_localcomm