! Copyright (C) 2008-2015 D. V. Wiebe
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
! This file is part of the GetData project.
!
! GetData is free software; you can redistribute it and/or modify it under
! the terms of the GNU Lesser General Public License as published by the
! Free Software Foundation; either version 2.1 of the License, or (at your
! option) any later version.
!
! GetData is distributed in the hope that it will be useful, but WITHOUT
! ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
! FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
! License for more details.
!
! You should have received a copy of the GNU Lesser General Public License
! along with GetData; if not, write to the Free Software Foundation, Inc.,
! 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
!
! -*- F95 -*-

module getdata
implicit none

@PARAMETERS95@

integer, parameter :: GD_FIELD_LEN=@GD_MAX_LINE_LENGTH@

type gd_entry
  integer :: field_type, n_fields, spf, data_type, bitnum, numbits, shift
  integer :: fragment_index, flags, poly_ord, array_len, windop, ithreshold
  integer :: count_val, period
  character (len=GD_FIELD_LEN), dimension(3) :: field
  character (len=GD_FIELD_LEN), dimension(6) :: scalar
  integer, dimension(6) :: scalar_ind
  double precision, dimension(3) :: m, b
  double precision, dimension(6) :: a
  double precision :: dividend, rthreshold
  double complex, dimension(3) :: cm, cb
  double complex, dimension(6) :: ca
  double complex :: cdividend
end type

contains
function fgd_open (dirfilename, flags)
  integer :: fgd_open
  character (len=*), intent (in) :: dirfilename
  integer, intent (in) :: flags

  ! call f77 library
  call gdopen(fgd_open, TRIM(dirfilename), LEN_TRIM(dirfilename), flags)
end function

function fgd_cbopen (dirfilename, flags, sehandler)
  integer :: fgd_cbopen
  character (len=*), intent (in) :: dirfilename
  integer, intent (in) :: flags
  interface
    subroutine sehandler(act, dirfile_unit, suberror, line)
      integer, intent (out) :: act
      integer, intent (in) :: dirfile_unit, suberror
      character (len=@GD_MAX_LINE_LENGTH@), intent (inout) :: line
    end subroutine
  end interface

  ! call f77 library
  call gdcopn(fgd_cbopen, TRIM(dirfilename), LEN_TRIM(dirfilename), flags, &
  sehandler)
end function

subroutine fgd_discard (dirfile)
  integer, intent(in) :: dirfile

  ! call f77 library
  call gddscd(dirfile)
end subroutine

subroutine fgd_close (dirfile)
  integer, intent(in) :: dirfile

  ! call f77 library
  call gdclos(dirfile)
end subroutine

subroutine fgd_flush (dirfile, field_code)
  integer, intent(in) :: dirfile
  character (len=*), intent(in) :: field_code

  ! call f77 library -- this will take care of figuring out whether
  !                     field_code is empty or not
  call gdflsh(dirfile, TRIM(field_code), LEN_TRIM(field_code))
end subroutine

! getdata with return_type=GD_NULL
function fgd_getdata_n (dirfile, field_code, first_frame, first_sample, &
  num_frames, num_samples)
  integer :: fgd_getdata_n
  integer, intent(in) :: dirfile, first_frame, first_sample, num_frames
  character (len=*), intent(in) :: field_code
  integer, intent(in) :: num_samples

  ! call f77 library
  call gdgetd(fgd_getdata_n, dirfile, TRIM(field_code), LEN_TRIM(field_code), &
  first_frame, first_sample, num_frames, num_samples, GD_NULL, 0)
end function

! getdata with return_type=GD_INT8
function fgd_getdata_i1 (dirfile, field_code, first_frame, first_sample, &
  num_frames, num_samples, data_out)
  integer :: fgd_getdata_i1
  integer, intent(in) :: dirfile, first_frame, first_sample, num_frames
  character (len=*), intent(in) :: field_code
  integer, intent(in) :: num_samples
  integer*1, dimension(:), intent(out) :: data_out

  ! call f77 library
  call gdgetd(fgd_getdata_i1, dirfile, TRIM(field_code), LEN_TRIM(field_code), &
  first_frame, first_sample, num_frames, num_samples, GD_INT8, data_out)
end function

! getdata with return_type=GD_INT16
function fgd_getdata_i2 (dirfile, field_code, first_frame, first_sample, &
  num_frames, num_samples, data_out)
  integer :: fgd_getdata_i2
  integer, intent(in) :: dirfile, first_frame, first_sample, num_frames
  character (len=*), intent(in) :: field_code
  integer, intent(in) :: num_samples
  integer*2, dimension(:), intent(out) :: data_out

  ! call f77 library
  call gdgetd(fgd_getdata_i2, dirfile, TRIM(field_code), LEN_TRIM(field_code), &
  first_frame, first_sample, num_frames, num_samples, GD_INT16, data_out)
end function

! getdata with return_type=GD_INT32
function fgd_getdata_i4 (dirfile, field_code, first_frame, first_sample, &
  num_frames, num_samples, data_out)
  integer :: fgd_getdata_i4
  integer, intent(in) :: dirfile, first_frame, first_sample, num_frames
  character (len=*), intent(in) :: field_code
  integer, intent(in) :: num_samples
  integer*4, dimension(:), intent(out) :: data_out

  ! call f77 library
  call gdgetd(fgd_getdata_i4, dirfile, TRIM(field_code), LEN_TRIM(field_code), &
  first_frame, first_sample, num_frames, num_samples, GD_INT32, data_out)
end function

! getdata with return_type=GD_INT64
function fgd_getdata_i8 (dirfile, field_code, first_frame, first_sample, &
  num_frames, num_samples, data_out)
  integer :: fgd_getdata_i8
  integer, intent(in) :: dirfile, first_frame, first_sample, num_frames
  character (len=*), intent(in) :: field_code
  integer, intent(in) :: num_samples
  integer*8, dimension(:), intent(out) :: data_out

  ! call f77 library
  call gdgetd(fgd_getdata_i8, dirfile, TRIM(field_code), LEN_TRIM(field_code), &
  first_frame, first_sample, num_frames, num_samples, GD_INT64, data_out)
end function

! getdata with return_type=GD_FLOAT32
function fgd_getdata_r4 (dirfile, field_code, first_frame, first_sample, &
  num_frames, num_samples, data_out)
  integer :: fgd_getdata_r4
  integer, intent(in) :: dirfile, first_frame, first_sample, num_frames
  character (len=*), intent(in) :: field_code
  integer, intent(in) :: num_samples
  real*4, dimension(:), intent(out) :: data_out

  ! call f77 library
  call gdgetd(fgd_getdata_r4, dirfile, TRIM(field_code), LEN_TRIM(field_code), &
  first_frame, first_sample, num_frames, num_samples, GD_FLOAT32, data_out)
end function

! getdata with return_type=GD_FLOAT64
function fgd_getdata_r8 (dirfile, field_code, first_frame, first_sample, &
  num_frames, num_samples, data_out)
  integer :: fgd_getdata_r8
  integer, intent(in) :: dirfile, first_frame, first_sample, num_frames
  character (len=*), intent(in) :: field_code
  integer, intent(in) :: num_samples
  double precision, dimension(:), intent(out) :: data_out

  ! call f77 library
  call gdgetd(fgd_getdata_r8, dirfile, TRIM(field_code), LEN_TRIM(field_code), &
  first_frame, first_sample, num_frames, num_samples, GD_FLOAT64, data_out)
end function

! getdata with return_type=GD_COMPLEX64
function fgd_getdata_c8 (dirfile, field_code, first_frame, first_sample, &
  num_frames, num_samples, data_out)
  integer :: fgd_getdata_c8
  integer, intent(in) :: dirfile, first_frame, first_sample, num_frames
  character (len=*), intent(in) :: field_code
  integer, intent(in) :: num_samples
  complex, dimension(:), intent(out) :: data_out

  ! call f77 library
  call gdgetd(fgd_getdata_c8, dirfile, TRIM(field_code), LEN_TRIM(field_code), &
  first_frame, first_sample, num_frames, num_samples, GD_COMPLEX64, data_out)
end function

! getdata with return_type=GD_COMPLEX128
function fgd_getdata_c16 (dirfile, field_code, first_frame, first_sample, &
  num_frames, num_samples, data_out)
  integer :: fgd_getdata_c16
  integer, intent(in) :: dirfile, first_frame, first_sample, num_frames
  character (len=*), intent(in) :: field_code
  integer, intent(in) :: num_samples
  double complex, dimension(:), intent(out) :: data_out

  ! call f77 library
  call gdgetd(fgd_getdata_c16, dirfile, TRIM(field_code), &
  LEN_TRIM(field_code), first_frame, first_sample, num_frames, num_samples, &
  GD_COMPLEX128, data_out)
end function

!get_constant with return_type=GD_NULL
subroutine fgd_get_constant_n (dirfile, field_code)
  integer, intent(in) :: dirfile
  character (len=*), intent(in) :: field_code
  
  ! call f77 library
  call gdgtco(dirfile, TRIM(field_code), LEN_TRIM(field_code), GD_NULL, 0)
end subroutine

!get_constant with return_type=GD_INT8
subroutine fgd_get_constant_i1 (dirfile, field_code, data_out)
  integer, intent(in) :: dirfile
  character (len=*), intent(in) :: field_code
  integer*1, intent(out)  :: data_out
  
  ! call f77 library
  call gdgtco(dirfile, TRIM(field_code), LEN_TRIM(field_code), GD_INT8, &
  data_out)
end subroutine

!get_constant with return_type=GD_INT16
subroutine fgd_get_constant_i2 (dirfile, field_code, data_out)
  integer, intent(in) :: dirfile
  character (len=*), intent(in) :: field_code
  integer*2, intent(out)  :: data_out
  
  ! call f77 library
  call gdgtco(dirfile, TRIM(field_code), LEN_TRIM(field_code), GD_INT16, &
  data_out)
end subroutine

!get_constant with return_type=GD_INT32
subroutine fgd_get_constant_i4 (dirfile, field_code, data_out)
  integer, intent(in) :: dirfile
  character (len=*), intent(in) :: field_code
  integer*4, intent(out)  :: data_out
  
  ! call f77 library
  call gdgtco(dirfile, TRIM(field_code), LEN_TRIM(field_code), GD_INT32, &
  data_out)
end subroutine

!get_constant with return_type=GD_INT64
subroutine fgd_get_constant_i8 (dirfile, field_code, data_out)
  integer, intent(in) :: dirfile
  character (len=*), intent(in) :: field_code
  integer*8, intent(out)  :: data_out
  
  ! call f77 library
  call gdgtco(dirfile, TRIM(field_code), LEN_TRIM(field_code), GD_INT64, &
  data_out)
end subroutine

!get_constant with return_type=GD_FLOAT32
subroutine fgd_get_constant_r4 (dirfile, field_code, data_out)
  integer, intent(in) :: dirfile
  character (len=*), intent(in) :: field_code
  real*4, intent(out)  :: data_out
  
  ! call f77 library
  call gdgtco(dirfile, TRIM(field_code), LEN_TRIM(field_code), GD_FLOAT32, &
  data_out)
end subroutine

!get_constant with return_type=GD_FLOAT64
subroutine fgd_get_constant_r8 (dirfile, field_code, data_out)
  integer, intent(in) :: dirfile
  character (len=*), intent(in) :: field_code
  double precision, intent(out)  :: data_out
  
  ! call f77 library
  call gdgtco(dirfile, TRIM(field_code), LEN_TRIM(field_code), GD_FLOAT64, &
  data_out)
end subroutine

!get_constant with return_type=GD_COMPLEX64
subroutine fgd_get_constant_c8 (dirfile, field_code, data_out)
  integer, intent(in) :: dirfile
  character (len=*), intent(in) :: field_code
  complex, intent(out)  :: data_out
  
  ! call f77 library
  call gdgtco(dirfile, TRIM(field_code), LEN_TRIM(field_code), GD_COMPLEX64, &
  data_out)
end subroutine

!get_constant with return_type=GD_COMPLEX128
subroutine fgd_get_constant_c16 (dirfile, field_code, data_out)
  integer, intent(in) :: dirfile
  character (len=*), intent(in) :: field_code
  double complex, intent(out)  :: data_out
  
  ! call f77 library
  call gdgtco(dirfile, TRIM(field_code), LEN_TRIM(field_code), GD_COMPLEX128, &
  data_out)
end subroutine

function fgd_get_string (dirfile, field_code, length, data_out)
  integer :: fgd_get_string
  integer, intent(in) :: dirfile, length
  character (len=*), intent(in) :: field_code
  character (len=*), intent(out) :: data_out

  ! call f77 library
  call gdgtst(fgd_get_string, dirfile, TRIM(field_code), LEN_TRIM(field_code), &
  length, data_out)
end function

function fgd_nfields (dirfile)
  integer :: fgd_nfields
  integer, intent(in) :: dirfile

  ! call f77 library
  call gdnfld(fgd_nfields, dirfile)
end function

function fgd_nfields_by_type (dirfile, entype)
  integer :: fgd_nfields_by_type
  integer, intent(in) :: dirfile, entype

  call gdnfdt(fgd_nfields_by_type, dirfile, entype)
end function

function fgd_nvectors (dirfile)
  integer :: fgd_nvectors
  integer, intent(in) :: dirfile

  call gdnvec(fgd_nvectors, dirfile)
end function

function fgd_nmfields (dirfile, parent)
  integer :: fgd_nmfields
  integer, intent(in) :: dirfile
  character (len=*), intent(in) :: parent

  ! call f77 library
  call gdnmfd(fgd_nmfields, dirfile, TRIM(parent), LEN_TRIM(parent))
end function

function fgd_nmfields_by_type (dirfile, parent, entype)
  integer :: fgd_nmfields_by_type
  integer, intent(in) :: dirfile, entype
  character (len=*), intent(in) :: parent

  call gdnmft(fgd_nmfields_by_type, dirfile, TRIM(parent), &
  LEN_TRIM(parent), entype)
end function

function fgd_nmvectors (dirfile, parent)
  integer :: fgd_nmvectors
  integer, intent(in) :: dirfile
  character (len=*), intent(in) :: parent

  call gdnmve(fgd_nmvectors, dirfile, TRIM(parent), LEN_TRIM(parent))
end function

function fgd_field_name_max (dirfile)
  integer :: fgd_field_name_max
  integer, intent(in) :: dirfile

  ! call f77 library
  call gdfdnx(fgd_field_name_max, dirfile)
end function

function fgd_mfield_name_max (dirfile, parent)
  integer :: fgd_mfield_name_max
  integer, intent(in) :: dirfile
  character (len=*), intent(in) :: parent

  ! call f77 library
  call gdmfnx(fgd_mfield_name_max, dirfile, TRIM(parent), LEN_TRIM(parent))
end function

subroutine fgd_field_list (field_list, dirfile, field_len)
  character(len=*), dimension(:), intent(out) :: field_list
  integer, intent(in) :: dirfile
  integer, intent(inout) :: field_len
  integer :: max_len, nfields, i

  ! make sure the field list is large enough
  max_len = fgd_field_name_max(dirfile)

  if (field_len .lt. max_len) then
    field_len = max_len
  else
    nfields = fgd_nfields(dirfile)
    do i=1,nfields
      ! call f77 library
      call gdfldn(field_list(i), field_len, dirfile, i)
    end do
  end if
end subroutine

subroutine fgd_field_list_by_type (field_list, dirfile, entype, field_len)
  character(len=*), dimension(:), intent(out) :: field_list
  integer, intent(in) :: dirfile, entype
  integer, intent(inout) :: field_len
  integer :: max_len, nfields, i

  ! make sure the field list is large enough
  max_len = fgd_field_name_max(dirfile)

  if (field_len .lt. max_len) then
    field_len = max_len
  else
    nfields = fgd_nfields_by_type(dirfile, entype)
    do i=1,nfields
      ! call f77 library
      call gdfdnt(field_list(i), field_len, dirfile, entype, i)
    end do
  end if
end subroutine

subroutine fgd_vector_list (field_list, dirfile, field_len)
  character(len=*), dimension(:), intent(out) :: field_list
  integer, intent(in) :: dirfile
  integer, intent(inout) :: field_len
  integer :: max_len, nfields, i

  ! make sure the field list is large enough
  max_len = fgd_field_name_max(dirfile)

  if (field_len .lt. max_len) then
    field_len = max_len
  else
    nfields = fgd_nvectors(dirfile)
    do i=1,nfields
      ! call f77 library
      call gdvecn(field_list(i), field_len, dirfile, i)
    end do
  end if
end subroutine

subroutine fgd_mfield_list (field_list, dirfile, parent, field_len)
  character(len=*), dimension(:), intent(out) :: field_list
  integer, intent(in) :: dirfile
  integer, intent(inout) :: field_len
  integer :: max_len, nfields, i
  character (len=*), intent(in) :: parent

  ! make sure the field list is large enough
  max_len = fgd_mfield_name_max(dirfile, parent)

  if (field_len .lt. max_len) then
    field_len = max_len
  else
    nfields = fgd_nmfields(dirfile, parent)
    do i=1,nfields
      ! call f77 library
      call gdmfdn(field_list(i), field_len, dirfile, TRIM(parent), &
      LEN_TRIM(parent), i)
    end do
  end if
end subroutine

