Graphics Plus/Graphics Plus.iso/general/hdf/unix/hdf3_2r2.lha/HDF3.2r2/src/vgff.f

Text File | 1992-10-28 | 14.9 KB | 608 lines

C***************************************************************************
C
C
C                         NCSA HDF version 3.2r2
C                            October 30, 1992
C
C NCSA HDF Version 3.2 source code and documentation are in the public
C domain.  Specifically, we give to the public domain all rights for future
C licensing of the source code, all resale rights, and all publishing rights.
C
C We ask, but do not require, that the following message be included in all
C derived works:
C
C Portions developed at the National Center for Supercomputing Applications at
C the University of Illinois at Urbana-Champaign, in collaboration with the
C Information Technology Institute of Singapore.
C
C THE UNIVERSITY OF ILLINOIS GIVES NO WARRANTY, EXPRESSED OR IMPLIED, FOR THE
C SOFTWARE AND/OR DOCUMENTATION PROVIDED, INCLUDING, WITHOUT LIMITATION,
C WARRANTY OF MERCHANTABILITY AND WARRANTY OF FITNESS FOR A PARTICULAR PURPOSE
C
C***************************************************************************

C
C $Header: /hdf/hdf/v3.2r2/src/RCS/vgff.f,v 1.2 1992/10/23 19:13:12 koziol beta koziol $
C
C $Log: vgff.f,v $
c Revision 1.2  1992/10/23  19:13:12  koziol
c Created fortran stubs dfvopen and dfvclos for DFvsetopen() and DFvsetclose
c
c Revision 1.1  1992/08/25  21:40:44  koziol
c Initial revision
c
C
c    **************************************************************************
c    * Likkai Ng May 1991 NCSA
c    *
c    * vgFf.f
c    * Part of the HDF VSet interface.
c    *
c    * Contains fortran routines callable from fortran programs.
c    *
c    **************************************************************************

C------------------------------------------------------------------------------
C Name: dfvopen
C Purpose:  call dfivopn, open file
C Inputs:   path: Name of file to be opened
C           access: DFACC_READ, DFACC_WRITE, DFACC_CREATE,
C                      or any bitwise-or of the above.
C           ndds: Number of dds in header block if file needs to be created.
C Returns: 0 on success, FAIL on failure with error set
C Users:    Fortran stub routine
C Invokes: hiopen
C----------------------------------------------------------------------------*/

    integer function dfvopen(filename, access, defdds)

    character*(*) filename
    integer       access, defdds, dfivopn

    dfvopen = dfivopn(filename, access, defdds, len(filename))
    return
    end


c    ============================================================
c     VGROUP ROUTINES
c    ============================================================

c    attachs to a vgroup
c    related: Vattach--vatchc--VFATCH

    integer    function VFATCH(f, vgid, accesstype)
    integer        f, vgid
    character*1    accesstype
    integer        VATCHC

    VFATCH = VATCHC (f, vgid, accesstype)
    end

c    ------------------------------------------------------------
c    detaches from a vgroup
c    related: Vdetach--vdtchc--VFDTCH

    subroutine    VFDTCH (vg)
    integer        vg

    call VDTCHC (vg)
    end

c    ------------------------------------------------------------
c    general inquiry on a vgroup
c    related: Vgetname--vgnamc--VFGNAM

    subroutine VFGNAM (vg, vgname)
    integer            vg
    character*(*)    vgname

    call VGNAMC (vg, vgname)
    end
c    ------------------------------------------------------------
c    get the class name of a vgroup
c    related: Vgetclass--vgclsc--VFGCLS

    subroutine VFGCLS (vg, vgclass)

    integer            vg
    character*(*)    vgclass

    call VGCLSC  (vg, vgclass)
    end
c    ------------------------------------------------------------
c    general inquiry on a vgroup
c    related: Vinquire--vinqc--VFINQ

    integer    function    VFINQ (vg, nentries, vgname)
    integer            vg, nentries
    character*(*)    vgname
    integer            VINQC

    VFINQ = VINQC (vg, nentries, vgname)
    end

c    ------------------------------------------------------------
c    gets the id of the next vgroup in the file
c    related: Vgetid--vgidc--VFGID

    integer    function    VFGID (f, vgid)
    integer        f, vgid
    integer        VGIDC

    VFGID = VGIDC (f, vgid)
    end

