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
|
program getinfo_about_vgroup
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)
integer SIZE
parameter(SIZE = 10)
C
C Function declaration
C
integer hopen, hclose
integer vfstart, vfatch, vfgnam, vfgcls, vflone, vfdtch, vfend
C
C**** Variable declaration *******************************************
C
integer status
integer file_id
integer vgroup_id
integer lone_vg_number, num_of_lones
character*64 vgroup_name, vgroup_class
integer ref_array(SIZE)
integer i
C
C**** End of variable declaration ************************************
C
C
C Initialize ref_array.
C
do 10 i = 1, SIZE
ref_array(i) = 0
10 continue
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 Get and print the name and class name of all lone vgroups.
C First, call vflone with num_of_lones set to 0 to get the number of
C lone vgroups in the file and check whether size of ref_array is
C big enough to hold reference numbers of ALL lone groups.
C If ref_array is not big enough, exit the program after displaying an
C informative message.
C
num_of_lones = 0
num_of_lones = vflone(file_id, ref_array, num_of_lones)
if (num_of_lones .gt. SIZE) then
write(*,*) num_of_lones, 'lone vgroups is found'
write(*,*) 'increase the size of ref_array to hold reference '
write(*,*) 'numbers of all lone vgroups in the file'
stop
endif
C
C If there are any lone groups in the file,
C
if (num_of_lones .gt. 0) then
C
C call vflone again to retrieve the reference numbers into ref_array.
C
num_of_lones = vflone(file_id, ref_array, num_of_lones)
C
C Display the name and class of each vgroup.
C
write(*,*) 'Lone vgroups in the file are:'
do 20 lone_vg_number = 1, num_of_lones
C
C Attach to the current vgroup, then get and display its name and class.
C Note: the current vgroup must be detached before moving to the next.
C
vgroup_name = ' '
vgroup_class = ' '
vgroup_id = vfatch(file_id, ref_array(lone_vg_number), 'r')
status = vfgnam(vgroup_id, vgroup_name)
status = vfgcls(vgroup_id, vgroup_class)
write(*,*) 'Vgroup name ' , vgroup_name
write(*,*) 'Vgroup class ' , vgroup_class
write(*,*)
status = vfdtch(vgroup_id)
20 continue
endif
C
C Terminate access to the V interface and close the HDF file.
C
status = vfend(file_id)
status = hclose(file_id)
end
|