g2jpc.F90

Go to the documentation of this file.

 
 
subroutine jpcpack(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_jpcpackd(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_jpcpackd
     end function g2c_jpcpackd
     function g2c_jpcpackf(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_jpcpackf
     end function g2c_jpcpackf
  end interface
 
  width_c = width
  height_c = height
 
#if KIND==4
  ret = g2c_jpcpackf(fld, width_c, height_c, idrstmpl, cpack, lcpack)
#else
  ret = g2c_jpcpackd(fld, width_c, height_c, idrstmpl, cpack, lcpack)
#endif
 
subroutine jpcpack(fld,width,height,idrstmpl,cpack,lcpack) …
end subroutine
 
subroutine jpcunpack(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_jpcunpackd(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_jpcunpackd
   end function g2c_jpcunpackd
   function g2c_jpcunpackf(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_jpcunpackf
   end function g2c_jpcunpackf
  end interface
 
  len_c = len
  ndpts_c = ndpts
#if KIND==4
  ret = g2c_jpcunpackf(cpack, len_c, idrstmpl, ndpts_c, fld)
#else
  ret = g2c_jpcunpackd(cpack, len_c, idrstmpl, ndpts_c, fld)
#endif
 
subroutine jpcunpack(cpack,len,idrstmpl,ndpts,fld) …
end subroutine jpcunpack