psmile_enddef_msg_inters_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_intersections. In addition there are two routines
! which allow to convert between object from this type and a integer
! array which is sendable via MPI.
! Since objects of type enddef_msg_intersections have a dynamical
! size it seems unpractically for me to create a MPI datatype for
! sending these objects.
!
!
! !REVISION HISTORY:
!
!   Date      Programmer   Description
! ----------  ----------   -----------
! 25.11.10    M. Hanke     created
!
!----------------------------------------------------------------------
!
!  $Id: psmile_enddef_msg_inters_utils.F90 2792 2010-12-01 17:35:05Z hanke $
!  $Author: hanke $
!
!----------------------------------------------------------------------

subroutine psmile_init_enddef_msg_inters (msg_intersections)
   use psmile_common, only : enddef_msg_intersections, &
                             psmile_undef

   implicit none

   type (enddef_msg_intersections), intent (out) :: msg_intersections

   msg_intersections%tgt_comp_id                   = psmile_undef
   msg_intersections%src_comp_id                   = psmile_undef
   msg_intersections%tgt_grid_id                   = psmile_undef
   msg_intersections%src_grid_id                   = psmile_undef
   msg_intersections%first_tgt_all_extents_grid_id = psmile_undef
   msg_intersections%first_src_all_extents_grid_id = psmile_undef
   msg_intersections%first_tgt_method_id           = psmile_undef
   msg_intersections%method_type                   = psmile_undef
   msg_intersections%method_datatype               = psmile_undef
   msg_intersections%all_comp_infos_comp_idx       = psmile_undef
   msg_intersections%first_tgt_var_id              = psmile_undef
   msg_intersections%tgt_mask_id                   = psmile_undef
   msg_intersections%transient_in_id               = psmile_undef
   msg_intersections%transient_out_id              = psmile_undef
   msg_intersections%num_vars                      = psmile_undef
   msg_intersections%num_parts                     = psmile_undef
   msg_intersections%relative_msg_tag              = psmile_undef
   msg_intersections%requires_conserv_remap        = psmile_undef

   nullify (msg_intersections%intersections)

end subroutine psmile_init_enddef_msg_inters

subroutine psmile_pack_msg_intersections (msg_intersections, buffer)
   use psmile_common, only : enddef_msg_intersections, ndim_3d, &
                             ip_msgint_inter, nd_msgint, psmile_undef 

   implicit none

   type (enddef_msg_intersections), intent (in) :: msg_intersections
   integer, intent (out)                        :: buffer(nd_msgint)

   integer :: npart, offset, n

   buffer = psmile_undef

   buffer  (1) = msg_intersections%src_comp_id
   buffer  (2) = msg_intersections%first_src_all_extents_grid_id
   buffer  (3) = msg_intersections%tgt_comp_id
   buffer  (4) = msg_intersections%tgt_grid_id
   buffer  (5) = msg_intersections%first_tgt_all_extents_grid_id
   buffer  (6) = msg_intersections%first_tgt_method_id
   buffer  (7) = msg_intersections%method_type
   buffer  (8) = msg_intersections%method_datatype
   buffer  (9) = msg_intersections%all_comp_infos_comp_idx
   buffer (10) = msg_intersections%first_tgt_var_id
   buffer (11) = msg_intersections%tgt_mask_id
   buffer (12) = msg_intersections%transient_in_id
   buffer (13) = msg_intersections%num_parts
   buffer (14) = msg_intersections%transient_out_id
   buffer (15) = msg_intersections%num_vars
   buffer (16) = msg_intersections%requires_conserv_remap
   buffer (17) = msg_intersections%relative_msg_tag

   npart = msg_intersections%num_parts

   if (npart > 0) then

      do n = 1, npart
         buffer (ip_msgint_inter+1+(n-1)*2*ndim_3d:ip_msgint_inter+n*2*ndim_3d) = &
               pack (msg_intersections%intersections(n)%intersection, .true.)
      enddo

      buffer (ip_msgint_inter+2*ndim_3d*npart+1:ip_msgint_inter+2*ndim_3d*npart+npart) = &
         msg_intersections%intersections(1:npart)%tgt_all_extents_grid_id

      buffer (ip_msgint_inter+2*ndim_3d*npart+npart+1:ip_msgint_inter+2*ndim_3d*npart+2*npart) = &
         msg_intersections%intersections(1:npart)%src_all_extents_grid_id

      ! if there is additional data for gridless grids
      if (npart < size (msg_intersections%intersections)) then

         buffer(ip_msgint_inter+2*ndim_3d*npart+2*npart+1) = msg_intersections%num_parts

         do n = 1, size (msg_intersections%intersections) - npart

            buffer(ip_msgint_inter+2*ndim_3d*npart+2*npart+2+(n-1)*2*ndim_3d: &
                   ip_msgint_inter+2*ndim_3d*npart+2*npart+1+n*2*ndim_3d) =   &
               pack (msg_intersections%intersections(n+npart)%intersection, .true.)
         enddo
      endif
   endif