subroutine fgd_mfield_list_by_type (field_list, dirfile, parent, entype, &
field_len)
  character(len=*), dimension(:), intent(out) :: field_list
  integer, intent(in) :: dirfile, entype
  integer, intent(inout) :: field_len
  integer :: max_len, nfields, i
  character (len=*), intent(in) :: parent

  ! make sure the field list is large enough
  max_len = fgd_mfield_name_max(dirfile, parent)

  if (field_len .lt. max_len) then
    field_len = max_len
  else
    nfields = fgd_nmfields_by_type(dirfile, parent, entype)
    do i=1,nfields
      ! call f77 library
      call gdmfdt(field_list(i), field_len, dirfile, TRIM(parent), &
      LEN_TRIM(parent), entype, i)
    end do
  end if
end subroutine

subroutine fgd_mvector_list (field_list, dirfile, parent, field_len)
  character(len=*), dimension(:), intent(out) :: field_list
  integer, intent(in) :: dirfile
  integer, intent(inout) :: field_len
  integer :: max_len, nfields, i
  character (len=*), intent(in) :: parent

  ! make sure the field list is large enough
  max_len = fgd_mfield_name_max(dirfile, parent)

  if (field_len .lt. max_len) then
    field_len = max_len
  else
    nfields = fgd_nmvectors(dirfile, parent)
    do i=1,nfields
      ! call f77 library
      call gdmven(field_list(i), field_len, dirfile, TRIM(parent), &
      LEN_TRIM(parent), i)
    end do
  end if
end subroutine

function fgd_bof (dirfile, field_code)
  integer :: fgd_bof
  integer, intent(in) :: dirfile
  character (len=*), intent(in) :: field_code

  ! call f77 library
  call gdgbof(fgd_bof, dirfile, TRIM(field_code), LEN_TRIM(field_code))
end function

function fgd_eof (dirfile, field_code)
  integer :: fgd_eof
  integer, intent(in) :: dirfile
  character (len=*), intent(in) :: field_code

  ! call f77 library
  call gdgeof(fgd_eof, dirfile, TRIM(field_code), LEN_TRIM(field_code))
end function

function fgd_nframes (dirfile)
  integer :: fgd_nframes
  integer, intent(in) :: dirfile

  ! call f77 library
  call gdnfrm(fgd_nframes, dirfile)
end function

function fgd_spf (dirfile, field_code)
  integer :: fgd_spf
  integer, intent(in) :: dirfile
  character (len=*), intent(in) :: field_code

  ! call f77 library
  call gdgspf(fgd_spf, dirfile, TRIM(field_code), LEN_TRIM(field_code))
end function

! putdata with data_type=GD_INT8
function fgd_putdata_i1 (dirfile, field_code, first_frame, first_sample, &
  num_frames, num_samples, data_in)
  integer :: fgd_putdata_i1
  integer, intent(in) :: dirfile, first_frame, first_sample, num_frames
  character (len=*), intent(in) :: field_code
  integer, intent(in) :: num_samples
  integer*1, dimension(:), intent(in) :: data_in

  ! call f77 library
  call gdputd(fgd_putdata_i1, dirfile, TRIM(field_code), LEN_TRIM(field_code), &
  first_frame, first_sample, num_frames, num_samples, GD_INT8, data_in)
end function

! putdata with data_type=GD_INT16
function fgd_putdata_i2 (dirfile, field_code, first_frame, first_sample, &
  num_frames, num_samples, data_in)
  integer :: fgd_putdata_i2
  integer, intent(in) :: dirfile, first_frame, first_sample, num_frames
  character (len=*), intent(in) :: field_code
  integer, intent(in) :: num_samples
  integer*2, dimension(:), intent(in) :: data_in

  ! call f77 library
  call gdputd(fgd_putdata_i2, dirfile, TRIM(field_code), LEN_TRIM(field_code), &
  first_frame, first_sample, num_frames, num_samples, GD_INT16, data_in)
end function

! putdata with data_type=GD_INT32
function fgd_putdata_i4 (dirfile, field_code, first_frame, first_sample, &
  num_frames, num_samples, data_in)
  integer :: fgd_putdata_i4
  integer, intent(in) :: dirfile, first_frame, first_sample, num_frames
  character (len=*), intent(in) :: field_code
  integer, intent(in) :: num_samples
  integer*4, dimension(:), intent(in) :: data_in

  ! call f77 library
  call gdputd(fgd_putdata_i4, dirfile, TRIM(field_code), LEN_TRIM(field_code), &
  first_frame, first_sample, num_frames, num_samples, GD_INT32, data_in)
end function

! putdata with data_type=GD_INT64
function fgd_putdata_i8 (dirfile, field_code, first_frame, first_sample, &
  num_frames, num_samples, data_in)
  integer :: fgd_putdata_i8
  integer, intent(in) :: dirfile, first_frame, first_sample, num_frames
  character (len=*), intent(in) :: field_code
  integer, intent(in) :: num_samples
  integer*8, dimension(:), intent(in) :: data_in

  ! call f77 library
  call gdputd(fgd_putdata_i8, dirfile, TRIM(field_code), LEN_TRIM(field_code), &
  first_frame, first_sample, num_frames, num_samples, GD_INT64, data_in)
end function

! putdata with data_type=GD_FLOAT32
function fgd_putdata_r4 (dirfile, field_code, first_frame, first_sample, &
  num_frames, num_samples, data_in)
  integer :: fgd_putdata_r4
  integer, intent(in) :: dirfile, first_frame, first_sample, num_frames
  character (len=*), intent(in) :: field_code
  integer, intent(in) :: num_samples
  real*4, dimension(:), intent(in) :: data_in

  ! call f77 library
  call gdputd(fgd_putdata_r4, dirfile, TRIM(field_code), LEN_TRIM(field_code), &
  first_frame, first_sample, num_frames, num_samples, GD_FLOAT32, data_in)
end function

! putdata with data_type=GD_FLOAT64
function fgd_putdata_r8 (dirfile, field_code, first_frame, first_sample, &
  num_frames, num_samples, data_in)
  integer :: fgd_putdata_r8
  integer, intent(in) :: dirfile, first_frame, first_sample, num_frames
  character (len=*), intent(in) :: field_code
  integer, intent(in) :: num_samples
  double precision, dimension(:), intent(in) :: data_in

  ! call f77 library
  call gdputd(fgd_putdata_r8, dirfile, TRIM(field_code), LEN_TRIM(field_code), &
  first_frame, first_sample, num_frames, num_samples, GD_FLOAT64, data_in)
end function

! putdata with data_type=GD_COMPLEX64
function fgd_putdata_c8 (dirfile, field_code, first_frame, first_sample, &
  num_frames, num_samples, data_in)
  integer :: fgd_putdata_c8
  integer, intent(in) :: dirfile, first_frame, first_sample, num_frames
  character (len=*), intent(in) :: field_code
  integer, intent(in) :: num_samples
  complex, dimension(:), intent(in) :: data_in

  ! call f77 library
  call gdputd(fgd_putdata_c8, dirfile, TRIM(field_code), LEN_TRIM(field_code), &
  first_frame, first_sample, num_frames, num_samples, GD_COMPLEX64, data_in)
end function

! putdata with data_type=GD_COMPLEX128
function fgd_putdata_c16 (dirfile, field_code, first_frame, first_sample, &
  num_frames, num_samples, data_in)
  integer :: fgd_putdata_c16
  integer, intent(in) :: dirfile, first_frame, first_sample, num_frames
  character (len=*), intent(in) :: field_code
  integer, intent(in) :: num_samples
  double complex, dimension(:), intent(in) :: data_in

  ! call f77 library
  call gdputd(fgd_putdata_c16, dirfile, TRIM(field_code), &
  LEN_TRIM(field_code), first_frame, first_sample, num_frames, num_samples, &
  GD_COMPLEX128, data_in)
end function

! put_constant with data_type=GD_INT8
subroutine fgd_put_constant_i1 (dirfile, field_code, data_in)
  integer, intent(in) :: dirfile
  character (len=*), intent(in) :: field_code
  integer*1, intent(in) :: data_in

  ! call f77 library
  call gdptco(dirfile, TRIM(field_code), LEN_TRIM(field_code), GD_INT8, data_in)
end subroutine

! put_constant with data_type=GD_INT16
subroutine fgd_put_constant_i2 (dirfile, field_code, data_in)
  integer, intent(in) :: dirfile
  character (len=*), intent(in) :: field_code
  integer*2, intent(in) :: data_in

  ! call f77 library
  call gdptco(dirfile, TRIM(field_code), LEN_TRIM(field_code), GD_INT16, &
  data_in)
end subroutine

! put_constant with data_type=GD_INT32
subroutine fgd_put_constant_i4 (dirfile, field_code, data_in)
  integer, intent(in) :: dirfile
  character (len=*), intent(in) :: field_code
  integer*4, intent(in) :: data_in

  ! call f77 library
  call gdptco(dirfile, TRIM(field_code), LEN_TRIM(field_code), GD_INT32, &
  data_in)
end subroutine

! put_constant with data_type=GD_INT64
subroutine fgd_put_constant_i8 (dirfile, field_code, data_in)
  integer, intent(in) :: dirfile
  character (len=*), intent(in) :: field_code
  integer*8, intent(in) :: data_in

  ! call f77 library
  call gdptco(dirfile, TRIM(field_code), LEN_TRIM(field_code), GD_INT64, &
  data_in)
end subroutine

! put_constant with data_type=GD_FLOAT32
subroutine fgd_put_constant_r4 (dirfile, field_code, data_in)
  integer, intent(in) :: dirfile
  character (len=*), intent(in) :: field_code
  real*4, intent(in) :: data_in

  ! call f77 library
  call gdptco(dirfile, TRIM(field_code), LEN_TRIM(field_code), GD_FLOAT32, &
  data_in)
end subroutine

! put_constant with data_type=GD_FLOAT64
subroutine fgd_put_constant_r8 (dirfile, field_code, data_in)
  integer, intent(in) :: dirfile
  character (len=*), intent(in) :: field_code
  double precision, intent(in) :: data_in

  ! call f77 library
  call gdptco(dirfile, TRIM(field_code), LEN_TRIM(field_code), GD_FLOAT64, &
  data_in)
end subroutine

! put_constant with data_type=GD_COMPLEX64
subroutine fgd_put_constant_c8 (dirfile, field_code, data_in)
  integer, intent(in) :: dirfile
  character (len=*), intent(in) :: field_code
  complex, intent(in) :: data_in

  ! call f77 library
  call gdptco(dirfile, TRIM(field_code), LEN_TRIM(field_code), GD_COMPLEX64, &
  data_in)
end subroutine

! put_constant with data_type=GD_COMPLEX128
subroutine fgd_put_constant_c16 (dirfile, field_code, data_in)
  integer, intent(in) :: dirfile
  character (len=*), intent(in) :: field_code
  double complex, intent(in) :: data_in

  ! call f77 library
  call gdptco(dirfile, TRIM(field_code), LEN_TRIM(field_code), GD_COMPLEX128, &
  data_in)
end subroutine

function fgd_put_string (dirfile, field_code, data_in)
  integer :: fgd_put_string
  integer, intent(in) :: dirfile
  character (len=*), intent(in) :: field_code, data_in

  call gdptst(fgd_put_string, dirfile, TRIM(field_code), LEN_TRIM(field_code), &
  LEN_TRIM(data_in), TRIM(data_in))
end function

function fgd_error (dirfile)
  integer :: fgd_error
  integer, intent(in) :: dirfile

  ! call f77 library
  call gderor(fgd_error, dirfile)
end function

function fgd_error_count (dirfile)
  integer :: fgd_error_count
  integer, intent(in) :: dirfile

  ! call f77 library
  call gdecnt(fgd_error_count, dirfile)
end function

subroutine fgd_error_string (dirfile, buffer, len)
  integer, intent(in) :: dirfile, len
  character (len=*), intent(out) :: buffer

  ! call f77 library
  call gdestr(dirfile, buffer, len)
end subroutine

function fgd_entry (dirfile, field_code, ent)
  integer :: fgd_entry
  integer, intent(in) :: dirfile
  character (len=*), intent(in) :: field_code
  type(gd_entry), intent(out) :: ent
  integer :: i

  ! the call may modify the lengths, so don't use parameters
  integer :: len1 = GD_FIELD_LEN
  integer :: len2 = GD_FIELD_LEN
  integer :: len3 = GD_FIELD_LEN

  ! get field type from f77 library
  call gdenty(fgd_entry, dirfile, TRIM(field_code), LEN_TRIM(field_code))

  ! flags
  call gdenfl(ent%flags, dirfile, TRIM(field_code), LEN_TRIM(field_code))

  if (fgd_entry .EQ. GD_RAW_ENTRY) then
    ! raw
    call gdgerw(ent%spf, ent%data_type, ent%fragment_index, dirfile, &
    TRIM(field_code), LEN_TRIM(field_code))
    call gdgsca(ent%scalar(1), len1, ent%scalar_ind(1), dirfile, &
    TRIM(field_code), LEN_TRIM(field_code), 1)
  else if (fgd_entry .EQ. GD_LINCOM_ENTRY) then
    ! lincom
    if (IAND(GD_EN_COMPSCAL, ent%flags) .NE. 0) then
      call gdgecl(ent%n_fields, ent%field(1), len1, ent%cm(1), ent%cb(1), &
      ent%field(2), len2, ent%cm(2), ent%cb(2), ent%field(3), len3, ent%cm(3), &
      ent%cb(3), ent%fragment_index, dirfile, TRIM(field_code), &
      LEN_TRIM(field_code))
    else
      call gdgelc(ent%n_fields, ent%field(1), len1, ent%m(1), ent%b(1), &
      ent%field(2), len2, ent%m(2), ent%b(2), ent%field(3), len3, ent%m(3), &
      ent%b(3), ent%fragment_index, dirfile, TRIM(field_code), &
      LEN_TRIM(field_code))
    end if
    do i=1,6
      len1 = GD_FIELD_LEN
      call gdgsca(ent%scalar(i), len1, ent%scalar_ind(i), dirfile, &
      TRIM(field_code), LEN_TRIM(field_code), i)
    end do
  else if (fgd_entry .EQ. GD_LINTERP_ENTRY) then
    ! linterp
    call gdgelt(ent%field(1), len1, ent%field(2), len2, ent%fragment_index, &
    dirfile, TRIM(field_code), LEN_TRIM(field_code))
  else if (fgd_entry .EQ. GD_BIT_ENTRY) then
    ! bit
    call gdgebt(ent%field(1), len1, ent%bitnum, ent%numbits, &
    ent%fragment_index, dirfile, TRIM(field_code), LEN_TRIM(field_code))
    len1 = GD_FIELD_LEN
    call gdgsca(ent%scalar(1), len1, ent%scalar_ind(1), dirfile, &
    TRIM(field_code), LEN_TRIM(field_code), 1)
    len1 = GD_FIELD_LEN
    call gdgsca(ent%scalar(2), len1, ent%scalar_ind(2), dirfile, &
    TRIM(field_code), LEN_TRIM(field_code), 2)
  else if (fgd_entry .EQ. GD_SBIT_ENTRY) then
    ! sbit
    call gdgesb(ent%field(1), len1, ent%bitnum, ent%numbits, &
    ent%fragment_index, dirfile, TRIM(field_code), LEN_TRIM(field_code))
    call gdgsca(ent%scalar(1), len1, ent%scalar_ind(1), dirfile, &
    TRIM(field_code), LEN_TRIM(field_code), 1)
    len1 = GD_FIELD_LEN
    call gdgsca(ent%scalar(2), len1, ent%scalar_ind(2), dirfile, &
    TRIM(field_code), LEN_TRIM(field_code), 2)
  else if (fgd_entry .EQ. GD_MULTIPLY_ENTRY) then
    ! multiply
    call gdgemt(ent%field(1), len1, ent%field(2), len2, ent%fragment_index, &
    dirfile, TRIM(field_code), LEN_TRIM(field_code))
  else if (fgd_entry .EQ. GD_DIVIDE_ENTRY) then
    ! divide
    call gdgedv(ent%field(1), len1, ent%field(2), len2, ent%fragment_index, &
    dirfile, TRIM(field_code), LEN_TRIM(field_code))
  else if (fgd_entry .EQ. GD_PHASE_ENTRY) then
    !phase
    call gdgeph(ent%field(1), len1, ent%shift, ent%fragment_index, dirfile, &
    TRIM(field_code), LEN_TRIM(field_code))
    len1 = GD_FIELD_LEN
    call gdgsca(ent%scalar(1), len1, ent%scalar_ind(1), dirfile, &
    TRIM(field_code), LEN_TRIM(field_code), 1)
  else if (fgd_entry .EQ. GD_POLYNOM_ENTRY) then
    ! polynom
    if (IAND(GD_EN_COMPSCAL, ent%flags) .NE. 0) then
      call gdgecp(ent%poly_ord, ent%field(1), len1, ent%ca(1), ent%ca(2), &
      ent%ca(3), ent%ca(4), ent%ca(5), ent%ca(6), ent%fragment_index, dirfile, &
      TRIM(field_code), LEN_TRIM(field_code))
    else
      call gdgepn(ent%poly_ord, ent%field(1), len1, ent%a(1), ent%a(2), &
      ent%a(3), ent%a(4), ent%a(5), ent%a(6), ent%fragment_index, dirfile, &
      TRIM(field_code), LEN_TRIM(field_code))
    end if
    do i=1,6
      len1 = GD_FIELD_LEN
      call gdgsca(ent%scalar(i), len1, ent%scalar_ind(i), dirfile, &
      TRIM(field_code), LEN_TRIM(field_code), i)
    end do
  else if (fgd_entry .EQ. GD_RECIP_ENTRY) then
    ! recip
    if (IAND(GD_EN_COMPSCAL, ent%flags) .NE. 0) then
      call gdgecr(ent%field(1), len1, ent%cdividend, ent%fragment_index, &
      dirfile, TRIM(field_code), LEN_TRIM(field_code))
    else
      call gdgerc(ent%field(1), len1, ent%dividend, ent%fragment_index, &
      dirfile, TRIM(field_code), LEN_TRIM(field_code))
    end if
    len1 = GD_FIELD_LEN
    call gdgsca(ent%scalar(1), len1, ent%scalar_ind(1), dirfile, &
    TRIM(field_code), LEN_TRIM(field_code), 1)
  else if (fgd_entry .EQ. GD_WINDOW_ENTRY) then
    ! window
    call gdgewd(ent%field(1), len1, ent%field(2), len2, ent%windop, &
    ent%ithreshold, ent%rthreshold, ent%fragment_index, dirfile, &
    TRIM(field_code), LEN_TRIM(field_code))

    len1 = GD_FIELD_LEN
    call gdgsca(ent%scalar(1), len1, ent%scalar_ind(1), dirfile, &
    TRIM(field_code), LEN_TRIM(field_code), 1)
  else if (fgd_entry .EQ. GD_MPLEX_ENTRY) then
    ! mplex
    call gdgemx(ent%field(1), len1, ent%field(2), len2, ent%count_val, &
    ent%period, ent%fragment_index, dirfile, TRIM(field_code), &
    LEN_TRIM(field_code))

    len1 = GD_FIELD_LEN
    call gdgsca(ent%scalar(1), len1, ent%scalar_ind(1), dirfile, &
    TRIM(field_code), LEN_TRIM(field_code), 1)

    len1 = GD_FIELD_LEN
    call gdgsca(ent%scalar(2), len1, ent%scalar_ind(2), dirfile, &
    TRIM(field_code), LEN_TRIM(field_code), 2)
  else if (fgd_entry .EQ. GD_CONST_ENTRY) then
    !const
    call gdgeco(ent%data_type, ent%fragment_index, dirfile, TRIM(field_code), &
    LEN_TRIM(field_code))
  else if (fgd_entry .EQ. GD_CARRAY_ENTRY) then
    !carray
    call gdgeca(ent%data_type, ent%array_len, ent%fragment_index, dirfile, &
    TRIM(field_code), LEN_TRIM(field_code))
  else if (fgd_entry .EQ. GD_STRING_ENTRY) then
    !string
    call gdfrgi(ent%fragment_index, dirfile, TRIM(field_code), &
    LEN_TRIM(field_code))
  else
    ! on the off chance we got a type we weren't prepared to deal with
    fgd_entry = GD_NO_ENTRY
  end if
  ent%field_type = fgd_entry
