217 lines
5.6 KiB
Fortran
217 lines
5.6 KiB
Fortran
program brows
|
|
|
|
integer pin, pout, n,l
|
|
integer nmax
|
|
parameter (nmax=9999)
|
|
character filelist*256, name*256
|
|
real xval(nmax), yval(nmax), sig(nmax), rmon(nmax)
|
|
external list_none
|
|
external cvtyp
|
|
character*4 cvtyp
|
|
|
|
call sys_get_cmdpar(filelist, l)
|
|
|
|
name=cvtyp(0) ! init types
|
|
if (filelist .eq. ' ') then
|
|
call dat_ask_filelist(filelist, ' ')
|
|
endif
|
|
call dat_silent
|
|
pin=0
|
|
pout=0
|
|
call dat_open_next(filelist, pin, name, pout
|
|
& , list_none, nmax, n, xval, yval, sig, rmon)
|
|
call dat_get_filename(filelist, l)
|
|
call list_file(filelist(1:l))
|
|
end
|
|
|
|
|
|
subroutine list_none(name, value)
|
|
|
|
character name*(*)
|
|
real value
|
|
|
|
end
|
|
|
|
|
|
subroutine list_file(filename)
|
|
|
|
implicit none
|
|
|
|
character filename*(*)
|
|
|
|
include 'napif.inc'
|
|
|
|
integer fileid(NXhandlesize)
|
|
integer status, type, level, l, m, length, j, i
|
|
integer rank, dim(32)
|
|
integer*4 idata(64)
|
|
real*4 val
|
|
character cdata*80, name*257, class*257
|
|
|
|
external cvtyp, cvt_str
|
|
character*4 cvtyp
|
|
character tab*80/' '/
|
|
integer cvt_str
|
|
|
|
100 format(1x,10a)
|
|
|
|
level=0
|
|
call NXswitchReport(0)
|
|
status=NXopen(filename, NXacc_read, fileid)
|
|
if (status .ne. NX_ok) then
|
|
print *,filename,' is probably not a HDF file'
|
|
goto 999
|
|
endif
|
|
1 status=NXgetnextattr(fileid, name, length, type)
|
|
if (status .eq. NX_error) goto 999
|
|
if (status .eq. NX_ok) then
|
|
call str_trim(name,name,l)
|
|
length=256
|
|
status=NXgetattr(fileid, name(1:l), idata, length, type)
|
|
if (status .ne. NX_ok) goto 999
|
|
if (type .eq. nx_char .or.
|
|
1 type .eq. nx_uint8 .or. type .eq. nx_int8) then
|
|
length=cvt_str(cdata, idata)
|
|
elseif (type .eq. NX_INT32) then
|
|
length=12
|
|
write(cdata(1:12), '(i12)') idata(1)
|
|
else
|
|
length=4
|
|
cdata=cvtyp(type)
|
|
endif
|
|
write(*,100) tab(1:level*2+1)
|
|
1 ,'| ',name(1:l),':',cdata(1:length)
|
|
goto 1
|
|
endif
|
|
2 status=NXgetnextentry(fileid, name, class, type)
|
|
if (status .eq. NX_error) goto 999
|
|
if (status .eq. NX_ok) then
|
|
call str_trim(name, name, l)
|
|
call str_trim(class, class, m)
|
|
if (class .ne. 'SDS') then
|
|
write(*,100) tab(1:level*2+1)
|
|
1 ,'Group: ',name(1:l),', class:',class(1:m)
|
|
if (class(1:3) .ne. 'CDF') then
|
|
status=NXopengroup(fileid, name(1:l), class(1:m))
|
|
if (status .ne. NX_ok) goto 999
|
|
level=level+1
|
|
endif
|
|
goto 2
|
|
endif
|
|
status=NXopendata(fileid, name(1:l))
|
|
if (status .ne. NX_ok) goto 999
|
|
status=NXgetinfo(fileid, rank, dim, type)
|
|
if (status .ne. NX_ok .or. rank .gt. 16) goto 999
|
|
if (type .eq. nx_char .or.
|
|
& type .eq. nx_uint8 .or. type .eq. nx_int8) then
|
|
length=dim(1)
|
|
status=NXgetslab(fileid, idata, 1, length)
|
|
if (status .ne. NX_ok) goto 999
|
|
length=cvt_str(cdata, idata)
|
|
else
|
|
do i=1,rank
|
|
if (dim(i) .gt. 1 ) then
|
|
write(cdata,'(a,16i5)') ' array [',(dim(j),j=1,rank)
|
|
length=8+5*rank+6
|
|
cdata(length-5:length)='] '//cvtyp(type)
|
|
goto 29
|
|
endif
|
|
enddo
|
|
if (type .eq. NX_INT32) then
|
|
status=NXgetslab(fileid, idata, 1, 1)
|
|
if (status .ne. NX_ok) goto 999
|
|
length=12
|
|
write(cdata(1:12), '(i12)') idata(1)
|
|
elseif (type .eq. NX_FLOAT32) then
|
|
status=NXgetslab(fileid, val, 1, 1)
|
|
if (status .ne. NX_ok) goto 999
|
|
length=16
|
|
write(cdata(1:16), '(g16.5)') val
|
|
else
|
|
length=4
|
|
cdata=cvtyp(type)
|
|
endif
|
|
endif
|
|
29 write(*,100) tab(1:level*2+1)
|
|
1 ,name(1:l),':',cdata(1:length)
|
|
|
|
3 status=NXgetnextattr(fileid, name, length, type)
|
|
if (status .eq. NX_error) goto 999
|
|
if (status .eq. NX_ok) then
|
|
call str_trim(name,name,l)
|
|
|
|
length=256
|
|
status=NXgetattr(fileid, name(1:l), idata, length, type)
|
|
if (status .ne. NX_ok) goto 999
|
|
if (type .eq. nx_char .or.
|
|
1 type .eq. nx_uint8 .or. type .eq. nx_int8) then
|
|
length=cvt_str(cdata, idata)
|
|
elseif (type .eq. NX_INT32) then
|
|
length=12
|
|
write(cdata(1:12), '(i12)') idata(1)
|
|
else
|
|
length=4
|
|
cdata=cvtyp(type)
|
|
endif
|
|
write(*,100) tab(1:level*2+1)
|
|
1 ,'| ',name(1:l),':',cdata(1:length)
|
|
goto 3
|
|
endif
|
|
status=NXclosedata(fileid)
|
|
if (status .ne. NX_ok) goto 999
|
|
goto 2
|
|
endif
|
|
if (level .gt. 0) then
|
|
level=level-1
|
|
status=NXclosegroup(fileid)
|
|
if (status .ne. NX_ok) goto 999
|
|
goto 2
|
|
endif
|
|
9 status=NXclose(fileid)
|
|
if (status .ne. NX_ok) goto 999
|
|
print *,"o.k."
|
|
999 call nxlistreport
|
|
end
|
|
|
|
character*4 function cvtyp(type)
|
|
|
|
integer type
|
|
integer i
|
|
|
|
character*4 t(25)/3*' ','char','f32','f64',13*' ',
|
|
& 'i8','u8','i16','u16','i32','u32'/
|
|
|
|
if (type .le. 0 .or. type .gt. 25) then
|
|
do i=1,25
|
|
if (t(i) .eq. ' ') write(t(i),'(i2)') i
|
|
enddo
|
|
if (type .gt. 9999 .or. type .lt. 0) then
|
|
cvtyp='????'
|
|
else
|
|
write(cvtyp, '(i4)') type
|
|
endif
|
|
else
|
|
cvtyp=t(type)
|
|
endif
|
|
end
|
|
|
|
|
|
integer function cvt_str(cdata, idata)
|
|
|
|
character cdata*(*)
|
|
character str*257
|
|
byte idata(*)
|
|
|
|
integer l
|
|
|
|
call replace_string(str, idata)
|
|
call str_trim(str, str, l)
|
|
if (l+2 .gt. len(cdata)) then
|
|
cdata='"'//str(1:len(cdata)-5)//'..."'
|
|
cvt_str=len(cdata)
|
|
else
|
|
cdata='"'//str(1:l)//'"'
|
|
cvt_str=l+2
|
|
endif
|
|
end
|