c    ------------------------------------------------------------
c    gets the id of the next entry in the vgroup
c    related: Vgetnext--vgnxtc--VFGNXT

    integer    function    VFGNXT (vg, id)
    integer        vg, id
    integer        VGNXTC

    VFGNXT = VGNXTC (vg, id)
    end


c    ------------------------------------------------------------
c    sets the name of the vgroup
c    related: Vsetname--vsnamc--VFSNAM

    subroutine VFSNAM (vg, vgname)
    integer            vg
    character*(*)    vgname

    call VSNAMC (vg, vgname, len(vgname))
    end
c    ------------------------------------------------------------
c    sets the class name of the vgroup
c    related: Vsetclass--vsclsc--VFSCLS

    subroutine VFSCLS (vg, vgclass)
    integer            vg
    character*(*)    vgclass

    call VSCLSC  (vg, vgclass, len(vgclass))
    end

c    ------------------------------------------------------------
c    inserts a vset entity (ie vgroup or vdata) into the given vgroup
c    related: Vinsert--vinsrtc--VFINSRT


    integer    function VFINSRT (vg, velt)
    integer        vg, velt
    integer        VINSRTC

    VFINSRT = VINSRTC (vg, velt)
    end

c    ------------------------------------------------------------
c    tests if an id in a vgroup is a vgroup
c    related: Visvg--visvgc--VFISVG

    integer    function    VFISVG (vg, id)
    integer        vg, id
    integer        VISVGC

    VFISVG = VISVGC (vg, id)
    end

c    ------------------------------------------------------------
c    tests if an id in a vgroup is a vdata
c    related: Visvs--visvsc--VFISVS

    integer    function    VFISVS (vg, id)
    integer        vg, id
    integer        VISVSC

    VFISVS = VISVSC (vg, id)
    end



c    ============================================================
c     VDATA ROUTINES
c    ============================================================

c    attach to a vdata
c    related: VSattach--vsatchc--VFATCH

    integer    function    VSFATCH (f, vsid, accesstype)
    integer        f, vsid
    character*1    accesstype
    integer        VSATCHC

    VSFATCH = VSATCHC (f, vsid, accesstype)
    end

c    ------------------------------------------------------------
c    detach from a vdata
c    related: VSdetach--vsdtchc--VFDTCH

    subroutine    VSFDTCH (vs)
    integer        vs

    call VSDTCHC (vs)
    end

c    ------------------------------------------------------------
c    seeks to a given element position in a vadata
c    related: VSseek--vsseekc--VSFSEEK

    integer    function    VSFSEEK (vs, eltpos )
    integer        vs, eltpos
    integer        VSSEEKC

    VSFSEEK = VSSEEKC (vs, eltpos)
    end

c    ------------------------------------------------------------
c    gets the name of a vdata
c    related: VSgetname--vsgnamc--VSFGNAM

    subroutine  VSFGNAM (vs, vsname)
    integer            vs
    character*(*)    vsname

    call VSGNAMC (vs, vsname)
    end

c    ------------------------------------------------------------
c    get the class name of a vdata
c    related: VSgetclass--vsgclsc--VSFGCLS

    subroutine VSFGCLS (vs, vsclass)
    integer            vs
    character*(*)    vsclass

    call VSGCLSC  (vs, vsclass)
    end

c    ------------------------------------------------------------
c    general inquiry on a vdata
c    related: VSinquire--vsinqc--VSFINQ

    integer function VSFINQ (vs,nvs,ilace,fields,vsize,vsname)
    integer            vs, nvs, ilace, vsize
    character*(*)    fields, vsname
    integer            VSINQC

    VSFINQ = VSINQC (vs,nvs,ilace,fields,vsize,vsname)
    end

c    ------------------------------------------------------------
c    tests if given fields exist in the vdata
c    related: VSfexist--vsfexc--VSFEX

    integer    function VSFEX (vs, fields)
    integer            vs
    character*(*)    fields
    integer            VSFEXC

    VSFEX = VSFEXC (vs, fields, len(fields))
    end

c  ------------------------------------------------------------
c    gets the id of the next vdata from the file
c    related: VSgetid--vsgidc--VSFGID

    integer  function VSFGID (f, vsid)
    integer     f, vsid
    integer     VSGIDC

    VSFGID = VSGIDC (f, vsid)
    end