end function

function fgd_entry_type (dirfile, field_code)
  integer :: fgd_entry_type
  integer, intent(in) :: dirfile
  character (len=*), intent(in) :: field_code

  call gdenty(fgd_entry_type, dirfile, TRIM(field_code), &
  LEN_TRIM(field_code))
end function

function fgd_fragment_index (dirfile, field_code)
  integer :: fgd_fragment_index
  integer, intent(in) :: dirfile
  character (len=*), intent(in) :: field_code

  call gdfrgi(fgd_fragment_index, dirfile, TRIM(field_code), &
  LEN_TRIM(field_code))
end function

subroutine fgd_add (dirfile, field_code, ent)
  integer, intent(in) :: dirfile
  character (len=*), intent(in) :: field_code
  type(gd_entry), intent(in) :: ent
  integer*4 :: zero = 0
  character (len=1) :: nil = ""

  if (ent%field_type .EQ. GD_RAW_ENTRY) then
    call gdasrw(dirfile, TRIM(field_code), LEN_TRIM(field_code), &
    ent%data_type, ent%spf, TRIM(ent%scalar(1)), LEN_TRIM(ent%scalar(1)), &
    ent%scalar_ind(1), ent%fragment_index)
  else if (ent%field_type .EQ. GD_LINCOM_ENTRY) then
    if (IAND(GD_EN_COMPSCAL, ent%flags) .EQ. 0) then
      call gdaslc(dirfile, TRIM(field_code), LEN_TRIM(field_code), &
      ent%n_fields, TRIM(ent%field(1)), LEN_TRIM(ent%field(1)), ent%m(1), &
      TRIM(ent%scalar(1)), LEN_TRIM(ent%scalar(1)), ent%scalar_ind(1), &
      ent%b(1), TRIM(ent%scalar(4)), LEN_TRIM(ent%scalar(4)), &
      ent%scalar_ind(4), TRIM(ent%field(2)), LEN_TRIM(ent%field(2)), ent%m(2), &
      TRIM(ent%scalar(2)), LEN_TRIM(ent%scalar(2)), ent%scalar_ind(2), &
      ent%b(2), TRIM(ent%scalar(5)), LEN_TRIM(ent%scalar(5)), &
      ent%scalar_ind(5), TRIM(ent%field(3)), LEN_TRIM(ent%field(3)), ent%m(3), &
      TRIM(ent%scalar(3)), LEN_TRIM(ent%scalar(3)), ent%scalar_ind(3), &
      ent%b(3), TRIM(ent%scalar(6)), LEN_TRIM(ent%scalar(6)), &
      ent%scalar_ind(6), ent%fragment_index)
    else
      call gdascl(dirfile, TRIM(field_code), LEN_TRIM(field_code), &
      ent%n_fields, TRIM(ent%field(1)), LEN_TRIM(ent%field(1)), ent%cm(1), &
      TRIM(ent%scalar(1)), LEN_TRIM(ent%scalar(1)), ent%scalar_ind(1), &
      ent%cb(1), TRIM(ent%scalar(4)), LEN_TRIM(ent%scalar(4)), &
      ent%scalar_ind(4), TRIM(ent%field(2)), LEN_TRIM(ent%field(2)), &
      ent%cm(2), TRIM(ent%scalar(2)), LEN_TRIM(ent%scalar(2)), &
      ent%scalar_ind(2), ent%cb(2), TRIM(ent%scalar(5)), &
      LEN_TRIM(ent%scalar(5)), ent%scalar_ind(5), TRIM(ent%field(3)), &
      LEN_TRIM(ent%field(3)), ent%cm(3), TRIM(ent%scalar(3)), &
      LEN_TRIM(ent%scalar(3)), ent%scalar_ind(3), ent%cb(3), &
      TRIM(ent%scalar(6)), LEN_TRIM(ent%scalar(6)), ent%scalar_ind(6), &
      ent%fragment_index)
    end if
  else if (ent%field_type .EQ. GD_LINTERP_ENTRY) then
    call gdadlt(dirfile, TRIM(field_code), LEN_TRIM(field_code), &
    TRIM(ent%field(1)), LEN_TRIM(ent%field(1)), TRIM(ent%field(2)), &
    LEN_TRIM(ent%field(2)), ent%fragment_index)
  else if (ent%field_type .EQ. GD_BIT_ENTRY) then
    call gdasbt(dirfile, TRIM(field_code), LEN_TRIM(field_code), &
    TRIM(ent%field(1)), LEN_TRIM(ent%field(1)), ent%bitnum, &
    TRIM(ent%scalar(1)), LEN_TRIM(ent%scalar(1)), ent%scalar_ind(1), &
    ent%numbits, TRIM(ent%scalar(2)), LEN_TRIM(ent%scalar(2)), &
    ent%scalar_ind(2), ent%fragment_index)
  else if (ent%field_type .EQ. GD_SBIT_ENTRY) then
    call gdassb(dirfile, TRIM(field_code), LEN_TRIM(field_code), &
    TRIM(ent%field(1)), LEN_TRIM(ent%field(1)), ent%bitnum, &
    TRIM(ent%scalar(1)), LEN_TRIM(ent%scalar(1)), ent%scalar_ind(1), &
    ent%numbits, TRIM(ent%scalar(2)), LEN_TRIM(ent%scalar(2)), &
    ent%scalar_ind(2), ent%fragment_index)
  else if (ent%field_type .EQ. GD_MULTIPLY_ENTRY) then
    call gdadmt(dirfile, TRIM(field_code), LEN_TRIM(field_code), &
    TRIM(ent%field(1)), LEN_TRIM(ent%field(1)), TRIM(ent%field(2)), &
    LEN_TRIM(ent%field(2)), ent%fragment_index)
  else if (ent%field_type .EQ. GD_DIVIDE_ENTRY) then
    call gdaddv(dirfile, TRIM(field_code), LEN_TRIM(field_code), &
    TRIM(ent%field(1)), LEN_TRIM(ent%field(1)), TRIM(ent%field(2)), &
    LEN_TRIM(ent%field(2)), ent%fragment_index)
  else if (ent%field_type .EQ. GD_PHASE_ENTRY) then
    call gdasph(dirfile, TRIM(field_code), LEN_TRIM(field_code), &
    TRIM(ent%field(1)), LEN_TRIM(ent%field(1)), ent%shift, &
    TRIM(ent%scalar(1)), LEN_TRIM(ent%scalar(1)), ent%scalar_ind(1), &
    ent%fragment_index)
  else if (ent%field_type .EQ. GD_POLYNOM_ENTRY) then
    if (IAND(GD_EN_COMPSCAL, ent%flags) .EQ. 0) then
      call gdaspn(dirfile, TRIM(field_code), LEN_TRIM(field_code), &
      ent%poly_ord, TRIM(ent%field(1)), LEN_TRIM(ent%field(1)), ent%a(1), &
      TRIM(ent%scalar(1)), LEN_TRIM(ent%scalar(1)), ent%scalar_ind(1), &
      ent%a(2), TRIM(ent%scalar(2)), LEN_TRIM(ent%scalar(2)), &
      ent%scalar_ind(2), ent%a(3), TRIM(ent%scalar(3)), &
      LEN_TRIM(ent%scalar(3)), ent%scalar_ind(3), ent%a(4), &
      TRIM(ent%scalar(4)), LEN_TRIM(ent%scalar(4)), ent%scalar_ind(4), &
      ent%a(5), TRIM(ent%scalar(5)), LEN_TRIM(ent%scalar(5)), &
      ent%scalar_ind(5), ent%a(6), TRIM(ent%scalar(6)), &
      LEN_TRIM(ent%scalar(6)), ent%scalar_ind(6), ent%fragment_index)
    else
      call gdascp(dirfile, TRIM(field_code), LEN_TRIM(field_code), &
      ent%poly_ord, TRIM(ent%field(1)), LEN_TRIM(ent%field(1)), ent%ca(1), &
      TRIM(ent%scalar(1)), LEN_TRIM(ent%scalar(1)), ent%scalar_ind(1), &
      ent%ca(2), TRIM(ent%scalar(2)), LEN_TRIM(ent%scalar(2)), &
      ent%scalar_ind(2), ent%ca(3), TRIM(ent%scalar(3)), &
      LEN_TRIM(ent%scalar(3)), ent%scalar_ind(3), ent%ca(4), &
      TRIM(ent%scalar(4)), LEN_TRIM(ent%scalar(4)), ent%scalar_ind(4), &
      ent%ca(5), TRIM(ent%scalar(5)), LEN_TRIM(ent%scalar(5)), &
      ent%scalar_ind(5), ent%ca(6), TRIM(ent%scalar(6)), &
      LEN_TRIM(ent%scalar(6)), ent%scalar_ind(6), ent%fragment_index)
    end if
  else if (ent%field_type .EQ. GD_RECIP_ENTRY) then
    if (IAND(GD_EN_COMPSCAL, ent%flags) .EQ. 0) then
      call gdasrc(dirfile, TRIM(field_code), LEN_TRIM(field_code), &
      TRIM(ent%field(1)), LEN_TRIM(ent%field(1)), ent%dividend, &
      TRIM(ent%scalar(1)), LEN_TRIM(ent%scalar(1)), ent%scalar_ind(1), &
      ent%fragment_index)
    else
      call gdascr(dirfile, TRIM(field_code), LEN_TRIM(field_code), &
      TRIM(ent%field(1)), LEN_TRIM(ent%field(1)), ent%cdividend, &
      TRIM(ent%scalar(1)), LEN_TRIM(ent%scalar(1)), ent%scalar_ind(1), &
      ent%fragment_index)
    end if
  else if (ent%field_type .EQ. GD_WINDOW_ENTRY) then
    if ((ent%windop .EQ. GD_WINDOP_EQ) .OR. (ent%windop .EQ. GD_WINDOP_NE) &
    .OR. (ent%windop .EQ. GD_WINDOP_SET) .OR. (ent%windop .EQ. GD_WINDOP_CLR)) &
    then
      call gdaswd(dirfile, TRIM(field_code), LEN_TRIM(field_code), &
      TRIM(ent%field(1)), LEN_TRIM(ent%field(1)), TRIM(ent%field(2)), &
      LEN_TRIM(ent%field(2)), ent%windop, ent%ithreshold, &
      TRIM(ent%scalar(1)), LEN_TRIM(ent%scalar(1)), ent%scalar_ind(1), &
      ent%fragment_index)
    else
      call gdaswd(dirfile, TRIM(field_code), LEN_TRIM(field_code), &
      TRIM(ent%field(1)), LEN_TRIM(ent%field(1)), TRIM(ent%field(2)), &
      LEN_TRIM(ent%field(2)), ent%windop, ent%rthreshold, &
      TRIM(ent%scalar(1)), LEN_TRIM(ent%scalar(1)), ent%scalar_ind(1), &
      ent%fragment_index)
    end if
  else if (ent%field_type .EQ. GD_MPLEX_ENTRY) then
    call gdasmx(dirfile, TRIM(field_code), LEN_TRIM(field_code), &
    TRIM(ent%field(1)), LEN_TRIM(ent%field(1)), TRIM(ent%field(2)), &
    LEN_TRIM(ent%field(2)), ent%count_val, TRIM(ent%scalar(1)), &
    LEN_TRIM(ent%scalar(1)), ent%scalar_ind(1), ent%period, &
    TRIM(ent%scalar(2)), LEN_TRIM(ent%scalar(2)), ent%scalar_ind(2), &
    ent%fragment_index)
  else if (ent%field_type .EQ. GD_CONST_ENTRY) then
    call gdadco(dirfile, TRIM(field_code), LEN_TRIM(field_code), &
    ent%data_type, GD_INT32, zero, ent%fragment_index)
  else if (ent%field_type .EQ. GD_CARRAY_ENTRY) then
    call fgd_add_carray(dirfile, field_code, ent%data_type, ent%array_len, &
    ent%fragment_index)
  else if (ent%field_type .EQ. GD_STRING_ENTRY) then
    call gdadst(dirfile, TRIM(field_code), LEN_TRIM(field_code), nil, zero, &
    ent%fragment_index)
  end if
end subroutine

subroutine fgd_add_bit (dirfile, field_name, in_field, bitnum, numbits, &
  fragment_index)
  integer, intent(in) :: dirfile, bitnum, numbits, fragment_index
  character (len=*), intent(in) :: field_name, in_field

  call gdadbt(dirfile, TRIM(field_name), LEN_TRIM(field_name), TRIM(in_field), &
  LEN_TRIM(in_field), bitnum, numbits, fragment_index)
end subroutine

subroutine fgd_add_sbit (dirfile, field_name, in_field, bitnum, numbits, &
  fragment_index)
  integer, intent(in) :: dirfile, bitnum, numbits, fragment_index
  character (len=*), intent(in) :: field_name, in_field

  call gdadsb(dirfile, TRIM(field_name), LEN_TRIM(field_name), TRIM(in_field), &
  LEN_TRIM(in_field), bitnum, numbits, fragment_index)
end subroutine

subroutine fgd_add_const (dirfile, field_name, const_type, fragment_index)
  integer, intent(in) :: dirfile, const_type, fragment_index
  character (len=*), intent(in) :: field_name
  integer*4 :: zero = 0

  call gdadco(dirfile, TRIM(field_name), LEN_TRIM(field_name), const_type, &
  GD_INT32, zero, fragment_index)
end subroutine

subroutine fgd_add_lincom (dirfile, field_name, n_fields, in_field1, m1, b1, &
  in_field2, m2, b2, in_field3, m3, b3, fragment_index)
  integer, intent(in) :: dirfile, n_fields, fragment_index
  character (len=*), intent(in) :: field_name, in_field1, in_field2, in_field3
  double precision, intent(in) :: m1, b1, m2, b2, m3, b3

  call gdadlc(dirfile, TRIM(field_name), LEN_TRIM(field_name), n_fields, &
  TRIM(in_field1), LEN_TRIM(in_field1), m1, b1, TRIM(in_field2), &
  LEN_TRIM(in_field2), m2, b2, TRIM(in_field3), LEN_TRIM(in_field3), m3, b3, &
  fragment_index)
end subroutine

