psmile_trs_set_src_epio3d_dble.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_set_src_epio3d_dble
!
! !INTERFACE:
subroutine psmile_trs_set_src_epio3d_dble(id_epio_id,        &
                                          id_trans_rank,     &
                                          id_epio_size,      &
                                          id_lonlatz_size,   &
                                          dda_epio_lon,      &
                                          dda_epio_lat,      &
                                          dda_epio_z,        &
                                          id_mask_transfer,  &
                                          ida_epio_mask,     &
                                          id_err)

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

  IMPLICIT NONE
!
! !INPUT PARAMETERS:
!
  INTEGER, INTENT (In)                                  :: id_lonlatz_size
  INTEGER, INTENT (In)                                  :: id_epio_size
  !dda_epio_lat: latitudes for grid points or compressed corners
  DOUBLE PRECISION, DIMENSION(id_lonlatz_size), INTENT(In) :: dda_epio_lat
  !dda_epio_lon: longitudes for grid points or compressed corners
  DOUBLE PRECISION, DIMENSION(id_lonlatz_size), INTENT(In) :: dda_epio_lon
  !dda_epio_z: vertical position for grid points or compressed corners
  DOUBLE PRECISION, DIMENSION(id_lonlatz_size), INTENT(In) :: dda_epio_z
  INTEGER, INTENT (In)                                  :: id_mask_transfer
  INTEGER, DIMENSION(id_epio_size), INTENT (In)         :: ida_epio_mask

!
! !OUTPUT PARAMETERS:
!
  INTEGER, INTENT (Out)               :: id_epio_id      ! epio index
  INTEGER, INTENT (Out)               :: id_trans_rank   ! trans rank
  INTEGER, INTENT (Out)               :: id_err          ! error value

! !DESCRIPTION:
! Subroutine "PSMILe_Trs_set_src_epio3d_dble" sends point or corner
! epio informations to the transformer. If id_lonlatz_size=id_epio_size,
! point information is sent; if not, corner information is sent.
!
! !REVISION HISTORY:
!   Date      Programmer   Description
! ----------  ----------   -----------
! 24/03/2002  D. Declat    Creation of PSMILe_Trs_set_src_epio3d
! 01/12/2003  D. Declat    Modification to "double" version and src/tgt arrays
! 06/10/2006  S. Valcke    Modification for corners
!
!EOP
!-------------------------------------------------------------------------
! $Id: psmile_trs_set_src_epio3d_dble.F90 2325 2010-04-21 15:00:07Z valcke $
! $Author: valcke $
!-------------------------------------------------------------------------
!
! 0. Local declarations
!
  CHARACTER(LEN=len_cvs_string), SAVE  :: mycvs = 
     '$Id: psmile_trs_set_src_epio3d_dble.F90 2325 2010-04-21 15:00:07Z valcke $'

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

#ifdef DEBUG
   print *, trim(ch_id), ': - id_epio_size    ', id_epio_size
   print *, trim(ch_id), ': - id_lonlatz_size ', id_lonlatz_size
#endif
!
! Initialize ila_args content to 999999
!
  ila_args = 999999
!
! 0. Get rank and epio id from the transformer
!
  ila_args(1) = PSMILe_trans_Set_rank_trans
  ila_args(2) = global_rank
  ila_args(4) = Appl%sequence_number
  ila_args(5) = Appl%rank
!
! 0.1 Send the header message to the transformer
!
  call psmile_trs_inform(ila_args, PRISMdrv_root, id_err)
!
! 0.2 Receive the rank given by the transformer
!
  CALL MPI_Recv (id_trans_rank, 1, MPI_Integer, &
       PRISMdrv_root, 5, comm_trans, il_status, id_err)
!
! 0.3 Send the header message to the transformer
!
  ila_args(1) = PSMILe_trans_Set_epio_trans

  call psmile_trs_inform(ila_args, id_trans_rank, id_err)
!
! 0.4 Receive the epio_id given by the transformer
!
  CALL MPI_Recv (id_epio_id, 1, MPI_Integer, &
       id_trans_rank, 6, comm_trans, il_status, id_err)
!
! 1. Set the header message for sending the lat, lon, z vectors
!
! 1.1. Initialize the contents to 999999

  ila_args = 999999

! 1.2. Fill the content

  ila_args(1) = PSMILe_trans_Set_src_epio_info
  ila_args(2) = global_rank
  ila_args(3) = PRISM_DOUBLE_PRECISION
  ila_args(4) = Appl%sequence_number
  ila_args(5) = Appl%rank
  ila_args(6) = id_epio_id
  ila_args(7) = id_epio_size
! PSMILe_3D = PRISM_3d to indicate to the transformer this is a 3d information
! (ie reception of z coordinates)
  ila_args(8) = id_lonlatz_size
  ila_args(9) = PSMILe_3D
  ila_args(10) = id_mask_transfer
!
! 2. Send the header message to the transformer
!
  call psmile_trs_inform(ila_args, id_trans_rank, id_err)
!
! 3. Provide the elements involved in the interp to the transformer
!
! 3.1. The grid points or compressed corner lat
  CALL MPI_Send(dda_epio_lat(1), id_lonlatz_size, &
     MPI_Double_precision, id_trans_rank, 1, comm_trans, id_err)
  
! 3.2. The grid point or compressed corner point lon
  CALL MPI_Send(dda_epio_lon(1), id_lonlatz_size, &
     MPI_Double_precision, id_trans_rank, 2, comm_trans, id_err)
  
! 3.3. The grid point or compressed corner point z
  CALL MPI_Send(dda_epio_z(1), id_lonlatz_size, &
     MPI_Double_precision, id_trans_rank, 3, comm_trans, id_err)

! 3.4. The mask
  IF (id_mask_transfer == 1) THEN
      CALL MPI_Send(ida_epio_mask(1), id_epio_size, MPI_Integer, &
         id_trans_rank, 4, comm_trans, id_err)
  END IF

  
#ifdef VERBOSE
      print *, trim(ch_id), &
         ': PSMILe_Trs_set_src_epio3d_dble: eof ierror =', id_err
      call psmile_flushstd
#endif /* VERBOSE */
  
    END SUBROUTINE PSMILe_Trs_set_src_epio3d_dble