c    ------------------------------------------------------------
c    sets the name of a vdata
c    related: VSsetname--vssnamc--VSFSNAM

    subroutine VSFSNAM (vs, vsname)
    integer            vs
    character*(*)    vsname

    call VSSNAMC (vs, vsname, len(vsname))
    end

c    ------------------------------------------------------------
c    set the class name of a vdata
c    related: VSsetclass--vssclsc--VSFSCLS

    subroutine VSFSCLS (vs, vsclass)
    integer            vs
    character*(*)    vsclass

    call VSSCLSC  (vs, vsclass, len(vsclass))
    end

c    ------------------------------------------------------------
c    sets the fields in a vdata for reading or writing
c    related: VSsetfields--vssfldc--VSFSFLD

    integer    function    VSFSFLD (vs, fields)
    integer            vs
    character*(*)    fields
    integer        VSSFLDC

    VSFSFLD = VSSFLDC (vs, fields, len(fields))
    end

c    ------------------------------------------------------------
c    sets the file interlace of a vdata
c    related: VSsetinterlace--vssintc--VSFSINT

    integer     function VSFSINT (vs, interface)
    integer         vs, interlace
    integer        VSSINTC

    VSFSINT = VSSINTC (vs, interlace)
    end

c    ------------------------------------------------------------
c    defines a new field to be used in the vdata
c    related: VSfdefine--vsfdefc--VSFFDEF

    integer    function    VSFFDEF (vs, field, localtype, order)

    integer            vs, localtype, order
    character*(*)    field
    integer            VSFDEFC

    VSFFDEF = VSFDEFC ( vs, field, localtype, order, len(field))

    end

c    ------------------------------------------------------------
c    reads from a vdata
c    related: VSread--vsreadc--VSFREAD

    integer    function    VSFREAD (vs, buf, nelts , interlace)

    integer            vs, nelts , interlace
    character*(*)    buf
    integer            VSREADC

    VSFREAD = VSREADC (vs, buf, nelts, interlace)
    end

c    ------------------------------------------------------------
c    writes to a vdata
c    related: VSwrite--vswritc--VSFWRIT

    integer    function    VSFWRIT (vs, buf, nelts, interlace)

    integer            vs, nelts, interlace
    integer            buf(*)
    integer            VSWRITC

    VSFWRIT = VSWRITC (vs, buf, nelts, interlace)
    end

c    ===========================================
c    MISCELLANEOUS USEFUL VDATA INQUIRY ROUTINES
c    ===========================================
c
c    undocumented


c    gets the interlace of a vdata
c    related: VSgetinterlace--vsgintc--VSFGINT

    integer     function VSFGINT (vs)
    integer         vs
    integer        VSGINTC

    VSFGINT = VSGINTC (vs)
    end

c    ------------------------------------------------------------
c    gets the number of elements in a vdata
c    related: VSelts--vseltsc--VSFELTS

    integer     function VSFELTS (vs)
    integer  vs
    integer    VSELTSC

    VSFELTS = VSELTSC (vs)
    end

c    ------------------------------------------------------------
c    gets the fields in the vdata
c    related: VSgetfields--vsgfldc--VSFGFLD

    integer    function VSFGFLD (vs, fields)
    integer            vs
    character*(*)     fields
    integer            VSGFLDC

    VSFGFLD = VSGFLDC (vs, fields)
    end

c    ------------------------------------------------------------
c     determines the (machine) size of the given fields
c    related: VSsizeof--vssizc--VSFSIZ

    integer    function VSFSIZ (vs, fields)
    integer            vs
    character*(*)     fields
    integer            VSSIZC

    VSFSIZ = VSSIZC (vs, fields, len(fields))
    end

c    ------------------------------------------------------------
c    determines the no of entries in a vgroup
c    related: Ventries--ventsc--VFENTS

    integer     function    VFENTS (f, vgid)
    integer    f, vgid
    integer    VENTSC

    VFENTS = VENTSC (f, vgid)
    end

c    ------------------------------------------------------------
c    DEBUGGING ROUTINES
c    ------------------------------------------------------------

c    enable debug
c    related: setjj--setjjc--SETFJJ

    integer     function SETFJJ()
    integer  setjjc

    SETFJJ = setjjc()
    end

c    ------------------------------------------------------------
c    disable debug
c    related: setnojj--setnojjc--SETFNJJ

    integer     function SETFNJJ()
    integer  setnojjc

    SETFNJJ = setnojjc()
    end