subroutine fgd_add_clincom (dirfile, field_name, n_fields, in_field1, m1, b1, &
  in_field2, m2, b2, in_field3, m3, b3, fragment_index)
  integer, intent(in) :: dirfile, n_fields, fragment_index
  character (len=*), intent(in) :: field_name, in_field1, in_field2, in_field3
  double complex, intent(in) :: m1, b1, m2, b2, m3, b3

  call gdadcl(dirfile, TRIM(field_name), LEN_TRIM(field_name), n_fields, &
  TRIM(in_field1), LEN_TRIM(in_field1), m1, b1, TRIM(in_field2), &
  LEN_TRIM(in_field2), m2, b2, TRIM(in_field3), LEN_TRIM(in_field3), m3, b3, &
  fragment_index)
end subroutine

subroutine fgd_add_polynom (dirfile, field_name, poly_ord, in_field, a0, a1, &
  a2, a3, a4, a5, fragment_index)
  integer, intent(in) :: dirfile, poly_ord, fragment_index
  character (len=*), intent(in) :: field_name, in_field
  double precision, intent(in) :: a0, a1, a2, a3, a4, a5

  call gdadpn(dirfile, TRIM(field_name), LEN_TRIM(field_name), poly_ord, &
  TRIM(in_field), LEN_TRIM(in_field), a0, a1, a2, a3, a4, a5, &
  fragment_index)
end subroutine

subroutine fgd_add_cpolynom (dirfile, field_name, poly_ord, in_field, a0, a1, &
  a2, a3, a4, a5, fragment_index)
  integer, intent(in) :: dirfile, poly_ord, fragment_index
  character (len=*), intent(in) :: field_name, in_field
  double complex, intent(in) :: a0, a1, a2, a3, a4, a5

  call gdadcp(dirfile, TRIM(field_name), LEN_TRIM(field_name), poly_ord, &
  TRIM(in_field), LEN_TRIM(in_field), a0, a1, a2, a3, a4, a5, &
  fragment_index)
end subroutine

subroutine fgd_add_linterp (dirfile, field_name, in_field, table, &
  fragment_index)
  integer, intent(in) :: dirfile, fragment_index
  character (len=*), intent(in) :: field_name, in_field, table

  call gdadlt(dirfile, TRIM(field_name), LEN_TRIM(field_name), TRIM(in_field), &
  LEN_TRIM(in_field), TRIM(table), LEN_TRIM(table), fragment_index)
end subroutine

subroutine fgd_add_multiply (dirfile, field_name, in_field1, in_field2, &
  fragment_index)
  integer, intent(in) :: dirfile, fragment_index
  character (len=*), intent(in) :: field_name, in_field1, in_field2

  call gdadmt(dirfile, TRIM(field_name), LEN_TRIM(field_name), &
  TRIM(in_field1), LEN_TRIM(in_field1), TRIM(in_field2), LEN_TRIM(in_field2), &
  fragment_index)
end subroutine

subroutine fgd_add_divide (dirfile, field_name, in_field1, in_field2, &
  fragment_index)
  integer, intent(in) :: dirfile, fragment_index
  character (len=*), intent(in) :: field_name, in_field1, in_field2

  call gdaddv(dirfile, TRIM(field_name), LEN_TRIM(field_name), &
  TRIM(in_field1), LEN_TRIM(in_field1), TRIM(in_field2), LEN_TRIM(in_field2), &
  fragment_index)
end subroutine

subroutine fgd_add_recip (dirfile, field_name, in_field, dividend, &
  fragment_index)
  integer, intent(in) :: dirfile, fragment_index
  double precision, intent(in) :: dividend
  character (len=*), intent(in) :: field_name, in_field

  call gdadrc(dirfile, TRIM(field_name), LEN_TRIM(field_name), TRIM(in_field), &
  LEN_TRIM(in_field), dividend, fragment_index)
end subroutine

subroutine fgd_add_crecip (dirfile, field_name, in_field, cdividend, &
  fragment_index)
  integer, intent(in) :: dirfile, fragment_index
  double complex, intent(in) :: cdividend
  character (len=*), intent(in) :: field_name, in_field

  call gdadcr(dirfile, TRIM(field_name), LEN_TRIM(field_name), TRIM(in_field), &
  LEN_TRIM(in_field), cdividend, fragment_index)
end subroutine

subroutine fgd_add_phase (dirfile, field_name, in_field, phase, fragment_index)
  integer, intent(in) :: dirfile, phase, fragment_index
  character (len=*), intent(in) :: field_name, in_field

  call gdadph(dirfile, TRIM(field_name), LEN_TRIM(field_name), &
  TRIM(in_field), LEN_TRIM(in_field), phase, fragment_index)
end subroutine

subroutine fgd_add_raw (dirfile, field_code, data_type, spf, fragment_index)
  integer, intent(in) :: dirfile, data_type, spf, fragment_index
  character (len=*), intent(in) :: field_code

  call gdadrw(dirfile, TRIM(field_code), LEN_TRIM(field_code), data_type, spf, &
  fragment_index)
end subroutine

subroutine fgd_add_string (dirfile, field_code, fragment_index)
  integer, intent(in) :: dirfile, fragment_index
  character (len=*), intent(in) :: field_code
  
  character (len=1) :: nil = ""

  call gdadst(dirfile, TRIM(field_code), LEN_TRIM(field_code), nil, 0, &
  fragment_index)
end subroutine

subroutine fgd_madd (dirfile, parent, field_code, ent)
  integer, intent(in) :: dirfile
  character (len=*), intent(in) :: field_code, parent
  type(gd_entry), intent(in) :: ent
  integer*4 :: zero = 0
  character (len=1) :: nil = ""

  if (ent%field_type .EQ. GD_LINCOM_ENTRY) then
    if (IAND(GD_EN_COMPSCAL, ent%flags) .NE. 0) then
      call gdmdcl(dirfile, TRIM(parent), LEN_TRIM(parent), TRIM(field_code), &
      LEN_TRIM(field_code), ent%n_fields, TRIM(ent%field(1)), &
      LEN_TRIM(ent%field(1)), ent%cm(1), ent%cb(1), TRIM(ent%field(2)), &
      LEN_TRIM(ent%field(2)), ent%cm(2), ent%cb(2), TRIM(ent%field(3)), &
      LEN_TRIM(ent%field(3)), ent%cm(3), ent%cb(3))
    else
      call gdmdlc(dirfile, TRIM(parent), LEN_TRIM(parent), TRIM(field_code), &
      LEN_TRIM(field_code), ent%n_fields, TRIM(ent%field(1)), &
      LEN_TRIM(ent%field(1)), ent%m(1), ent%b(1), TRIM(ent%field(2)), &
      LEN_TRIM(ent%field(2)), ent%m(2), ent%b(2), TRIM(ent%field(3)), &
      LEN_TRIM(ent%field(3)), ent%m(3), ent%b(3))
    end if
  else if (ent%field_type .EQ. GD_LINTERP_ENTRY) then
    call gdmdlt(dirfile, TRIM(parent), LEN_TRIM(parent), TRIM(field_code), &
    LEN_TRIM(field_code), TRIM(ent%field(1)), LEN_TRIM(ent%field(1)), &
    TRIM(ent%field(2)), LEN_TRIM(ent%field(2)))
  else if (ent%field_type .EQ. GD_BIT_ENTRY) then
    call gdmdbt(dirfile, TRIM(parent), LEN_TRIM(parent), TRIM(field_code), &
    LEN_TRIM(field_code), TRIM(ent%field(1)), LEN_TRIM(ent%field(1)), &
    ent%bitnum, ent%numbits)
  else if (ent%field_type .EQ. GD_SBIT_ENTRY) then
    call gdmdsb(dirfile, TRIM(parent), LEN_TRIM(parent), TRIM(field_code), &
    LEN_TRIM(field_code), TRIM(ent%field(1)), LEN_TRIM(ent%field(1)), &
    ent%bitnum, ent%numbits)
  else if (ent%field_type .EQ. GD_MULTIPLY_ENTRY) then
    call gdmdmt(dirfile, TRIM(parent), LEN_TRIM(parent), TRIM(field_code), &
    LEN_TRIM(field_code), TRIM(ent%field(1)), LEN_TRIM(ent%field(1)), &
    TRIM(ent%field(2)), LEN_TRIM(ent%field(2)))
  else if (ent%field_type .EQ. GD_DIVIDE_ENTRY) then
    call gdmddv(dirfile, TRIM(parent), LEN_TRIM(parent), TRIM(field_code), &
    LEN_TRIM(field_code), TRIM(ent%field(1)), LEN_TRIM(ent%field(1)), &
    TRIM(ent%field(2)), LEN_TRIM(ent%field(2)))
  else if (ent%field_type .EQ. GD_POLYNOM_ENTRY) then
    if (IAND(GD_EN_COMPSCAL, ent%flags) .NE. 0) then
      call gdmdcp(dirfile, TRIM(parent), LEN_TRIM(parent), TRIM(field_code), &
      LEN_TRIM(field_code), ent%poly_ord, TRIM(ent%field(1)), &
      LEN_TRIM(ent%field(1)), ent%ca(1), ent%ca(2), ent%ca(3), ent%ca(4), &
      ent%ca(5), ent%ca(6))
    else
      call gdmdpn(dirfile, TRIM(parent), LEN_TRIM(parent), TRIM(field_code), &
      LEN_TRIM(field_code), ent%poly_ord, TRIM(ent%field(1)), &
      LEN_TRIM(ent%field(1)), ent%a(1), ent%a(2), ent%a(3), ent%a(4), &
      ent%a(5), ent%a(6))
    end if
  else if (ent%field_type .EQ. GD_RECIP_ENTRY) then
    if (IAND(GD_EN_COMPSCAL, ent%flags) .NE. 0) then
      call gdmdcr(dirfile, TRIM(parent), LEN_TRIM(parent), TRIM(field_code), &
      LEN_TRIM(field_code), TRIM(ent%field(1)), LEN_TRIM(ent%field(1)), &
      ent%cdividend)
    else
      call gdmdrc(dirfile, TRIM(parent), LEN_TRIM(parent), TRIM(field_code), &
      LEN_TRIM(field_code), TRIM(ent%field(1)), LEN_TRIM(ent%field(1)), &
      ent%dividend)
    end if
  else if (ent%field_type .EQ. GD_PHASE_ENTRY) then
    call gdmdph(dirfile, TRIM(parent), LEN_TRIM(parent), TRIM(field_code), &
    LEN_TRIM(field_code), TRIM(ent%field(1)), LEN_TRIM(ent%field(1)), ent%shift)
  else if (ent%field_type .EQ. GD_WINDOW_ENTRY) then
    if ((ent%windop .EQ. GD_WINDOP_EQ) .OR. (ent%windop .EQ. GD_WINDOP_NE) &
    .OR. (ent%windop .EQ. GD_WINDOP_SET) .OR. (ent%windop .EQ. GD_WINDOP_CLR)) &
    then
      call gdmdwd(dirfile, TRIM(parent), LEN_TRIM(parent), TRIM(field_code), &
      LEN_TRIM(field_code), TRIM(ent%field(1)), LEN_TRIM(ent%field(1)), &
      TRIM(ent%field(2)), LEN_TRIM(ent%field(2)), ent%windop, ent%ithreshold, &
      ent%fragment_index)
    else
      call gdmdwd(dirfile, TRIM(parent), LEN_TRIM(parent), TRIM(field_code), &
      LEN_TRIM(field_code), TRIM(ent%field(1)), LEN_TRIM(ent%field(1)), &
      TRIM(ent%field(2)), LEN_TRIM(ent%field(2)), ent%windop, ent%rthreshold, &
      ent%fragment_index)
    end if
  else if (ent%field_type .EQ. GD_MPLEX_ENTRY) then
    call gdmdmx(dirfile, TRIM(parent), LEN_TRIM(parent), TRIM(field_code), &
    LEN_TRIM(field_code), TRIM(ent%field(1)), LEN_TRIM(ent%field(1)), &
    TRIM(ent%field(2)), LEN_TRIM(ent%field(2)), ent%count_val, ent%period)
  else if (ent%field_type .EQ. GD_CONST_ENTRY) then
    call gdmdco(dirfile, TRIM(parent), LEN_TRIM(parent), TRIM(field_code), &
    LEN_TRIM(field_code), ent%data_type, GD_INT32, zero)
  else if (ent%field_type .EQ. GD_CARRAY_ENTRY) then
    call fgd_madd_carray(dirfile, parent, field_code, ent%data_type, &
    ent%array_len)
  else if (ent%field_type .EQ. GD_STRING_ENTRY) then
    call gdmdst(dirfile, TRIM(parent), LEN_TRIM(parent), TRIM(field_code), &
    LEN_TRIM(field_code), nil, zero)
  end if
end subroutine

subroutine fgd_madd_bit (dirfile, parent, field_name, in_field, bitnum, &
  numbits)
  integer, intent(in) :: dirfile, bitnum, numbits
  character (len=*), intent(in) :: field_name, in_field, parent

  call gdmdbt(dirfile, TRIM(parent), LEN_TRIM(parent), TRIM(field_name), &
  LEN_TRIM(field_name), TRIM(in_field), LEN_TRIM(in_field), bitnum, numbits)
end subroutine

subroutine fgd_madd_sbit (dirfile, parent, field_name, in_field, bitnum, &
  numbits)
  integer, intent(in) :: dirfile, bitnum, numbits
  character (len=*), intent(in) :: field_name, in_field, parent

  call gdmdsb(dirfile, TRIM(parent), LEN_TRIM(parent), TRIM(field_name), &
  LEN_TRIM(field_name), TRIM(in_field), LEN_TRIM(in_field), bitnum, numbits)
end subroutine

subroutine fgd_madd_const (dirfile, parent, field_name, const_type)
  integer, intent(in) :: dirfile, const_type
  character (len=*), intent(in) :: field_name, parent
  integer*4 :: zero = 0

  call gdmdco(dirfile, TRIM(parent), LEN_TRIM(parent), TRIM(field_name), &
  LEN_TRIM(field_name), const_type, GD_INT32, zero)
end subroutine

subroutine fgd_madd_lincom (dirfile, parent, field_name, n_fields, in_field1, &
  m1, b1, in_field2, m2, b2, in_field3, m3, b3)
  integer, intent(in) :: dirfile, n_fields
  character (len=*), intent(in) :: field_name, in_field1, in_field2, in_field3
  character (len=*), intent(in) :: parent
  double precision, intent(in) :: m1, b1, m2, b2, m3, b3

  call gdmdlc(dirfile, TRIM(parent), LEN_TRIM(parent), TRIM(field_name), &
  LEN_TRIM(field_name), n_fields, TRIM(in_field1), LEN_TRIM(in_field1), m1, &
  b1, TRIM(in_field2), LEN_TRIM(in_field2), m2, b2, TRIM(in_field3), &
  LEN_TRIM(in_field3), m3, b3)
end subroutine

subroutine fgd_madd_clincom (dirfile, parent, field_name, n_fields, in_field1, &
  m1, b1, in_field2, m2, b2, in_field3, m3, b3)
  integer, intent(in) :: dirfile, n_fields
  character (len=*), intent(in) :: field_name, in_field1, in_field2, in_field3
  character (len=*), intent(in) :: parent
  double complex, intent(in) :: m1, b1, m2, b2, m3, b3

  call gdmdcl(dirfile, TRIM(parent), LEN_TRIM(parent), TRIM(field_name), &
  LEN_TRIM(field_name), n_fields, TRIM(in_field1), LEN_TRIM(in_field1), m1, &
  b1, TRIM(in_field2), LEN_TRIM(in_field2), m2, b2, TRIM(in_field3), &
  LEN_TRIM(in_field3), m3, b3)
end subroutine

subroutine fgd_madd_polynom (dirfile, parent, field_name, poly_ord, in_field, &
  a0, a1, a2, a3, a4, a5)
  integer, intent(in) :: dirfile, poly_ord
  character (len=*), intent(in) :: field_name, in_field
  character (len=*), intent(in) :: parent
  double precision, intent(in) :: a0, a1, a2, a3, a4, a5

  call gdmdpn(dirfile, TRIM(parent), LEN_TRIM(parent), TRIM(field_name), &
  LEN_TRIM(field_name), poly_ord, TRIM(in_field), LEN_TRIM(in_field), a0, &
  a1, a2, a3, a4, a5)
end subroutine

subroutine fgd_madd_cpolynom (dirfile, parent, field_name, poly_ord, in_field, &
  a0, a1, a2, a3, a4, a5)
  integer, intent(in) :: dirfile, poly_ord
  character (len=*), intent(in) :: field_name, in_field
  character (len=*), intent(in) :: parent
  double complex, intent(in) :: a0, a1, a2, a3, a4, a5

  call gdmdcp(dirfile, TRIM(parent), LEN_TRIM(parent), TRIM(field_name), &
  LEN_TRIM(field_name), poly_ord, TRIM(in_field), LEN_TRIM(in_field), a0, &
  a1, a2, a3, a4, a5)
end subroutine

subroutine fgd_madd_linterp (dirfile, parent, field_name, in_field, table)
  integer, intent(in) :: dirfile
  character (len=*), intent(in) :: field_name, in_field, table, parent

  call gdmdlt(dirfile, TRIM(parent), LEN_TRIM(parent), TRIM(field_name), &
  LEN_TRIM(field_name), TRIM(in_field), LEN_TRIM(in_field), TRIM(table), &
  LEN_TRIM(table))
end subroutine

