! Copyright (C) 2008-2010 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


! Error codes
integer, parameter :: GD_E_OK=0
integer, parameter :: GD_E_OPEN=1
integer, parameter :: GD_E_FORMAT=2
integer, parameter :: GD_E_TRUNC=3
integer, parameter :: GD_E_CREAT=4
integer, parameter :: GD_E_BAD_CODE=5
integer, parameter :: GD_E_BAD_TYPE=6
integer, parameter :: GD_E_RAW_IO=7
integer, parameter :: GD_E_OPEN_FRAGMENT=8
integer, parameter :: GD_E_OPEN_INCLUDE=8
integer, parameter :: GD_E_INTERNAL_ERROR=9
integer, parameter :: GD_E_ALLOC=10
integer, parameter :: GD_E_RANGE=11
integer, parameter :: GD_E_OPEN_LINFILE=12
integer, parameter :: GD_E_RECURSE_LEVEL=13
integer, parameter :: GD_E_BAD_DIRFILE=14
integer, parameter :: GD_E_BAD_FIELD_TYPE=15
integer, parameter :: GD_E_ACCMODE=16
integer, parameter :: GD_E_UNSUPPORTED=17
integer, parameter :: GD_E_BAD_ENTRY=19
integer, parameter :: GD_E_DUPLICATE=20
integer, parameter :: GD_E_DIMENSION=21
integer, parameter :: GD_E_BAD_INDEX=22
integer, parameter :: GD_E_BAD_SCALAR=23
integer, parameter :: GD_E_BAD_REFERENCE=24
integer, parameter :: GD_E_PROTECTED=25
integer, parameter :: GD_E_DELETE=26
integer, parameter :: GD_E_BAD_ENDIANNESS=27
integer, parameter :: GD_E_CALLBACK=28
integer, parameter :: GD_E_BAD_PROTECTION=29
integer, parameter :: GD_E_UNCLEAN_DB=30
integer, parameter :: GD_E_DOMAIN=31
integer, parameter :: GD_E_BAD_REPR=32
integer, parameter :: GD_E_BAD_VERSION=33
integer, parameter :: GD_E_FLUSH=34
integer, parameter :: GD_E_BOUNDS=35
integer, parameter :: GD_E_LINE_TOO_LONG=36

! Open flags
integer, parameter :: GD_RDONLY=0
integer, parameter :: GD_RDWR=1
integer, parameter :: GD_FORCE_ENDIAN=2
integer, parameter :: GD_BIG_ENDIAN=4
integer, parameter :: GD_LITTLE_ENDIAN=8
integer, parameter :: GD_CREAT=16
integer, parameter :: GD_EXCL=32
integer, parameter :: GD_TRUNC=64
integer, parameter :: GD_PEDANTIC=128
integer, parameter :: GD_FORCE_ENCODING=256
integer, parameter :: GD_VERBOSE=512
integer, parameter :: GD_IGNORE_DUPS=1024
integer, parameter :: GD_IGNORE_REFS=2048
integer, parameter :: GD_PRETTY_PRINT=4096
integer, parameter :: GD_ARM_ENDIAN=8192
integer, parameter :: GD_NOT_ARM_ENDIAN=0
integer, parameter :: GD_PERMISSIVE=16384
integer, parameter :: GD_AUTO_ENCODED=0
integer, parameter :: GD_UNENCODED=16777216
integer, parameter :: GD_TEXT_ENCODED=33554432
integer, parameter :: GD_SLIM_ENCODED=50331648
integer, parameter :: GD_GZIP_ENCODED=67108864
integer, parameter :: GD_BZIP2_ENCODED=83886080
integer, parameter :: GD_LZMA_ENCODED=100663296

! Field types
integer, parameter :: GD_NO_ENTRY=0
integer, parameter :: GD_RAW_ENTRY=1
integer, parameter :: GD_LINCOM_ENTRY=2
integer, parameter :: GD_LINTERP_ENTRY=3
integer, parameter :: GD_BIT_ENTRY=4
integer, parameter :: GD_MULTIPLY_ENTRY=5
integer, parameter :: GD_PHASE_ENTRY=6
integer, parameter :: GD_INDEX_ENTRY=7
integer, parameter :: GD_POLYNOM_ENTRY=8
integer, parameter :: GD_SBIT_ENTRY=9
integer, parameter :: GD_DIVIDE_ENTRY=10
integer, parameter :: GD_RECIP_ENTRY=11
integer, parameter :: GD_CONST_ENTRY=16
integer, parameter :: GD_CARRAY_ENTRY=18
integer, parameter :: GD_STRING_ENTRY=17

