psmile_enddef_msg_extra_utils.F90

Go to the documentation of this file.

!-----------------------------------------------------------------------
! Copyright 2011, 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_extra. 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.04.2011  M. Hanke     created
!
!----------------------------------------------------------------------
!
!  $Id: psmile_enddef_msg_extra_utils.F90 3117 2011-04-08 11:04:46Z hanke $
!  $Author: hanke $
!
!----------------------------------------------------------------------

subroutine psmile_init_enddef_msg_extra (msg_extra)
   use psmile_common, only : enddef_msg_extra, &
                             psmile_undef

   implicit none

   type (enddef_msg_extra), intent (out) :: msg_extra

   msg_extra%reqest_type         = psmile_undef
   msg_extra%datatype            = psmile_undef
   msg_extra%len_int_data        = psmile_undef
   msg_extra%len_coord_data      = psmile_undef
   msg_extra%global_comp_id      = psmile_undef
   msg_extra%transi_out_id       = psmile_undef
   msg_extra%num_volumes         = psmile_undef
   msg_extra%num_int_per_vol     = psmile_undef
   msg_extra%num_items_per_coord = psmile_undef
   msg_extra%partition_avail     = .false.
   msg_extra%partition(:)        = 0
   msg_extra%num_neigh           = psmile_undef
   msg_extra%local_grid_id       = psmile_undef
   msg_extra%idx_req             = psmile_undef

end subroutine psmile_init_enddef_msg_extra

subroutine psmile_pack_msg_extra (msg_extra, buffer)
   use psmile_common, only : enddef_msg_extra, msg_extra_size

   implicit none

   type (enddef_msg_extra), intent (in) :: msg_extra
   integer, intent (out)                    :: buffer(msg_extra_size)

   buffer  (1)    = msg_extra%reqest_type
   buffer  (2)    = msg_extra%datatype
   buffer  (3)    = msg_extra%len_int_data
   buffer  (4)    = msg_extra%len_coord_data
   buffer  (5)    = msg_extra%global_comp_id
   buffer  (6)    = msg_extra%transi_out_id
   buffer  (7)    = msg_extra%num_volumes
   buffer  (8)    = msg_extra%num_int_per_vol
   buffer  (9)    = msg_extra%num_items_per_coord
   if (msg_extra%partition_avail) then
      buffer (10)    = 1
   else
      buffer (10)    = 0
   endif
   buffer (11:13) = msg_extra%partition(:)
   buffer (14)    = msg_extra%num_neigh
   buffer (15)    = msg_extra%local_grid_id
   buffer (16)    = msg_extra%idx_req
#ifdef DEBUGX
  PRINT *, ' pack reqest_type         ', buffer   (1)
  PRINT *, ' pack datatype            ', buffer   (2)
  PRINT *, ' pack len_int_data        ', buffer   (3)
  PRINT *, ' pack len_coord_data      ', buffer   (4)
  PRINT *, ' pack global_comp_id      ', buffer   (5)
  PRINT *, ' pack transi_out_id       ', buffer   (6)
  PRINT *, ' pack num_volumes         ', buffer   (7)
  PRINT *, ' pack num_int_per_vol     ', buffer   (8)
  PRINT *, ' pack num_items_per_coord ', buffer   (9)
  PRINT *, ' pack partition_avail     ', buffer  (10) /= 0
  PRINT *, ' pack partition(:)        ', buffer  (11:13)
  PRINT *, ' pack num_neigh           ', buffer  (14)
  PRINT *, ' pack local_grid_id       ', buffer  (15)
  PRINT *, ' pack idx_req             ', buffer  (16)
#endif

end subroutine psmile_pack_msg_extra

subroutine psmile_unpack_msg_extra (msg_extra, buffer)
   use psmile_common, only : enddef_msg_extra, msg_extra_size

   implicit none

   type (enddef_msg_extra), intent (out) :: msg_extra
   integer, intent (in)                      :: buffer(msg_extra_size)

   msg_extra%reqest_type         = buffer  (1)
   msg_extra%datatype            = buffer  (2)
   msg_extra%len_int_data        = buffer  (3)
   msg_extra%len_coord_data      = buffer  (4)
   msg_extra%global_comp_id      = buffer  (5)
   msg_extra%transi_out_id       = buffer  (6)
   msg_extra%num_volumes         = buffer  (7)
   msg_extra%num_int_per_vol     = buffer  (8)
   msg_extra%num_items_per_coord = buffer  (9)
   msg_extra%partition_avail     = buffer (10) /= 0
   msg_extra%partition(:)        = buffer (11:13)
   msg_extra%num_neigh           = buffer (14)
   msg_extra%local_grid_id       = buffer (15)
   msg_extra%idx_req             = buffer (16)

#ifdef DEBUGX
  PRINT *, ' unpack reqest_type         ', buffer   (1)
  PRINT *, ' unpack datatype            ', buffer   (2)
  PRINT *, ' unpack len_int_data        ', buffer   (3)
  PRINT *, ' unpack len_coord_data      ', buffer   (4)
  PRINT *, ' unpack global_comp_id      ', buffer   (5)
  PRINT *, ' unpack transi_out_id       ', buffer   (6)
  PRINT *, ' unpack num_volumes         ', buffer   (7)
  PRINT *, ' unpack num_int_per_vol     ', buffer   (8)
  PRINT *, ' unpack num_items_per_coord ', buffer   (9)
  PRINT *, ' unpack partition_avail     ', buffer  (10) /= 0
  PRINT *, ' unpack partition(:)        ', buffer  (11:13)
  PRINT *, ' unpack num_neigh           ', buffer  (14)
  PRINT *, ' unpack local_grid_id       ', buffer  (15)
  PRINT *, ' unpack idx_req             ', buffer  (16)
#endif

end subroutine psmile_unpack_msg_extra