psmile_enddef_msg_locs_utils.F90

Go to the documentation of this file.

!-----------------------------------------------------------------------
! Copyright 2010, DKRZ, Hamburg, Germany.
! All rights reserved. Use is subject to OASIS4 license terms.
!-----------------------------------------------------------------------
!
! !DESCRIPTION:
!
! This file contains routines for initiating objects of the derived
! type enddef_msg_locations. In addition there are two routines
! which allow to convert between object from this type and an integer
! array, which is sendable via MPI.
!
!
! !REVISION HISTORY:
!
!   Date      Programmer   Description
! ----------  ----------   -----------
! 06.12.10    M. Hanke     created
!
!----------------------------------------------------------------------
!
!  $Id: psmile_enddef_msg_locs_utils.F90 2887 2011-01-14 09:25:49Z redler $
!  $Author: redler $
!
!----------------------------------------------------------------------

subroutine psmile_init_enddef_msg_locs (msg_locations)
   use psmile_common, only : enddef_msg_locations, &
                             psmile_undef

   implicit none

   type (enddef_msg_locations), intent (out) :: msg_locations

   msg_locations%requires_conserv_remap = psmile_undef
   msg_locations%msg_len                = psmile_undef
   msg_locations%transi_out_id          = psmile_undef
   msg_locations%src_rank               = psmile_undef
   msg_locations%transi_in_id           = psmile_undef
   msg_locations%tgt_method_id          = psmile_undef
   msg_locations%tgt_var_id             = psmile_undef
   msg_locations%relative_msg_tag       = psmile_undef
   msg_locations%num_locs_coupler       = psmile_undef
   msg_locations%num_locs_direct        = psmile_undef
   msg_locations%further_msg_flag       = psmile_undef
   msg_locations%epio_id                = psmile_undef
   msg_locations%trs_rank               = psmile_undef
   msg_locations%num_points_direct      = psmile_undef
   msg_locations%num_areas_direct       = psmile_undef

end subroutine psmile_init_enddef_msg_locs

subroutine psmile_pack_msg_locations (msg_locations, buffer)
   use psmile_common, only : enddef_msg_locations, msgloc_size

   implicit none

   type (enddef_msg_locations), intent (in) :: msg_locations
   integer, intent (out)                    :: buffer(msgloc_size)

   buffer  (1) = msg_locations%requires_conserv_remap
   buffer  (2) = msg_locations%msg_len
   buffer  (3) = msg_locations%transi_out_id
   buffer  (4) = msg_locations%src_rank
   buffer  (5) = msg_locations%transi_in_id
   buffer  (6) = msg_locations%tgt_method_id
   buffer  (7) = msg_locations%tgt_var_id
   buffer  (8) = msg_locations%relative_msg_tag
   buffer  (9) = msg_locations%num_locs_coupler
   buffer (10) = msg_locations%num_locs_direct
   buffer (11) = msg_locations%further_msg_flag
   buffer (12) = msg_locations%epio_id
   buffer (13) = msg_locations%trs_rank
   buffer (14) = msg_locations%num_points_direct
   buffer (15) = msg_locations%num_areas_direct
#ifdef DEBUGX
  PRINT *, ' pack requires_conserv_remap ', buffer  (1)
  PRINT *, ' pack msg_len                ', buffer  (2)
  PRINT *, ' pack transi_out_id          ', buffer  (3)
  PRINT *, ' pack src_rank               ', buffer  (4)
  PRINT *, ' pack transi_in_id           ', buffer  (5)
  PRINT *, ' pack tgt_method_id          ', buffer  (6)
  PRINT *, ' pack tgt_var_id             ', buffer  (7)
  PRINT *, ' pack relative_msg_tag       ', buffer  (8)
  PRINT *, ' pack num_locs_coupler       ', buffer  (9)
  PRINT *, ' pack num_locs_direct        ', buffer  (10)
  PRINT *, ' pack further_msg_flag       ', buffer  (11)
  PRINT *, ' pack epio_id                ', buffer  (12)
  PRINT *, ' pack trs_rank               ', buffer  (13)
  PRINT *, ' pack num_points_direct      ', buffer  (14)
  PRINT *, ' pack num_areas_direct       ', buffer  (15)
#endif

end subroutine psmile_pack_msg_locations

subroutine psmile_unpack_msg_locations (msg_locations, buffer)
   use psmile_common, only : enddef_msg_locations, msgloc_size

   implicit none

   type (enddef_msg_locations), intent (out) :: msg_locations
   integer, intent (in)                      :: buffer(msgloc_size)

   msg_locations%requires_conserv_remap = buffer  (1)
   msg_locations%msg_len                = buffer  (2)
   msg_locations%transi_out_id          = buffer  (3)
   msg_locations%src_rank               = buffer  (4)
   msg_locations%transi_in_id           = buffer  (5)
   msg_locations%tgt_method_id          = buffer  (6)
   msg_locations%tgt_var_id             = buffer  (7)
   msg_locations%relative_msg_tag       = buffer  (8)
   msg_locations%num_locs_coupler       = buffer  (9)
   msg_locations%num_locs_direct        = buffer (10)
   msg_locations%further_msg_flag       = buffer (11)
   msg_locations%epio_id                = buffer (12)
   msg_locations%trs_rank               = buffer (13)
   msg_locations%num_points_direct      = buffer (14)
   msg_locations%num_areas_direct       = buffer (15)
#ifdef DEBUGX
  PRINT *, ' unpack requires_conserv_remap ', buffer  (1)
  PRINT *, ' unpack msg_len                ', buffer  (2)
  PRINT *, ' unpack transi_out_id          ', buffer  (3)
  PRINT *, ' unpack src_rank               ', buffer  (4)
  PRINT *, ' unpack transi_in_id           ', buffer  (5)
  PRINT *, ' unpack tgt_method_id          ', buffer  (6)
  PRINT *, ' unpack tgt_var_id             ', buffer  (7)
  PRINT *, ' unpack relative_msg_tag       ', buffer  (8)
  PRINT *, ' unpack num_locs_coupler       ', buffer  (9)
  PRINT *, ' unpack num_locs_direct        ', buffer  (10)
  PRINT *, ' unpack further_msg_flag       ', buffer  (11)
  PRINT *, ' unpack epio_id                ', buffer  (12)
  PRINT *, ' unpack trs_rank               ', buffer  (13)
  PRINT *, ' unpack num_points_direct      ', buffer  (14)
  PRINT *, ' unpack num_areas_direct       ', buffer  (15)
#endif

end subroutine psmile_unpack_msg_locations