!c Description:
!c   変数を作り変える
!c
!c Current Code Owner: 
!c   sugiyama@gfd-dennou.org
!c
!c Histry: 
!c   Version    Date          Comment
!c   -------    ----------    --------
!c   1.0        2003-02-27    作成
!c
!c Copyright (C) SUGIYAMA Ko-ichiro, 2003, All rights reserved

module interface_packing
  interface packing

     subroutine packing_1d_int(var, sw, var_new)
       integer, intent(in)                :: var(:)
       integer, intent(out), allocatable  :: var_new(:)
       logical                               :: sw(:)
     end subroutine packing_1d_int

     subroutine packing_1d_real(var, sw, var_new)
       real(8), intent(in)                :: var(:)
       real(8), intent(out), allocatable  :: var_new(:)
       logical                            :: sw(:)
     end subroutine packing_1d_real

     subroutine packing_property(var, sw, var_new)
       use prm_type, only: type_property
       type(type_property), intent(in)                :: var(:)
       type(type_property), intent(out), allocatable  :: var_new(:)
       logical                                        :: sw(:)
     end subroutine packing_property

     subroutine packing_2d_real(var, ssw, esw, var_new)
       real(8), intent(in)                :: var(:,:)
       real(8), intent(out), allocatable  :: var_new(:,:)
       logical                            :: ssw(:)
       logical                            :: esw(:)
     end subroutine packing_2d_real

     subroutine packing_2d_int(var, ssw, esw, var_new)
       integer, intent(in)                :: var(:,:)
       integer, intent(out), allocatable  :: var_new(:,:)
       logical                               :: ssw(:)
       logical                               :: esw(:)
     end subroutine packing_2d_int

  end interface
end module interface_packing




subroutine packing_1d_int(var, sw, var_new)
  implicit none
  integer, intent(in)                :: var(:)
  integer, intent(out), allocatable  :: var_new(:)
  logical                               :: sw(:)

  integer                            :: M


  M = count(sw)
  allocate(var_new(M))

  var_new = pack(var, sw)

end subroutine packing_1d_int



subroutine packing_1d_real(var, sw, var_new)
  implicit none
  real(8), intent(in)                :: var(:)
  real(8), intent(out), allocatable  :: var_new(:)
  logical                            :: sw(:)

  integer                         :: M

  M = count(sw)
  allocate(var_new(M))

  var_new = pack(var, sw)

end subroutine packing_1d_real



subroutine packing_property(var, sw, var_new)
  use prm_type, only: type_property

  implicit none
  type(type_property), intent(in)                :: var(:)
  type(type_property), intent(out), allocatable  :: var_new(:)
  logical                                        :: sw(:)
  
  integer                                     :: M
  

  M = count(sw)
  allocate(var_new(M))

  var_new = pack(var, sw)
  
end subroutine packing_property



subroutine packing_2d_real(var, ssw, esw, var_new)
  implicit none
  real(8), intent(in)                :: var(:,:)
  real(8), intent(out), allocatable  :: var_new(:,:)
  logical                            :: ssw(:)
  logical                            :: esw(:)

  real(8), allocatable               :: var_tmp(:,:)
  integer                         :: N2
  integer                         :: M1, M2
  integer                         :: s


  N2 = size(var, 2)
  M1 = count(ssw)
  M2 = count(esw)
  allocate(var_new(M1, M2), var_tmp(M1, N2))  

  do s = 1, N2
     var_tmp(:,s) = pack(var(:,s), ssw)
  end do
  
  do s = 1, M1
     var_new(s,:) = pack(var_tmp(s,:), esw)
  end do

  deallocate(var_tmp)
  
end subroutine packing_2d_real



subroutine packing_2d_int(var, ssw, esw, var_new)
  implicit none
  integer, intent(in)                :: var(:,:)
  integer, intent(out), allocatable  :: var_new(:,:)
  logical                               :: ssw(:)
  logical                               :: esw(:)

  integer, allocatable               :: var_tmp(:,:)
  integer                            :: N2
  integer                            :: M1, M2
  integer                            :: s


  N2 = size(var, 2)
  M1 = count(ssw)
  M2 = count(esw)
  allocate(var_new(M1, M2), var_tmp(M1, N2))  

  do s = 1, N2
     var_tmp(:,s) = pack(var(:,s), ssw)
  end do

  do s = 1, M1
     var_new(s,:) = pack(var_tmp(s,:), esw)
  end do

  deallocate(var_tmp)

end subroutine packing_2d_int



