1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102
|
program vgroup_contents
implicit none
C
C Parameter declaration
C
character*19 FILE_NAME
C
parameter (FILE_NAME = 'General_Vgroups.hdf')
integer DFACC_ READ
parameter (DFACC_READ = 1)
C
C Function declaration
C
integer hopen, hclose
integer vfstart, vfatch, vfgid, vntrc, vfgttr, vfisvg,
+ vfisvs, vfdtch, vfend
C
C**** Variable declaration *******************************************
C
integer status
integer file_id
integer vgroup_id, vgroup_ref, vgroup_pos
integer obj_index, num_of_pairs
integer obj_tag, obj_ref
C
C**** End of variable declaration ************************************
C
C
C Open the HDF file for reading.
C
file_id = hopen(FILE_NAME, DFACC_READ, 0)
C
C Initialize the V interface.
C
status = vfstart(file_id)
C
C Obtain each vgroup in the file by its reference number, get the
C number of objects in the vgroup, and display the information
C about that vgroup.
C
vgroup_ref = -1
vgroup_pos = 0
10 continue
C
C Get the reference number of the next vgroup in the file.
C
vgroup_ref = vfgid(file_id, vgroup_ref)
C
C Attach to the vgroup or go to the end if no additional vgroup is found.
C
if(vgroup_ref. eq. -1) goto 100
vgroup_id = vfatch(file_id, vgroup_ref , 'r')
C
C Get the total number of objects in the vgroup.
C
num_of_pairs = vntrc(vgroup_id)
C
C If the vgroup contains any object, print the tag/ref number
C pair of each object in vgroup, in the order they appear in the
C file, and indicate whether the object is a vdata, vgroup, or neither.
C
if (num_of_pairs .gt. 0) then
write(*,*) 'Vgroup # ', vgroup_pos, ' contains:'
do 20 obj_index = 1, num_of_pairs
C
C Get the tag/ref number pair of the object specified by its index
C and display them.
C
status = vfgttr(vgroup_id, obj_index-1, obj_tag, obj_ref)
C
C State whether the HDF object referred to by obj_ref is a vdata,
C a vgroup, or neither.
C
if( vfisvg(vgroup_id, obj_ref) .eq. 1) then
write(*,*) 'tag = ', obj_tag, ' ref = ', obj_ref,
+ ' <--- is a vgroup '
else if ( vfisvs(vgroup_id, obj_ref) .eq. 1) then
write(*,*) 'tag = ', obj_tag, ' ref = ', obj_ref,
+ ' <--- is a vdata '
else
write(*,*) 'tag = ', obj_tag, ' ref = ', obj_ref,
+ ' <--- neither vdata nor vgroup '
endif
20 continue
else
write (*,*) 'Vgroup #', vgroup_pos, ' contains no HDF objects'
endif
write(*,*)
vgroup_pos = vgroup_pos + 1
goto 10
100 continue
C
C Terminate access to the vgroup.
C
status = vfdtch(vgroup_id)
C
C Terminate access to the V interface and close the HDF file.
C
status = vfend(file_id)
status = hclose(file_id)
end
|