psmile_enddef_action_loc.F90

Go to the documentation of this file.

!
!-----------------------------------------------------------------------
! Copyright 2006-2010, NEC Europe Ltd., London, UK.
! All rights reserved. Use is subject to OASIS4 license terms.
!-----------------------------------------------------------------------
!BOP
!
! !ROUTINE: PSMILe_Enddef_action_loc
!
! !INTERFACE:

      subroutine psmile_enddef_action_loc (msg_locations, ierror)
!
! !USES:
!
      use PRISM_constants
!
      use PSMILe, dummy_interface => PSMILe_Enddef_action_loc

      implicit none
!
! !INPUT PARAMETERS:
!
      Type (enddef_msg_locations), Intent (In) :: msg_locations

!     Contains basic information required to receive the locations
!
!
! !OUTPUT PARAMETERS:
!
      Integer, Intent (Out)           :: ierror

!     Returns the error code of PSMILe_Get_locations_3d;
!             ierror = 0 : No error
!             ierror > 0 : Severe error
!
! !LOCAL VARIABLES
!
!     ... for error handling
!
      Integer, parameter              :: nerrp = 1
      Integer                         :: ierrp (nerrp)
!
! !DESCRIPTION:
!
! Subroutine "PSMILe_Enddef_action_loc" performs the actions in order to
! receive the data on locations found for the method (grid) and the
! subgrid coords by process "sender".
! The data is sent by routine "PSMILe_Return_locations_3d" in the process
! which has searched the data.
!
! !REVISION HISTORY:
!
!   Date      Programmer   Description
! ----------  ----------   -----------
! 03.07.21    H. Ritzdorf  created
!
!EOP
!----------------------------------------------------------------------
!
!  $Id: psmile_enddef_action_loc.F90 2804 2010-12-07 10:07:10Z hanke $
!  $Author: hanke $
!
   Character(len=len_cvs_string), save :: mycvs = 
       '$Id: psmile_enddef_action_loc.F90 2804 2010-12-07 10:07:10Z hanke $'
!
!----------------------------------------------------------------------
!
!  Initialization
!
#ifdef VERBOSE
      print 9990, trim(ch_id), msg_locations%src_rank

      call psmile_flushstd
#endif /* VERBOSE */
!
      call psmile_get_locations_3d (msg_locations, ierror)
      if (ierror > 0) return
!
!     ... Have further messages to be received from this process ?
!
      if (msg_locations%further_msg_flag == 1) then
!
!===> ... Further messages have to be received;
!         activate requests for grid transfer again if it's
!         already finished.
!
         if (paction%n_answer >= paction%n_answer2recv) then
!
!===> ... Set up request for the next grid transfer
!
#ifdef PRISM_ASSERTION
            if (paction%lrequest(1) /= MPI_REQUEST_NULL) then
               call psmile_assert ( __FILE__, __LINE__, &
                                   'paction%lrequest(1) is not finished !')
            endif
#endif
!
            call MPI_Irecv (paction%msgreq, nd_msgint, MPI_INTEGER,      &
                            MPI_ANY_SOURCE, reqtag, comm_psmile, &
                            paction%lrequest(1), ierror)
            if ( ierror /= MPI_SUCCESS ) then
               ierrp (1) = ierror
               ierror = PRISM_Error_MPI

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

         endif
!
         paction%n_answer = paction%n_answer - 1

      else

!
!===> ... Locations from same sender have to be received
!
         paction%nloc_recv = paction%nloc_recv + 1

      endif
!
!===> All done
!
#ifdef VERBOSE
      print 9980, trim(ch_id), ierror

      call psmile_flushstd
#endif /* VERBOSE */
!
!  Formats:
!

#ifdef VERBOSE

9990 format (1x, a, ': psmile_enddef_action_loc: sender ', i6)
9980 format (1x, a, ': psmile_enddef_action_loc: eof ierror =', i3)

#endif /* VERBOSE */

      end subroutine PSMILe_Enddef_action_loc