g2png.F90

Go to the documentation of this file.

 
 
subroutine pngpack(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(out) :: lcpack
  integer(c_size_t) :: width_c, height_c
  integer :: ret
 
  interface
     function g2c_pngpackd(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_pngpackd
     end function g2c_pngpackd
     function g2c_pngpackf(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_pngpackf
     end function g2c_pngpackf
  end interface
 
  width_c = width
  height_c = height
 
#if KIND==4
  ret = g2c_pngpackf(fld, width_c, height_c, idrstmpl, cpack, lcpack)
#else
  ret = g2c_pngpackd(fld, width_c, height_c, idrstmpl, cpack, lcpack)
#endif
 
subroutine pngpack(fld, width, height, idrstmpl, cpack, lcpack) …
end subroutine pngpack
 
subroutine pngunpack(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_pngunpackd(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_pngunpackd
   end function g2c_pngunpackd
   function g2c_pngunpackf(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_pngunpackf
   end function g2c_pngunpackf
  end interface
 
  len_c = len
  ndpts_c = ndpts
#if KIND==4
  ret = g2c_pngunpackf(cpack, len_c, idrstmpl, ndpts_c, fld)
#else
  ret = g2c_pngunpackd(cpack, len_c, idrstmpl, ndpts_c, fld)
#endif
 
subroutine pngunpack(cpack, len, idrstmpl, ndpts, fld) …
end subroutine pngunpack