! Data types -- the unsigned types won't work when passed as
!               a return type, but we keep them anyways, since
!               they might appear as a result of calling fget_entry
integer, parameter :: GD_NULL=0
integer, parameter :: GD_UINT8=1
integer, parameter :: GD_INT8=33
integer, parameter :: GD_UINT16=2
integer, parameter :: GD_INT16=34
integer, parameter :: GD_UINT32=4
integer, parameter :: GD_INT32=36
integer, parameter :: GD_UINT64=8
integer, parameter :: GD_INT64=40
integer, parameter :: GD_FLOAT32=132
integer, parameter :: GD_FLOAT64=136
integer, parameter :: GD_COMPLEX64=264
integer, parameter :: GD_COMPLEX128=272

! Delete flags
integer, parameter :: GD_DEL_META=1
integer, parameter :: GD_DEL_DATA=2
integer, parameter :: GD_DEL_DEREF=4
integer, parameter :: GD_DEL_FORCE=8

! Protection levels
integer, parameter :: GD_PROTECT_NONE=0
integer, parameter :: GD_PROTECT_FORMAT=1
integer, parameter :: GD_PROTECT_DATA=2
integer, parameter :: GD_PROTECT_ALL=3

! Callback actions
integer, parameter :: GD_SYNTAX_ABORT=0
integer, parameter :: GD_SYNTAX_RESCAN=1
integer, parameter :: GD_SYNTAX_IGNORE=2
integer, parameter :: GD_SYNTAX_CONTINUE=3

! Syntax suberrors
integer, parameter :: GD_E_FORMAT_BAD_SPF=1
integer, parameter :: GD_E_FORMAT_N_FIELDS=2
integer, parameter :: GD_E_FORMAT_N_TOK=3
integer, parameter :: GD_E_FORMAT_NUMBITS=4
integer, parameter :: GD_E_FORMAT_BITNUM=5
integer, parameter :: GD_E_FORMAT_BITSIZE=6
integer, parameter :: GD_E_FORMAT_CHARACTER=7
integer, parameter :: GD_E_FORMAT_BAD_LINE=8
integer, parameter :: GD_E_FORMAT_RES_NAME=9
integer, parameter :: GD_E_FORMAT_ENDIAN=10
integer, parameter :: GD_E_FORMAT_BAD_TYPE=11
integer, parameter :: GD_E_FORMAT_BAD_NAME=12
integer, parameter :: GD_E_FORMAT_UNTERM=13
integer, parameter :: GD_E_FORMAT_METARAW=14
integer, parameter :: GD_E_FORMAT_NO_PARENT=15
integer, parameter :: GD_E_FORMAT_DUPLICATE=16
integer, parameter :: GD_E_FORMAT_LOCATION=17
integer, parameter :: GD_E_FORMAT_PROTECT=18
integer, parameter :: GD_E_FORMAT_LITERAL=19

! Special version codes
integer, parameter :: GD_VERSION_CURRENT=-1
integer, parameter :: GD_VERSION_LATEST=-2
integer, parameter :: GD_VERSION_EARLIEST=-3

! Miscellaneous parameters
integer, parameter :: GD_MAX_LINE_LENGTH=4096
integer, parameter :: GD_ALL_FRAGMENTS=-1
integer, parameter :: GD_DIRFILE_STANDARDS_VERSION=8


integer, parameter :: GD_FIELD_LEN=4096

