prismtrs_set_epio_trans.F90

Go to the documentation of this file.

!------------------------------------------------------------------------
! Copyright 2006-2010, CERFACS, Toulouse, France.
! Copyright 2006-2010, NEC High Performance Computing, Duesseldorf, Germany.
! All rights reserved. Use is subject to OASIS4 license terms.
!-----------------------------------------------------------------------
!BOP
!
! !ROUTINE: PRISMTrs_Set_epio_trans
!
! !INTERFACE
subroutine prismtrs_set_epio_trans(id_process_global_rank, id_err)

!
! !USES:
!
  USE PRISMDrv, dummy_interface => PRISMTrs_Set_epio_trans

  IMPLICIT NONE

!
! !PARAMETERS:
!
! global rank of the corresponding process
  INTEGER, INTENT (IN)                         :: id_process_global_rank

!
! ! RETURN VALUE
!
  INTEGER, INTENT (Out)                        :: id_err   ! error value

! !DESCRIPTION
! Subroutine "PRISMTrs_Set_epio_trans" sends back the epio_id and the trans
! rank
!
! !REVISED HISTORY
!   Date      Programmer   Description
! ----------  ----------   -----------
! 01/12/2003  D. Declat    Creation
!
! EOP
!----------------------------------------------------------------------
! $Id: prismtrs_set_epio_trans.F90 2325 2010-04-21 15:00:07Z valcke $
! $Author: valcke $
!----------------------------------------------------------------------
!
! 0. Local declarations
!
  CHARACTER(LEN=len_cvs_string), SAVE  :: mycvs = 
     '$Id: prismtrs_set_epio_trans.F90 2325 2010-04-21 15:00:07Z valcke $'
!
! Auxiliary variables
!
  INTEGER                            :: il_index
  INTEGER                            :: il_rank
  INTEGER, DIMENSION(2)              :: ila_send
!
!----------------------------------------------------------------------
!
#ifdef VERBOSE
  PRINT *, '| | | Enter PRISMTrs_Set_epio_trans'
  call psmile_flushstd
#endif

! 
! 1. Find the index if already register, or give an index and 
!      allocate if needed. Then send the id to the psmile.
  call prismtrs_get_epio_handle(il_index, id_err)
  ila_send(1) = il_index

  call prismtrs_get_trans_rank(il_rank, id_err)
  ila_send(2) = il_rank

  CALL MPI_Send(ila_send, 2, MPI_Integer, id_process_global_rank, 5, &
    comm_drv_trans, id_err)

!  
#ifdef VERBOSE
  PRINT *, '| | | Quit PRISMTrs_Set_epio_trans '
  call psmile_flushstd
#endif

END SUBROUTINE PRISMTrs_Set_epio_trans