psmile_get_face_ind_3d.F90

Go to the documentation of this file.

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

      subroutine psmile_get_face_ind_3d (search, extra_search,          &
                           send_info, len_cpl,                          &
                           send_mask, nreq, srcloc_ind, n_send,         &
                           ierror)
!
! !USES:
!
      use PRISM
!
      use PSMILe, dummy_interface => PSMILe_Get_face_ind_3d

      Implicit none
!
! !INPUT PARAMETERS:
!
      Type (Enddef_search),     Intent (In) :: search

!     Info's on coordinates to be searched
!
      Type (Extra_search_info), Intent (In) :: extra_search
!
!     Info's on locations which 
!     (*) require global search or
!     (*) extra neighbourhood search
!
      Type (Send_information),  Intent (In) :: send_info
!
!     Send info's for sends to the coupler.
!
      Integer,                  Intent (In) :: len_cpl (search%npart)

!     Number of points to be sent to the coupler for each partition.

      Integer,                  Intent (In) :: nreq
!
!     Total number of extra points to be searched.
!     Dimension of "send_mask".
!
      Logical,                  Intent (In) :: send_mask (nreq)
!
!     Mask for the points (of "indices_req") to be sent.
!
      Integer,                  Intent (In) :: n_send
!
!     Number of extra points to be sent and 
!     number of indices to be returned.
!
! !OUTPUT PARAMETERS:
!
      Integer,                  Intent (Out) :: srcloc_ind (ndim_3d, n_send)
!
!     3d-indices of the locations to be sent.
!
      Integer,                  Intent (Out) :: ierror

!     Returns the error code of PSMILe_Get_face_ind_3d;
!             ierror = 0 : No error
!             ierror > 0 : Severe error
!
! !LOCAL VARIABLES
!
!     ... loop variables
!
      Integer                         :: i, j, n
!
!     ... for partitions
!
      Integer                         :: ipart, nextra_prev
!
      Integer, Pointer                :: indices_req (:)
      Integer, Pointer                :: len_req (:)
      Integer, Pointer                :: srcloc (:)
!
!     ... for error handling
!
!     Integer, Parameter              :: nerrp = 3
!     Integer                         :: ierrp (nerrp)
!
! !DESCRIPTION:
!
! Subroutine "PSMILe_Get_face_ind_3d" computes the 3d indices of
! the locations to be sent to a "coinciding" (neighboured)
! process of the same component.
!
!
! !REVISION HISTORY:
!
!   Date      Programmer   Description
! ----------  ----------   -----------
! 02.02.05    H. Ritzdorf  created
!
!EOP
!----------------------------------------------------------------------
!
!  $Id: psmile_get_face_ind_3d.F90 2933 2011-01-31 16:42:27Z hanke $
!  $Author: hanke $
!
   Character(len=len_cvs_string), save :: mycvs = 
       '$Id: psmile_get_face_ind_3d.F90 2933 2011-01-31 16:42:27Z hanke $'
!
!----------------------------------------------------------------------
!
!  Initialization
!
#ifdef VERBOSE
      print 9990, trim(ch_id)

      call psmile_flushstd
#endif /* VERBOSE */
!
      ierror = 0
!
      len_req => extra_search%len_req
!
#ifdef PRISM_ASSERTION
      if (SUM(len_req(:)) > nreq) then
         print *, 'nreq, sum(len_req)', nreq, SUM(len_req(:))
         call psmile_assert ( __FILE__, __LINE__, &
                 'nreq is too small (inconsistent data)')
      endif
!
      if (send_info%nvec /= 1) then
         print *, 'nvec', send_info%nvec
         call psmile_assert ( __FILE__, __LINE__, &
                 'Routine is designed for irregular case (3d vector)')
      endif
#endif
!
!  For all parts "ipart"
!
!  indices_req = Indices of the extra points in entire list of all points
!                to be searched (i.e. for all parts "ipart")
!
      n = 0
      nextra_prev = 0
!
! Note: Only 1 vector is generated for full 3d indices
!       independent on number of partitions "search%npart".
!       Thus, "nprev" is always 0 and independent on "len_cpl".
!
      srcloc => send_info%srclocs(1,1)%vector
!
      do ipart = 1, search%npart
!
         if (len_req (ipart) > 0) then
            indices_req => extra_search%indices_req(ipart)%vector
!
               do j = 1, len_req (ipart)
               if (send_mask(nextra_prev+j)) then
!
!  ... Compute index in srcloc
!      "srcloc" is generated as array of dimension (ndim_3d, *).
!      "indices_req(j) - nprev" is the index in the second dimension.
!
                  n = n + 1
!
                  i = (indices_req(j) - 1) * ndim_3d
!
                  srcloc_ind (1, n) = srcloc (i+1)
                  srcloc_ind (2, n) = srcloc (i+2)
                  srcloc_ind (3, n) = srcloc (i+3)
               endif
               end do ! j
!
            nextra_prev = nextra_prev + len_req (ipart)
         endif
!
      end do ! ipart
!
#ifdef PRISM_ASSERTION
      if (n /= n_send) then
         print *, 'n, n_send', n, n_send
         call psmile_assert ( __FILE__, __LINE__, &
                 'All indices were NOT generated for srcloc_ind')
      endif
#endif
!
!===> All done
!
#ifdef VERBOSE
      print 9980, trim(ch_id), ierror

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

9990 format (1x, a, ': psmile_get_face_ind_3d:')
9980 format (1x, a, ': psmile_get_face_ind_3d: eof ierror =', i3)

#endif /* VERBOSE */

#ifdef DEBUG
#endif

      end subroutine PSMILe_Get_face_ind_3d