type gd_entry
  integer :: field_type, n_fields, spf, data_type, bitnum, numbits, shift
  integer :: fragment_index, comp_scal, poly_ord, array_len
  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
  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=4096), 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

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))

  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
    call gdcscl(ent%comp_scal, dirfile, TRIM(field_code), LEN_TRIM(field_code))
    if (ent%comp_scal .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(1), 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
    call gdcscl(ent%comp_scal, dirfile, TRIM(field_code), LEN_TRIM(field_code))
    if (ent%comp_scal .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(1), dirfile, &
      TRIM(field_code), LEN_TRIM(field_code), i)
    end do
  else if (fgd_entry .EQ. GD_RECIP_ENTRY) then
    ! recip
    call gdcscl(ent%comp_scal, dirfile, TRIM(field_code), LEN_TRIM(field_code))
    if (ent%comp_scal .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_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 gdadrw(dirfile, TRIM(field_code), LEN_TRIM(field_code), &
    ent%data_type, ent%spf, ent%fragment_index)
  else if (ent%field_type .EQ. GD_LINCOM_ENTRY) then
    if (ent%comp_scal .EQ. 0) then
      call gdadlc(dirfile, 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), ent%fragment_index)
    else
      call gdadcl(dirfile, 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), 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 gdadbt(dirfile, TRIM(field_code), LEN_TRIM(field_code), &
    TRIM(ent%field(1)), LEN_TRIM(ent%field(1)), ent%bitnum, ent%numbits, &
    ent%fragment_index)
  else if (ent%field_type .EQ. GD_SBIT_ENTRY) then
    call gdadsb(dirfile, TRIM(field_code), LEN_TRIM(field_code), &
    TRIM(ent%field(1)), LEN_TRIM(ent%field(1)), ent%bitnum, ent%numbits, &
    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 gdadph(dirfile, TRIM(field_code), LEN_TRIM(field_code), &
    TRIM(ent%field(1)), LEN_TRIM(ent%field(1)), ent%shift, ent%fragment_index)
  else if (ent%field_type .EQ. GD_POLYNOM_ENTRY) then
    if (ent%comp_scal .EQ. 0) then
      call gdadpn(dirfile, 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), ent%fragment_index)
    else
      call gdadcp(dirfile, 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), ent%fragment_index)
    end if
  else if (ent%field_type .EQ. GD_RECIP_ENTRY) then
    if (ent%comp_scal .EQ. 0) then
      call gdadcr(dirfile, TRIM(field_code), LEN_TRIM(field_code), &
      TRIM(ent%field(1)), LEN_TRIM(ent%field(1)), ent%dividend, &
      ent%fragment_index)
    else
      call gdadrc(dirfile, TRIM(field_code), LEN_TRIM(field_code), &
      TRIM(ent%field(1)), LEN_TRIM(ent%field(1)), ent%cdividend, &
      ent%fragment_index)
    end if
  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 (ent%comp_scal .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 (ent%comp_scal .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 (ent%comp_scal .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_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))
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=4096), 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, move_data)
  integer, intent(in) :: dirfile, new_fragment, move_data
  character (len=*), intent(in) :: field_code

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

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

  if (ent%field_type .EQ. GD_RAW_ENTRY) then
    call gdalrw(dirfile, TRIM(field_code), LEN_TRIM(field_code), &
    ent%data_type, ent%spf, recode)
  else if (ent%field_type .EQ. GD_LINCOM_ENTRY) then
    if (ent%comp_scal .NE. 0) then
      call gdalcl(dirfile, 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 gdallc(dirfile, 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 gdallt(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)), recode)
  else if (ent%field_type .EQ. GD_BIT_ENTRY) then
    call gdalbt(dirfile, 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 gdalsb(dirfile, 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 gdalmt(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)))
  else if (ent%field_type .EQ. GD_DIVIDE_ENTRY) then
    call gdaldv(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)))
  else if (ent%field_type .EQ. GD_PHASE_ENTRY) then
    call gdalph(dirfile, 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_POLYNOM_ENTRY) then
    if (ent%comp_scal .NE. 0) then
      call gdalcp(dirfile, 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 gdalpn(dirfile, 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 (ent%comp_scal .NE. 0) then
      call gdalcr(dirfile, TRIM(field_code), LEN_TRIM(field_code), &
      TRIM(ent%field(1)), LEN_TRIM(ent%field(1)), ent%cdividend)
    else
      call gdalrc(dirfile, TRIM(field_code), LEN_TRIM(field_code), &
      TRIM(ent%field(1)), LEN_TRIM(ent%field(1)), ent%a(1), ent%dividend)
    end if
  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, move_data)
  integer, intent(in) :: dirfile, move_data
  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), move_data)
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_carray_len (dirfile, field_code)
  integer :: fgd_carray_len
  integer, intent(in) :: dirfile
  character (len=*), intent(in) :: field_code

  ! call f77 library
  call gdcaln(fgd_carray_len, dirfile, TRIM(field_code), LEN_TRIM(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
  integer*1, dimension(array_len) :: zero

  zero = 0

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

end module