c    ------------------------------------------------------------
c    gets the refs of all lone vgroups in the file
c    related: Vlone--vlonec--VFLONE

    integer function VFLONE (f, idarray, asize)
    integer            f
    integer            idarray(*)
    integer            asize
    integer            VLONEC

    VFLONE = VLONEC  (f, idarray, asize)
    end

c    ------------------------------------------------------------
c    gets the refs of all lone vdatas in the file
c    related: VSlone--vslonec--VSFLONE

    integer function VSFLONE (f, idarray, asize)
    integer            f
    integer            idarray(*)
    integer            asize
    integer            VSLONEC

    VSFLONE = VSLONEC  (f, idarray, asize)
    end

c    ------------------------------------------------------------
c    store a simple dataset in a vdata
c    related: VHstoredata--vhsdc--vhfsd

    integer function VHFSD(f,field,buf,n,dtype,vsname,vsclass)
    integer        f
    character*(*)  field
    integer        buf(*)
    integer        n, dtype
    character*(*)  vsname, vsclass
    integer VHSDC

    VHFSD = VHSDC (f, field, buf, n, dtype, vsname, vsclass,
     1            len(field), len(vsname), len(vsclass))
    end

c    ------------------------------------------------------------
c    store an aggregate dataset in a vadata
c    related: VHstoredatam--vhsdmc--vhfsdm

    integer function VHFSDM (f,field,buf,n,dtype,vsname,vsclass,order)
    integer            f
    character*(*)  field
    integer            buf(*)
    integer            n, dtype, order
    character*(*)  vsname, vsclass
    integer VHSDMC

    VHFSDM = VHSDMC (f, field, buf, n, dtype, vsname,vsclass, order,
     1             len(field), len(vsname), len(vsclass))
    end

c    ------------------------------------------------------------
c    make a new vgroup given several tag/ref pairs
c    related: VHmakegroup--vhmkgpc--vhfmkgp

    integer function VHFMKGP(f,tagarray,refarray,n,vgname,vgclass)
    integer        f, n
    integer        tagarray(*), refarray(*)
    character*(*)  vgname, vgclass
    integer         VHMKGPC

    VHFMKGP = VHMKGPC (f, tagarray, refarray , n, vgname, vgclass,
     1                len(vgname), len(vgclass))
    end

c    ============================================================
c    More vgroup routines

c    locate a field in a vdata that belongs to this VGROUP
c    related: Vflocate--vffloc--vflocc

    integer function VFFLOC  (vg, field)
    integer            vg
    character*(*)    field
    integer             VFLOCC
    VFFLOC = VFLOCC (vg, field, len(field))
    end

c    ------------------------------------------------------------
c    tests if a tag/ref pair is in a vgroup.
c    related: Vinqtagref--vinqtrc--vfinqtr

    integer function VFINQTR  (vg, tag, ref)
    integer        vg, tag, ref
    integer        VINQTRC
    VFINQTR = VINQTRC (vg, tag, ref)
    end

c    ------------------------------------------------------------
c    gets the number of tag/refs stored in a vgroup
c    related: Velts--veltsc--vfelts

    integer function VFNTR (vg)
    integer        vg
    integer VNTRC
    VFNTR = VNTRC (vg)
    end

c    ------------------------------------------------------------
c    returns all the tag/ref pairs in a vgroup
c    related: Vgettagrefs--vgttrsc--vfgttrs

    integer function VFGTTRS (vg, tagarray, refarray, n)
    integer        vg, n
    integer        tagarray(*), refarray(*)
    integer        VGTTRSC

    VFGTTRS = VGTTRSC (vg, tagarray, refarray, n)
    end
c    ------------------------------------------------------------
c    returns a specified tag/ref pair in a vgroup
c    related: Vgettagref--vgttrc--vfgttr

    integer function VFGTTR (vg, which, tag, ref)
    integer        vg, which
    integer        tag, ref
    integer        VGTTRC

    VFGTTR = VGTTRC (vg, which, tag, ref)
    end

c    ------------------------------------------------------------
c    add a tag/ref pair to a vgroup
c    related: Vaddtagref--vadtrc--VFADTR

    integer function VFADTR    ( vg, tag, ref)
    integer        vg, tag, ref
    integer VADTRC

    VFADTR = VADTRC  ( vg, tag, ref)
    end
c    ============================================================