dbcreate.pro

basic median filter simulation

                        else: message,'Invalid data type "'+ item_type+ $
                                       '" specified',/IOERROR
                endcase
                format[nitems]=ff                       ;default print format
                headers[1,nitems]=names[nitems] ;default print header
                type[nitems]=idltype            ;idl data type for item
                nbytes[nitems]=nb               ;number of bytes for item
                sbyte[nitems]=nextbyte          ;position in record for item
                nextbyte=nextbyte+nb*numvals[nitems] ;next byte position
                nitems=nitems+1
                end

        'FORMATS': begin
;
;                process strings in form:
;                       <item name> <format> <header1>,<header2>,<header3>
;
                item_name=" "
                item_name=strupcase(gettok(st,' '))
                item_no=0
                while item_no lt nitems do begin
                        if strtrim(names[item_no]) eq item_name then begin
                                st = strtrim(st, 1)
                                format[item_no]=gettok(st,' ')
                                if strtrim(st,2) ne '' then begin
                                        st = strtrim(st, 1)
                                        headers[0,item_no]=gettok(st,',')
                                        headers[1,item_no]=gettok(st,',')
                                        headers[2,item_no]=strtrim(st)
                                endif
                        endif
                        item_no=item_no+1
                endwhile
                end

        'POINTERS': begin
;
;               process record in form:
;                       <item name> <data base name>
;
                item_name=strupcase(gettok(st,' '))
                item_no=0
                while item_no lt nitems do begin
                        if strtrim(names[item_no]) eq item_name then $
                                pointers[item_no]=strupcase(strtrim(st, 1))
                        item_no=item_no+1
                endwhile
                endcase

        'INDEX': begin
;
;               process record of type:
;               <item name> <index type>
;
                item_name=strupcase(gettok(st,' '))
                st = strtrim(st, 1)
                indextype=gettok(st,' ')
                item_no=0
                while item_no lt nitems do begin
                        if strtrim(names[item_no]) eq item_name then begin
                            case strupcase(indextype) of
                                'INDEX' : index[item_no]=1
                                'SORTED': index[item_no]=2
                                'SORT'  : index[item_no]=3
                                'SORT/INDEX' : index[item_no]=4
                                else    : message,'Invalid index type',/IOERROR
                            endcase
                        endif
                        item_no=item_no+1
                endwhile
                end
        else : begin
                print,'DBCREATE-- invalid block specfication of ',block
                print,'   Valid values are #TITLE, #ITEMS, #FORMATS, #INDEX,'
                print,'   #MAXENTRIES or #POINTERS'
               end
        endcase
next:
endwhile; loop on records
;
; create data base descriptor record --------------------------------------
;
;       byte array of 120 values
;
;       bytes
;         0-18   data base name character*19
;         19-79  data base title character*61
;         80-81  number of items (integer*2)
;         82-83  record length of DBF file (integer*2)
;         84-118 values filled in by DBOPEN
;         119    equals 1 if keyword EXTERNAL is true.
;
totbytes=((nextbyte+3)/4*4)  ;make record length a multiple of 4
drec = bytarr(120)
drec[0:79]=32b                      ;blanks
drec[0] = byte(strupcase(filename))
drec[19] = byte(title)
drec[80] = byte(fix(nitems),0,2)
drec[82] = byte(fix(totbytes),0,2)
drec[119] = byte(extern)
;
; create item description records
;
;  irec(*,i) contains decription of item number i with following
;  byte assignments:
;       0-19    item name (character*20)
;       20-21   IDL data type (integet*2)
;       22-23   Number of values for item (1 for scalar) (integer*2)
;       24-25   Starting byte position i record (integer*2)
;       26-27   Number of bytes per data value (integer*2)
;       28      Index type
;       29-97   Item description
;       98-99   Field length of the print format
;       100     Pointer flag
;       101-119 Data base this item points to
;       120-125 Print format
;       126-170 Print headers
;       171-199 Added by DBOPEN
irec=bytarr(200,nitems)
rec=bytarr(200)
headers = strmid(headers,0,15)       ;Added 15-Sep-92
for i=0,nitems-1 do begin
        rec[0:19]=32b  &  rec[101:170]=32b    ;Default string values are blanks
        rec[29:87] = 32b
        rec[0]  = byte(names[i])
        rec[20] = byte(type[i],0,2)
        rec[22] = byte(numvals[i],0,2)
        rec[24] = byte(sbyte[i],0,2)
        rec[26] = byte(nbytes[i],0,2)
        rec[28] = index[i]
        rec[29] = byte(desc[i])
        if strtrim(pointers[i]) ne '' then rec[100]=1 else rec[100]=0
        rec[101]= byte(strupcase(pointers[i]))
        rec[120]= byte(format[i])
        ff=strtrim(format[i])
        flen=fix(gettok(strmid(ff,1,strlen(ff)-1),'.'))
        rec[98] = byte(flen,0,2)
        rec[126]= byte(headers[0,i]) > 32b    ;Modified Nov-91
        rec[141]= byte(headers[1,i]) > 32b
        rec[156]= byte(headers[2,i]) > 32b
        irec[0,i]=rec