subroutine fgd_madd_multiply (dirfile, parent, field_name, in_field1, in_field2)
  integer, intent(in) :: dirfile
  character (len=*), intent(in) :: field_name, in_field1, in_field2, parent

  call gdmdmt(dirfile, TRIM(parent), LEN_TRIM(parent), TRIM(field_name), &
  LEN_TRIM(field_name), TRIM(in_field1), LEN_TRIM(in_field1), TRIM(in_field2), &
  LEN_TRIM(in_field2))
end subroutine

subroutine fgd_madd_divide (dirfile, parent, field_name, in_field1, in_field2)
  integer, intent(in) :: dirfile
  character (len=*), intent(in) :: field_name, in_field1, in_field2, parent

  call gdmddv(dirfile, TRIM(parent), LEN_TRIM(parent), TRIM(field_name), &
  LEN_TRIM(field_name), TRIM(in_field1), LEN_TRIM(in_field1), TRIM(in_field2), &
  LEN_TRIM(in_field2))
end subroutine

subroutine fgd_madd_recip (dirfile, parent, field_name, in_field, dividend)
  integer, intent(in) :: dirfile
  double precision, intent(in) :: dividend
  character (len=*), intent(in) :: field_name, in_field, parent

  call gdmdrc(dirfile, TRIM(parent), LEN_TRIM(parent), TRIM(field_name), &
  LEN_TRIM(field_name), TRIM(in_field), LEN_TRIM(in_field), dividend)
end subroutine

subroutine fgd_madd_crecip (dirfile, parent, field_name, in_field, cdividend)
  integer, intent(in) :: dirfile
  double complex, intent(in) :: cdividend
  character (len=*), intent(in) :: field_name, in_field, parent

  call gdmdcr(dirfile, TRIM(parent), LEN_TRIM(parent), TRIM(field_name), &
  LEN_TRIM(field_name), TRIM(in_field), LEN_TRIM(in_field), cdividend)
end subroutine

subroutine fgd_madd_phase (dirfile, parent, field_name, in_field, phase)
  integer, intent(in) :: dirfile, phase
  character (len=*), intent(in) :: field_name, in_field, parent

  call gdmdph(dirfile, TRIM(parent), LEN_TRIM(parent), TRIM(field_name), &
  LEN_TRIM(field_name), TRIM(in_field), LEN_TRIM(in_field), phase)
end subroutine

subroutine fgd_madd_string (dirfile, parent, field_code)
  integer, intent(in) :: dirfile
  character (len=*), intent(in) :: field_code, parent
  
  character (len=1) :: nil = ""

  call gdmdst(dirfile, TRIM(parent), LEN_TRIM(parent), TRIM(field_code), &
  LEN_TRIM(field_code), nil, 0)
end subroutine

subroutine fgd_add_spec (dirfile, spec, fragment_index)
  integer, intent(in) :: dirfile, fragment_index
  character (len=*), intent(in) :: spec

  call gdadsp(dirfile, TRIM(spec), LEN_TRIM(spec), fragment_index)
end subroutine

subroutine fgd_madd_spec (dirfile, spec, parent)
  integer, intent(in) :: dirfile
  character (len=*), intent(in) :: parent, spec

  call gdmdsp(dirfile, TRIM(spec), LEN_TRIM(spec), TRIM(parent), &
  LEN_TRIM(parent))
end subroutine

function fgd_fragmentname (dirfile, ind)
  character (len=GD_MAX_LINE_LENGTH) :: fgd_fragmentname
  integer, intent(in) :: dirfile, ind
  integer :: l = GD_MAX_LINE_LENGTH

  call gdfrgn(fgd_fragmentname, l, dirfile, ind)
end function

function fgd_nfragments (dirfile)
  integer :: fgd_nfragments
  integer, intent(in) :: dirfile

  call gdnfrg(fgd_nfragments, dirfile)
end function

subroutine fgd_metaflush (dirfile)
  integer, intent(in) :: dirfile

  call gdmfls(dirfile)
end subroutine

subroutine fgd_rewrite_fragment (dirfile, fragment)
  integer, intent(in) :: dirfile, fragment

  call gdrfrg(dirfile, fragment)
end subroutine

subroutine fgd_include (dirfile, fragmentname, fragment_index, flags)
  integer, intent(in) :: dirfile, fragment_index, flags
  character (len=*), intent(in) :: fragmentname

  call gdincl(dirfile, TRIM(fragmentname), LEN_TRIM(fragmentname), &
  fragment_index, flags)
end subroutine

function fgd_reference (dirfile, field_code)
  character (len=GD_FIELD_LEN) :: fgd_reference
  integer, intent(in) :: dirfile
  character (len=*), intent(in) :: field_code

  integer :: l = GD_FIELD_LEN

  call gdrefe(fgd_reference, l, dirfile, TRIM(field_code), LEN_TRIM(field_code))

  if (l .EQ. 0) then
    fgd_reference = ""
  endif
end function 

subroutine fgd_parser_callback (dirfile, sehandler)
  integer, intent(in) :: dirfile
  interface
    subroutine sehandler(act, dirfile_unit, suberror, line)
      integer, intent (out) :: act
      integer, intent (in) :: dirfile_unit, suberror
      character (len=@GD_MAX_LINE_LENGTH@), intent (inout) :: line
    end subroutine
  end interface

  call gdclbk(dirfile, sehandler)
end subroutine

function fgd_encoding (dirfile, fragment)
  integer :: fgd_encoding
  integer, intent(in) :: dirfile, fragment

  call gdgenc(fgd_encoding, dirfile, fragment)
end function

subroutine fgd_alter_encoding (dirfile, encoding, fragment, recode)
  integer, intent(in) :: dirfile, encoding, fragment, recode

  call gdaenc(dirfile, encoding, fragment, recode)
end subroutine

function fgd_endianness (dirfile, fragment)
  integer :: fgd_endianness
  integer, intent(in) :: dirfile, fragment

  call gdgend(fgd_endianness, dirfile, fragment)
end function

subroutine fgd_alter_endianness (dirfile, endianness, fragment, recode)
  integer, intent(in) :: dirfile, endianness, fragment, recode

  call gdaend(dirfile, endianness, fragment, recode)
end subroutine

function fgd_frameoffset (dirfile, fragment)
  integer :: fgd_frameoffset
  integer, intent(in) :: dirfile, fragment

  call gdgfof(fgd_frameoffset, dirfile, fragment)
end function

subroutine fgd_alter_frameoffset (dirfile, frameoffset, fragment, recode)
  integer, intent(in) :: dirfile, frameoffset, fragment, recode

  call gdafof(dirfile, frameoffset, fragment, recode)
end subroutine

function fgd_protection (dirfile, fragment)
  integer :: fgd_protection
  integer, intent(in) :: dirfile, fragment

  call gdgprt(fgd_protection, dirfile, fragment)
end function

subroutine fgd_alter_protection (dirfile, protection_level, fragment)
  integer, intent(in) :: dirfile, protection_level, fragment

  call gdaprt(dirfile, protection_level, fragment)
end subroutine

function fgd_parent_fragment (dirfile, fragment)
  integer :: fgd_parent_fragment
  integer, intent(in) :: dirfile, fragment

  call gdpfrg(fgd_parent_fragment, dirfile, fragment)
end function

subroutine fgd_uninclude (dirfile, fragment, del)
  integer, intent(in) :: dirfile, fragment, del

  call gduinc(dirfile, fragment, del)
end subroutine

function fgd_raw_filename (dirfile, field_code)
  character (len=GD_MAX_LINE_LENGTH) :: fgd_raw_filename
  integer, intent(in) :: dirfile
  character (len=*), intent(in) :: field_code

  integer :: l = GD_MAX_LINE_LENGTH

  call gdrwfn (fgd_raw_filename, l, dirfile, TRIM(field_code), &
  LEN_TRIM(field_code))
end function

subroutine fgd_move (dirfile, field_code, new_fragment, flags)
  integer, intent(in) :: dirfile, new_fragment, flags
  character (len=*), intent(in) :: field_code

  call gdmove (dirfile, TRIM(field_code), LEN_TRIM(field_code), new_fragment, &
  flags)
end subroutine

! calculate in_fields string lengths
subroutine fgd__set_field_len (field_len, m, ent)
  integer, dimension(3), intent(out) :: field_len
  integer, intent(in) :: m
  type(gd_entry), intent(in) :: ent
  
  integer :: i

  do i=1,m
    field_len(i) = LEN_TRIM(ent%field(i))
    if (field_len(i) .eq. 0) then
      field_len(i) = -1
    end if
  end do
end subroutine

! calculate scalar string lengths
subroutine fgd__set_scalar_len (scalar_len, remove_scalars, mask, ent)
  integer, dimension(6), intent(out) :: scalar_len
  integer, intent(in) :: remove_scalars, mask
  type(gd_entry), intent(in) :: ent
  
  integer :: i

  do i=1,6
    if (BTEST(IAND(NOT(remove_scalars), mask), i - 1)) then
      scalar_len(i) = LEN_TRIM(ent%scalar(i))
    else
      scalar_len(i) = -1
    end if
  end do
end subroutine

subroutine fgd_alter_entry (dirfile, field_code, ent, remove_scalars, recode)
  integer, intent(in) :: dirfile, remove_scalars, recode
  character (len=*), intent(in) :: field_code
  type(gd_entry), intent(in) :: ent

  ! lincom scalar bitmasks
  integer, parameter, dimension(3) :: lincom_mask = (/ 9, 27, 63 /)

  ! polynom scalar bitmasks
  integer, parameter, dimension(6) :: polynom_mask = (/ 3, 7, 15, 31, 63, 127 /)

  integer, dimension(6) :: scalar_len
  integer, dimension(3) :: field_len
  integer :: n

  if (ent%field_type .EQ. GD_RAW_ENTRY) then
    call fgd__set_scalar_len(scalar_len, remove_scalars, 1, ent)

    call gdlsrw(dirfile, TRIM(field_code), LEN_TRIM(field_code), &
    ent%data_type, ent%spf, TRIM(ent%scalar(1)), scalar_len(1), &
    ent%scalar_ind(1), recode)
  else if (ent%field_type .EQ. GD_LINCOM_ENTRY) then
    n = ent%n_fields
    if (n .gt. 3 .or. n .lt. 1) then
      n = 3
    end if
    call fgd__set_scalar_len(scalar_len, remove_scalars, lincom_mask(n), ent)
    call fgd__set_field_len(field_len, n, ent)

    if (IAND(GD_EN_COMPSCAL, ent%flags) .NE. 0) then
      call gdlscl(dirfile, TRIM(field_code), LEN_TRIM(field_code), &
      ent%n_fields, TRIM(ent%field(1)), field_len(1), &
      ent%cm(1), TRIM(ent%scalar(1)), scalar_len(1), ent%scalar_ind(1), &
      ent%cb(1), TRIM(ent%scalar(4)), scalar_len(4), ent%scalar_ind(4), &
      TRIM(ent%field(2)), field_len(2), &
      ent%cm(2), TRIM(ent%scalar(2)), scalar_len(2), ent%scalar_ind(2), &
      ent%cb(2), TRIM(ent%scalar(5)), scalar_len(5), ent%scalar_ind(5), &
      TRIM(ent%field(3)), field_len(3), &
      ent%cm(3), TRIM(ent%scalar(3)), scalar_len(3), ent%scalar_ind(3), &
      ent%cb(3), TRIM(ent%scalar(6)), scalar_len(6), ent%scalar_ind(6))
    else
      call gdlslc(dirfile, TRIM(field_code), LEN_TRIM(field_code), &
      ent%n_fields, TRIM(ent%field(1)), field_len(1), &
      ent%m(1), TRIM(ent%scalar(1)), scalar_len(1), ent%scalar_ind(1), &
      ent%b(1), TRIM(ent%scalar(4)), scalar_len(4), ent%scalar_ind(4), &
      TRIM(ent%field(2)), field_len(2), &
      ent%m(2), TRIM(ent%scalar(2)), scalar_len(2), ent%scalar_ind(2), &
      ent%b(2), TRIM(ent%scalar(5)), scalar_len(5), ent%scalar_ind(5), &
      TRIM(ent%field(3)), field_len(3), &
      ent%m(3), TRIM(ent%scalar(3)), scalar_len(3), ent%scalar_ind(3), &
      ent%b(3), TRIM(ent%scalar(6)), scalar_len(6), ent%scalar_ind(6))
    end if
  else if (ent%field_type .EQ. GD_LINTERP_ENTRY) then
    call fgd__set_field_len(field_len, 2, ent)

    call gdallt(dirfile, TRIM(field_code), LEN_TRIM(field_code), &
    TRIM(ent%field(1)), field_len(1), TRIM(ent%field(2)), field_len(2), recode)
  else if (ent%field_type .EQ. GD_BIT_ENTRY) then
    call fgd__set_scalar_len(scalar_len, remove_scalars, 3, ent)
    call fgd__set_field_len(field_len, 1, ent)

    call gdlsbt(dirfile, TRIM(field_code), LEN_TRIM(field_code), &
    TRIM(ent%field(1)), field_len(1), &
    ent%bitnum, TRIM(ent%scalar(1)), scalar_len(1), ent%scalar_ind(1), &
    ent%numbits, TRIM(ent%scalar(2)), scalar_len(2), ent%scalar_ind(2))
  else if (ent%field_type .EQ. GD_SBIT_ENTRY) then
    call fgd__set_scalar_len(scalar_len, remove_scalars, 3, ent)
    call fgd__set_field_len(field_len, 1, ent)

    call gdlssb(dirfile, TRIM(field_code), LEN_TRIM(field_code), &
    TRIM(ent%field(1)), field_len(1), &
    ent%bitnum, TRIM(ent%scalar(1)), scalar_len(1), ent%scalar_ind(1), &
    ent%numbits, TRIM(ent%scalar(2)), scalar_len(2), ent%scalar_ind(2))
  else if (ent%field_type .EQ. GD_MULTIPLY_ENTRY) then
    call fgd__set_field_len(field_len, 2, ent)

    call gdalmt(dirfile, TRIM(field_code), LEN_TRIM(field_code), &
    TRIM(ent%field(1)), field_len(1), TRIM(ent%field(2)), field_len(2))
  else if (ent%field_type .EQ. GD_DIVIDE_ENTRY) then
    call fgd__set_field_len(field_len, 2, ent)

    call gdaldv(dirfile, TRIM(field_code), LEN_TRIM(field_code), &
    TRIM(ent%field(1)), field_len(1), TRIM(ent%field(2)), field_len(2))
  else if (ent%field_type .EQ. GD_PHASE_ENTRY) then
    call fgd__set_scalar_len(scalar_len, remove_scalars, 1, ent)
    call fgd__set_field_len(field_len, 1, ent)

    call gdlsph(dirfile, TRIM(field_code), LEN_TRIM(field_code), &
    TRIM(ent%field(1)), field_len(1), ent%shift, &
    TRIM(ent%scalar(1)), scalar_len(1), ent%scalar_ind(1))
  else if (ent%field_type .EQ. GD_POLYNOM_ENTRY) then
    n = ent%poly_ord
    if (n .gt. 6 .or. n .lt. 2) then
      n = 6
    end if
    call fgd__set_scalar_len(scalar_len, remove_scalars, polynom_mask(n), ent)
    call fgd__set_field_len(field_len, 1, ent)

    if (IAND(GD_EN_COMPSCAL, ent%flags) .NE. 0) then
      call gdlscp(dirfile, TRIM(field_code), LEN_TRIM(field_code), &
      ent%poly_ord, TRIM(ent%field(1)), field_len(1), &
      ent%ca(1), TRIM(ent%scalar(1)), scalar_len(1), ent%scalar_ind(1), &
      ent%ca(2), TRIM(ent%scalar(2)), scalar_len(2), ent%scalar_ind(2), &
      ent%ca(3), TRIM(ent%scalar(3)), scalar_len(3), ent%scalar_ind(3), &
      ent%ca(4), TRIM(ent%scalar(4)), scalar_len(4), ent%scalar_ind(4), &
      ent%ca(5), TRIM(ent%scalar(5)), scalar_len(5), ent%scalar_ind(5), &
      ent%ca(6), TRIM(ent%scalar(6)), scalar_len(6), ent%scalar_ind(6))
    else
      call gdlspn(dirfile, TRIM(field_code), LEN_TRIM(field_code), &
      ent%poly_ord, TRIM(ent%field(1)), field_len(1), &
      ent%a(1), TRIM(ent%scalar(1)), scalar_len(1), ent%scalar_ind(1), &
      ent%a(2), TRIM(ent%scalar(2)), scalar_len(2), ent%scalar_ind(2), &
      ent%a(3), TRIM(ent%scalar(3)), scalar_len(3), ent%scalar_ind(3), &
      ent%a(4), TRIM(ent%scalar(4)), scalar_len(4), ent%scalar_ind(4), &
      ent%a(5), TRIM(ent%scalar(5)), scalar_len(5), ent%scalar_ind(5), &
      ent%a(6), TRIM(ent%scalar(6)), scalar_len(6), ent%scalar_ind(6))
    end if
  else if (ent%field_type .EQ. GD_RECIP_ENTRY) then
    call fgd__set_scalar_len(scalar_len, remove_scalars, 1, ent)
    call fgd__set_field_len(field_len, 1, ent)

    if (IAND(GD_EN_COMPSCAL, ent%flags) .NE. 0) then
      call gdlscr(dirfile, TRIM(field_code), LEN_TRIM(field_code), &
      TRIM(ent%field(1)), field_len(1), ent%cdividend, TRIM(ent%scalar(1)), &
      scalar_len(1), ent%scalar_ind(1))
    else
      call gdlsrc(dirfile, TRIM(field_code), LEN_TRIM(field_code), &
      TRIM(ent%field(1)), field_len(1), ent%dividend, TRIM(ent%scalar(1)), &
      scalar_len(1), ent%scalar_ind(1))
    end if
  else if (ent%field_type .EQ. GD_WINDOW_ENTRY) then
    call fgd__set_scalar_len(scalar_len, remove_scalars, 1, ent)
    call fgd__set_field_len(field_len, 2, ent)

    if ((ent%windop .EQ. GD_WINDOP_EQ) .OR. (ent%windop .EQ. GD_WINDOP_NE) &
    .OR. (ent%windop .EQ. GD_WINDOP_SET) .OR. (ent%windop .EQ. GD_WINDOP_CLR)) &
    then
      call gdlswd(dirfile, TRIM(field_code), LEN_TRIM(field_code), &
      TRIM(ent%field(1)), field_len(1), TRIM(ent%field(2)), field_len(2), &
      ent%windop, ent%ithreshold, TRIM(ent%scalar(1)), scalar_len(1), &
      ent%scalar_ind(1))
    else
      call gdlswd(dirfile, TRIM(field_code), LEN_TRIM(field_code), &
      TRIM(ent%field(1)), field_len(1), TRIM(ent%field(2)), field_len(2), &
      ent%windop, ent%rthreshold, TRIM(ent%scalar(1)), scalar_len(1), &
      ent%scalar_ind(1))
    end if
  else if (ent%field_type .EQ. GD_MPLEX_ENTRY) then
    call fgd__set_scalar_len(scalar_len, remove_scalars, 3, ent)
    call fgd__set_field_len(field_len, 2, ent)

    call gdlsmx(dirfile, TRIM(field_code), LEN_TRIM(field_code), &
    TRIM(ent%field(1)), field_len(1), TRIM(ent%field(2)), field_len(2), &
    ent%count_val, TRIM(ent%scalar(1)), scalar_len(1), ent%scalar_ind(1), &
    ent%period, TRIM(ent%scalar(2)), scalar_len(2), ent%scalar_ind(2))
  else if (ent%field_type .EQ. GD_CONST_ENTRY) then
    call gdalco(dirfile, TRIM(field_code), LEN_TRIM(field_code), ent%data_type)
  else if (ent%field_type .EQ. GD_CARRAY_ENTRY) then
    call gdalca(dirfile, TRIM(field_code), LEN_TRIM(field_code), &
    ent%data_type, ent%array_len)
  end if
