psmile_trs_give_neighcells3d.F90

Go to the documentation of this file.

!------------------------------------------------------------------------
! Copyright 2006-2010, CERFACS, Toulouse, France.
! All rights reserved. Use is subject to OASIS4 license terms.
!-----------------------------------------------------------------------
!BOP
!
! !ROUTINE: PSMILe_Trs_give_neighcells3d
!
! !INTERFACE:

subroutine psmile_trs_give_neighcells3d(id_epio_id,        &
                                        id_trans_rank,     &
                                        id_epio_tgt_size,  &
                                        ida_nbsrccells_pertgtpt, &
                                        id_source_size,    &
                                        id_nb_corners,     &
                                        ida_source_cell_index, &
                                        ida_corner_index,  &
                                        id_grid_type,      &
                                        id_err)

!
! !USES:
!
  use PRISM_constants
  USE PSMILe, dummy_interface => PSMILe_Trs_give_neighcells3d

  IMPLICIT NONE
!
! !INPUT PARAMETERS:
!
! associated epio id
  INTEGER, INTENT (In)                     :: id_epio_id
  INTEGER, INTENT (In)                     :: id_trans_rank   

! size of the corresponding epiot
  INTEGER, INTENT (In)                     :: id_epio_tgt_size

! size of the corresponding epios
  INTEGER, INTENT (In)                     :: id_source_size

! number of neighbors
  INTEGER, INTENT (In)                     :: id_nb_corners 

! number of source cells per target cell
  INTEGER, DIMENSION(id_epio_tgt_size), INTENT (In) :: 
                                              ida_nbsrccells_pertgtpt

! index of the epio source cell
  INTEGER, DIMENSION(id_source_size), INTENT (In) ::   
                                              ida_source_cell_index

! index of the epio source cell corners in the corners lon/lat/z arrays
  INTEGER, DIMENSION(id_nb_corners*id_source_size), INTENT (In) :: 
                                              ida_corner_index

  INTEGER, INTENT (In)                     :: id_grid_type
!
! !OUTPUT PARAMETERS:
!
  INTEGER, INTENT (Out)                    :: id_err   ! error value

! !DESCRIPTION:
!
! Subroutine "PSMILe_Trs_give_neighcells3d" insures the exchange of information,
! when an interpolation is required.
!
! !REVISION HISTORY:
!   Date      Programmer   Description
! ----------  ----------   -----------
! 24/03/2003  D. Declat    Creation
!
!EOP
!----------------------------------------------------------------------
! $Id: psmile_trs_give_neighcells3d.F90 2082 2009-10-21 13:31:19Z hanke $
! $Author: hanke $
!----------------------------------------------------------------------
!
! 0. Local declarations
!
  CHARACTER(LEN=len_cvs_string), SAVE  :: mycvs = 
    '$Id: psmile_trs_give_neighcells3d.F90 2082 2009-10-21 13:31:19Z hanke $'

  INTEGER, DIMENSION(PSMILe_trans_Header_length) :: ila_args 
!
!----------------------------------------------------------------------
!
#ifdef VERBOSE
      print *, trim(ch_id), ': PSMILe_Trs_give_neighcells3d: start'
      call psmile_flushstd
#endif /* VERBOSE */

#ifdef DEBUG
   print *, trim(ch_id), ': - id_epio_id       ', id_epio_id
   print *, trim(ch_id), ': - id_trans_rank    ', id_trans_rank
   print *, trim(ch_id), ': - id_epio_tgt_size ', id_epio_tgt_size
   print *, trim(ch_id), ': - id_source_size   ', id_source_size
   print *, trim(ch_id), ': - id_nb_corners    ', id_nb_corners
   print *, trim(ch_id), ': - id_grid_type     ', id_grid_type
#endif
!
! 1. Set the header message
!
! 1.1. Initialize the contents to 999999

  ila_args = 999999
  id_err = 0

! 1.2. Content : action, global rank, number of the transformation, field_id,
!                comp_id, size (of the EPIOT)

  ila_args(1)  = PSMILe_trans_Set_neighbors_info
  ila_args(2)  = global_rank
  ila_args(3)  = id_epio_id
  ila_args(4)  = id_epio_tgt_size
  ila_args(5)  = id_nb_corners
  ila_args(6)  = PSMILe_3D
  ila_args(7)  = id_source_size
  ila_args(11) = id_grid_type
!
! 2. Send the header message to the transformer
!
  call psmile_trs_inform(ila_args, id_trans_rank, id_err)
!
! 3. Send the neighbors of the target points
!
!    The transformer has to evaluate ila_args(7) to check
!    whether a second MPI_Recv has to be performed.
!    ila_args(7) /= PSMILE_undef
!
  CALL MPI_Send(ida_nbsrccells_pertgtpt(1), id_epio_tgt_size, &
     MPI_Integer, id_trans_rank, 5, comm_trans, id_err)

  CALL MPI_Send(ida_corner_index(1), id_nb_corners*id_source_size, &
     MPI_Integer, id_trans_rank, 6, comm_trans, id_err)
  CALL MPI_Send(ida_source_cell_index(1), id_source_size, &
     MPI_Integer, id_trans_rank, 7, comm_trans, id_err)
!
#ifdef VERBOSE
      print *, trim(ch_id), &
         ': PSMILe_Trs_give_neighcells3d: eof ierror =', id_err
      call psmile_flushstd
#endif /* VERBOSE */

END SUBROUTINE PSMILe_Trs_give_neighcells3d