/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

  1. pro dbwrt,entry,index,append,noconvert=noconvert
  2. ;+
  3. ; NAME:
  4. ; DBWRT
  5. ; PURPOSE:
  6. ; procedure to update or add a new entry to a data base
  7. ;
  8. ; CALLING SEQUENCE:
  9. ; dbwrt, entry, [ index, append, /NoConvert ]
  10. ;
  11. ; INPUTS:
  12. ; entry - entry record to be updated or added if first
  13. ; item (entry number=0)
  14. ;
  15. ; OPTIONAL INPUTS:
  16. ; index - optional integer flag, if set to non zero then index
  17. ; file is updated. (default=0, do not update index file)
  18. ; (Updating the index file is time-consuming, and should
  19. ; normally be done after all changes have been made.
  20. ; append - optional integer flag, if set to non-zero the record
  21. ; is appended as a new entry, regardless of what the
  22. ; entry number in the record is. The entry number will
  23. ; be reset to the next entry number in the file.
  24. ; OUTPUTS:
  25. ; data base file is updated.
  26. ; If index is non-zero then the index file is updated.
  27. ; OPTIONAL INPUT KEYWORD:
  28. ; NoConvert - If set then don't convert to host format with an external
  29. ; database. Useful when the calling program decides that
  30. ; conversion isn't needed (i.e. on a big-endian machine), or
  31. ; takes care of the conversion itself.
  32. ; OPERATIONAL NOTES:
  33. ; !PRIV must be greater than 1 to execute
  34. ; HISTORY:
  35. ; version 2 D. Lindler Feb. 1988 (new db format)
  36. ; converted to IDL Version 2. M. Greason, STX, June 1990.
  37. ; William Thompson, GSFC/CDS (ARC), 28 May 1994
  38. ; Added support for external (IEEE) representation.
  39. ; Converted to IDL V5.0 W. Landsman 24-Nov-1997
  40. ;-
  41. ;-------------------------------------------------------------------
  42. COMMON db_com,qdb,qitems,qdbrec
  43. if N_params() LT 2 then index=0
  44. if N_params() LT 3 then append=0
  45. ; Determine whether or not the database uses external data representation.
  46. external = (qdb[119] eq 1) and (not keyword_set(noconvert))
  47. ; get some info on the data base
  48. update = db_info( 'UPDATE' )
  49. if update EQ 0 then message,'Database opened for read only'
  50. len = db_info( 'LENGTH', 0 ) ;record length
  51. qnentry = db_info( 'ENTRIES', 0 )
  52. ; determine if entry is correct size
  53. s = size(entry)
  54. if s[0] NE 1 then message,'Entry must be a 1-dimensional array'
  55. if s[1] NE len then $
  56. message,'Entry not the proper length of '+strtrim(len,2)+' bytes'
  57. if s[2] NE 1 then $
  58. message,'Entry vector (first parameter) must be a byte array'
  59. ; get entry number
  60. if append then enum =0 else enum = dbxval(entry,3,1,0,4)
  61. if ( enum GT qnentry ) or ( enum LT 0 ) then $
  62. message,'Invalid entry number of '+strtrim(enum,2)+' (first value in entry)'
  63. if enum EQ 0 then begin ;add new entry
  64. qnentry = qnentry+1
  65. qdb[84] = byte(qnentry,0,4)
  66. enum = qnentry
  67. dbxput,long(enum),entry,3,0,4
  68. newentry = 1b
  69. endif else newentry =0b
  70. tmp = entry
  71. if external then db_ent2ext, tmp
  72. qdbrec[enum]=tmp
  73. ; update index file if necessary
  74. if index EQ 0 then return
  75. nitems = db_info( 'ITEMS', 0 ) ;Total number of items
  76. indextype = db_item_info( 'INDEX', indgen(nitems)) ;Which ones are indexed?
  77. indexed = where(indextype,nindex)
  78. if nindex LE 0 then return ;If no indexed items, then we are done
  79. indextype = indextype[indexed] ;Now contains only indexed items
  80. unit = db_info( 'UNIT_DBX', 0 )
  81. reclong = assoc(unit,lonarr(2),0)
  82. h = reclong[0]
  83. maxentries = h[1]
  84. if external then ieee_to_host, maxentries
  85. if newentry then $
  86. if (maxentries LT qnentry) then begin ;Enough room for new indexed items?
  87. print,'DBWRT -- maxentries too small'
  88. print,'Rerun DBCREATE with maxentries in .dbd file at least ',qnentry
  89. return
  90. endif
  91. reclong = assoc(unit,lonarr(7,nindex),8)
  92. header = reclong[0]
  93. if external then ieee_to_host,header
  94. hitem = header[0,*] ;indexed item number
  95. hblock = header[3,*]
  96. sblock = header[4,*] & sblock = sblock[*]
  97. iblock = header[5,*] & iblock = iblock[*]
  98. ublock = header[6,*] & ublock = ublock[*]
  99. db_item, indexed, itnum, ivalnum, idltype, startbyte, numvals, nbytes
  100. pos = where(hitem EQ itnum )
  101. for i = 0, nindex-1 do begin
  102. v = dbxval( entry, idltype[i], numvals[i], startbyte[i], nbytes[i] )
  103. sbyte = nbytes[i] * (enum-1)
  104. isort = (indextype[i] EQ 3) or (indextype[i] EQ 4)
  105. datarec = dbindex_blk(unit, sblock[pos[i]], 512, sbyte, idltype[i])
  106. reclong = assoc(unit,lonarr(1),(iblock[pos]*512L))
  107. case indextype[i] of
  108. 1: begin
  109. tmp = v
  110. if external then host_to_ieee, tmp
  111. datarec[0] = tmp
  112. end
  113. 2: begin
  114. tmp = v
  115. if external then host_to_ieee, tmp
  116. datarec[0] = tmp
  117. if (qnentry mod 512) EQ 0 then begin ;Update
  118. nb = qnentry/512
  119. hbyte = nbytes[i] * nb
  120. datarec = dbindex_blk(unit,hblock[pos[i]],512,hbyte,idltype[i])
  121. tmp = v
  122. if external then host_to_ieee, tmp
  123. datarec[0] = tmp
  124. endif
  125. end
  126. 3: begin ;SORT
  127. datarec = dbindex_blk(unit,sblock[pos[i]],512,0,idltype[i])
  128. values = datarec[0:(qnentry-1)] ;Read in old values
  129. if external then ieee_to_host, values
  130. reclong = dbindex_blk(unit,iblock[pos[i]],512,0,3)
  131. sub = reclong[0:(qnentry-1)] ;Read in old indices
  132. if external then ieee_to_host, sub
  133. if enum lt qnentry then begin ;Change an old value?
  134. sort_index = where(sub EQ enum) ;Which value to change
  135. sort_index = sort_index[0]
  136. if values[sort_index] EQ v $ ;Value remains the same so
  137. then isort =0 $ ;don't bother sorting again
  138. else values[sort_index] = v ;Update with new value
  139. endif else values = [values,v] ;Append a new value
  140. end
  141. 4: begin ;SORT/INDEX
  142. values = datarec[qnentry-1,ublock*512] ;Update index record
  143. if external then ieee_to_host, values
  144. if enum lt qnentry then begin
  145. if values[enum-1] EQ v then isort = 0 else values[enum-1] = v
  146. endif else values = [values,v]
  147. datarec = dbindex_blk(unit,ublock[pos[i]],512,sbyte,idltype[i])
  148. tmp = v
  149. if external then host_to_ieee, tmp
  150. datarec[0] = tmp
  151. end
  152. else:
  153. endcase
  154. if isort then begin ;resort values?
  155. sub = bsort(values)
  156. values = values[sub]
  157. nb = (qnentry + 511)/512
  158. ind = indgen(nb)*512L
  159. sval = values[ind]
  160. ;
  161. datarec = dbindex_blk(unit, hblock[pos[i]], 512, 0, idltype[i])
  162. tmp = sval
  163. if external then host_to_ieee, tmp
  164. datarec[0] = tmp
  165. ;
  166. datarec = dbindex_blk(unit, sblock[pos[i]], 512, 0, idltype[i])
  167. tmp = values
  168. if external then host_to_ieee, tmp
  169. datarec[0] = tmp
  170. ;
  171. reclong = dbindex_blk(unit, iblock[pos[i]], 512, 0, 3)
  172. tmp = sub+1
  173. if external then host_to_ieee, tmp
  174. reclong[0] = tmp
  175. endif
  176. endfor
  177. return
  178. end