end subroutine

subroutine fgd_alter_bit (dirfile, field_name, in_field, bitnum, numbits)
  integer, intent(in) :: dirfile, bitnum, numbits
  character (len=*), intent(in) :: field_name, in_field

  call gdalbt(dirfile, TRIM(field_name), LEN_TRIM(field_name), TRIM(in_field), &
  LEN_TRIM(in_field), bitnum, numbits)
end subroutine

subroutine fgd_alter_sbit (dirfile, field_name, in_field, bitnum, numbits)
  integer, intent(in) :: dirfile, bitnum, numbits
  character (len=*), intent(in) :: field_name, in_field

  call gdalsb(dirfile, TRIM(field_name), LEN_TRIM(field_name), TRIM(in_field), &
  LEN_TRIM(in_field), bitnum, numbits)
end subroutine

subroutine fgd_alter_const (dirfile, field_name, const_type)
  integer, intent(in) :: dirfile, const_type
  character (len=*), intent(in) :: field_name

  call gdalco(dirfile, TRIM(field_name), LEN_TRIM(field_name), const_type)
end subroutine

subroutine fgd_alter_lincom (dirfile, field_name, n_fields, in_field1, m1, b1, &
  in_field2, m2, b2, in_field3, m3, b3)
  integer, intent(in) :: dirfile, n_fields
  character (len=*), intent(in) :: field_name, in_field1, in_field2, in_field3
  double precision, intent(in) :: m1, b1, m2, b2, m3, b3

  call gdallc(dirfile, TRIM(field_name), LEN_TRIM(field_name), n_fields, &
  TRIM(in_field1), LEN_TRIM(in_field1), m1, b1, TRIM(in_field2), &
  LEN_TRIM(in_field2), m2, b2, TRIM(in_field3), LEN_TRIM(in_field3), m3, b3)
end subroutine

subroutine fgd_alter_clincom (dirfile, field_name, n_fields, in_field1, m1, &
  b1, in_field2, m2, b2, in_field3, m3, b3)
  integer, intent(in) :: dirfile, n_fields
  character (len=*), intent(in) :: field_name, in_field1, in_field2, in_field3
  double complex, intent(in) :: m1, b1, m2, b2, m3, b3

  call gdalcl(dirfile, TRIM(field_name), LEN_TRIM(field_name), n_fields, &
  TRIM(in_field1), LEN_TRIM(in_field1), m1, b1, TRIM(in_field2), &
  LEN_TRIM(in_field2), m2, b2, TRIM(in_field3), LEN_TRIM(in_field3), m3, b3)
end subroutine

subroutine fgd_alter_polynom (dirfile, field_name, poly_ord, in_field, a0, a1, &
  a2, a3, a4, a5)
  integer, intent(in) :: dirfile, poly_ord
  character (len=*), intent(in) :: field_name, in_field
  double precision, intent(in) :: a0, a1, a2, a3, a4, a5

  call gdalpn(dirfile, TRIM(field_name), LEN_TRIM(field_name), poly_ord, &
  TRIM(in_field), LEN_TRIM(in_field), a0, a1, a2, a3, a4, a5)
end subroutine

subroutine fgd_alter_cpolynom (dirfile, field_name, poly_ord, in_field, a0, &
  a1, a2, a3, a4, a5)
  integer, intent(in) :: dirfile, poly_ord
  character (len=*), intent(in) :: field_name, in_field
  double complex, intent(in) :: a0, a1, a2, a3, a4, a5

  call gdalcp(dirfile, TRIM(field_name), LEN_TRIM(field_name), poly_ord, &
  TRIM(in_field), LEN_TRIM(in_field), a0, a1, a2, a3, a4, a5)
end subroutine

subroutine fgd_alter_linterp (dirfile, field_name, in_field, table, move)
  integer, intent(in) :: dirfile, move
  character (len=*), intent(in) :: field_name, in_field, table

  call gdallt(dirfile, TRIM(field_name), LEN_TRIM(field_name), TRIM(in_field), &
  LEN_TRIM(in_field), TRIM(table), LEN_TRIM(table), move)
end subroutine

subroutine fgd_alter_multiply (dirfile, field_name, in_field1, in_field2)
  integer, intent(in) :: dirfile
  character (len=*), intent(in) :: field_name, in_field1, in_field2

  call gdalmt(dirfile, TRIM(field_name), LEN_TRIM(field_name), &
  TRIM(in_field1), LEN_TRIM(in_field1), TRIM(in_field2), LEN_TRIM(in_field2))
end subroutine

subroutine fgd_alter_divide (dirfile, field_name, in_field1, in_field2)
  integer, intent(in) :: dirfile
  character (len=*), intent(in) :: field_name, in_field1, in_field2

  call gdaldv(dirfile, TRIM(field_name), LEN_TRIM(field_name), &
  TRIM(in_field1), LEN_TRIM(in_field1), TRIM(in_field2), LEN_TRIM(in_field2))
end subroutine

subroutine fgd_alter_recip (dirfile, field_name, in_field, dividend)
  integer, intent(in) :: dirfile
  double precision, intent(in) :: dividend
  character (len=*), intent(in) :: field_name, in_field

  call gdalrc(dirfile, TRIM(field_name), LEN_TRIM(field_name), &
  TRIM(in_field), LEN_TRIM(in_field), dividend)
end subroutine

subroutine fgd_alter_crecip (dirfile, field_name, in_field, cdividend)
  integer, intent(in) :: dirfile
  double complex, intent(in) :: cdividend
  character (len=*), intent(in) :: field_name, in_field

  call gdalcr(dirfile, TRIM(field_name), LEN_TRIM(field_name), &
  TRIM(in_field), LEN_TRIM(in_field), cdividend)
end subroutine

subroutine fgd_alter_phase (dirfile, field_name, in_field, phase)
  integer, intent(in) :: dirfile, phase
  character (len=*), intent(in) :: field_name, in_field

  call gdalph(dirfile, TRIM(field_name), LEN_TRIM(field_name), &
  TRIM(in_field), LEN_TRIM(in_field), phase)
end subroutine

subroutine fgd_alter_raw (dirfile, field_code, data_type, spf, move)
  integer, intent(in) :: dirfile, data_type, spf, move
  character (len=*), intent(in) :: field_code

  call gdalrw(dirfile, TRIM(field_code), LEN_TRIM(field_code), data_type, spf, &
  move)
end subroutine

subroutine fgd_alter_spec (dirfile, spec, recode)
  integer, intent(in) :: dirfile, recode
  character (len=*), intent(in) :: spec

  call gdalsp(dirfile, TRIM(spec), LEN_TRIM(spec), recode)
end subroutine

subroutine fgd_malter_spec (dirfile, spec, parent, recode)
  integer, intent(in) :: dirfile, recode
  character (len=*), intent(in) :: parent, spec

  call gdmlsp(dirfile, TRIM(spec), LEN_TRIM(spec), TRIM(parent), &
  LEN_TRIM(parent), recode)
end subroutine

subroutine fgd_rename (dirfile, field_code, new_name, flags)
  integer, intent(in) :: dirfile, flags
  character (len=*), intent(in) :: field_code, new_name

  call gdrenm(dirfile, TRIM(field_code), LEN_TRIM(field_code), TRIM(new_name), &
  LEN_TRIM(new_name), flags)
end subroutine

subroutine fgd_delete (dirfile, field_code, flags)
  integer, intent(in) :: dirfile, flags
  character (len=*), intent(in) :: field_code

  call gddele(dirfile, TRIM(field_code), LEN_TRIM(field_code), flags)
end subroutine

function fgd_native_type (dirfile, field_code)
  integer :: fgd_native_type
  integer, intent(in) :: dirfile
  character (len=*), intent(in) :: field_code

  call gdntyp(fgd_native_type, dirfile, TRIM(field_code), LEN_TRIM(field_code))
end function

function fgd_validate (dirfile, field_code)
  integer :: fgd_validate
  integer, intent(in) :: dirfile
  character (len=*), intent(in) :: field_code

  call gdvldt(fgd_validate, dirfile, TRIM(field_code), LEN_TRIM(field_code))
end function

function fgd_framenum (dirfile, field_code, value)
  double precision :: fgd_framenum
  integer, intent(in) :: dirfile
  character (len=*), intent(in) :: field_code
  double precision, intent(in) :: value

  call gdfnum(fgd_framenum, dirfile, TRIM(field_code), LEN_TRIM(field_code), &
  value)
end function

function fgd_framenum_subset (dirfile, field_code, value, frame_start, &
frame_end)
  double precision :: fgd_framenum_subset
  integer, intent(in) :: dirfile, frame_start, frame_end
  character (len=*), intent(in) :: field_code
  double precision, intent(in) :: value

  call gdfnss(fgd_framenum_subset, dirfile, TRIM(field_code), &
  LEN_TRIM(field_code), value, frame_start, frame_end)
end function

subroutine fgd_dirfilename (dirfilename, l, dirfile, fragment_index)
  character (len=*), intent(out) :: dirfilename
  integer, intent(in) :: dirfile, fragment_index
  integer, intent(inout) :: l

  call gdname(dirfilename, l, dirfile, fragment_index)
end subroutine

function fgd_invalid_dirfile ()
  integer :: fgd_invalid_dirfile

  call gdinvd(fgd_invalid_dirfile)
end function

function fgd_dirfile_standards (dirfile, version)
  integer :: fgd_dirfile_standards
  integer, intent(in) :: dirfile, version

  fgd_dirfile_standards = version

  call gdstdv(fgd_dirfile_standards, dirfile)
end function

!gd_get_carray_slice with return_type=GD_NULL
subroutine fgd_get_carray_n (dirfile, field_code, start, array_len)
  integer, intent(in) :: dirfile, start, array_len
  character (len=*), intent(in) :: field_code
  
  ! call f77 library
  if (array_len .eq. 0) then
    call gdgtca(dirfile, TRIM(field_code), LEN_TRIM(field_code), GD_NULL, 0)
  else
    call gdgcas(dirfile, TRIM(field_code), LEN_TRIM(field_code), start, &
    array_len, GD_NULL, 0)
  end if
end subroutine

!gd_get_carray_slice with return_type=GD_INT8
subroutine fgd_get_carray_i1 (dirfile, field_code, start, array_len, data_out)
  integer, intent(in) :: dirfile, start, array_len
  character (len=*), intent(in) :: field_code
  integer*1, dimension(:), intent(out)  :: data_out
  
  ! call f77 library
  if (array_len .eq. 0) then
    call gdgtca(dirfile, TRIM(field_code), LEN_TRIM(field_code), GD_INT8, &
    data_out)
  else
    call gdgcas(dirfile, TRIM(field_code), LEN_TRIM(field_code), start, &
    array_len, GD_INT8, data_out)
  end if
end subroutine

!gd_get_carray_slice with return_type=GD_INT16
subroutine fgd_get_carray_i2 (dirfile, field_code, start, array_len, data_out)
  integer, intent(in) :: dirfile, start, array_len
  character (len=*), intent(in) :: field_code
  integer*2, dimension(:), intent(out)  :: data_out
  
  ! call f77 library
  if (array_len .eq. 0) then
    call gdgtca(dirfile, TRIM(field_code), LEN_TRIM(field_code), GD_INT16, &
    data_out)
  else
    call gdgcas(dirfile, TRIM(field_code), LEN_TRIM(field_code), start, &
    array_len, GD_INT16, data_out)
  end if
end subroutine

!gd_get_carray_slice with return_type=GD_INT32
subroutine fgd_get_carray_i4 (dirfile, field_code, start, array_len, data_out)
  integer, intent(in) :: dirfile, start, array_len
  character (len=*), intent(in) :: field_code
  integer*4, dimension(:), intent(out)  :: data_out
  
  ! call f77 library
  if (array_len .eq. 0) then
    call gdgtca(dirfile, TRIM(field_code), LEN_TRIM(field_code), GD_INT32, &
    data_out)
  else
    call gdgcas(dirfile, TRIM(field_code), LEN_TRIM(field_code), start, &
    array_len, GD_INT32, data_out)
  end if
end subroutine

!gd_get_carray_slice with return_type=GD_INT64
subroutine fgd_get_carray_i8 (dirfile, field_code, start, array_len, data_out)
  integer, intent(in) :: dirfile, start, array_len
  character (len=*), intent(in) :: field_code
  integer*8, dimension(:), intent(out)  :: data_out
  
  ! call f77 library
  if (array_len .eq. 0) then
    call gdgtca(dirfile, TRIM(field_code), LEN_TRIM(field_code), GD_INT64, &
    data_out)
  else
    call gdgcas(dirfile, TRIM(field_code), LEN_TRIM(field_code), start, &
    array_len, GD_INT64, data_out)
  end if
end subroutine

!gd_get_carray_slice with return_type=GD_FLOAT32
subroutine fgd_get_carray_r4 (dirfile, field_code, start, array_len, data_out)
  integer, intent(in) :: dirfile, start, array_len
  character (len=*), intent(in) :: field_code
  real*4, dimension(:), intent(out)  :: data_out
  
  ! call f77 library
  if (array_len .eq. 0) then
    call gdgtca(dirfile, TRIM(field_code), LEN_TRIM(field_code), GD_FLOAT32, &
    data_out)
  else
    call gdgcas(dirfile, TRIM(field_code), LEN_TRIM(field_code), start, &
    array_len, GD_FLOAT32, data_out)
  end if
end subroutine

!gd_get_carray_slice with return_type=GD_FLOAT64
subroutine fgd_get_carray_r8 (dirfile, field_code, start, array_len, data_out)
  integer, intent(in) :: dirfile, start, array_len
  character (len=*), intent(in) :: field_code
  double precision, dimension(:), intent(out)  :: data_out
  
  ! call f77 library
  if (array_len .eq. 0) then
    call gdgtca(dirfile, TRIM(field_code), LEN_TRIM(field_code), GD_FLOAT64, &
    data_out)
  else
    call gdgcas(dirfile, TRIM(field_code), LEN_TRIM(field_code), start, &
    array_len, GD_FLOAT64, data_out)
  end if
end subroutine

!gd_get_carray_slice with return_type=GD_COMPLEX64
subroutine fgd_get_carray_c8 (dirfile, field_code, start, array_len, data_out)
  integer, intent(in) :: dirfile, start, array_len
  character (len=*), intent(in) :: field_code
  complex, dimension(:), intent(out)  :: data_out
  
  ! call f77 library
  if (array_len .eq. 0) then
    call gdgtca(dirfile, TRIM(field_code), LEN_TRIM(field_code), GD_COMPLEX64, &
    data_out)
  else
    call gdgcas(dirfile, TRIM(field_code), LEN_TRIM(field_code), start, &
    array_len, GD_COMPLEX64, data_out)
  end if
end subroutine

