g2aec.F90

Go to the documentation of this file.

 
 
subroutine aecpack(fld,width,height,idrstmpl,cpack,lcpack)
 
  use, intrinsic :: iso_c_binding, only: c_size_t
  implicit none
  
  integer,intent(in) :: width,height
  real,intent(in) :: fld(width*height)
  character(len=1),intent(out) :: cpack(*)
  integer,intent(inout) :: idrstmpl(*)
  integer,intent(inout) :: lcpack
  integer(c_size_t) :: width_c, height_c
  integer :: ret
 
  interface
   function g2c_aecpackd(fld, width, height, idrstmpl, cpack, lcpack) bind(c)
    use, intrinsic :: iso_c_binding
    real(kind=c_double), intent(in):: fld(*)
    integer(c_size_t), value, intent(in) :: width, height
    integer(c_int), intent(inout) :: idrstmpl(*)
    character(kind=c_char), intent(out) :: cpack(*)
    integer(c_int), intent(out) :: lcpack
    integer(c_int) :: g2c_aecpackd
   end function g2c_aecpackd
   function g2c_aecpackf(fld, width, height, idrstmpl, cpack, lcpack) bind(c)
    use, intrinsic :: iso_c_binding
    real(kind=c_float), intent(in):: fld(*)
    integer(c_size_t), value, intent(in) :: width, height
    integer(c_int), intent(inout) :: idrstmpl(*)
    character(kind=c_char), intent(out) :: cpack(*)
    integer(c_int), intent(out) :: lcpack
    integer(c_int) :: g2c_aecpackf
   end function g2c_aecpackf
  end interface
 
  width_c = width
  height_c = height
  
#if KIND==4
  ret = g2c_aecpackf(fld, width_c, height_c, idrstmpl, cpack, lcpack)
#else
  ret = g2c_aecpackd(fld, width_c, height_c, idrstmpl, cpack, lcpack)
#endif
 
end subroutine
  
subroutine aecunpack(cpack,len,idrstmpl,ndpts,fld)
  
  use, intrinsic :: iso_c_binding, only: c_size_t
  implicit none
  
  character(len=1),intent(in) :: cpack(len)
  integer,intent(in) :: ndpts,len
  integer,intent(in) :: idrstmpl(*)
  real,intent(out) :: fld(ndpts)
  integer(c_size_t) :: ndpts_c, len_c
  integer :: ret
 
  interface
   function g2c_aecunpackd(cpack, len, idrstmpl, ndpts, fld) bind(c)
    use, intrinsic :: iso_c_binding
    implicit none 
    integer(c_size_t), value, intent(in) :: len
    integer(c_size_t), value, intent(in) :: ndpts 
    character(kind=c_char), intent(in) :: cpack(*)
    integer(c_int), intent(in) :: idrstmpl(*)
    real(kind=c_double), intent(out) :: fld(*)
    integer(c_int) :: g2c_aecunpackd
   end function g2c_aecunpackd
   function g2c_aecunpackf(cpack, len, idrstmpl, ndpts, fld) bind(c)
    use, intrinsic :: iso_c_binding
    implicit none 
    integer(c_size_t), value, intent(in) :: len
    integer(c_size_t), value, intent(in) :: ndpts 
    character(kind=c_char), intent(in) :: cpack(*)
    integer(c_int), intent(in) :: idrstmpl(*)
    real(kind=c_float), intent(out) :: fld(*)
    integer(c_int) :: g2c_aecunpackf
   end function g2c_aecunpackf
  end interface
 
  len_c = len
  ndpts_c = ndpts
#if KIND==4
  ret = g2c_aecunpackf(cpack, len_c, idrstmpl, ndpts_c, fld)
#else
  ret = g2c_aecunpackd(cpack, len_c, idrstmpl, ndpts_c, fld)
#endif
  
end subroutine aecunpack