bufr_c2f_interface.F90

Go to the documentation of this file.

 
 
module bufr_c2f_interface
 
  use iso_c_binding
 
  implicit none
 
  private
  public :: open_c, close_c, openbf_c, closbf_c, exitbufr_c, bort_c, readmg_c, readsb_c, readns_c, ireadmg_c, ireadsb_c
  public :: ireadns_c, openmb_c, openmg_c, ufbint_c, ufbrep_c, ufbseq_c, mtinfo_c, bvers_c, status_c, ibfms_c
  public :: get_isc_c, get_link_c, get_itp_c, get_typ_c, get_tag_c, get_jmpb_c, get_inode_c, get_nval_c, get_val_c
  public :: get_inv_c, get_irf_c, readlc_c, delete_table_data_c, cmpmsg_c, catch_borts_c, check_for_bort_c, iupbs01_c
  public :: imrkopr_c, istdesc_c, ifxy_c, igetntbi_c, igettdi_c, stntbi_c, igetprm_c, isetprm_c, maxout_c, igetmxby_c
  public :: elemdx_c, cadn30_c, strnum_c, uptdd_c, pktdd_c, nemdefs_c, nemspecs_c, nemtab_c, nemtbb_c, numtbd_c
  public :: writsb_c, writsa_c, ufbstp_c, writlc_c, drfini_c, ufbcnt_c, ufbevn_c, ufbqcd_c, ufbqcp_c, getcfmng_c
  public :: upftbv_c, ufbtab_c, ufbpos_c, datelen_c, iupvs01_c, nmsub_c, pkvs01_c, datebf_c, dumpbf_c, minimg_c, upds3_c
  public :: pkbs1_c, strcpt_c, rtrcpt_c, atrcpt_c, dxdump_c, ufbdmp_c, ufdump_c, copybf_c, copymg_c, copysb_c, ufbcpy_c
  public :: readerme_c, rdmgsb_c, ufbmem_c, ufbmex_c, ufbmms_c, ufbmns_c, rdmemm_c, rdmems_c, ufbrms_c, ufbtam_c
  public :: cpymem_c, ufbcup_c, stdmsg_c, stndrd_c, codflg_c, gettagpr_c, gettagre_c, cnved4_c, lcmgdf_c
  public :: setvalnb_c, getvalnb_c, getabdb_c, ufbget_c, ufbinx_c, ufbovr_c, closmg_c, ifbget_c, igetsc_c
  public :: wrdxtb_c, mesgbf_c, mesgbc_c, invmrg_c, ipkm_c, iupm_c
 
  integer, allocatable, target, save :: isc_f(:), link_f(:), itp_f(:), jmpb_f(:), irf_f(:)
  character(len=10), allocatable, target, save :: tag_f(:)
  character(len=3), allocatable, target, save :: typ_f(:)
 
  contains
 
    function get_c_string_length(c_str) result(nchars)
      character(kind=c_char, len=1), intent(in) :: c_str(*)
      integer :: nchars
 
      nchars = 1
      do while (c_str(nchars) /= c_null_char)
        nchars = nchars + 1
      end do
      nchars = nchars - 1
    end function get_c_string_length
 
    function c_f_string(c_str) result(f_str)
      character(kind=c_char, len=1), intent(in) :: c_str(*)
      character(len=:), allocatable :: f_str
      integer :: nchars
 
      nchars = get_c_string_length(c_str)
 
      allocate(character(len=nchars) :: f_str)
      f_str = transfer(c_str(1:nchars), f_str)
    end function c_f_string
 
    subroutine copy_f_c_str(f_str, c_str, c_str_len)
      character(len=*), intent(in) :: f_str
      character(kind=c_char), intent(inout) :: c_str(*)
      integer, intent(in) :: c_str_len
      integer :: ii
 
      if (c_str_len /= 0) then
        do ii = 1, c_str_len
          c_str(ii) = f_str(ii:ii)
        enddo
        c_str(c_str_len) = c_null_char
      end if
    end subroutine copy_f_c_str
 
    subroutine open_c(lunit, filepath) bind(C, name='open_f')
      integer(c_int), value, intent(in) :: lunit
      character(kind=c_char) :: filepath
 
      open(lunit, file=c_f_string(filepath))
    end subroutine open_c
 
    subroutine close_c(lunit) bind(C, name='close_f')
      integer(c_int), value, intent(in) :: lunit
 
      close(unit=lunit)
    end subroutine close_c
 
    recursive subroutine openbf_c(bufr_unit, cio, table_file_id) bind(C, name='openbf_f')
      integer(c_int), value, intent(in) :: bufr_unit, table_file_id
      character(kind=c_char), intent(in) :: cio(*)
      character(len=5) :: io
      integer :: lio
 
      lio = get_c_string_length(cio)
      if (lio == 0) then
        io(1:1) = ' '
        lio = 1
      else
        io = transfer(cio(1:lio), io)
      endif
      call openbf(bufr_unit, io(1:lio), table_file_id)
    end subroutine openbf_c
 
    recursive subroutine closbf_c(bufr_unit) bind(C, name='closbf_f')
      integer(c_int), value, intent(in) :: bufr_unit
 
      call closbf(bufr_unit)
    end subroutine closbf_c
 
    subroutine exitbufr_c() bind(C, name='exitbufr_f')
      call exitbufr()
    end subroutine exitbufr_c
 
    function ireadmg_c(bufr_unit, c_subset, iddate, subset_str_len) result(ires) bind(C, name='ireadmg_f')
      integer(c_int), value, intent(in) :: bufr_unit, subset_str_len
      character(kind=c_char), intent(out) :: c_subset(*)
      integer(c_int), intent(out) :: iddate
      integer(c_int) :: ires
      character(len=25) :: f_subset
      integer :: ireadmg
 
      ires = ireadmg(bufr_unit, f_subset, iddate)
 
      if (ires == 0) then
        call copy_f_c_str(f_subset, c_subset, subset_str_len)
      end if
    end function ireadmg_c
 
    recursive subroutine readmg_c(bufr_unit, c_subset, iddate, subset_str_len, ires) bind(C, name='readmg_f')
      integer(c_int), value, intent(in) :: bufr_unit, subset_str_len
      character(kind=c_char), intent(out) :: c_subset(*)
      integer(c_int), intent(out) :: iddate, ires
      character(len=25) :: f_subset
 
      call readmg(bufr_unit, f_subset, iddate, ires)
 
      if (ires == 0) then
        call copy_f_c_str(f_subset, c_subset, subset_str_len)
      end if
    end subroutine readmg_c
 
    function ireadsb_c(bufr_unit) result(ires) bind(C, name='ireadsb_f')
      integer(c_int), value, intent(in) :: bufr_unit
      integer(c_int) :: ires
      integer :: ireadsb
 
      ires = ireadsb(bufr_unit)
    end function ireadsb_c
 
    recursive subroutine readsb_c(bufr_unit, ires) bind(C, name='readsb_f')
      integer(c_int), value, intent(in) :: bufr_unit
      integer(c_int), intent(out) :: ires
 
      call readsb(bufr_unit, ires)
    end subroutine readsb_c
 
    recursive subroutine writsb_c(bufr_unit) bind(C, name='writsb_f')
      integer(c_int), value, intent(in) :: bufr_unit
 
      call writsb(bufr_unit)
    end subroutine writsb_c
 
    recursive subroutine writsa_c(bufr_unit, bufr_len, bufr, nbufr) bind(C, name='writsa_f')
      integer(c_int), value, intent(in) :: bufr_unit, bufr_len
      integer(c_int), intent(out) :: bufr(*), nbufr
 
      call writsa(bufr_unit, bufr_len, bufr, nbufr)
    end subroutine writsa_c
 
    recursive subroutine ufbint_c(bufr_unit, c_data, dim_1, dim_2, iret, table_b_mnemonic) bind(C, name='ufbint_f')
      integer(c_int), value, intent(in) :: bufr_unit, dim_1, dim_2
      type(c_ptr), intent(inout) ::  c_data
      integer(c_int), intent(out) :: iret
      character(kind=c_char), intent(in) :: table_b_mnemonic(*)
      character(len=90) :: str
      real, pointer :: f_data
      integer :: lstr
 
      lstr = get_c_string_length(table_b_mnemonic)
      if (lstr == 0) then
        str(1:1) = ' '
        lstr = 1
      else
        str = transfer(table_b_mnemonic(1:lstr), str)
      endif
      call c_f_pointer(c_data, f_data)
      call ufbint(bufr_unit, f_data, dim_1, dim_2, iret, str(1:lstr))
    end subroutine ufbint_c
 
    recursive subroutine ufbrep_c(bufr_unit, c_data, dim_1, dim_2, iret, table_b_mnemonic) bind(C, name='ufbrep_f')
      integer(c_int), value, intent(in) :: bufr_unit, dim_1, dim_2
      type(c_ptr), intent(inout) :: c_data
      integer(c_int), intent(out) :: iret
      character(kind=c_char), intent(in) :: table_b_mnemonic(*)
      character(len=90) :: str
      real, pointer :: f_data
      integer :: lstr
 
      lstr = get_c_string_length(table_b_mnemonic)
      if (lstr == 0) then
        str(1:1) = ' '
        lstr = 1
      else
        str = transfer(table_b_mnemonic(1:lstr), str)
      endif
      call c_f_pointer(c_data, f_data)
      call ufbrep(bufr_unit, f_data, dim_1, dim_2, iret, str(1:lstr))
    end subroutine ufbrep_c
 
    recursive subroutine ufbstp_c(bufr_unit, c_data, dim_1, dim_2, iret, table_b_mnemonic) bind(C, name='ufbstp_f')
      integer(c_int), value, intent(in) :: bufr_unit, dim_1, dim_2
      type(c_ptr), intent(inout) :: c_data
      integer(c_int), intent(out) :: iret
      character(kind=c_char), intent(in) :: table_b_mnemonic(*)
      character(len=90) :: str
      real, pointer :: f_data
      integer :: lstr
 
      lstr = get_c_string_length(table_b_mnemonic)
      if (lstr == 0) then
        str(1:1) = ' '
        lstr = 1
      else
        str = transfer(table_b_mnemonic(1:lstr), str)
      endif
      call c_f_pointer(c_data, f_data)
      call ufbstp(bufr_unit, f_data, dim_1, dim_2, iret, str(1:lstr))
    end subroutine ufbstp_c
 
    recursive subroutine ufbevn_c(bufr_unit, c_data, dim_1, dim_2, dim_3, iret, table_b_mnemonic) bind(C, name='ufbevn_f')
      integer(c_int), value, intent(in) :: bufr_unit, dim_1, dim_2, dim_3
      type(c_ptr), intent(out) ::  c_data
      integer(c_int), intent(out) :: iret
      character(kind=c_char), intent(in) :: table_b_mnemonic(*)
      character(len=90) :: str
      real, pointer :: f_data
      integer :: lstr
 
      lstr = get_c_string_length(table_b_mnemonic)
      if (lstr == 0) then
        str(1:1) = ' '
        lstr = 1
      else
        str = transfer(table_b_mnemonic(1:lstr), str)
      endif
      call c_f_pointer(c_data, f_data)
      call ufbevn(bufr_unit, f_data, dim_1, dim_2, dim_3, iret, str(1:lstr))
    end subroutine ufbevn_c
 
    subroutine mtinfo_c(path, file_unit_1, file_unit_2) bind(C, name='mtinfo_f')
      character(kind=c_char), intent(in) :: path(*)
      integer(c_int), value, intent(in) :: file_unit_1, file_unit_2
      character(len=240) :: mtdir
      integer :: lmtdir
 
      lmtdir = get_c_string_length(path)
      if (lmtdir == 0) then
        mtdir(1:1) = ' '
        lmtdir = 1
      else
        mtdir = transfer(path(1:lmtdir), mtdir)
      endif
      call mtinfo(mtdir(1:lmtdir), file_unit_1, file_unit_2)
    end subroutine mtinfo_c
 
    recursive subroutine status_c(file_unit, lun, il, im) bind(C, name='status_f')
      integer(c_int), value, intent(in) :: file_unit
      integer(c_int), intent(out) :: lun
      integer(c_int), intent(out) :: il
      integer(c_int), intent(out) :: im
 
      call status(file_unit, lun, il, im)
    end subroutine status_c
 
    subroutine nemdefs_c(file_unit, mnemonic, unit_c, unit_str_len, desc_c, desc_str_len, iret) &
            bind(c, name='nemdefs_f')
      integer(c_int), value, intent(in) :: file_unit, unit_str_len, desc_str_len
      character(kind=c_char), intent(in) :: mnemonic(*)
      character(kind=c_char), intent(out) :: unit_c(*), desc_c(*)
      integer(c_int), intent(out) :: iret
      character(len=25) :: unit_f
      character(len=55) :: desc_f
      character(len=10) :: tag
      integer :: ltag
 
      ltag = get_c_string_length(mnemonic)
      if (ltag == 0) then
        tag(1:1) = ' '
        ltag = 1
      else
        tag = transfer(mnemonic(1:ltag), tag)
      endif
 
      ! Get the unit and description strings
      call nemdefs ( file_unit, tag(1:ltag), desc_f, unit_f, iret)
 
      if (iret == 0) then
        ! Copy the unit Fortran string into the resulting C-style string.
        call copy_f_c_str(unit_f, unit_c, min(len(unit_f), unit_str_len))
        ! Copy the descriptor Fortran string into the resulting C-style string.
        call copy_f_c_str(desc_f, desc_c, min(len(desc_f), desc_str_len))
      end if
    end subroutine nemdefs_c
 
    subroutine nemspecs_c(file_unit, mnemonic, mnemonic_idx, scale, reference, bits, iret) &
            bind(c, name='nemspecs_f')
      integer(c_int), value, intent(in) :: file_unit, mnemonic_idx
      character(kind=c_char), intent(in) :: mnemonic(*)
      integer(c_int), intent(out) :: scale, reference, bits, iret
      character(len=10) :: tag
      integer :: ltag
 
      ltag = get_c_string_length(mnemonic)
      if (ltag == 0) then
        tag(1:1) = ' '
        ltag = 1
      else
        tag = transfer(mnemonic(1:ltag), tag)
      endif
 
      ! Get the scale, reference and bits
      call nemspecs(file_unit, tag(1:ltag), mnemonic_idx, scale, reference, bits, iret)
    end subroutine nemspecs_c
 
    subroutine nemtab_c(lun, mnemonic, descriptor, table_type, table_idx) &
            bind(c, name='nemtab_f')
      integer(c_int), value, intent(in) :: lun
      character(kind=c_char), intent(in) :: mnemonic(*)
      integer(c_int), intent(out) :: descriptor, table_idx
      character(kind=c_char), intent(out) :: table_type(*)
      character(len=1) :: table_type_f
      character(len=10) :: tag
      integer :: ltag
 
      ltag = get_c_string_length(mnemonic)
      if (ltag == 0) then
        tag(1:1) = ' '
        ltag = 1
      else
        tag = transfer(mnemonic(1:ltag), tag)
      endif
 
      call nemtab(lun, tag(1:ltag), descriptor, table_type_f, table_idx)
 
      table_type(1) = table_type_f(1:1)
    end subroutine nemtab_c
 
    subroutine nemtbb_c(lun, table_idx, unit_str, unit_str_len, scale, reference, bits) &
            bind(c, name='nemtbb_f')
      integer(c_int), intent(in), value :: lun
      integer(c_int), intent(in), value :: table_idx
      character(kind=c_char), intent(out) :: unit_str(*)
      integer(c_int), intent(in), value :: unit_str_len
      integer(c_int), intent(out) :: scale
      integer(c_int), intent(out) :: reference
      integer(c_int), intent(out) :: bits
 
      character(len=25) :: unit_str_f
 
      ! Get the scale, reference and bits
      call nemtbb( lun, table_idx, unit_str_f, scale, reference, bits)
      call copy_f_c_str(unit_str_f, unit_str, min(len(unit_str_f), unit_str_len))
    end subroutine nemtbb_c
 
    subroutine get_isc_c(isc_ptr, isc_size) bind(C, name='get_isc_f')
      use moda_tables
      type(c_ptr), intent(inout) :: isc_ptr
      integer(c_int), intent(out) :: isc_size
 
      allocate(isc_f(ntab))
      isc_f(1:ntab) = isc(1:ntab)
      isc_size = size(isc_f)
      isc_ptr = c_loc(isc_f(1))
    end subroutine get_isc_c
 
    subroutine get_link_c(link_ptr, link_size) bind(C, name='get_link_f')
      use moda_tables
      type(c_ptr), intent(inout) :: link_ptr
      integer(c_int), intent(out) :: link_size
 
      allocate(link_f(ntab))
      link_f(1:ntab) = link(1:ntab)
      link_size = size(link_f)
      link_ptr = c_loc(link_f(1))
    end subroutine get_link_c
 
    subroutine get_itp_c(itp_ptr, itp_size) bind(C, name='get_itp_f')
      use moda_tables
      type(c_ptr), intent(inout) :: itp_ptr
      integer(c_int), intent(out) :: itp_size
 
      allocate(itp_f(ntab))
      itp_f(1:ntab) = itp(1:ntab)
      itp_size = size(itp_f)
      itp_ptr = c_loc(itp_f(1))
    end subroutine get_itp_c
 
    subroutine get_typ_c(typ_ptr, typ_len, mem_size) bind(C, name='get_typ_f')
      use moda_tables
      type(c_ptr), intent(inout) :: typ_ptr
      integer(c_int), intent(out) :: typ_len
      integer(c_int), intent(out) :: mem_size
 
      allocate(typ_f(ntab))
      typ_f(1:ntab) = typ(1:ntab)
      typ_len = len(typ(1))
      mem_size = size(typ_f)
      typ_ptr = c_loc(typ_f(1))
    end subroutine get_typ_c
 
    subroutine get_tag_c(tag_ptr, tag_len, mem_size) bind(C, name='get_tag_f')
      use moda_tables
      type(c_ptr), intent(inout) :: tag_ptr
      integer(c_int), intent(out) :: tag_len
      integer(c_int), intent(out) :: mem_size
 
      allocate(tag_f(ntab))
      tag_f(1:ntab) = tag(1:ntab)
      tag_len = len(tag(1))
      mem_size = size(tag_f)
      tag_ptr = c_loc(tag_f(1))
    end subroutine get_tag_c
 
    subroutine get_jmpb_c(jmpb_ptr, jmpb_size) bind(C, name='get_jmpb_f')
      use moda_tables
      type(c_ptr), intent(inout) :: jmpb_ptr
      integer(c_int), intent(out) :: jmpb_size
 
      allocate(jmpb_f(ntab))
      jmpb_f(1:ntab) = jmpb(1:ntab)
      jmpb_size = size(jmpb_f)
      jmpb_ptr = c_loc(jmpb_f(1))
    end subroutine get_jmpb_c
 
    subroutine get_irf_c(irf_ptr, irf_size) bind(C, name='get_irf_f')
      use moda_tables
      type(c_ptr), intent(inout) :: irf_ptr
      integer(c_int), intent(out) :: irf_size
 
      allocate(irf_f(ntab))
      irf_f(1:ntab) = irf(1:ntab)
      irf_size = size(irf_f)
      irf_ptr = c_loc(irf_f(1))
    end subroutine get_irf_c
 
    subroutine get_inode_c(lun, start_node) bind(C, name='get_inode_f')
      use moda_msgcwd
      integer(c_int), value, intent(in) :: lun
      integer(c_int), intent(out) :: start_node
 
      start_node = inode(lun)
    end subroutine get_inode_c
 
    subroutine get_nval_c(lun, num_nodes) bind(C, name='get_nval_f')
      use moda_usrint
      integer(c_int), value, intent(in) :: lun
      integer(c_int), intent(out) :: num_nodes
 
      num_nodes = nval(lun)
    end subroutine get_nval_c
 
    subroutine get_val_c(lun, val_ptr, val_size) bind(C, name='get_val_f')
      use moda_usrint
      integer(c_int), value, intent(in) :: lun
      type(c_ptr), intent(inout) :: val_ptr
      integer(c_int), intent(out) :: val_size
 
      val_size = size(val(:, lun))
      val_ptr = c_loc(val(1, lun))
    end subroutine get_val_c
 
    subroutine get_inv_c(lun, inv_ptr, inv_size) bind(C, name='get_inv_f')
      use moda_usrint
      integer(c_int), value, intent(in) :: lun
      type(c_ptr), intent(inout) :: inv_ptr
      integer(c_int), intent(out) :: inv_size
 
      inv_size = size(inv(:, lun))
      inv_ptr = c_loc(inv(1, lun))
    end subroutine get_inv_c
 
    recursive subroutine readlc_c(lunit, str_id, output_str, output_str_len) bind(C, name='readlc_f')
      integer(c_int), value, intent(in) :: lunit, output_str_len
      character(kind=c_char), intent(in) :: str_id(*)
      character(kind=c_char), intent(out) :: output_str(*)
      character(len=256) :: output_str_f
      character(len=14) :: str
      integer :: output_str_len_f, lstr
 
      lstr = get_c_string_length(str_id)
      if (lstr == 0) then
        str(1:1) = ' '
        lstr = 1
      else
        str = transfer(str_id(1:lstr), str)
      endif
 
      call readlc(lunit, output_str_f, str(1:lstr))
 
      output_str_len_f = len(trim(output_str_f)) + 1  ! add 1 for the null terminator
      call copy_f_c_str(output_str_f, output_str, min(output_str_len_f, output_str_len))
    end subroutine readlc_c
 
    recursive subroutine writlc_c(lunit, str, chr) bind(C, name='writlc_f')
      integer(c_int), value, intent(in) :: lunit
      character(kind=c_char), intent(in) :: str(*), chr(*)
      character(len=14) :: my_str
      character(len=255) :: my_chr
      integer :: lstr, lchr
 
      lstr = get_c_string_length(str)
      if (lstr == 0) then
        my_str(1:1) = ' '
        lstr = 1
      else
        my_str = transfer(str(1:lstr), my_str)
      endif
 
      lchr = get_c_string_length(chr)
      if (lchr == 0) then
        my_chr(1:1) = ' '
        lchr = 1
      else
        my_chr = transfer(chr(1:lchr), my_chr)
      endif
 
      call writlc(lunit, my_chr(1:lchr), my_str(1:lstr))
    end subroutine writlc_c
 
    subroutine delete_table_data_c() bind(C, name='delete_table_data_f')
      if (allocated(isc_f)) deallocate(isc_f)
      if (allocated(link_f)) deallocate(link_f)
      if (allocated(itp_f)) deallocate(itp_f)
      if (allocated(typ_f)) deallocate(typ_f)
      if (allocated(tag_f)) deallocate(tag_f)
      if (allocated(jmpb_f)) deallocate(jmpb_f)
      if (allocated(irf_f)) deallocate(irf_f)
    end subroutine delete_table_data_c
 
    function iupbs01_c(bufr, mnemonic) result(ires) bind(C, name='iupbs01_f')
      integer(c_int), intent(in) :: bufr(*)
      character(kind=c_char), intent(in) :: mnemonic(*)
      integer(c_int) :: ires
      integer :: iupbs01, ltag
      character(len=10) :: tag
 
      ltag = get_c_string_length(mnemonic)
      if (ltag == 0) then
        tag(1:1) = ' '
        ltag = 1
      else
        tag = transfer(mnemonic(1:ltag), tag)
      endif
 
      ires = iupbs01(bufr,tag(1:ltag))
    end function iupbs01_c
 
    function igetprm_c(cprmnm) result(ires) bind(C, name='igetprm_f')
      character(kind=c_char), intent(in) :: cprmnm(*)
      integer(c_int) :: ires
      integer :: igetprm
 
      ires = igetprm(c_f_string(cprmnm))
    end function igetprm_c
 
    function isetprm_c(cprmnm,ipval) result(ires) bind(C, name='isetprm_f')
      character(kind=c_char), intent(in) :: cprmnm(*)
      integer(c_int), value, intent(in) :: ipval
      integer(c_int) :: ires
      integer :: isetprm
 
      ires = isetprm(c_f_string(cprmnm),ipval)
    end function isetprm_c
 
    subroutine maxout_c(max0) bind(C, name='maxout_f')
      integer(c_int), value, intent(in) :: max0
 
      call maxout(max0)
    end subroutine maxout_c
 
    function igetmxby_c() result(ires) bind(C, name='igetmxby_f')
      integer(c_int) :: ires
      integer :: igetmxby
 
      ires = igetmxby()
    end function igetmxby_c
 
    subroutine cadn30_c(idn, adn, adn_str_len) bind(C, name='cadn30_f')
      integer(c_int), intent(in), value :: idn, adn_str_len
      character(kind=c_char), intent(out) :: adn(*)
      character(len=8) :: adn_f
 
      call cadn30(idn, adn_f)
      call copy_f_c_str(adn_f, adn, adn_str_len)
    end subroutine cadn30_c
 
    function igetntbi_c(lun, table_type) result(ires) bind(C, name='igetntbi_f')
      integer(c_int), value, intent(in) :: lun
      character(kind=c_char), intent(in) :: table_type(*)
      integer(c_int) :: ires
      integer :: igetntbi
      character(len=1) :: table_type_f
 
      table_type_f(1:1) = table_type(1)(1:1)
 
      ires = igetntbi(lun, table_type_f)
    end function igetntbi_c
 
    subroutine elemdx_c(card,lun) bind(C, name='elemdx_f')
      integer(c_int), value, intent(in) :: lun
      character(kind=c_char), intent(in) :: card(*)
      character(len=80) :: card_f
      integer :: ii
 
      do ii = 1,80
        card_f(ii:ii) = card(ii)
      enddo
      call elemdx(card_f, lun)
    end subroutine elemdx_c
 
    subroutine numtbd_c(lun,idn,nemo,nemo_str_len,tab,iret) bind(C, name='numtbd_f')
      integer(c_int), value, intent(in) :: lun, idn, nemo_str_len
      character(kind=c_char), intent(out) :: nemo(*), tab(*)
      integer(c_int), intent(out) :: iret
 
      character(len=9) :: nemo_f
      character(len=1) :: tab_f
 
      call numtbd(lun, idn, nemo_f, tab_f, iret)
 
      call copy_f_c_str(nemo_f, nemo, nemo_str_len)
      tab(1) = tab_f(1:1)
    end subroutine numtbd_c
 
    function ifxy_c(cfxy) result(ires) bind(C, name='ifxy_f')
      character(kind=c_char), intent(in) :: cfxy(*)
      integer(c_int) :: ires
      integer :: ifxy
 
      ires = ifxy(c_f_string(cfxy))
    end function ifxy_c
 
    subroutine uptdd_c(id, lun, ient, iret) bind(C, name='uptdd_f')
      integer(c_int), intent(in), value :: id, lun, ient
      integer(c_int), intent(out) :: iret
 
      call uptdd(id, lun, ient, iret)
    end subroutine uptdd_c
 
    function imrkopr_c(nemo) result(ires) bind(C, name='imrkopr_f')
      character(kind=c_char), intent(in) :: nemo(*)
      integer(c_int) :: ires
      integer :: imrkopr
 
      ires = imrkopr(c_f_string(nemo))
    end function imrkopr_c
 
    function istdesc_c(idn) result(ires) bind(C, name='istdesc_f')
      integer(c_int), intent(in), value :: idn
      integer(c_int) :: ires
      integer :: istdesc
 
      ires = istdesc(idn)
    end function istdesc_c
 
    recursive subroutine drfini_c(bufr_unit, mdrf, ndrf, table_d_mnemonic) bind(C, name='drfini_f')
      integer(c_int), value, intent(in) :: bufr_unit, ndrf
      integer(c_int), intent(in) :: mdrf(*)
      character(kind=c_char), intent(in) :: table_d_mnemonic(*)
      character(len=12) :: str
      integer :: lstr
 
      lstr = get_c_string_length(table_d_mnemonic)
      if (lstr == 0) then
        str(1:1) = ' '
        lstr = 1
      else
        str = transfer(table_d_mnemonic(1:lstr), str)
      endif
      call drfini(bufr_unit, mdrf, ndrf, str(1:lstr))
    end subroutine drfini_c
 
    recursive subroutine ufbseq_c(bufr_unit, c_data, dim_1, dim_2, iret, table_d_mnemonic) bind(C, name='ufbseq_f')
      integer(c_int), value, intent(in) :: bufr_unit, dim_1, dim_2
      type(c_ptr), intent(inout) ::  c_data
      integer(c_int), intent(out) :: iret
      character(kind=c_char), intent(in) :: table_d_mnemonic(*)
      character(len=90) :: str
      real, pointer :: f_data
      integer :: lstr
 
      lstr = get_c_string_length(table_d_mnemonic)
      if (lstr == 0) then
        str(1:1) = ' '
        lstr = 1
      else
        str = transfer(table_d_mnemonic(1:lstr), str)
      endif
      call c_f_pointer(c_data, f_data)
      call ufbseq(bufr_unit, f_data, dim_1, dim_2, iret, str(1:lstr))
    end subroutine ufbseq_c
 
    function ireadns_c(bufr_unit, c_subset, iddate, subset_str_len) result(ires) bind(C, name='ireadns_f')
      integer(c_int), value, intent(in) :: bufr_unit
      character(kind=c_char), intent(out) :: c_subset(*)
      integer(c_int), intent(out) :: iddate
      integer(c_int), value, intent(in) :: subset_str_len
      integer(c_int) :: ires
      character(len=25) :: f_subset
      integer :: ireadns
 
      ires = ireadns(bufr_unit, f_subset, iddate)
 
      if (ires == 0) then
        call copy_f_c_str(f_subset, c_subset, subset_str_len)
      end if
    end function ireadns_c
 
    recursive subroutine readns_c(bufr_unit, c_subset, iddate, subset_str_len, ires) bind(C, name='readns_f')
      integer(c_int), value, intent(in) :: bufr_unit
      character(kind=c_char), intent(out) :: c_subset(*)
      integer(c_int), intent(out) :: iddate, ires
      integer(c_int), value, intent(in) :: subset_str_len
      character(len=25) :: f_subset
 
      call readns(bufr_unit, f_subset, iddate, ires)
 
      if (ires == 0) then
        call copy_f_c_str(f_subset, c_subset, subset_str_len)
      end if
    end subroutine readns_c
 
    function ibfms_c(r8val) result(ires) bind(C, name='ibfms_f')
      real(c_double), intent(in), value :: r8val
      integer(c_int) :: ires
      integer :: ibfms
 
      ires = ibfms(r8val)
    end function ibfms_c
 
    subroutine strnum_c(str,num,iret) bind(C, name='strnum_f')
      character(kind=c_char), intent(in) :: str(*)
      integer(c_int), intent(out) :: num, iret
 
      call strnum(c_f_string(str), num, iret)
    end subroutine strnum_c
 
    subroutine stntbi_c(n,lun,numb,nemo,celsq) bind(C, name='stntbi_f')
      integer(c_int), intent(in), value :: n, lun
      character(kind=c_char), intent(in) :: numb(*), nemo(*), celsq(*)
      character(len=6) :: numb_f
      character(len=8) :: nemo_f
      character(len=55) :: celsq_f
      integer :: ii
 
      do ii = 1,6
        numb_f(ii:ii) = numb(ii)
      enddo
      do ii = 1,8
        nemo_f(ii:ii) = nemo(ii)
      enddo
      do ii = 1,55
        celsq_f(ii:ii) = celsq(ii)
      enddo
      call stntbi(n, lun, numb_f, nemo_f, celsq_f)
    end subroutine stntbi_c
 
    function igettdi_c(iflag) result(ires) bind(C, name='igettdi_f')
      integer(c_int), intent(in), value :: iflag
      integer(c_int) :: ires
      integer :: igettdi
 
      ires = igettdi(iflag)
    end function igettdi_c
 
    subroutine pktdd_c(id, lun, idn, iret) bind(C, name='pktdd_f')
      integer(c_int), intent(in), value :: id, lun, idn
      integer(c_int), intent(out) :: iret
 
      call pktdd(id, lun, idn, iret)
    end subroutine pktdd_c
 
    recursive subroutine bort_c(errstr) bind(C, name='bort_f')
      character(kind=c_char), intent(in) :: errstr(*)
      character(len=255) :: my_errstr
      integer :: lers
 
      lers = get_c_string_length(errstr)
      my_errstr = transfer(errstr(1:lers), my_errstr)
 
      call bort(my_errstr(1:lers))
    end subroutine bort_c
 
    recursive subroutine openmb_c(bufr_unit, c_subset, iddate) bind(C, name='openmb_f')
      integer(c_int), value, intent(in) :: bufr_unit, iddate
      character(kind=c_char), intent(in) :: c_subset(*)
      character(len=8) :: f_subset
      integer :: lfs
 
      lfs = get_c_string_length(c_subset)
      if (lfs == 0) then
        f_subset(1:1) = ' '
        lfs = 1
      else
        f_subset = transfer(c_subset(1:lfs), f_subset)
      endif
 
      call openmb(bufr_unit, f_subset(1:lfs), iddate)
    end subroutine openmb_c
 
    recursive subroutine openmg_c(bufr_unit, c_subset, iddate) bind(C, name='openmg_f')
      integer(c_int), value, intent(in) :: bufr_unit, iddate
      character(kind=c_char), intent(in) :: c_subset(*)
      character(len=8) :: f_subset
      integer :: lfs
 
      lfs = get_c_string_length(c_subset)
      if (lfs == 0) then
        f_subset(1:1) = ' '
        lfs = 1
      else
        f_subset = transfer(c_subset(1:lfs), f_subset)
      endif
 
      call openmg(bufr_unit, f_subset(1:lfs), iddate)
    end subroutine openmg_c
 
    recursive subroutine closmg_c(bufr_unit) bind(C, name='closmg_f')
      integer(c_int), value, intent(in) :: bufr_unit
 
      call closmg(bufr_unit)
    end subroutine closmg_c
 
    recursive subroutine bvers_c(cverstr, cverstr_len) bind(C, name='bvers_f')
      character(kind=c_char), intent(out) :: cverstr(*)
      integer(c_int), value, intent(in) :: cverstr_len
      character(len=10) :: f_cverstr
 
      call bvers(f_cverstr)
      call copy_f_c_str(f_cverstr, cverstr, cverstr_len)
    end subroutine bvers_c
 
    recursive subroutine cmpmsg_c(cf) bind(C, name='cmpmsg_f')
      character(kind=c_char), intent(in) :: cf(*)
      character :: ch
 
      ch = cf(1)
      call cmpmsg(ch)
    end subroutine cmpmsg_c
 
    function catch_borts_c(cf) result(ires) bind(C, name='catch_borts_f')
      character(kind=c_char), intent(in) :: cf(*)
      character :: ch
      integer(c_int) :: ires
      integer :: catch_borts
 
      ch = cf(1)
      ires = catch_borts(ch)
    end function catch_borts_c
 
    function bort_target_set_c() result(ires) bind(C, name='bort_target_set_f')
      integer(c_int) :: ires
      integer :: bort_target_set
 
      ires = bort_target_set()
    end function bort_target_set_c
 
    subroutine bort_target_unset_c() bind(C, name='bort_target_unset_f')
      call bort_target_unset
    end subroutine bort_target_unset_c
 
    subroutine check_for_bort_c(error_str, error_str_len) bind(C, name='check_for_bort_f')
      integer(c_int), value, intent(in) :: error_str_len
      character(kind=c_char), intent(out) :: error_str(*)
      character(len=310) :: error_str_f
      integer :: error_str_len_f
 
      call check_for_bort(error_str_f, error_str_len_f)
 
      error_str_len_f = error_str_len_f + 1  ! add 1 for the null terminator
      call copy_f_c_str(error_str_f, error_str, min(error_str_len_f, error_str_len))
    end subroutine check_for_bort_c
 
    recursive subroutine ufbcnt_c(lunit, kmsg, ksub) bind(C, name='ufbcnt_f')
      integer(c_int), value, intent(in) :: lunit
      integer(c_int), intent(out) :: kmsg, ksub
 
      call ufbcnt(lunit, kmsg, ksub)
    end subroutine ufbcnt_c
 
    recursive subroutine ufbqcd_c(lunit, cnemo, iqcd) bind(C, name='ufbqcd_f')
      integer(c_int), value, intent(in) :: lunit
      integer(c_int), intent(out) :: iqcd
      character(kind=c_char), intent(in) :: cnemo(*)
      character(len=12) :: nemo
      integer :: lcn
 
      lcn = get_c_string_length(cnemo)
      if (lcn == 0) then
        nemo(1:1) = ' '
        lcn = 1
      else
        nemo = transfer(cnemo(1:lcn), nemo)
      endif
      call ufbqcd(lunit, nemo(1:lcn), iqcd)
    end subroutine ufbqcd_c
 
    recursive subroutine ufbqcp_c(lunit, iqcp, cnemo, cnemo_len) bind(C, name='ufbqcp_f')
      integer(c_int), value, intent(in) :: lunit, iqcp, cnemo_len
      character(kind=c_char), intent(out) :: cnemo(*)
      character(len=8) :: nemo
      integer :: lnm
 
      call ufbqcp(lunit, iqcp, nemo)
 
      lnm = len(trim(nemo)) + 1  ! add 1 for the null terminator
      call copy_f_c_str(nemo, cnemo, min(lnm, cnemo_len))
    end subroutine ufbqcp_c
 
    recursive subroutine getcfmng_c(lunit, cnemoi, ivali, cnemod, ivald, cmeang_c, lcmgc, iret) &
        bind(c, name='getcfmng_f')
      integer(c_int), value, intent(in) :: lunit, ivali, ivald, lcmgc
      integer(c_int), intent(out) :: iret
      character(kind=c_char), intent(in) :: cnemoi(*), cnemod(*)
      character(kind=c_char), intent(out) :: cmeang_c(*)
      character(len=600) :: cmeang
      character(len=8) :: nemoi, nemod
      integer :: lcni, lcnd, lcmg
 
      lcni = get_c_string_length(cnemoi)
      if (lcni == 0) then
        nemoi(1:1) = ' '
        lcni = 1
      else
        nemoi = transfer(cnemoi(1:lcni), nemoi)
      endif
      lcnd = get_c_string_length(cnemod)
      if (lcnd == 0) then
        nemod(1:1) = ' '
        lcnd = 1
      else
        nemod = transfer(cnemod(1:lcnd), nemod)
      endif
 
      call getcfmng(lunit, nemoi(1:lcni), ivali, nemod(1:lcnd), ivald, cmeang(1:min(len(cmeang), lcmgc)), lcmg, iret)
 
      lcmg = lcmg + 1  ! add 1 for the null terminator
      call copy_f_c_str(cmeang, cmeang_c, min(lcmg, lcmgc))
    end subroutine getcfmng_c
 
    recursive subroutine upftbv_c(lunit, cnemo, val, ibit, mxib, nib) bind(C, name='upftbv_f')
      integer(c_int), value, intent(in) :: lunit, mxib
      integer(c_int), intent(out) :: ibit(*), nib
      real(c_double), value, intent(in) :: val
      character(kind=c_char), intent(in) :: cnemo(*)
      character(len=12) :: nemo
      integer :: lcn
 
      lcn = get_c_string_length(cnemo)
      if (lcn == 0) then
        nemo(1:1) = ' '
        lcn = 1
      else
        nemo = transfer(cnemo(1:lcn), nemo)
      endif
      call upftbv(lunit, nemo(1:lcn), val, mxib, ibit, nib)
    end subroutine upftbv_c
 
    recursive subroutine ufbtab_c(bufr_unit, c_data, dim_1, dim_2, iret, table_b_mnemonic) bind(C, name='ufbtab_f')
      integer(c_int), value, intent(in) :: bufr_unit, dim_1, dim_2
      type(c_ptr), intent(out) ::  c_data
      integer(c_int), intent(inout) :: iret
      character(kind=c_char), intent(in) :: table_b_mnemonic(*)
      character(len=90) :: str
      real, pointer :: f_data
      integer :: lstr
 
      lstr = get_c_string_length(table_b_mnemonic)
      if (lstr == 0) then
        str(1:1) = ' '
        lstr = 1
      else
        str = transfer(table_b_mnemonic(1:lstr), str)
      endif
      call c_f_pointer(c_data, f_data)
 
      call ufbtab(bufr_unit, f_data, dim_1, dim_2, iret, str(1:lstr))
    end subroutine ufbtab_c
 
    recursive subroutine ufbpos_c(bufr_unit, irec, isub, c_subset, iddate, subset_str_len) bind(C, name='ufbpos_f')
      integer(c_int), value, intent(in) :: bufr_unit, subset_str_len, irec, isub
      character(kind=c_char), intent(out) :: c_subset(*)
      integer(c_int), intent(out) :: iddate
      character(len=25) :: f_subset
 
      call ufbpos(bufr_unit, irec, isub, f_subset, iddate)
 
      call copy_f_c_str(f_subset, c_subset, subset_str_len)
    end subroutine ufbpos_c
 
    recursive subroutine datelen_c(len) bind(C, name='datelen_f')
      integer(c_int), value, intent(in) :: len
 
      call datelen(len)
    end subroutine datelen_c
 
    recursive function iupvs01_c(bufr_unit, c_s01m) result(ires) bind(C, name='iupvs01_f')
      integer(c_int), value, intent(in) :: bufr_unit
      character(kind=c_char), intent(in) :: c_s01m(*)
      integer(c_int) :: ires
      integer :: iupvs01, lfs
      character(len=12) :: f_s01m
 
      lfs = get_c_string_length(c_s01m)
      if (lfs == 0) then
        f_s01m(1:1) = ' '
        lfs = 1
      else
        f_s01m = transfer(c_s01m(1:lfs), f_s01m)
      endif
 
      ires = iupvs01(bufr_unit, f_s01m(1:lfs))
    end function iupvs01_c
 
    recursive function nmsub_c(bufr_unit) result(ires) bind(C, name='nmsub_f')
      integer(c_int), value, intent(in) :: bufr_unit
      integer(c_int) :: ires
      integer :: nmsub
 
      ires = nmsub(bufr_unit)
    end function nmsub_c
 
    recursive subroutine pkvs01_c(c_s01m, ival) bind(C, name='pkvs01_f')
      character(kind=c_char), intent(in) :: c_s01m(*)
      integer(c_int), value, intent(in) :: ival
      integer :: lfs
      character(len=12) :: f_s01m
 
      lfs = get_c_string_length(c_s01m)
      if (lfs == 0) then
        f_s01m(1:1) = ' '
        lfs = 1
      else
        f_s01m = transfer(c_s01m(1:lfs), f_s01m)
      endif
 
      call pkvs01(f_s01m(1:lfs), ival)
    end subroutine pkvs01_c
 
    recursive subroutine datebf_c(bufr_unit, mear, mmon, mday, mour, idate) bind(C, name='datebf_f')
      integer(c_int), value, intent(in) :: bufr_unit
      integer(c_int), intent(out) :: mear, mmon, mday, mour, idate
 
      call datebf(bufr_unit, mear, mmon, mday, mour, idate)
    end subroutine datebf_c
 
    recursive subroutine dumpbf_c(bufr_unit, jdate, jdump) bind(C, name='dumpbf_f')
      integer(c_int), value, intent(in) :: bufr_unit
      integer(c_int), intent(out) :: jdate(*), jdump(*)
 
      call dumpbf(bufr_unit, jdate, jdump)
    end subroutine dumpbf_c
 
    recursive subroutine minimg_c(bufr_unit, mini) bind(C, name='minimg_f')
      integer(c_int), value, intent(in) :: bufr_unit, mini
 
      call minimg(bufr_unit, mini)
    end subroutine minimg_c
 
    recursive subroutine upds3_c(mbay, lcds3, ccds3, nds3) bind(C, name='upds3_f')
      integer(c_int), value, intent(in) :: lcds3
      integer(c_int), intent(in) :: mbay(*)
      integer(c_int), intent(out) :: nds3
      character(kind=c_char), intent(out) :: ccds3(6,*)
      character(len=6) :: cds3(600)
      integer :: ii, jj
 
      call upds3(mbay, lcds3, cds3, nds3)
      do ii = 1, nds3
        do jj = 1, 6
          ccds3(jj,ii) = cds3(ii)(jj:jj)
        enddo
      enddo
    end subroutine upds3_c
 
    recursive subroutine pkbs1_c(ival, mbay, c_s1m) bind(C, name='pkbs1_f')
      character(kind=c_char), intent(in) :: c_s1m(*)
      integer(c_int), value, intent(in) :: ival
      integer(c_int), intent(inout) :: mbay(*)
      integer :: lfs
      character(len=12) :: f_s1m
 
      lfs = get_c_string_length(c_s1m)
      if (lfs == 0) then
        f_s1m(1:1) = ' '
        lfs = 1
      else
        f_s1m = transfer(c_s1m(1:lfs), f_s1m)
      endif
 
      call pkbs1(ival, mbay, f_s1m(1:lfs))
    end subroutine pkbs1_c
 
    recursive subroutine strcpt_c(cf, iyr, imo, idy, ihr, imi) bind(C, name='strcpt_f')
      integer(c_int), value, intent(in) :: iyr, imo, idy, ihr, imi
      character(kind=c_char), intent(in) :: cf(*)
      character :: ch
 
      ch = cf(1)
      call strcpt(ch, iyr, imo, idy, ihr, imi)
    end subroutine strcpt_c
 
    recursive subroutine rtrcpt_c(lunit, iyr, imo, idy, ihr, imi, iret) bind(C, name='rtrcpt_f')
      integer(c_int), value, intent(in) :: lunit
      integer(c_int), intent(out) :: iyr, imo, idy, ihr, imi, iret
 
      call rtrcpt(lunit, iyr, imo, idy, ihr, imi, iret)
    end subroutine rtrcpt_c
 
    recursive subroutine atrcpt_c(msgin, lmsgot, msgot) bind(C, name='atrcpt_f')
      integer(c_int), value, intent(in) :: lmsgot
      integer(c_int), intent(in) :: msgin(*)
      integer(c_int), intent(out) :: msgot(*)
 
      call atrcpt(msgin, lmsgot, msgot)
    end subroutine atrcpt_c
 
    recursive subroutine dxdump_c(lunit, luprt) bind(C, name='dxdump_f')
      integer(c_int), value, intent(in) :: lunit, luprt
 
      call dxdump(lunit, luprt)
    end subroutine dxdump_c
 
    recursive subroutine ufbdmp_c(lunit, luprt) bind(C, name='ufbdmp_f')
      integer(c_int), value, intent(in) :: lunit, luprt
 
      call ufbdmp(lunit, luprt)
    end subroutine ufbdmp_c
 
    recursive subroutine ufdump_c(lunit, luprt) bind(C, name='ufdump_f')
      integer(c_int), value, intent(in) :: lunit, luprt
 
      call ufdump(lunit, luprt)
    end subroutine ufdump_c
 
    recursive subroutine copybf_c(lunin, lunot) bind(C, name='copybf_f')
      integer(c_int), value, intent(in) :: lunin, lunot
 
      call copybf(lunin, lunot)
    end subroutine copybf_c
 
    recursive subroutine copymg_c(lunin, lunot) bind(C, name='copymg_f')
      integer(c_int), value, intent(in) :: lunin, lunot
 
      call copymg(lunin, lunot)
    end subroutine copymg_c
 
    recursive subroutine copysb_c(lunin, lunot, iret) bind(C, name='copysb_f')
      integer(c_int), value, intent(in) :: lunin, lunot
      integer(c_int), intent(out) :: iret
 
      call copysb(lunin, lunot, iret)
    end subroutine copysb_c
 
    recursive subroutine ufbcpy_c(lunin, lunot) bind(C, name='ufbcpy_f')
      integer(c_int), value, intent(in) :: lunin, lunot
 
      call ufbcpy(lunin, lunot)
    end subroutine ufbcpy_c
 
    recursive subroutine readerme_c(mesg, bufr_unit, c_subset, iddate, subset_str_len, ires) bind(C, name='readerme_f')
      integer(c_int), value, intent(in) :: bufr_unit, subset_str_len
      integer(c_int), intent(in) :: mesg(*)
      integer(c_int), intent(out) :: iddate, ires
      character(kind=c_char), intent(out) :: c_subset(*)
      character(len=25) :: f_subset
 
      call readerme(mesg, bufr_unit, f_subset, iddate, ires)
 
      if (ires == 0) then
        call copy_f_c_str(f_subset, c_subset, subset_str_len)
      end if
    end subroutine readerme_c
 
    recursive subroutine rdmgsb_c(lunit, imsg, isub) bind(C, name='rdmgsb_f')
      integer(c_int), value, intent(in) :: lunit, imsg, isub
 
      call rdmgsb(lunit, imsg, isub)
    end subroutine rdmgsb_c
 
    recursive subroutine ufbmem_c(lunit, inew, iret, iunit) bind(C, name='ufbmem_f')
      integer(c_int), value, intent(in) :: lunit, inew
      integer(c_int), intent(out) :: iret, iunit
 
      call ufbmem(lunit, inew, iret, iunit)
    end subroutine ufbmem_c
 
    recursive subroutine ufbmex_c(lunit, lundx, inew, iret, mesg) bind(C, name='ufbmex_f')
      integer(c_int), value, intent(in) :: lunit, lundx, inew
      integer(c_int), intent(out) :: iret, mesg(*)
 
      call ufbmex(lunit, lundx, inew, iret, mesg)
    end subroutine ufbmex_c
 
    recursive subroutine ufbmms_c(imsg, isub, c_subset, jdate, subset_str_len) bind(C, name='ufbmms_f')
      integer(c_int), value, intent(in) :: imsg, isub, subset_str_len
      integer(c_int), intent(out) :: jdate
      character(kind=c_char), intent(out) :: c_subset(*)
      character(len=10) :: f_subset
 
      call ufbmms(imsg, isub, f_subset, jdate)
 
      call copy_f_c_str(f_subset, c_subset, subset_str_len)
    end subroutine ufbmms_c
 
    recursive subroutine ufbmns_c(irep, c_subset, idate, subset_str_len) bind(C, name='ufbmns_f')
      integer(c_int), value, intent(in) :: irep, subset_str_len
      integer(c_int), intent(out) :: idate
      character(kind=c_char), intent(out) :: c_subset(*)
      character(len=10) :: f_subset
 
      call ufbmns(irep, f_subset, idate)
 
      call copy_f_c_str(f_subset, c_subset, subset_str_len)
    end subroutine ufbmns_c
 
    recursive subroutine rdmemm_c(imsg, c_subset, jdate, subset_str_len, ires) bind(C, name='rdmemm_f')
      integer(c_int), value, intent(in) :: imsg, subset_str_len
      character(kind=c_char), intent(out) :: c_subset(*)
      integer(c_int), intent(out) :: jdate, ires
      character(len=10) :: f_subset
 
      call rdmemm(imsg, f_subset, jdate, ires)
 
      if (ires == 0) then
        call copy_f_c_str(f_subset, c_subset, subset_str_len)
      end if
    end subroutine rdmemm_c
 
    recursive subroutine rdmems_c(isub, ires) bind(C, name='rdmems_f')
      integer(c_int), value, intent(in) :: isub
      integer(c_int), intent(out) :: ires
 
      call rdmems(isub, ires)
    end subroutine rdmems_c
 
    recursive subroutine ufbrms_c(imsg, isub, c_data, dim_1, dim_2, iret, table_b_mnemonic) bind(C, name='ufbrms_f')
      integer(c_int), value, intent(in) :: imsg, isub, dim_1, dim_2
      type(c_ptr), intent(out) ::  c_data
      integer(c_int), intent(out) :: iret
      character(kind=c_char), intent(in) :: table_b_mnemonic(*)
      character(len=90) :: str
      real, pointer :: f_data
      integer :: lstr
 
      lstr = get_c_string_length(table_b_mnemonic)
      if (lstr == 0) then
        str(1:1) = ' '
        lstr = 1
      else
        str = transfer(table_b_mnemonic(1:lstr), str)
      endif
      call c_f_pointer(c_data, f_data)
      call ufbrms(imsg, isub, f_data, dim_1, dim_2, iret, str(1:lstr))
    end subroutine ufbrms_c
 
    recursive subroutine ufbtam_c(c_data, dim_1, dim_2, iret, table_b_mnemonic) bind(C, name='ufbtam_f')
      integer(c_int), value, intent(in) :: dim_1, dim_2
      type(c_ptr), intent(out) ::  c_data
      integer(c_int), intent(out) :: iret
      character(kind=c_char), intent(in) :: table_b_mnemonic(*)
      character(len=90) :: str
      real, pointer :: f_data
      integer :: lstr
 
      lstr = get_c_string_length(table_b_mnemonic)
      if (lstr == 0) then
        str(1:1) = ' '
        lstr = 1
      else
        str = transfer(table_b_mnemonic(1:lstr), str)
      endif
      call c_f_pointer(c_data, f_data)
 
      call ufbtam(f_data, dim_1, dim_2, iret, str(1:lstr))
    end subroutine ufbtam_c
 
    recursive subroutine cpymem_c(lunot) bind(C, name='cpymem_f')
      integer(c_int), value, intent(in) :: lunot
 
      call cpymem(lunot)
    end subroutine cpymem_c
 
    recursive subroutine ufbcup_c(lunin, lunot) bind(C, name='ufbcup_f')
      integer(c_int), value, intent(in) :: lunin, lunot
 
      call ufbcup(lunin, lunot)
    end subroutine ufbcup_c
 
    recursive subroutine stdmsg_c(cf) bind(C, name='stdmsg_f')
      character(kind=c_char), intent(in) :: cf(*)
      character :: ch
 
      ch = cf(1)
      call stdmsg(ch)
    end subroutine stdmsg_c
 
    recursive subroutine stndrd_c(lunit, msgin, lmsgot, msgot) bind(C, name='stndrd_f')
      integer(c_int), value, intent(in) :: lunit, lmsgot
      integer(c_int), intent(in) :: msgin(*)
      integer(c_int), intent(out) :: msgot(*)
 
      call stndrd(lunit, msgin, lmsgot, msgot)
    end subroutine stndrd_c
 
    recursive subroutine codflg_c(cf) bind(C, name='codflg_f')
      character(kind=c_char), intent(in) :: cf(*)
      character :: ch
 
      ch = cf(1)
      call codflg(ch)
    end subroutine codflg_c
 
    recursive subroutine gettagpr_c(bufr_unit, c_tagch, ntagch, c_tagpr, tagpr_len, ires) bind(C, name='gettagpr_f')
      integer(c_int), value, intent(in) :: bufr_unit, ntagch, tagpr_len
      integer(c_int), intent(out) :: ires
      character(kind=c_char), intent(in) :: c_tagch(*)
      character(kind=c_char), intent(out) :: c_tagpr(*)
      character(len=10) :: f_tagch, f_tagpr
      integer :: lfc, lfp
 
      lfc = get_c_string_length(c_tagch)
      if (lfc == 0) then
        f_tagch(1:1) = ' '
        lfc = 1
      else
        f_tagch = transfer(c_tagch(1:lfc), f_tagch)
      endif
 
      call gettagpr(bufr_unit, f_tagch(1:lfc), ntagch, f_tagpr, ires)
 
      lfp = len(trim(f_tagpr)) + 1  ! add 1 for the null terminator
      call copy_f_c_str(f_tagpr, c_tagpr, min(lfp, tagpr_len))
    end subroutine gettagpr_c
 
    recursive subroutine gettagre_c(bufr_unit, c_tagi, ntagi, c_tagre, tagre_len, ntagre, ires) bind(C, name='gettagre_f')
      integer(c_int), value, intent(in) :: bufr_unit, ntagi, tagre_len
      integer(c_int), intent(out) :: ntagre, ires
      character(kind=c_char), intent(in) :: c_tagi(*)
      character(kind=c_char), intent(out) :: c_tagre(*)
      character(len=10) :: f_tagi, f_tagre
      integer :: lfi, lfr
 
      lfi = get_c_string_length(c_tagi)
      if (lfi == 0) then
        f_tagi(1:1) = ' '
        lfi = 1
      else
        f_tagi = transfer(c_tagi(1:lfi), f_tagi)
      endif
 
      call gettagre(bufr_unit, f_tagi(1:lfi), ntagi, f_tagre, ntagre, ires)
 
      lfr = len(trim(f_tagre)) + 1  ! add 1 for the null terminator
      call copy_f_c_str(f_tagre, c_tagre, min(lfr, tagre_len))
    end subroutine gettagre_c
 
    recursive subroutine cnved4_c(msgin, lmsgot, msgot) bind(C, name='cnved4_f')
      integer(c_int), value, intent(in) :: lmsgot
      integer(c_int), intent(in) :: msgin(*)
      integer(c_int), intent(out) :: msgot(*)
 
      call cnved4(msgin, lmsgot, msgot)
    end subroutine cnved4_c
 
    recursive function lcmgdf_c(bufr_unit, c_subset) result(ires) bind(C, name='lcmgdf_f')
      integer(c_int), value, intent(in) :: bufr_unit
      integer(c_int) :: ires
      character(kind=c_char), intent(in) :: c_subset(*)
      character(len=8) :: f_subset
      integer :: lcmgdf, lfs
 
      lfs = get_c_string_length(c_subset)
      if (lfs == 0) then
        f_subset(1:1) = ' '
        lfs = 1
      else
        f_subset = transfer(c_subset(1:lfs), f_subset)
      endif
 
      ires = lcmgdf(bufr_unit, f_subset(1:lfs))
    end function lcmgdf_c
 
    recursive subroutine setvalnb_c(bufr_unit, c_tagpv, ntagpv, c_tagnb, ntagnb, r8val, ires) bind(C, name='setvalnb_f')
      integer(c_int), value, intent(in) :: bufr_unit, ntagpv, ntagnb
      integer(c_int), intent(out) :: ires
      character(kind=c_char), intent(in) :: c_tagpv(*), c_tagnb(*)
      real(c_double), value, intent(in) :: r8val
      character(len=10) :: f_tagpv, f_tagnb
      integer :: lfp, lfn
 
      lfp = get_c_string_length(c_tagpv)
      if (lfp == 0) then
        f_tagpv(1:1) = ' '
        lfp = 1
      else
        f_tagpv = transfer(c_tagpv(1:lfp), f_tagpv)
      endif
      lfn = get_c_string_length(c_tagnb)
      if (lfn == 0) then
        f_tagnb(1:1) = ' '
        lfn = 1
      else
        f_tagnb = transfer(c_tagnb(1:lfn), f_tagnb)
      endif
 
      call setvalnb(bufr_unit, f_tagpv(1:lfp), ntagpv, f_tagnb(1:lfn), ntagnb, r8val, ires)
    end subroutine setvalnb_c
 
    recursive function getvalnb_c(bufr_unit, c_tagpv, ntagpv, c_tagnb, ntagnb) result(r8val) bind(C, name='getvalnb_f')
      integer(c_int), value, intent(in) :: bufr_unit, ntagpv, ntagnb
      character(kind=c_char), intent(in) :: c_tagpv(*), c_tagnb(*)
      real(c_double) :: r8val
      character(len=10) :: f_tagpv, f_tagnb
      integer :: lfp, lfn
      real*8 :: getvalnb
 
      lfp = get_c_string_length(c_tagpv)
      if (lfp == 0) then
        f_tagpv(1:1) = ' '
        lfp = 1
      else
        f_tagpv = transfer(c_tagpv(1:lfp), f_tagpv)
      endif
      lfn = get_c_string_length(c_tagnb)
      if (lfn == 0) then
        f_tagnb(1:1) = ' '
        lfn = 1
      else
        f_tagnb = transfer(c_tagnb(1:lfn), f_tagnb)
      endif
 
      r8val = getvalnb(bufr_unit, f_tagpv(1:lfp), ntagpv, f_tagnb(1:lfn), ntagnb)
    end function getvalnb_c
 
    recursive subroutine getabdb_c(lunit, itab, ctabdb, jtab) bind(C, name='getabdb_f')
      integer(c_int), value, intent(in) :: lunit, itab
      integer(c_int), intent(out) :: jtab
      character(kind=c_char), intent(out) :: ctabdb(128,*)
      character(len=128) :: tabdb(1000)
      integer :: ii, jj
 
      call getabdb(lunit, tabdb, itab, jtab)
      do ii = 1, jtab
        do jj = 1, 128
          ctabdb(jj,ii) = tabdb(ii)(jj:jj)
        enddo
      enddo
    end subroutine getabdb_c
 
    recursive subroutine ufbget_c(bufr_unit, tab, i1, iret, table_b_mnemonic) bind(C, name='ufbget_f')
      integer(c_int), value, intent(in) :: bufr_unit, i1
      integer(c_int), intent(out) :: iret
      real(c_double), intent(out) :: tab(*)
      character(kind=c_char), intent(in) :: table_b_mnemonic(*)
      character(len=90) :: str
      integer :: lstr
 
      lstr = get_c_string_length(table_b_mnemonic)
      if (lstr == 0) then
        str(1:1) = ' '
        lstr = 1
      else
        str = transfer(table_b_mnemonic(1:lstr), str)
      endif
 
      call ufbget(bufr_unit, tab, i1, iret, str(1:lstr))
    end subroutine ufbget_c
 
    recursive subroutine ufbinx_c(bufr_unit, imsg, isub, c_data, dim_1, dim_2, iret, table_b_mnemonic) &
        bind(c, name='ufbinx_f')
      integer(c_int), value, intent(in) :: bufr_unit, dim_1, dim_2, imsg, isub
      type(c_ptr), intent(out) ::  c_data
      integer(c_int), intent(out) :: iret
      character(kind=c_char), intent(in) :: table_b_mnemonic(*)
      character(len=90) :: str
      real, pointer :: f_data
      integer :: lstr
 
      lstr = get_c_string_length(table_b_mnemonic)
      if (lstr == 0) then
        str(1:1) = ' '
        lstr = 1
      else
        str = transfer(table_b_mnemonic(1:lstr), str)
      endif
 
      call c_f_pointer(c_data, f_data)
      call ufbinx(bufr_unit, imsg, isub, f_data, dim_1, dim_2, iret, str(1:lstr))
    end subroutine ufbinx_c
 
    recursive subroutine ufbovr_c(bufr_unit, c_data, dim_1, dim_2, iret, table_b_mnemonic) &
        bind(c, name='ufbovr_f')
      integer(c_int), value, intent(in) :: bufr_unit, dim_1, dim_2
      type(c_ptr), intent(in) ::  c_data
      integer(c_int), intent(out) :: iret
      character(kind=c_char), intent(in) :: table_b_mnemonic(*)
      character(len=90) :: str
      real, pointer :: f_data
      integer :: lstr
 
      lstr = get_c_string_length(table_b_mnemonic)
      if (lstr == 0) then
        str(1:1) = ' '
        lstr = 1
      else
        str = transfer(table_b_mnemonic(1:lstr), str)
      endif
 
      call c_f_pointer(c_data, f_data)
      call ufbovr(bufr_unit, f_data, dim_1, dim_2, iret, str(1:lstr))
    end subroutine ufbovr_c
 
    recursive function ifbget_c(bufr_unit) result(ires) bind(C, name='ifbget_f')
      integer(c_int), value, intent(in) :: bufr_unit
      integer(c_int) :: ires
      integer :: ifbget
 
      ires = ifbget(bufr_unit)
    end function ifbget_c
 
    recursive function igetsc_c(bufr_unit) result(ires) bind(C, name='igetsc_f')
      integer(c_int), value, intent(in) :: bufr_unit
      integer(c_int) :: ires
      integer :: igetsc
 
      ires = igetsc(bufr_unit)
    end function igetsc_c
 
    recursive subroutine wrdxtb_c(lundx, lunot) bind(C, name='wrdxtb_f')
      integer(c_int), value, intent(in) :: lundx, lunot
 
      call wrdxtb(lundx, lunot)
    end subroutine wrdxtb_c
 
    recursive subroutine mesgbf_c(lunit, mesgtyp) bind(C, name='mesgbf_f')
      integer(c_int), value, intent(in) :: lunit
      integer(c_int), intent(out) :: mesgtyp
 
      call mesgbf(lunit, mesgtyp)
    end subroutine mesgbf_c
 
    recursive subroutine mesgbc_c(lunin, mesgtyp, icomp) bind(C, name='mesgbc_f')
      integer(c_int), value, intent(in) :: lunin
      integer(c_int), intent(out) :: mesgtyp, icomp
 
      call mesgbc(lunin, mesgtyp, icomp)
    end subroutine mesgbc_c
 
    recursive subroutine invmrg_c(lubfi, lubfj) bind(C, name='invmrg_f')
      integer(c_int), value, intent(in) :: lubfi, lubfj
 
      call invmrg(lubfi, lubfj)
    end subroutine invmrg_c
 
    recursive function iupm_c(cbay, nbits, lcbay) result(ires) bind(C, name='iupm_f')
      character(kind=c_char), intent(in) :: cbay(*)
      integer(c_int), value, intent(in) :: nbits, lcbay
      integer(c_int) :: ires
      integer :: iupm
      character(len=16) :: f_cbay
 
      f_cbay = transfer(cbay(1:lcbay), f_cbay)
 
      ires = iupm(f_cbay(1:lcbay), nbits)
    end function iupm_c
 
    recursive subroutine ipkm_c(cbay, nbyt, ival, cbay_len) bind(C, name='ipkm_f')
      character(kind=c_char), intent(out) :: cbay(*)
      integer(c_int), value, intent(in) :: nbyt, ival, cbay_len
      character(len=8) :: f_cbay
      integer :: nbytp1
 
      call ipkm(f_cbay, nbyt, ival)
 
      nbytp1 = nbyt + 1  ! add 1 for the null terminator
      call copy_f_c_str(f_cbay, cbay, min(nbytp1, cbay_len))
    end subroutine ipkm_c
 
end module bufr_c2f_interface