end
;
; Make sure user is on ZDBASE and write description file
;
 close,unit
 openw,unit,zdir + filename+'.dbh'
   
On_ioerror, NULL 
if extern then begin
        tmp = fix(drec,80,1) & host_to_ieee,tmp & drec[80] = byte(tmp,0,2)
        tmp = fix(drec,82,1) & host_to_ieee,tmp & drec[82] = byte(tmp,0,2)
;
        tmp = fix(irec[20:27,*],0,4,nitems)
        host_to_ieee,tmp
        irec[20,0] = byte(tmp,0,8,nitems)
;
        tmp = fix(irec[98:99,*],0,1,nitems)
        host_to_ieee,tmp
        irec[98,0] = byte(tmp,0,2,nitems)
;
        tmp = fix(irec[171:178,*],0,4,nitems)
        host_to_ieee,tmp
        irec[171,0] = byte(tmp,0,8,nitems)
endif
writeu, unit, drec
writeu, unit, irec
;
; if new data base create .dbf and .dbx files -----------------------------
;

if newdb then begin
    close,unit
    openw, unit, zdir + filename+'.dbf'
    header = bytarr(totbytes)
    p = assoc(unit,header)
    p[0] = header
end

;
; determine if any indexed items
;
nindex = total(index GT 0)
;
; create empty index file if needed
;
if (nindex GT 0) and (newindex) then begin
        indexed = where(index GT 0)
;
; create header array
;       header=intarr(7,nindex)
;               header(i,*) contains values
;               i=0     item number
;               i=1     index type
;               i=2     idl data type for the item
;               i=3     starting block for header
;               i=4     starting block for data
;               i=5     starting block for indices (type 3)
;               i=6     starting block for unsorted data (type 4)
;
        nb = (maxentries+511)/512       ;number of 512 value groups
        nextblock = 1
        header = lonarr(7,nindex)
        for ii = 0, nindex-1 do begin
                item = indexed[ii]
                header[0,ii] = item
                header[1,ii] = index[item]
                header[2,ii] = type[item]
                data_blocks = nbytes[item]*nb
                if index[item] NE 1 $
                             then header_blocks = (nbytes[item]*nb+511)/512 $
                             else header_blocks = 0
                if (index[item] eq 3) or (index[item] EQ 4) then $
                                 index_blocks=(4*nb) else index_blocks=0
                if index[item] EQ 4 then unsort_blocks = data_blocks else $
                                                        unsort_blocks=0
                header[3,ii] = nextblock
                header[4,ii] = nextblock+header_blocks
                header[5,ii] = header[4,ii]+data_blocks
                header[6,ii] = header[5,ii]+index_blocks
                nextblock = header[6,ii]+unsort_blocks
        end
        totblocks = nextblock
        close, unit
        openw, unit, zdir + filename+'.dbx'
;
        p = assoc(unit,lonarr(2))
        tmp = [long(nindex),maxentries]
        if extern then host_to_ieee, tmp
        p[0] = tmp
;
        p = assoc(unit,lonarr(7,nindex),8)
        tmp = header
        if extern then host_to_ieee, tmp
        p[0] = tmp
endif
free_lun, unit
return
;
BAD_IO: free_lun,unit
print, !ERROR_STATE.MSG_PREFIX + !ERROR_STATE.MSG
print, !ERROR_STATE.MSG_PREFIX + !ERROR_STATE.SYS_mSG

return
;
end