/idl/heiles_all/goddard_jan2007/pro/database/dbwrt.pro
http://github.com/charleshull6/c_soft · IDL · 206 lines · 178 code · 28 blank · 0 comment · 47 complexity · fa82686d8e937737711c5ec6ed056bf6 MD5 · raw file
- pro dbwrt,entry,index,append,noconvert=noconvert
- ;+
- ; NAME:
- ; DBWRT
- ; PURPOSE:
- ; procedure to update or add a new entry to a data base
- ;
- ; CALLING SEQUENCE:
- ; dbwrt, entry, [ index, append, /NoConvert ]
- ;
- ; INPUTS:
- ; entry - entry record to be updated or added if first
- ; item (entry number=0)
- ;
- ; OPTIONAL INPUTS:
- ; index - optional integer flag, if set to non zero then index
- ; file is updated. (default=0, do not update index file)
- ; (Updating the index file is time-consuming, and should
- ; normally be done after all changes have been made.
- ; append - optional integer flag, if set to non-zero the record
- ; is appended as a new entry, regardless of what the
- ; entry number in the record is. The entry number will
- ; be reset to the next entry number in the file.
- ; OUTPUTS:
- ; data base file is updated.
- ; If index is non-zero then the index file is updated.
- ; OPTIONAL INPUT KEYWORD:
- ; NoConvert - If set then don't convert to host format with an external
- ; database. Useful when the calling program decides that
- ; conversion isn't needed (i.e. on a big-endian machine), or
- ; takes care of the conversion itself.
- ; OPERATIONAL NOTES:
- ; !PRIV must be greater than 1 to execute
- ; HISTORY:
- ; version 2 D. Lindler Feb. 1988 (new db format)
- ; converted to IDL Version 2. M. Greason, STX, June 1990.
- ; William Thompson, GSFC/CDS (ARC), 28 May 1994
- ; Added support for external (IEEE) representation.
- ; Converted to IDL V5.0 W. Landsman 24-Nov-1997
- ;-
- ;-------------------------------------------------------------------
- COMMON db_com,qdb,qitems,qdbrec
- if N_params() LT 2 then index=0
- if N_params() LT 3 then append=0
- ; Determine whether or not the database uses external data representation.
- external = (qdb[119] eq 1) and (not keyword_set(noconvert))
-
- ; get some info on the data base
- update = db_info( 'UPDATE' )
- if update EQ 0 then message,'Database opened for read only'
- len = db_info( 'LENGTH', 0 ) ;record length
- qnentry = db_info( 'ENTRIES', 0 )
- ; determine if entry is correct size
- s = size(entry)
- if s[0] NE 1 then message,'Entry must be a 1-dimensional array'
- if s[1] NE len then $
- message,'Entry not the proper length of '+strtrim(len,2)+' bytes'
- if s[2] NE 1 then $
- message,'Entry vector (first parameter) must be a byte array'
- ; get entry number
- if append then enum =0 else enum = dbxval(entry,3,1,0,4)
- if ( enum GT qnentry ) or ( enum LT 0 ) then $
- message,'Invalid entry number of '+strtrim(enum,2)+' (first value in entry)'
- if enum EQ 0 then begin ;add new entry
- qnentry = qnentry+1
- qdb[84] = byte(qnentry,0,4)
- enum = qnentry
- dbxput,long(enum),entry,3,0,4
- newentry = 1b
- endif else newentry =0b
- tmp = entry
- if external then db_ent2ext, tmp
- qdbrec[enum]=tmp
- ; update index file if necessary
- if index EQ 0 then return
- nitems = db_info( 'ITEMS', 0 ) ;Total number of items
- indextype = db_item_info( 'INDEX', indgen(nitems)) ;Which ones are indexed?
- indexed = where(indextype,nindex)
- if nindex LE 0 then return ;If no indexed items, then we are done
- indextype = indextype[indexed] ;Now contains only indexed items
- unit = db_info( 'UNIT_DBX', 0 )
- reclong = assoc(unit,lonarr(2),0)
- h = reclong[0]
- maxentries = h[1]
- if external then ieee_to_host, maxentries
- if newentry then $
- if (maxentries LT qnentry) then begin ;Enough room for new indexed items?
- print,'DBWRT -- maxentries too small'
- print,'Rerun DBCREATE with maxentries in .dbd file at least ',qnentry
- return
- endif
- reclong = assoc(unit,lonarr(7,nindex),8)
- header = reclong[0]
- if external then ieee_to_host,header
- hitem = header[0,*] ;indexed item number
- hblock = header[3,*]
- sblock = header[4,*] & sblock = sblock[*]
- iblock = header[5,*] & iblock = iblock[*]
- ublock = header[6,*] & ublock = ublock[*]
- db_item, indexed, itnum, ivalnum, idltype, startbyte, numvals, nbytes
- pos = where(hitem EQ itnum )
- for i = 0, nindex-1 do begin
- v = dbxval( entry, idltype[i], numvals[i], startbyte[i], nbytes[i] )
- sbyte = nbytes[i] * (enum-1)
- isort = (indextype[i] EQ 3) or (indextype[i] EQ 4)
- datarec = dbindex_blk(unit, sblock[pos[i]], 512, sbyte, idltype[i])
- reclong = assoc(unit,lonarr(1),(iblock[pos]*512L))
- case indextype[i] of
- 1: begin
- tmp = v
- if external then host_to_ieee, tmp
- datarec[0] = tmp
- end
- 2: begin
- tmp = v
- if external then host_to_ieee, tmp
- datarec[0] = tmp
- if (qnentry mod 512) EQ 0 then begin ;Update
- nb = qnentry/512
- hbyte = nbytes[i] * nb
- datarec = dbindex_blk(unit,hblock[pos[i]],512,hbyte,idltype[i])
- tmp = v
- if external then host_to_ieee, tmp
- datarec[0] = tmp
- endif
- end
- 3: begin ;SORT
- datarec = dbindex_blk(unit,sblock[pos[i]],512,0,idltype[i])
- values = datarec[0:(qnentry-1)] ;Read in old values
- if external then ieee_to_host, values
- reclong = dbindex_blk(unit,iblock[pos[i]],512,0,3)
- sub = reclong[0:(qnentry-1)] ;Read in old indices
- if external then ieee_to_host, sub
- if enum lt qnentry then begin ;Change an old value?
- sort_index = where(sub EQ enum) ;Which value to change
- sort_index = sort_index[0]
- if values[sort_index] EQ v $ ;Value remains the same so
- then isort =0 $ ;don't bother sorting again
- else values[sort_index] = v ;Update with new value
- endif else values = [values,v] ;Append a new value
- end
- 4: begin ;SORT/INDEX
- values = datarec[qnentry-1,ublock*512] ;Update index record
- if external then ieee_to_host, values
- if enum lt qnentry then begin
- if values[enum-1] EQ v then isort = 0 else values[enum-1] = v
- endif else values = [values,v]
- datarec = dbindex_blk(unit,ublock[pos[i]],512,sbyte,idltype[i])
- tmp = v
- if external then host_to_ieee, tmp
- datarec[0] = tmp
- end
- else:
- endcase
- if isort then begin ;resort values?
- sub = bsort(values)
- values = values[sub]
- nb = (qnentry + 511)/512
- ind = indgen(nb)*512L
- sval = values[ind]
- ;
- datarec = dbindex_blk(unit, hblock[pos[i]], 512, 0, idltype[i])
- tmp = sval
- if external then host_to_ieee, tmp
- datarec[0] = tmp
- ;
- datarec = dbindex_blk(unit, sblock[pos[i]], 512, 0, idltype[i])
- tmp = values
- if external then host_to_ieee, tmp
- datarec[0] = tmp
- ;
- reclong = dbindex_blk(unit, iblock[pos[i]], 512, 0, 3)
- tmp = sub+1
- if external then host_to_ieee, tmp
- reclong[0] = tmp
- endif
- endfor
- return
- end