c This file consists of two fortran 77 source files: hkf.f and pkhkf.fh c the next 803 lines are hkf.f C! module hkf C! Copyright (C) 1995, Garnatz and Grovender, Inc. C! C! Permission to distribute this software and its documentation within C! your department or organization, is granted only under the terms C! of our Software Licensing Agreement. A fee must be paid for use C! of this software. C! C! For a copy of the Software Licensing Agreement write to: C! C! Garnatz and Grovender, Inc. C! 5301 26th Avenue South C! Minneapolis Minnesota USA 55417-1923 C! C! This general terms of the Software Licensing Agreement provide for C! distribution of this software under what is generally called a C! "shareware" agreement. If you are using this software, you are C! requested to acquire a license to use it at one of the following C! 4 levels: C! C! INDIVIDUAL USE: C! level 0: 1 developer with source, on only 1 computer $45.00 C! MULTIPLE USE: C! level 1: 1 developer, and up to 10 runtime copies $120.00 C! level 2: up to 10 developers, and up to 100 runtime copies $350.00 C! level 3: unlimited developers, and unlimited runtime copies $2500.00 C! C! Upon payment and acceptance of the Software Licensing Agreement you C! will be entitled to many benefits, including 1) updates and bugfixes C! as needed, 2) complete documentation, 3) additional utility programs to C! inquire into the status of and repair damaged files, 4)access to fee-based C! consulting and other services. C! C! This software is provided as is and Garnatz and Grovender, Inc. disclaims C! all warranties with regard to this software, including all implied warranties C! of merchantability and fitness for a particular purpose. In no event C! shall Garnatz and Grovender, Inc. be liable for any special, indirect or C! consequential damages or any damages whatsoever resulting from loss of C! use, data or profits, whether in an action of contract, negligence or C! other tortious action, arising out of or in connection with the use or C! performance of this software. C! ------------- subroutine hk_file_create (name, unit, rsv1, err) include 'pkhkf.fh' character*(*) name integer unit integer err integer rsv1, rsv2 C integer ierr integer ival integer i integer pk_new_record_hkf C call pk_file_create_hkf (name, unit, rsv1, ierr) if(ierr .ne. 0) go to 99 C call pk_file_open_hkf (name, unit, 'write', rsv2, ierr) if(ierr .ne. 0) go to 99 do 10 i=1,max_hk pk_hkf_item_1(i) = ' ' pk_hkf_item_2(i) = ' ' 10 continue pk_hkf_item_3 = 0 pk_hkf_item_4 = 0 C do 20 i=1,rsv1 ival = pk_new_record_hkf (pk_hkf_item_1 & , pk_hkf_item_2, pk_hkf_item_3, pk_hkf_item_4 ,ierr) if((ival .ne. i) .or. (ierr .ne. 0)) then print*, ' hkf create error ',i,ival,ierr go to 99 end if 20 continue C 98 continue call pk_file_close_hkf (ierr) print*, 'pk_create initial write done ',ierr if(ierr .ne. 0) go to 99 err = ierr extended_error_hkf = ierr return 99 continue extended_error_hkf = ierr ierr = HKERR_FILE err = ierr end C! subroutine hk_file_open (name, unit, action, rsv1, err) include 'pkhkf.fh' character*(*) name integer unit character*(*) action integer rsv1 integer err C integer ierr hk_curr_rno = 0 call pk_file_open_hkf (name, unit, action, rsv1, ierr) if(ierr .ne. 0) go to 99 err = ierr extended_error_hkf = ierr return 99 continue extended_error_hkf = ierr err = HKERR_FILE end C subroutine hk_file_close (err) include 'pkhkf.fh' integer err C hk_curr_rno = 0 call pk_file_close_hkf (err) 99 continue if (err .ne. 0) err = HKERR_FILE end C end subroutine pk_file_close_hkf C subroutine hk_get_record (hk_key, hk_data, err) c include 'pkhkf.fh' character*(*) hk_key character*(*) hk_data integer err C character*(len1) data_item_1 dimension data_item_1(max_hk) character*(len2) data_item_2 dimension data_item_2(max_hk) integer number_good integer overfl_block common /hkf_char/ data_item_1, data_item_2 common /hkf_int/ number_good, overfl_block integer ierr integer ival integer pk_rno integer hk_hash integer hk_binary_search C ierr = 0 extended_error_hkf = 0 pk_rno = hk_hash(hk_key, pk_block_hkf_rsv3) 33 continue if(pk_rno .ne. hk_curr_rno) then call pk_get_record_hkf (pk_rno, data_item_1 & , data_item_2, number_good, overfl_block, err) if(err .ne. 0) go to 98 hk_curr_rno = pk_rno end if ival = hk_binary_search(hk_key, data_item_1, number_good) if (ival .gt. 0) then hk_data = data_item_2(ival) err = ierr return endif c follow link to next data block if(overfl_block .ne. 0) then pk_rno = overfl_block go to 33 end if ierr = HKERR_ILLREC go to 99 C 98 continue hk_curr_rno = 0 extended_error_hkf = ierr ierr = HKERR_FILE 99 continue err = ierr end C end subroutine hk_get_record C subroutine hk_put_new_record (hk_key, hk_data, err) include 'pkhkf.fh' character*(*) hk_key character*(*) hk_data integer err C character*(len1) data_item_1 dimension data_item_1(max_hk) character*(len2) data_item_2 dimension data_item_2(max_hk) integer number_good integer overfl_block common /hkf_char/ data_item_1, data_item_2 common /hkf_int/ number_good, overfl_block integer ierr integer ival integer i integer pk_rno integer ispace integer hk_hash integer hk_binary_search integer pk_new_record_hkf C c print*,' hk_put_record called ',hk_key ierr = 0 ispace = 0 extended_error_hkf = 0 pk_rno = hk_hash(hk_key, pk_block_hkf_rsv3) 33 continue if(pk_rno .ne. hk_curr_rno) then call pk_get_record_hkf (pk_rno, data_item_1 & , data_item_2, number_good, overfl_block, err) if(err .ne. 0) go to 98 hk_curr_rno = pk_rno end if if((ispace .eq. 0) .and. (number_good .lt. max_hk)) & ispace = pk_rno ival = hk_binary_search(hk_key, data_item_1, number_good) if (ival .gt. 0) then err = HKERR_ILLREC return endif c follow link to next data block if(overfl_block .ne. 0) then pk_rno = overfl_block go to 33 end if C ival = abs(ival) c print*,' put - search not found ',ival if(ival .eq. 0) then ival = 1 else if(hk_key .gt. data_item_1(ival)) then ival = ival + 1 end if c print*,' put - modified ival ',ival if((pk_rno .ne. ispace) .or. (number_good .ge. max_hk)) then if(ispace .ne. 0) then pk_rno = ispace c some space available in an earlier block if(pk_rno .ne. hk_curr_rno) then call pk_get_record_hkf (pk_rno, data_item_1 & , data_item_2, number_good, overfl_block, err) if(err .ne. 0) go to 98 hk_curr_rno = pk_rno c set position in old block ival = hk_binary_search(hk_key, data_item_1, & number_good) ival = abs(ival) if(ival .eq. 0) then ival = 1 else if(hk_key .gt. data_item_1(ival)) then ival = ival + 1 end if c some space available do 40 i=number_good,ival,-1 data_item_1(i+1) = data_item_1(i) data_item_2(i+1) = data_item_2(i) 40 continue number_good = number_good + 1 data_item_1(ival) = hk_key data_item_2(ival) = hk_data end if else c no space available - allocate new overflow block pk_hkf_item_1(1) = hk_key pk_hkf_item_2(1) = hk_data do 50 i=2,max_hk pk_hkf_item_1(i) = ' ' pk_hkf_item_2(i) = ' ' 50 continue pk_hkf_item_3 = 1 pk_hkf_item_4 = 0 C overfl_block = pk_new_record_hkf (pk_hkf_item_1 & , pk_hkf_item_2, pk_hkf_item_3, pk_hkf_item_4 ,ierr) C print*,' add overflow block -- ', C & hk_key,' ',overfl_block,ierr if(ierr .ne. 0) go to 98 end if else c some space available in current block do 60 i=number_good,ival,-1 data_item_1(i+1) = data_item_1(i) data_item_2(i+1) = data_item_2(i) 60 continue number_good = number_good + 1 data_item_1(ival) = hk_key data_item_2(ival) = hk_data end if C call pk_put_record_hkf (pk_rno, data_item_1 & , data_item_2 & , number_good & , overfl_block & , err) return 98 continue hk_curr_rno = 0 extended_error_hkf = ierr ierr = HKERR_FILE 99 continue err = ierr end C end subroutine hk_put_new_record C subroutine hk_delete_record (hk_key, err) include 'pkhkf.fh' character*(*) hk_key integer err C integer ierr character*(len1) data_item_1 dimension data_item_1(max_hk) character*(len2) data_item_2 dimension data_item_2(max_hk) integer number_good integer overfl_block common /hkf_char/ data_item_1, data_item_2 common /hkf_int/ number_good, overfl_block integer pk_rno integer hk_hash integer hk_binary_search integer i integer ival C ierr = 0 extended_error_hkf = 0 pk_rno = hk_hash(hk_key, pk_block_hkf_rsv3) 33 continue if(pk_rno .ne. hk_curr_rno) then call pk_get_record_hkf (pk_rno, data_item_1 & , data_item_2, number_good, overfl_block, err) if(err .ne. 0) go to 98 hk_curr_rno = pk_rno end if ival = hk_binary_search(hk_key, data_item_1, number_good) if (ival .gt. 0) then print*,' delete called',ival do 40 i=ival,number_good data_item_1(i) = data_item_1(i+1) data_item_2(i) = data_item_2(i+1) 40 continue number_good = number_good - 1 go to 50 endif c follow link to next data block if(overfl_block .ne. 0) then pk_rno = overfl_block go to 33 end if C 50 continue call pk_put_record_hkf (pk_rno, data_item_1 & , data_item_2 & , number_good & , overfl_block & , err) return 98 continue hk_curr_rno = 0 extended_error_hkf = ierr ierr = HKERR_FILE 99 continue err = ierr end C end subroutine hk_delete_record C integer function hk_binary_search & (hk_key, keys, nkeys) implicit integer(a-z) character*(*) hk_key dimension keys(nkeys) character*(*) keys C integer ival integer is integer ie C is = 1 ie = nkeys ival = 0 if(nkeys .eq. 0) go to 99 33 continue ival = (is+ie)/2 if(ie .le. is) go to 98 if(keys(ival) .eq. hk_key) go to 99 if(hk_key .gt. keys(ival)) then is = ival + 1 else ie = ival end if go to 33 c 98 continue if(keys(ival) .ne. hk_key) ival = -ival 99 continue hk_binary_search = ival end C block data com_ipri common /ipri/ ipri(0:7) data ipri /137, 71, 127, 131, 139, 149, 151, 157/ end C integer function hk_hash(hk_key, npr) implicit integer(a-z) character*(*) hk_key c common /ipri/ ipri(0:7) c integer trim_len c il = trim_len(hk_key) ih = 0 do 10 i=1,il iv = ichar(hk_key(i:i)) ih = ih + ipri(mod(i,8)) * (iv + i) 10 continue hk_hash = mod(ih, npr) + 1 end c end function hk_hash Cend module hk_file Cmodule pk_file_hkf C! ------------- subroutine pk_file_create_hkf (name, unit, rsv3, err) include 'pkhkf.fh' character*(*) name integer unit integer rsv3 integer err C! integer ierr integer unitu integer trim_len character*128 fname C! unitu = unit err = 0 ierr = 0 extended_error_hkf = 0 pk_block_hkf_name = name pk_block_hkf_copyrt = 'Copyright(c) Garnatz and Grovender, Inc.& & 1995.' pk_block_hkf_v_name = 'hk_file7' pk_block_hkf_v_num = 72 pk_block_hkf_num_recs = 0 pk_block_hkf_del_ptr = 0 pk_block_hkf_rec_len = lenf pk_block_hkf_num_indx = 0 pk_block_hkf_rsv1 = 0 pk_block_hkf_rsv2 = 0 pk_block_hkf_rsv3 = rsv3 pk_block_hkf_writable = .true. pk_block_hkf_unit = -1 pk_block_hkf_first_loc = Max (1, (lenhdr-1) /lenf+1) pk_block_hkf_hdr_len = lenhdr ierr = 0 fname = name(1: trim_len(name)) // '.hk' open (unit=unitu, file=fname, status='new', access='direct', & & recl=lenhdr, form='unformatted', iostat=ierr, err=98) write (unitu, iostat=ierr, rec=1, err=98) & pk_block_hkf_name, & pk_block_hkf_copyrt, & pk_block_hkf_v_name, & pk_block_hkf_v_num, & pk_block_hkf_num_recs, & pk_block_hkf_del_ptr, & pk_block_hkf_rec_len, & pk_block_hkf_num_indx, & pk_block_hkf_rsv1, & pk_block_hkf_rsv2, & pk_block_hkf_rsv3, & pk_block_hkf_writable, & pk_block_hkf_unit, & pk_block_hkf_first_loc, & pk_block_hkf_hdr_len close (unitu, iostat=ierr) go to 99 98 continue extended_error_hkf = ierr ierr = HKERR_FILE 99 continue err = ierr end C! subroutine pk_file_open_hkf (name, unit, action, rsv3, err) include 'pkhkf.fh' character*(*) name integer unit character*(*) action integer rsv3 integer err C integer ierr integer unitu character*128 fname character*9 my_action integer trim_len C extended_error_hkf = 0 C unitu = unit my_action = action C ierr = 0 err = 0 last_rno_hkf = 0 fname = name(1: trim_len(name)) // '.hk' open (unit=unitu, file=fname, status='old', access='direct', & recl=lenhdr, form='unformatted', & iostat=ierr, err=98) if (ierr .ne. 0) go to 98 read (unit=unitu, rec=1, iostat=ierr, err=98) & pk_block_hkf_name, & pk_block_hkf_copyrt, & pk_block_hkf_v_name, & pk_block_hkf_v_num, & pk_block_hkf_num_recs, & pk_block_hkf_del_ptr, & pk_block_hkf_rec_len, & pk_block_hkf_num_indx, & pk_block_hkf_rsv1, & pk_block_hkf_rsv2, & pk_block_hkf_rsv3, & pk_block_hkf_writable, & pk_block_hkf_unit, & pk_block_hkf_first_loc, & pk_block_hkf_hdr_len pk_block_hkf_unit = unitu pk_block_hkf_name = fname pk_block_hkf_writable = .true. if(my_action .eq. 'read') then pk_block_hkf_writable = .false. end if rsv3 = pk_block_hkf_rsv3 close (unit=unitu, iostat=ierr, err=98) if (ierr .ne. 0) go to 98 C! open data file C !print*, ' open data file ', pk_block_hkf_rec_len open (unit=unitu, file=fname, access='direct', & recl=pk_block_hkf_rec_len, form='unformatted', & iostat=ierr, err=98) err = ierr return 98 continue extended_error_hkf = ierr err = HKERR_FILE return end C end function pk_file_open_hkf C! subroutine pk_file_close_hkf (err) include 'pkhkf.fh' integer err C integer ierr integer unitu character*128 fname C extended_error_hkf = 0 ierr = 0 if (pk_block_hkf_unit .le. 0) then ierr = HKERR_ILLREC go to 97 end if C! close data file close (unit=pk_block_hkf_unit, iostat=ierr, err=99) C! open, update, and close control file if( .not. pk_block_hkf_writable) then return end if fname = pk_block_hkf_name open (unit=pk_block_hkf_unit, file=fname, status='old', & recl=pk_block_hkf_hdr_len, access='direct', & form='unformatted', & iostat=ierr, err=99) c &', action='readwrite', iostat=ierr, err=99) if (ierr .ne. 0) go to 99 unitu = pk_block_hkf_unit pk_block_hkf_unit = -1 write (unit=unitu, rec=1, iostat=ierr, err=99) & pk_block_hkf_name, & pk_block_hkf_copyrt, & pk_block_hkf_v_name, & pk_block_hkf_v_num, & pk_block_hkf_num_recs, & pk_block_hkf_del_ptr, & pk_block_hkf_rec_len, & pk_block_hkf_num_indx, & pk_block_hkf_rsv1, & pk_block_hkf_rsv2, & pk_block_hkf_rsv3, & pk_block_hkf_writable, & pk_block_hkf_unit, & pk_block_hkf_first_loc, & pk_block_hkf_hdr_len close (unit=unitu, iostat=ierr, err=99) 97 continue err = ierr return 99 continue extended_error_hkf = ierr err = HKERR_FILE end C end subroutine pk_file_close_hkf C subroutine pk_get_record_hkf (pk_rno, data_item_1 c & , data_item_2, err) c & , data_item_2, data_item_3, err) & , data_item_2, data_item_3, data_item_4, err) c include 'pkhkf.fh' integer pk_rno character*(*) data_item_1 character*(*) data_item_2 dimension data_item_1(max_hk) dimension data_item_2(max_hk) integer data_item_3 integer data_item_4 integer err C integer ierr C ierr = 0 extended_error_hkf = 0 last_rno_hkf = 0 if ((pk_rno .le. 0) .or. & (pk_rno .gt. pk_block_hkf_num_recs)) then ierr = HKERR_ILLREC go to 99 end if read (unit=pk_block_hkf_unit, & rec=pk_rno+pk_block_hkf_first_loc, iostat=ierr, err=98) & v_d_flag_hkf, & data_item_1 & , data_item_2 & , data_item_3 & , data_item_4 c if (v_d_flag_hkf .ne. -1) then ierr = HKERR_ILLREC go to 99 end if last_rno_hkf = pk_rno go to 99 98 continue extended_error_hkf = ierr ierr = HKERR_FILE 99 continue err = ierr end C end subroutine pk_get_record_hkf C subroutine pk_put_record_hkf (pk_rno, data_item_1 & , data_item_2 & , data_item_3 & , data_item_4 & , err) include 'pkhkf.fh' integer pk_rno character*(*) data_item_1 character*(*) data_item_2 dimension data_item_1(max_hk) dimension data_item_2(max_hk) integer data_item_3 integer data_item_4 integer err C integer ierr C ierr = 0 extended_error_hkf = 0 if ((pk_rno .le. 0) .or. & (pk_rno .gt. pk_block_hkf_num_recs)) then ierr = HKERR_ILLREC go to 99 end if if (last_rno_hkf .ne. pk_rno) then read (unit=pk_block_hkf_unit, & rec=pk_rno+pk_block_hkf_first_loc, iostat=ierr, err=98) & v_d_flag_hkf if (v_d_flag_hkf .ne. -1) then ierr = HKERR_ILLREC last_rno_hkf = 0 go to 99 end if end if write (unit=pk_block_hkf_unit, & rec = pk_rno+pk_block_hkf_first_loc, iostat=ierr, err=98) & v_d_flag_hkf, & data_item_1 & , data_item_2 & , data_item_3 & , data_item_4 go to 99 98 continue extended_error_hkf = ierr ierr = HKERR_FILE 99 continue err = ierr end C end subroutine pk_put_record_hkf C! integer function pk_new_record_hkf (data_item_1 c & , data_item_2, err) C & , err) C & , data_item_2, data_item_3, err) & , data_item_2, data_item_3, data_item_4 ,err) include 'pkhkf.fh' character*(*) data_item_1 character*(*) data_item_2 dimension data_item_1(max_hk) dimension data_item_2(max_hk) integer data_item_3 integer data_item_4 integer err C integer rno integer ierr C ierr = 0 extended_error_hkf = 0 last_rno_hkf = 0 if (pk_block_hkf_del_ptr .gt. 0) then rno = pk_block_hkf_del_ptr read (unit=pk_block_hkf_unit, rec= & rno+pk_block_hkf_first_loc, iostat=ierr, err=99) & v_d_flag_hkf, & pk_hkf_item_1 & , pk_hkf_item_2 & , pk_hkf_item_3 & , pk_hkf_item_4 if (ierr .ne. 0) then rno = -1 go to 99 end if pk_block_hkf_del_ptr = v_d_flag_hkf else pk_block_hkf_num_recs = pk_block_hkf_num_recs + 1 rno = pk_block_hkf_num_recs end if C v_d_flag_hkf = -1 write (unit=pk_block_hkf_unit, & rec=rno+pk_block_hkf_first_loc, iostat=ierr, err=99) & v_d_flag_hkf, & data_item_1 & , data_item_2 & , data_item_3 & , data_item_4 C err = ierr pk_new_record_hkf = rno return 99 continue extended_error_hkf = ierr err = HKERR_FILE pk_new_record_hkf = rno end C end function pk_new_record_hkf C! subroutine pk_delete_record_hkf (pk_rno, err) include 'pkhkf.fh' integer pk_rno integer err C integer ierr C ierr = 0 last_rno_hkf = 0 call pk_get_record_hkf (pk_rno, & pk_hkf_item_1, pk_hkf_item_2, & pk_hkf_item_3, pk_hkf_item_4, & ierr) if (ierr .ne. 0) go to 99 v_d_flag_hkf = pk_block_hkf_del_ptr pk_block_hkf_del_ptr = pk_rno C write (unit=pk_block_hkf_unit, rec= & pk_rno+pk_block_hkf_first_loc, iostat=ierr, err=99) & v_d_flag_hkf err = ierr return 99 continue extended_error_hkf = ierr err = HKERR_FILE end C end subroutine pk_delete_record_hkf C! integer function ext_err_hkf() include 'pkhkf.fh' ext_err_hkf = extended_error_hkf end C end function ext_err_hkf C! integer function trim_len(ch) character*(*) ch l = len(ch) do 120 i=l,1,-1 if(ch(i:i) .ne. ' ') then trim_len = i return end if 120 continue trim_len = 0 end c end of hkf.f c start of pkhkf.fh the next 134 lines Cfile: pkhkf.fh C! ------------ C! Copyright (C) 1995, Garnatz and Grovender, Inc. C! C! Permission to distribute this software and its documentation within C! your department or organization, is granted only under the terms C! of our Software Licensing Agreement. A fee must be paid for use C! of this software. C! C! For a copy of the Software Licensing Agreement write to: C! C! Garnatz and Grovender, Inc. C! 5301 26th Avenue South C! Minneapolis Minnesota USA 55417-1923 C! C! This general terms of the Software Licensing Agreement provide for C! distribution of this software under what is generally called a C! "shareware" agreement. If you are using this software, you are C! requested to acquire a license to use it at one of the following C! 4 levels: C! C! INDIVIDUAL USE: C! level 0: 1 developer with source, on only 1 computer $45.00 C! MULTIPLE USE: C! level 1: 1 developer, and up to 10 runtime copies $120.00 C! level 2: up to 10 developers, and up to 100 runtime copies $350.00 C! level 3: unlimited developers, and unlimited runtime copies $2500.00 C! C! Upon payment and acceptance of the Software Licensing Agreement you C! will be entitled to many benefits, including 1) updates and bugfixes C! as needed, 2) complete documentation, 3) additional utility programs to C! inquire into the status of and repair damaged files, 4)access to fee-based C! consulting and other services. C! C! This software is provided as is and Garnatz and Grovender, Inc. disclaims C! all warranties with regard to this software, including all implied warranties C! of merchantability and fitness for a particular purpose. In no event C! shall Garnatz and Grovender, Inc. be liable for any special, indirect or C! consequential damages or any damages whatsoever resulting from loss of C! use, data or profits, whether in an action of contract, negligence or C! other tortious action, arising out of or in connection with the use or C! performance of this software. C! ------------- implicit none integer v_d_flag_hkf integer last_rno_hkf integer extended_error_hkf integer hk_curr_rno common /pk_record_hkf_key_int/ v_d_flag_hkf & , last_rno_hkf & , extended_error_hkf & , hk_curr_rno integer max_hk parameter (max_hk=16) C! C! Customize this file by globally replacing '_KEY' with '_yourstring' C! identifier and entering your key and data fields below. C ! your data goes here integer len1 parameter (len1=8) character*(len1) pk_hkf_item_1 dimension pk_hkf_item_1(max_hk) integer len2 parameter (len2=120) character*(len2) pk_hkf_item_2 dimension pk_hkf_item_2(max_hk) C integer pk_hkf_item_3 integer pk_hkf_item_4 C common /pk_record_hkf_items/ & pk_hkf_item_1 & ,pk_hkf_item_2 common /pk_record_hkf_ints/ & pk_hkf_item_3 & ,pk_hkf_item_4 C c! also customize by calculating the length of the header and the c! data records. integer sizeof_int parameter(sizeof_int=4) C! data record length is keylen+max_hk*(len1+len2)+3*sizeof(integer) integer lenf c parameter(lenf=132) parameter(lenf=(len1+len2)*max_hk+sizeof_int*3) C! header record length is 128+128+8+12*sizeof(integer) integer lenhdr c parameter(lenhdr=264+12*4) parameter(lenhdr=264+12*sizeof_int) c character*128 pk_block_hkf_name character*128 pk_block_hkf_copyrt character*8 pk_block_hkf_v_name C common /pk_header_hkf/ pk_block_hkf_name, & pk_block_hkf_copyrt, & pk_block_hkf_v_name C integer pk_block_hkf_v_num integer pk_block_hkf_num_recs integer pk_block_hkf_del_ptr integer pk_block_hkf_rec_len integer pk_block_hkf_num_indx integer pk_block_hkf_rsv1 integer pk_block_hkf_rsv2 integer pk_block_hkf_rsv3 logical pk_block_hkf_writable integer pk_block_hkf_unit integer pk_block_hkf_first_loc integer pk_block_hkf_hdr_len C common /pk_header_hkf_int/ & pk_block_hkf_v_num, & pk_block_hkf_num_recs, & pk_block_hkf_del_ptr, & pk_block_hkf_rec_len, & pk_block_hkf_num_indx, & pk_block_hkf_rsv1, & pk_block_hkf_rsv2, & pk_block_hkf_rsv3, & pk_block_hkf_writable, & pk_block_hkf_unit, & pk_block_hkf_first_loc, & pk_block_hkf_hdr_len C! integer HKERR_ILLREC integer HKERR_FILE integer HKERR_MEM integer HKERR_NOFILE C! parameter ( HKERR_ILLREC = -11 ) parameter ( HKERR_FILE = -12 ) parameter ( HKERR_MEM = -13 ) parameter ( HKERR_NOFILE = -14 ) C! c end of pkhkf.fh