!gd_get_carray_slice with return_type=GD_COMPLEX128
subroutine fgd_get_carray_c16 (dirfile, field_code, start, array_len, data_out)
  integer, intent(in) :: dirfile, start, array_len
  character (len=*), intent(in) :: field_code
  double complex, dimension(:), intent(out)  :: data_out
  
  ! call f77 library
  if (array_len .eq. 0) then
    call gdgtca(dirfile, TRIM(field_code), LEN_TRIM(field_code), &
    GD_COMPLEX128, data_out)
  else
    call gdgcas(dirfile, TRIM(field_code), LEN_TRIM(field_code), start, &
    array_len, GD_COMPLEX128, data_out)
  end if
end subroutine

! put_carray_slice with data_type=GD_INT8
subroutine fgd_put_carray_i1 (dirfile, field_code, start, array_len, data_in)
  integer, intent(in) :: dirfile, start, array_len
  character (len=*), intent(in) :: field_code
  integer*1, dimension(:), intent(in) :: data_in

  ! call f77 library
  if (array_len .eq. 0) then
    call gdptca(dirfile, TRIM(field_code), LEN_TRIM(field_code), GD_INT8, &
    data_in)
  else
    call gdpcas(dirfile, TRIM(field_code), LEN_TRIM(field_code), start, &
    array_len, GD_INT8, data_in)
  end if
end subroutine

! put_carray_slice with data_type=GD_INT16
subroutine fgd_put_carray_i2 (dirfile, field_code, start, array_len, data_in)
  integer, intent(in) :: dirfile, start, array_len
  character (len=*), intent(in) :: field_code
  integer*2, dimension(:), intent(in) :: data_in

  ! call f77 library
  if (array_len .eq. 0) then
    call gdptca(dirfile, TRIM(field_code), LEN_TRIM(field_code), GD_INT16, &
    data_in)
  else
    call gdpcas(dirfile, TRIM(field_code), LEN_TRIM(field_code), start, &
    array_len, GD_INT16, data_in)
  end if
end subroutine

! put_carray_slice with data_type=GD_INT32
subroutine fgd_put_carray_i4 (dirfile, field_code, start, array_len, data_in)
  integer, intent(in) :: dirfile, start, array_len
  character (len=*), intent(in) :: field_code
  integer*4, dimension(:), intent(in) :: data_in

  ! call f77 library
  if (array_len .eq. 0) then
    call gdptca(dirfile, TRIM(field_code), LEN_TRIM(field_code), GD_INT32, &
    data_in)
  else
    call gdpcas(dirfile, TRIM(field_code), LEN_TRIM(field_code), start, &
    array_len, GD_INT32, data_in)
  end if
end subroutine

! put_carray_slice with data_type=GD_INT64
subroutine fgd_put_carray_i8 (dirfile, field_code, start, array_len, data_in)
  integer, intent(in) :: dirfile, start, array_len
  character (len=*), intent(in) :: field_code
  integer*8, dimension(:), intent(in) :: data_in

  ! call f77 library
  if (array_len .eq. 0) then
    call gdptca(dirfile, TRIM(field_code), LEN_TRIM(field_code), GD_INT64, &
    data_in)
  else
    call gdpcas(dirfile, TRIM(field_code), LEN_TRIM(field_code), start, &
    array_len, GD_INT64, data_in)
  end if
end subroutine

! put_carray_slice with data_type=GD_FLOAT32
subroutine fgd_put_carray_r4 (dirfile, field_code, start, array_len, data_in)
  integer, intent(in) :: dirfile, start, array_len
  character (len=*), intent(in) :: field_code
  real*4, dimension(:), intent(in) :: data_in

  ! call f77 library
  if (array_len .eq. 0) then
    call gdptca(dirfile, TRIM(field_code), LEN_TRIM(field_code), GD_FLOAT32, &
    data_in)
  else
    call gdpcas(dirfile, TRIM(field_code), LEN_TRIM(field_code), start, &
    array_len, GD_FLOAT32, data_in)
  end if
end subroutine

! put_carray_slice with data_type=GD_FLOAT64
subroutine fgd_put_carray_r8 (dirfile, field_code, start, array_len, data_in)
  integer, intent(in) :: dirfile, start, array_len
  character (len=*), intent(in) :: field_code
  double precision, dimension(:), intent(in) :: data_in

  ! call f77 library
  if (array_len .eq. 0) then
    call gdptca(dirfile, TRIM(field_code), LEN_TRIM(field_code), GD_FLOAT64, &
    data_in)
  else
    call gdpcas(dirfile, TRIM(field_code), LEN_TRIM(field_code), start, &
    array_len, GD_FLOAT64, data_in)
  end if
end subroutine

! put_carray_slice with data_type=GD_COMPLEX64
subroutine fgd_put_carray_c8 (dirfile, field_code, start, array_len, data_in)
  integer, intent(in) :: dirfile, start, array_len
  character (len=*), intent(in) :: field_code
  complex, dimension(:), intent(in) :: data_in

  ! call f77 library
  if (array_len .eq. 0) then
    call gdptca(dirfile, TRIM(field_code), LEN_TRIM(field_code), GD_COMPLEX64, &
    data_in)
  else
    call gdpcas(dirfile, TRIM(field_code), LEN_TRIM(field_code), start, &
    array_len, GD_COMPLEX64, data_in)
  end if
end subroutine

! put_carray_slice with data_type=GD_COMPLEX128
subroutine fgd_put_carray_c16 (dirfile, field_code, start, array_len, data_in)
  integer, intent(in) :: dirfile, start, array_len
  character (len=*), intent(in) :: field_code
  double complex, dimension(:), intent(in) :: data_in

  ! call f77 library
  if (array_len .eq. 0) then
    call gdptca(dirfile, TRIM(field_code), LEN_TRIM(field_code), &
    GD_COMPLEX128, data_in)
  else
    call gdpcas(dirfile, TRIM(field_code), LEN_TRIM(field_code), start, &
    array_len, GD_COMPLEX128, data_in)
  end if
end subroutine

function fgd_array_len (dirfile, field_code)
  integer :: fgd_array_len
  integer, intent(in) :: dirfile
  character (len=*), intent(in) :: field_code

  ! call f77 library
  call gdarln(fgd_array_len, dirfile, TRIM(field_code), LEN_TRIM(field_code))
end function

function fgd_carray_len (dirfile, field_code)
  integer :: fgd_carray_len
  integer, intent(in) :: dirfile
  character (len=*), intent(in) :: field_code

  fgd_carray_len = fgd_array_len(dirfile,field_code)
end function

subroutine fgd_add_carray (dirfile, field_name, const_type, array_len, &
fragment_index)
  integer, intent(in) :: dirfile, const_type, fragment_index, array_len
  character (len=*), intent(in) :: field_name
  integer*1, dimension(array_len) :: zero

  zero = 0

  call gdadca(dirfile, TRIM(field_name), LEN_TRIM(field_name), const_type, &
  array_len, GD_INT8, zero, fragment_index)
end subroutine

subroutine fgd_madd_carray (dirfile, parent, field_name, const_type, array_len)
  integer, intent(in) :: dirfile, const_type, array_len
  character (len=*), intent(in) :: field_name, parent
  integer*1, dimension(array_len) :: zero

  zero = 0

  call gdmdca(dirfile, TRIM(parent), LEN_TRIM(parent), TRIM(field_name), &
  LEN_TRIM(field_name), const_type, array_len, GD_INT8, zero)
end subroutine

subroutine fgd_alter_carray (dirfile, field_name, const_type, array_len)
  integer, intent(in) :: dirfile, const_type, array_len
  character (len=*), intent(in) :: field_name

  call gdalca(dirfile, TRIM(field_name), LEN_TRIM(field_name), const_type, &
  array_len)
end subroutine

function fgd_seek (dirfile, field_name, frame_num, sample_num, flags)
  integer :: fgd_seek
  integer, intent(in) :: dirfile, frame_num, sample_num, flags
  character (len=*), intent(in) :: field_name
  
  call gdseek(fgd_seek, dirfile, TRIM(field_name), LEN_TRIM(field_name), &
  frame_num, sample_num, flags)
end function

function fgd_tell (dirfile, field_name)
  integer :: fgd_tell
  integer, intent(in) :: dirfile
  character (len=*), intent(in) :: field_name
  
  call gdtell(fgd_tell, dirfile, TRIM(field_name), LEN_TRIM(field_name))
end function

! gd_constants with return_type=GD_INT8
subroutine fgd_constants_i1 (constants, dirfile)
  integer*1, dimension(:), intent(out) :: constants
  integer, intent(in) :: dirfile
  integer :: nfields, i

  nfields = fgd_nfields_by_type(dirfile, GD_CONST_ENTRY)
  do i=1,nfields
    ! call f77 library
    call gdcons(constants(i), dirfile, GD_INT8, i)
  end do
end subroutine

! gd_constants with return_type=GD_INT16
subroutine fgd_constants_i2 (constants, dirfile)
  integer*2, dimension(:), intent(out) :: constants
  integer, intent(in) :: dirfile
  integer :: nfields, i

  nfields = fgd_nfields_by_type(dirfile, GD_CONST_ENTRY)
  do i=1,nfields
    ! call f77 library
    call gdcons(constants(i), dirfile, GD_INT16, i)
  end do
end subroutine

! gd_constants with return_type=GD_INT32
subroutine fgd_constants_i4 (constants, dirfile)
  integer*4, dimension(:), intent(out) :: constants
  integer, intent(in) :: dirfile
  integer :: nfields, i

  nfields = fgd_nfields_by_type(dirfile, GD_CONST_ENTRY)
  do i=1,nfields
    ! call f77 library
    call gdcons(constants(i), dirfile, GD_INT32, i)
  end do
end subroutine

! gd_constants with return_type=GD_INT64
subroutine fgd_constants_i8 (constants, dirfile)
  integer*8, dimension(:), intent(out) :: constants
  integer, intent(in) :: dirfile
  integer :: nfields, i

  nfields = fgd_nfields_by_type(dirfile, GD_CONST_ENTRY)
  do i=1,nfields
    ! call f77 library
    call gdcons(constants(i), dirfile, GD_INT64, i)
  end do
end subroutine

! gd_constants with return_type=GD_FLOAT32
subroutine fgd_constants_r4 (constants, dirfile)
  real*4, dimension(:), intent(out) :: constants
  integer, intent(in) :: dirfile
  integer :: nfields, i

  nfields = fgd_nfields_by_type(dirfile, GD_CONST_ENTRY)
  do i=1,nfields
    ! call f77 library
    call gdcons(constants(i), dirfile, GD_FLOAT32, i)
  end do
end subroutine

! gd_constants with return_type=GD_FLOAT64
subroutine fgd_constants_r8 (constants, dirfile)
  real*8, dimension(:), intent(out) :: constants
  integer, intent(in) :: dirfile
  integer :: nfields, i

  nfields = fgd_nfields_by_type(dirfile, GD_STRING_ENTRY)
  do i=1,nfields
    ! call f77 library
    call gdcons(constants(i), dirfile, GD_FLOAT64, i)
  end do
end subroutine

! gd_constants with return_type=GD_COMPLEX64
subroutine fgd_constants_c8 (constants, dirfile)
  complex, dimension(:), intent(out) :: constants
  integer, intent(in) :: dirfile
  integer :: nfields, i

  nfields = fgd_nfields_by_type(dirfile, GD_STRING_ENTRY)
  do i=1,nfields
    ! call f77 library
    call gdcons(constants(i), dirfile, GD_COMPLEX64, i)
  end do
end subroutine

! gd_constants with return_type=GD_COMPLEX128
subroutine fgd_constants_c16 (constants, dirfile)
  double complex, dimension(:), intent(out) :: constants
  integer, intent(in) :: dirfile
  integer :: nfields, i

  nfields = fgd_nfields_by_type(dirfile, GD_STRING_ENTRY)
  do i=1,nfields
    ! call f77 library
    call gdcons(constants(i), dirfile, GD_COMPLEX128, i)
  end do
end subroutine

! gd_mconstants with return_type=GD_INT8
subroutine fgd_mconstants_i1 (constants, dirfile, parent)
  integer*1, dimension(:), intent(out) :: constants
  integer, intent(in) :: dirfile
  integer :: nfields, i
  character (len=*), intent(in) :: parent

  nfields = fgd_nmfields_by_type(dirfile, parent, GD_CONST_ENTRY)
  do i=1,nfields
    ! call f77 library
    call gdmcos(constants(i), dirfile, TRIM(parent), LEN_TRIM(parent), &
    GD_INT8, i)
  end do
end subroutine

! gd_mconstants with return_type=GD_INT16
subroutine fgd_mconstants_i2 (constants, dirfile, parent)
  integer*2, dimension(:), intent(out) :: constants
  integer, intent(in) :: dirfile
  integer :: nfields, i
  character (len=*), intent(in) :: parent

  nfields = fgd_nmfields_by_type(dirfile, parent, GD_CONST_ENTRY)
  do i=1,nfields
    ! call f77 library
    call gdmcos(constants(i), dirfile, TRIM(parent), LEN_TRIM(parent), &
    GD_INT16, i)
  end do
end subroutine

! gd_mconstants with return_type=GD_INT32
subroutine fgd_mconstants_i4 (constants, dirfile, parent)
  integer*4, dimension(:), intent(out) :: constants
  integer, intent(in) :: dirfile
  integer :: nfields, i
  character (len=*), intent(in) :: parent

  nfields = fgd_nmfields_by_type(dirfile, parent, GD_CONST_ENTRY)
  do i=1,nfields
    ! call f77 library
    call gdmcos(constants(i), dirfile, TRIM(parent), LEN_TRIM(parent), &
    GD_INT32, i)
  end do
end subroutine

! gd_mconstants with return_type=GD_INT64
subroutine fgd_mconstants_i8 (constants, dirfile, parent)
  integer*8, dimension(:), intent(out) :: constants
  integer, intent(in) :: dirfile
  integer :: nfields, i
  character (len=*), intent(in) :: parent

  nfields = fgd_nmfields_by_type(dirfile, parent, GD_CONST_ENTRY)
  do i=1,nfields
    ! call f77 library
    call gdmcos(constants(i), dirfile, TRIM(parent), LEN_TRIM(parent), &
    GD_INT64, i)
  end do
end subroutine

! gd_mconstants with return_type=GD_FLOAT32
subroutine fgd_mconstants_r4 (constants, dirfile, parent)
  real*4, dimension(:), intent(out) :: constants
  integer, intent(in) :: dirfile
  integer :: nfields, i
  character (len=*), intent(in) :: parent

  nfields = fgd_nmfields_by_type(dirfile, parent, GD_CONST_ENTRY)
  do i=1,nfields
    ! call f77 library
    call gdmcos(constants(i), dirfile, TRIM(parent), LEN_TRIM(parent), &
    GD_FLOAT32, i)
  end do
end subroutine

! gd_mconstants with return_type=GD_FLOAT64
subroutine fgd_mconstants_r8 (constants, dirfile, parent)
  real*8, dimension(:), intent(out) :: constants
  integer, intent(in) :: dirfile
  integer :: nfields, i
  character (len=*), intent(in) :: parent

  nfields = fgd_nmfields_by_type(dirfile, parent, GD_CONST_ENTRY)
  do i=1,nfields
    ! call f77 library
    call gdmcos(constants(i), dirfile, TRIM(parent), LEN_TRIM(parent), &
    GD_FLOAT64, i)
  end do
end subroutine

! gd_mconstants with return_type=GD_COMPLEX64
subroutine fgd_mconstants_c8 (constants, dirfile, parent)
  complex, dimension(:), intent(out) :: constants
  integer, intent(in) :: dirfile
  integer :: nfields, i
  character (len=*), intent(in) :: parent

  nfields = fgd_nmfields_by_type(dirfile, parent, GD_CONST_ENTRY)
  do i=1,nfields
    ! call f77 library
    call gdmcos(constants(i), dirfile, TRIM(parent), LEN_TRIM(parent), &
    GD_COMPLEX64, i)
  end do
end subroutine

! gd_mconstants with return_type=GD_COMPLEX128
subroutine fgd_mconstants_c16 (constants, dirfile, parent)
  double complex, dimension(:), intent(out) :: constants
  integer, intent(in) :: dirfile
  integer :: nfields, i
  character (len=*), intent(in) :: parent

  nfields = fgd_nmfields_by_type(dirfile, parent, GD_CONST_ENTRY)
  do i=1,nfields
    ! call f77 library
    call gdmcos(constants(i), dirfile, TRIM(parent), LEN_TRIM(parent), &
    GD_COMPLEX128, i)
  end do
end subroutine

function fgd_string_value_max (dirfile)
  integer :: fgd_string_value_max
  integer, intent(in) :: dirfile

  ! call f77 library
  call gdstrx(fgd_string_value_max, dirfile)
end function

subroutine fgd_strings (strings, dirfile, string_len)
  character(len=*), dimension(:), intent(out) :: strings
  integer, intent(in) :: dirfile
  integer, intent(inout) :: string_len
  integer :: max_len, nfields, i

  ! make sure the string list is large enough
  max_len = fgd_string_value_max(dirfile)

  if (string_len .lt. max_len) then
    string_len = max_len
  else
    nfields = fgd_nfields_by_type(dirfile, GD_STRING_ENTRY)
    do i=1,nfields
      ! call f77 library
      call gdstrs(strings(i), string_len, dirfile, i)
    end do
  end if