end subroutine psmile_pack_msg_intersections

subroutine psmile_unpack_msg_intersections (msg_intersections, buffer)
   use psmile_common, only : enddef_msg_intersections, ndim_3d, &
                             ip_msgint_inter, nd_msgint, psmile_undef

   implicit none

   type (enddef_msg_intersections), intent (out) :: msg_intersections
   integer, intent (in)                          :: buffer(nd_msgint)

   integer :: n, npart, npart_alloc

   msg_intersections%src_comp_id                   = buffer  (1)
   msg_intersections%first_src_all_extents_grid_id = buffer  (2)
   msg_intersections%tgt_comp_id                   = buffer  (3)
   msg_intersections%tgt_grid_id                   = buffer  (4)
   msg_intersections%first_tgt_all_extents_grid_id = buffer  (5)
   msg_intersections%first_tgt_method_id           = buffer  (6)
   msg_intersections%method_type                   = buffer  (7)
   msg_intersections%method_datatype               = buffer  (8)
   msg_intersections%all_comp_infos_comp_idx       = buffer  (9)
   msg_intersections%first_tgt_var_id              = buffer (10)
   msg_intersections%tgt_mask_id                   = buffer (11)
   msg_intersections%transient_in_id               = buffer (12)
   msg_intersections%num_parts                     = buffer (13)
   msg_intersections%transient_out_id              = buffer (14)
   msg_intersections%num_vars                      = buffer (15)
   msg_intersections%requires_conserv_remap        = buffer (16)
   msg_intersections%relative_msg_tag              = buffer (17)

   npart = msg_intersections%num_parts

   ! In case we have a gridless grid npart is stored twice in buffer
   if (buffer(ip_msgint_inter+2*ndim_3d*npart+2*npart+1) == buffer (13)) then
      npart_alloc = 2 * npart
   else
      npart_alloc = npart
   endif

   if (npart > 0) then

      allocate (msg_intersections%intersections(npart_alloc))

      do n = 1, msg_intersections%num_parts
         msg_intersections%intersections(n)%intersection = &
            reshape (buffer(ip_msgint_inter+1+(n-1)*2*ndim_3d:ip_msgint_inter+n*2*ndim_3d), &
                     (/2,ndim_3d/))
      enddo

      msg_intersections%intersections(1:npart)%tgt_all_extents_grid_id = &
         buffer (ip_msgint_inter+2*ndim_3d*npart+1:ip_msgint_inter+2*ndim_3d*npart+npart)

      msg_intersections%intersections(1:npart)%src_all_extents_grid_id = &
         buffer (ip_msgint_inter+2*ndim_3d*npart+npart+1:ip_msgint_inter+2*ndim_3d*npart+2*npart)

      ! if we have a gridless grid, then there is additional grid information in buffer
      if (npart /= npart_alloc) then

         msg_intersections%intersections(npart+1:npart_alloc)%tgt_all_extents_grid_id = psmile_undef
         msg_intersections%intersections(npart+1:npart_alloc)%src_all_extents_grid_id = psmile_undef

         do n = 1, msg_intersections%num_parts

            msg_intersections%intersections(n+npart)%intersection =                       &
               reshape (buffer(ip_msgint_inter+2*ndim_3d*npart+2*npart+2+(n-1)*2*ndim_3d: &
                               ip_msgint_inter+2*ndim_3d*npart+2*npart+1+n*2*ndim_3d),    &
                        (/2,ndim_3d/))
         enddo
      endif

   else

      nullify (msg_intersections%intersections)

   endif

end subroutine psmile_unpack_msg_intersections

subroutine psmile_copy_msg_intersections (msg_intersections_to, &
                                          msg_intersections_from)
   use psmile_common, only : enddef_msg_intersections

   implicit none

   type (enddef_msg_intersections), intent (in)  :: msg_intersections_from
   type (enddef_msg_intersections), intent (out) :: msg_intersections_to

   msg_intersections_to = msg_intersections_from

   nullify (msg_intersections_to%intersections)

   allocate (msg_intersections_to%intersections (size (msg_intersections_from%intersections)))

   msg_intersections_to%intersections = msg_intersections_from%intersections

end subroutine psmile_copy_msg_intersections