end subroutine

function fgd_mstring_value_max (dirfile, parent)
  integer :: fgd_mstring_value_max
  integer, intent(in) :: dirfile
  character (len=*), intent(in) :: parent

  ! call f77 library
  call gdmstx(fgd_mstring_value_max, dirfile, TRIM(parent), LEN_TRIM(parent))
end function

subroutine fgd_mstrings (strings, dirfile, parent, string_len)
  character(len=*), dimension(:), intent(out) :: strings
  integer, intent(in) :: dirfile
  integer, intent(inout) :: string_len
  integer :: max_len, nfields, i
  character (len=*), intent(in) :: parent

  ! make sure the field list is large enough
  max_len = fgd_mstring_value_max(dirfile, parent)

  if (string_len .lt. max_len) then
    string_len = max_len
  else
    nfields = fgd_nmfields_by_type(dirfile, parent, GD_STRING_ENTRY)
    do i=1,nfields
      ! call f77 library
      call gdmsts(strings(i), string_len, dirfile, TRIM(parent), &
      LEN_TRIM(parent), i)
    end do
  end if
end subroutine

subroutine fgd_add_alias (dirfile, field_code, targ, fragment_index)
  integer, intent(in) :: dirfile, fragment_index
  character(len=*), intent(in) :: field_code, targ

  call gdadal(dirfile, TRIM(field_code), LEN_TRIM(field_code), TRIM(targ), &
  LEN_TRIM(targ), fragment_index)
end subroutine

subroutine fgd_add_window_i (dirfile, field_code, in_field, check_field, &
  windop, threshold, fragment_index)
  character(len=*), intent(in) :: field_code, in_field, check_field
  integer, intent(in) :: dirfile, windop, threshold, fragment_index

  ! convert to double precision, if necessary
  if (windop .NE. GD_WINDOP_EQ .AND. windop .NE. GD_WINDOP_NE .AND. &
  windop .NE. GD_WINDOP_SET .AND. windop .NE. GD_WINDOP_CLR) then
    call gdadwd(dirfile, TRIM(field_code), LEN_TRIM(field_code), &
    TRIM(in_field), LEN_TRIM(in_field), TRIM(check_field), &
    LEN_TRIM(check_field), windop, 1d0 * threshold, fragment_index)
  else
    call gdadwd(dirfile, TRIM(field_code), LEN_TRIM(field_code), &
    TRIM(in_field), LEN_TRIM(in_field), TRIM(check_field), &
    LEN_TRIM(check_field), windop, threshold, fragment_index)
  end if
end subroutine

subroutine fgd_add_window_r (dirfile, field_code, in_field, check_field, &
  windop, threshold, fragment_index)
  character(len=*), intent(in) :: field_code, in_field, check_field
  integer, intent(in) :: dirfile, windop, fragment_index
  double precision, intent(in) :: threshold

  ! convert to integer, if necessary
  if (windop .NE. GD_WINDOP_EQ .AND. windop .NE. GD_WINDOP_NE .AND. &
  windop .NE. GD_WINDOP_SET .AND. windop .NE. GD_WINDOP_CLR) then
    call gdadwd(dirfile, TRIM(field_code), LEN_TRIM(field_code), &
    TRIM(in_field), LEN_TRIM(in_field), TRIM(check_field), &
    LEN_TRIM(check_field), windop, threshold, fragment_index)
  else
    call gdadwd(dirfile, TRIM(field_code), LEN_TRIM(field_code), &
    TRIM(in_field), LEN_TRIM(in_field), TRIM(check_field), &
    LEN_TRIM(check_field), windop, threshold, INT(fragment_index))
  end if
end subroutine

subroutine fgd_madd_window_i (dirfile, parent, field_code, in_field, &
  check_field, windop, threshold)
  character(len=*), intent(in) :: parent, field_code, in_field, check_field
  integer, intent(in) :: dirfile, windop, threshold

  ! convert to double precision, if necessary
  if (windop .NE. GD_WINDOP_EQ .AND. windop .NE. GD_WINDOP_NE .AND. &
  windop .NE. GD_WINDOP_SET .AND. windop .NE. GD_WINDOP_CLR) then
    call gdmdwd(dirfile, TRIM(parent), LEN_TRIM(parent), TRIM(field_code), &
    LEN_TRIM(field_code), TRIM(in_field), LEN_TRIM(in_field), &
    TRIM(check_field), LEN_TRIM(check_field), windop, 1d0 * threshold)
  else
    call gdmdwd(dirfile, TRIM(parent), LEN_TRIM(parent), TRIM(field_code), &
    LEN_TRIM(field_code), TRIM(in_field), LEN_TRIM(in_field), &
    TRIM(check_field), LEN_TRIM(check_field), windop, threshold)
  end if
end subroutine

subroutine fgd_madd_window_r (dirfile, parent, field_code, in_field, &
  check_field, windop, threshold)
  character(len=*), intent(in) :: parent, field_code, in_field, check_field
  integer, intent(in) :: dirfile, windop
  double precision, intent(in) :: threshold

  ! convert to integer, if necessary
  if (windop .NE. GD_WINDOP_EQ .AND. windop .NE. GD_WINDOP_NE .AND. &
  windop .NE. GD_WINDOP_SET .AND. windop .NE. GD_WINDOP_CLR) then
    call gdmdwd(dirfile, TRIM(parent), LEN_TRIM(parent), TRIM(field_code), &
    LEN_TRIM(field_code), TRIM(in_field), LEN_TRIM(in_field), &
    TRIM(check_field), LEN_TRIM(check_field), windop, threshold)
  else
    call gdmdwd(dirfile, TRIM(parent), LEN_TRIM(parent), TRIM(field_code), &
    LEN_TRIM(field_code), TRIM(in_field), LEN_TRIM(in_field), &
    TRIM(check_field), LEN_TRIM(check_field), windop, INT(threshold))
  end if
end subroutine

function fgd_alias_target (dirfile, field_code)
  character (len=GD_MAX_LINE_LENGTH) :: fgd_alias_target
  integer, intent(in) :: dirfile
  character(len=*), intent(in) :: field_code
  integer :: l = GD_MAX_LINE_LENGTH

  call gdatrg(fgd_alias_target, l, dirfile, TRIM(field_code), &
  LEN_TRIM(field_code))
end function

function fgd_naliases (dirfile, field_code)
  integer :: fgd_naliases
  integer, intent(in) :: dirfile
  character(len=*), intent(in) :: field_code

  call gdnals(fgd_naliases, dirfile, TRIM(field_code), LEN_TRIM(field_code))
end function

function fgd_alias_max (dirfile, field_code)
  integer :: fgd_alias_max
  integer, intent(in) :: dirfile
  character(len=*), intent(in) :: field_code

  call gdalsx(fgd_alias_max, dirfile, TRIM(field_code), LEN_TRIM(field_code))
end function

subroutine fgd_aliases (aliases, dirfile, field_code, alias_len)
  character(len=*), dimension(:), intent(out) :: aliases
  integer, intent(in) :: dirfile
  character(len=*), intent(in) :: field_code
  integer, intent(inout) :: alias_len
  integer :: max_len, nalias, i

  ! make sure the field list is large enough
  max_len = fgd_alias_max(dirfile, field_code)

  if (alias_len .lt. max_len) then
    alias_len = max_len
  else
    nalias = fgd_naliases(dirfile, field_code)
    do i=1,nalias
      call gdalss(aliases(i), alias_len, dirfile, TRIM(field_code), &
      LEN_TRIM(field_code), i)
    end do
  end if
end subroutine

subroutine fgd_alter_affixes (dirfile, fragment_index, prefix, suffix)
  integer, intent(in) :: dirfile, fragment_index
  character(len=*), intent(in) :: prefix, suffix

  call gdaafx(dirfile, fragment_index, TRIM(prefix), LEN_TRIM(prefix), &
  TRIM(suffix), LEN_TRIM(suffix))
end subroutine

subroutine fgd_alter_window_i (dirfile, field_name, in_field, check_field, &
  windop, threshold)
  integer, intent(in) :: dirfile, windop, threshold
  character (len=*), intent(in) :: field_name, in_field, check_field

  ! convert to double precision, if necessary
  if (windop .NE. GD_WINDOP_EQ .AND. windop .NE. GD_WINDOP_NE .AND. &
  windop .NE. GD_WINDOP_SET .AND. windop .NE. GD_WINDOP_CLR) then
    call gdalwd(dirfile, TRIM(field_name), LEN_TRIM(field_name), &
    TRIM(in_field), LEN_TRIM(in_field), TRIM(check_field), &
    LEN_TRIM(check_field), windop, 1d0 * threshold)
  else
    call gdalwd(dirfile, TRIM(field_name), LEN_TRIM(field_name), &
    TRIM(in_field), LEN_TRIM(in_field), TRIM(check_field), &
    LEN_TRIM(check_field), windop, threshold)
  end if
end subroutine

subroutine fgd_alter_window_r (dirfile, field_name, in_field, check_field, &
  windop, threshold)
  integer, intent(in) :: dirfile, windop
  character (len=*), intent(in) :: field_name, in_field, check_field
  double precision, intent(in) :: threshold

  ! convert to integer, if necessary
  if (windop .NE. GD_WINDOP_EQ .AND. windop .NE. GD_WINDOP_NE .AND. &
  windop .NE. GD_WINDOP_SET .AND. windop .NE. GD_WINDOP_CLR) then
    call gdalwd(dirfile, TRIM(field_name), LEN_TRIM(field_name), &
    TRIM(in_field), LEN_TRIM(in_field), TRIM(check_field), &
    LEN_TRIM(check_field), windop, threshold)
  else
    call gdalwd(dirfile, TRIM(field_name), LEN_TRIM(field_name), &
    TRIM(in_field), LEN_TRIM(in_field), TRIM(check_field), &
    LEN_TRIM(check_field), windop, INT(threshold))
  end if
end subroutine

function fgd_hidden (dirfile, field_code)
  integer :: fgd_hidden
  integer, intent(in) :: dirfile
  character (len=*), intent(in) :: field_code

  call gdhidn(fgd_hidden, dirfile, TRIM(field_code), LEN_TRIM(field_code))
end function

subroutine fgd_hide (dirfile, field_code)
  integer, intent(in) :: dirfile
  character (len=*), intent(in) :: field_code

  call gdhide(dirfile, TRIM(field_code), LEN_TRIM(field_code))
end subroutine

subroutine fgd_unhide (dirfile, field_code)
  integer, intent(in) :: dirfile
  character (len=*), intent(in) :: field_code

  call gduhid(dirfile, TRIM(field_code), LEN_TRIM(field_code))
end subroutine

subroutine fgd_madd_alias (dirfile, parent, field_code, targ)
  integer, intent(in) :: dirfile
  character(len=*), intent(in) :: parent, field_code, targ

  call gdmdal(dirfile, TRIM(parent), LEN_TRIM(parent), TRIM(field_code), &
  LEN_TRIM(field_code), TRIM(targ), LEN_TRIM(targ))
end subroutine

subroutine fgd_include_affix (dirfile, fragmentname, fragment_index, prefix, &
suffix, flags)
  integer, intent(in) :: dirfile, fragment_index, flags
  character (len=*), intent(in) :: fragmentname, prefix, suffix

  call gdinca(dirfile, TRIM(fragmentname), LEN_TRIM(fragmentname), &
  fragment_index, TRIM(prefix), LEN_TRIM(prefix), TRIM(suffix), &
  LEN_TRIM(suffix), flags)
end subroutine

subroutine fgd_sync (dirfile, field_code)
  integer, intent(in) :: dirfile
  character (len=*), intent(in) :: field_code

  call gdsync(dirfile, TRIM(field_code), LEN_TRIM(field_code))
end subroutine

subroutine fgd_raw_close (dirfile, field_code)
  integer, intent(in) :: dirfile
  character (len=*), intent(in) :: field_code

  call gdrclo(dirfile, TRIM(field_code), LEN_TRIM(field_code))
end subroutine

subroutine fgd_fragment_affixes (prefix, pl, suffix, sl, dirfile, &
fragment_index)
  character(len=*), intent(out) :: prefix, suffix
  integer, intent(in) :: dirfile, fragment_index
  integer, intent(inout) :: pl, sl

  call gdfraf(prefix, pl, suffix, sl, dirfile, fragment_index)
end subroutine
  
subroutine fgd_add_mplex (dirfile, field_code, in_field, count_field, &
  count_val, period, fragment_index)
  character(len=*), intent(in) :: field_code, in_field, count_field
  integer, intent(in) :: dirfile, count_val, period, fragment_index

  call gdadmx(dirfile, TRIM(field_code), LEN_TRIM(field_code), TRIM(in_field), &
  LEN_TRIM(in_field), TRIM(count_field), LEN_TRIM(count_field), count_val, &
  period, fragment_index)
end subroutine

subroutine fgd_madd_mplex (dirfile, parent, field_code, in_field, count_field, &
  count_val, period)
  character(len=*), intent(in) :: parent, field_code, in_field, count_field
  integer, intent(in) :: dirfile, count_val, period

  call gdmdmx(dirfile, TRIM(parent), LEN_TRIM(parent), TRIM(field_code), &
  LEN_TRIM(field_code), TRIM(in_field), LEN_TRIM(in_field), TRIM(count_field), &
  LEN_TRIM(count_field), count_val, period)
end subroutine

subroutine fgd_alter_mplex (dirfile, field_name, in_field, count_field, &
  count_val, period)
  integer, intent(in) :: dirfile, count_val, period
  character (len=*), intent(in) :: field_name, in_field, count_field

  call gdalmx(dirfile, TRIM(field_name), LEN_TRIM(field_name), TRIM(in_field), &
  LEN_TRIM(in_field), TRIM(count_field), LEN_TRIM(count_field), count_val, &
  period)
end subroutine

subroutine fgd_strtok (token, l, dirfile, string)
  character (len=*), intent(out) :: token
  integer, intent(inout) :: l
  integer, intent(in) :: dirfile
  character (len=*), intent(in) :: string

  call gdtoke(token, l, dirfile, TRIM(string), LEN_TRIM(string))
end subroutine

function fgd_desync (dirfile, flags)
  integer :: fgd_desync
  integer, intent(in) :: dirfile, flags

  call gddsyn(fgd_desync, dirfile, flags)
end function

function fgd_flags (dirfile, set, reset)
  integer :: fgd_flags
  integer, intent(in) :: dirfile, set, reset

  call gdflag(fgd_flags, dirfile, set, reset)
end function

subroutine fgd_verbose_prefix(dirfile, prefix)
  integer, intent(in) :: dirfile
  character (len=*), intent(in) :: prefix

  call gdvbpx(dirfile, TRIM(prefix), LEN_TRIM(prefix))
end subroutine

subroutine fgd_mplex_lookback(dirfile, lookback)
  integer, intent(in) :: dirfile, lookback

  call gdmxlb(dirfile, lookback)
end subroutine

function fgd_nentries (dirfile, parent, entype, flags)
  integer :: fgd_nentries
  integer, intent(in) :: dirfile, entype, flags
  character (len=*), intent(in) :: parent
  integer :: parent_l

  parent_l = LEN_TRIM(parent)
  if (parent_l .EQ. 0) parent_l = -1

  ! call f77 library
  call gdnent(fgd_nentries, dirfile, TRIM(parent), parent_l, entype, flags)
end function

function fgd_entry_name_max (dirfile, parent, entype, flags)
  integer :: fgd_entry_name_max
  integer, intent(in) :: dirfile, entype, flags
  character (len=*), intent(in) :: parent
  integer :: parent_l

  parent_l = LEN_TRIM(parent)
  if (parent_l .EQ. 0) parent_l = -1

  ! call f77 library
  call gdentx(fgd_entry_name_max, dirfile, TRIM(parent), parent_l, entype, &
  flags)
end function

subroutine fgd_entry_list (entry_list, dirfile, parent, entype, flags, &
entry_len)
  character(len=*), dimension(:), intent(out) :: entry_list
  integer, intent(in) :: dirfile, entype, flags
  integer, intent(inout) :: entry_len
  character (len=*), intent(in) :: parent
  integer :: max_len, nentries, i, parent_l

  ! make sure the entry list is large enough
  max_len = fgd_entry_name_max(dirfile, parent, entype, flags)
  parent_l = LEN_TRIM(parent)
  if (parent_l .EQ. 0) parent_l = -1

  if (entry_len .lt. max_len) then
    entry_len = max_len
  else
    nentries = fgd_nentries(dirfile, parent, entype, flags)
    do i=1,nentries
      ! call f77 library
      call gdentn(entry_list(i), entry_len, dirfile, TRIM(parent), parent_l, &
      entype, flags, i)
    end do
  end if
end subroutine

function fgd_linterp_tablename (dirfile, field_code)
  character (len=GD_MAX_LINE_LENGTH) :: fgd_linterp_tablename
  integer, intent(in) :: dirfile
  character (len=*), intent(in) :: field_code

  integer :: l = GD_MAX_LINE_LENGTH

  call gdlttn (fgd_linterp_tablename, l, dirfile, TRIM(field_code), &
  LEN_TRIM(field_code))
end function

function fgd_encoding_support (encoding)
  integer :: fgd_encoding_support
  integer, intent(in) :: encoding

  call gdencs(fgd_encoding_support, encoding)
end function

end module
