        !COMPILER-GENERATED INTERFACE MODULE: Fri May 22 16:58:24 2020
        ! This source file is for reference only and may not completely
        ! represent the generated interface used by the compiler.
        MODULE LUBKSB__genmod
          INTERFACE
            SUBROUTINE LUBKSB(A,I_MIN,N,INDX,B,M)
              INTEGER(KIND=4), INTENT(IN) :: M
              INTEGER(KIND=4), INTENT(IN) :: N
              INTEGER(KIND=4), INTENT(IN) :: I_MIN
              REAL(KIND=8), INTENT(IN) :: A(I_MIN:N,I_MIN:N)
              INTEGER(KIND=4), INTENT(IN) :: INDX(I_MIN:N)
              REAL(KIND=8), INTENT(INOUT) :: B(I_MIN:N,I_MIN:M)
            END SUBROUTINE LUBKSB
          END INTERFACE
        END MODULE LUBKSB__genmod


text:
! wind_event_lib.for - portion of wind_lib refering to event getting
!
!------------------------------------------------------------------------------
!------------------------------------------------------------------------------
! Event Retrieval routines
!------------------------------------------------------------------------------
!------------------------------------------------------------------------------
!------------------------------------------------------------------------------
	integer*4	function	w_event(ch,event)
! This is a convenience routine for application programs that move
! strictly forward in a stream gathering successive events.
! Eventually wind_tm_get_event is called to extract the event from the stream.
	implicit	none
	include		'wind_tm_user_def.for'
	include		'wind_extra_info_def.for'
	include		'wind_return_code_def.for'

	integer*4	ch				! TM channel number
	character*(*)	event				! event type

$IF ABSOFT_FORTRAN
	character*(*)	rn,rn2
	parameter	(rn='W_EVENT')			! name of this routine
	parameter	(rn2='W_CHANNEL_POSITION')	! name of this routine
$ELSE
	parameter	rn='W_EVENT'			! name of this routine
	parameter	rn2='W_CHANNEL_POSITION'	! name of this routine
$ENDIF
	integer*4	wind_tm_get_next_event		! a function
	integer*4	ios
	integer*4	ok, ok2
	integer*4	mjr,mnr
	structure /saved_context/
	   integer*4	mjr
	   integer*4	mnr
	   integer*4	n_opens
	end structure
	record /saved_context/ scxt(max_channels)
	integer*4	wind_tm_mfmf_to_scet		! a function
	integer*4	wind_tm_scet_to_mfmf		! a function
$IF ABSOFT_FORTRAN
	integer*4	o
$ELSE
	integer*4	i,o
$ENDIF
	integer*4	w_channel_position		! an entry point
	integer*4	w_status			! an entry point
	integer*4	last_status(max_channels)
	real*8		t
	real*8		r8
	character*256	f
	logical*4	loop
	integer*4	loop_count
	integer*4	return_code
	integer*4	w_channel_reopen
	integer*4	w_ur8_to_x_filename

	w_event = 0

	if (ch .lt. 1 .or. ch .gt. max_channels) goto 90

	if (scxt(ch).n_opens .ne. user(ch).n_file_opens) then
	   scxt(ch).mjr = user(ch).first_major
	   scxt(ch).mnr = user(ch).first_minor.i4val
	   scxt(ch).n_opens = user(ch).n_file_opens
	end if

	ok = 0
	do while(ok .ne. 1)
	   ok = wind_tm_get_next_event(
	1	ch,
	1	scxt(ch).mjr,
	1	scxt(ch).mnr,
	1	event)
	   last_status(ch) = ok
	   if (ok .eq. w_end_of_file) then
	      w_event = ok
	      return
	   else if (ok .ne. 1) then
	      write(6,2,iostat=o) 'skipping bad/partial event'
	   end if
	end do
	w_event = ok

	! synchronize the MF.mf position with a UR8 time value
	if (ok .eq. 1) then
	   exi(ch).ur8_position = exi(ch).ur8_eoe
	else
	   ok2 = wind_tm_mfmf_to_scet(ch,scxt(ch).mjr,scxt(ch).mnr,r8)
	   if (ok2 .ne. 1) then
	      if (ok .ne. w_end_of_file) goto 92
	      ! coerce r8 to eof time
	      mjr = user(ch).last_major
	      mnr = user(ch).last_minor.i4val
	      ok = wind_tm_mfmf_to_scet(ch,mjr,mnr,r8)
	   end if
	   exi(ch).ur8_position = r8
	end if

	return
  2	format(1x,'W_EVENT: ',a)
  9	format(1x,a,':',1x,a)
 90	write(6,9,iostat=ios) rn, 'invalid channel number.'
	w_event = w_bad_channel
	return
 92	continue
	w_event = ok
	if (user(ch).suppress_messages) return
	write(6,9,iostat=ios) rn, 'error synching MF.mf to UR8 time'
	return

	!----------------------------------------------------------------------
	entry	w_status(ch)
	if (ch .lt. 1 .or. ch .gt. max_channels) goto 200
	w_status = last_status(ch)
	return
 200	write(6,9,iostat=ios) 'W_STATUS', 'invalid channel number.'
	! this is ambiguous, can also be last return code from w_event
	w_status = w_bad_channel
	return

	!----------------------------------------------------------------------
	entry	w_channel_position(ch, t)

	if (ch .lt. 1 .or. ch .gt. max_channels) goto 10

	exi(ch).ur8_context  = t	! ...allows independent cdf access

	return_code = 1
	loop_count = 0
 1000	continue
	loop = .false.
	loop_count = loop_count + 1
	if (t .eq. 0.0 .or. t .eq. exi(ch).stream_bod) then
	   !
	   ! goto earliest position in current file
	   !
	   mjr = user(ch).first_major
	   mnr = user(ch).first_minor.i4val
	   ok = wind_tm_mfmf_to_scet(ch,mjr,mnr,t)
	   if (ok .eq. w_bad_rec_quality_flag) then
	      ! error already reported, allow user to position on bad record
	      ! may eventually want to advance to valid data...no, w_event()
	      ! will do that...
	   else if (ok .ne. 1) then
	      goto 20
	   end if
	   ! ...don't let context time goto zero
	   if (exi(ch).ur8_context .eq. 0.0d0)
	1     exi(ch).ur8_context = exi(ch).stream_bod
	   !
	else if (t .eq. -1.0) then
	   !
	   ! goto latest position in current file
	   !
	   mjr = user(ch).last_major
	   mnr = user(ch).last_minor.i4val
	   ok = wind_tm_mfmf_to_scet(ch,mjr,mnr,t)
	   if (ok .eq. w_bad_rec_quality_flag) then
	      ! error already reported, allow user to position on bad record
	      ! may eventually want to advance to valid data...no, w_event()
	      ! will do that...
	   else if (ok .ne. 1) then
	      goto 50
	   end if
	   ! ...don't let context time goto -1
	   if (exi(ch).ur8_context .eq. -1.0d0)
	1     exi(ch).ur8_context = exi(ch).stream_bod + 1.0
	   !
$IF ABSOFT_FORTRAN
	else if (t .ge. exi(ch).stream_boi .and. t .le.
	1	exi(ch).stream_eoi) then
$ELSE
	else if (t .ge. exi(ch).stream_boi .and. t .le. exi(ch).stream_eoi) then
$ENDIF
	   !
	   ! goto position within current file
	   !
	   ok = wind_tm_scet_to_mfmf(ch,mjr,mnr,t)
	   if (ok .ne. 1) goto 30
	   !
	else if (t .gt. exi(ch).stream_bod .and.
	1        t .lt. exi(ch).stream_boi) then
	   ! in a gap between beginning of day and beginning of info
	   t = 0.0
	   loop = .true.
	else if (t .gt. exi(ch).stream_eoi .and.
	1        t .le. exi(ch).stream_eod) then
	   ! in a gap between end of info and end of day
	   t = exi(ch).stream_bod + 1.0
	   loop = .true.
	else if (t .ge. exi(ch).stream_bow .and.
	1        t .le. exi(ch).stream_eow) then
	   !
	   ! within the defined window, go to a new file
	   !
	   ok = w_ur8_to_x_filename(t, cdhf_lz_stream, f)
	   if (ok .ne. 1) goto 40
	   ok = w_channel_reopen(ch, f)
	   if (ok .ne. 1) goto 44
	   loop = .true.
	else
	   ! assume the caller is only interested in changing the context
	   if (t .gt. exi(ch).stream_eow) then
	      t = -1.0
	      loop = .true.
	      return_code = w_end_of_file
	      call w_msg_put(ch,rn2,': time is after end of window')
	   else if (t .lt. exi(ch).stream_bow) then
	      t = 0.0
	      loop = .true.
	      return_code = w_beginning_of_file
	      call w_msg_put(ch,rn2,': time is before beginning of window')
	   else
	      return_code = 0
	   end if
	end if

	if (loop_count .gt. 3) goto 46
	if (loop) goto 1000

	scxt(ch).mjr = mjr
	scxt(ch).mnr = mnr
	exi(ch).ur8_position = t
	if (scxt(ch).n_opens .ne. user(ch).n_file_opens) then
	   scxt(ch).n_opens = user(ch).n_file_opens
	end if

	w_channel_position = return_code
	return
  1	format(1x,'W_CHANNEL_POSITION: ', a, :, f16.10)
 10	write(6,1,iostat=ios) 'invalid channel number.'
	w_channel_position = w_bad_channel
	return
 20	w_channel_position = ok
	if (user(ch).suppress_messages) return
	write(6,1,iostat=ios) 'Cannot get record at beginning of file.'
	return
 30	w_channel_position = ok
	if (user(ch).suppress_messages) return
	write(6,1,iostat=ios) 'Cannot get record at UR8 time: ', t
	return
 40	w_channel_position = ok
	if (user(ch).suppress_messages) return
	write(6,1,iostat=ios) 'Cannot get new file at UR8 time: ', t
	return
 44	w_channel_position = ok
	if (user(ch).suppress_messages) return
	write(6,1,iostat=ios) 'Cannot open file at UR8 time: ', t
	return
 46	w_channel_position = ok
	if (user(ch).suppress_messages) return
	write(6,1,iostat=ios) 'Loop count exceeded, UR8 time t: ', t
	return
 50	w_channel_position = ok
	if (user(ch).suppress_messages) return
	write(6,1,iostat=ios) 'Cannot get record at end of file.'
	return
	end
!------------------------------------------------------------------------------
	integer*4	function	wind_tm_get_next_event
	1				(ch,major,minor,cevent_type)
! This is a convenience routine for application programs.  It is only
! a trivial front end for the wind_tm_get_event routine.
	implicit	none
	include		'wind_tm_user_def.for'
	include		'wind_return_code_def.for'
	integer*4	ch				! TM channel number
	integer*4	major				! major frame number
	integer*4	minor				! minor frame number
	character*(*)	cevent_type			! event type
	integer*4	ok
	integer*4	wind_tm_get_event
$IF ABSOFT_FORTRAN
!	integer*4	wind_tm_eof
$ELSE
	integer*4	wind_tm_eof
$ENDIF
	character*32	event_name

	event_name = cevent_type
	call to_upper(event_name,0,0)
	if (event_name(1:2) .eq. 'HK' .or. event_name(1:3) .eq. 'CDF') then
	   event_name = 'HK'
	   major = major + 1
	else if (event_name(1:11) .eq. 'MAJOR_FRAME') then
	   major = major + 1
	else if (event_name(1:11) .eq. 'MINOR_FRAME') then
	   call wind_tm_increment_mfmf(major,minor)
	else
	   call wind_tm_increment_packet(major,minor)
	end if

	ok = wind_tm_get_event(ch,major,minor,event_name)
	if (ok .ne. 1) goto 20

	wind_tm_get_next_event = ok

	return
  1	format(1x,'WIND_TM_GET_NEXT_EVENT: ', a, i4)
! 10	wind_tm_get_next_event = w_end_of_file
!	if (user(ch).suppress_messages) return
!	type 1, 'cannot get next event (EOF), status=', w_end_of_file
!	return
 20	wind_tm_get_next_event = ok
	if (user(ch).suppress_messages) return
	type 1, 'cannot get next event, status=', ok
	return
	end
!------------------------------------------------------------------------------
	integer*4	function	wind_tm_get_previous_event
	1				(ch,major,minor,event_type)
! This is a convenience routine for application programs that move backwards
! and forwards in time through the telemetry stream in "event" units.
! The search for the specified event begins at the stream position defined by
! the packet that include the current major and minor frame numbers
! arguments.  Eventually wind_tm_get_event is called to extract
! the event from the stream.
	implicit	none
	include		'wind_tm_user_def.for'
	include		'wind_tm_event_def.for'
	include		'wind_return_code_def.for'

	integer*4	ch				! TM channel number
	integer*4	major				! major frame number
	integer*4	minor				! minor frame number
	character*(*)	event_type			! event type

$IF ABSOFT_FORTRAN
	character*(*)	rn
	parameter	(rn='WIND_TM_GET_PREVIOUS_EVENT')	! name of this routine
$ELSE
	parameter	rn='WIND_TM_GET_PREVIOUS_EVENT'	! name of this routine
$ENDIF
	integer*4	ok
	integer*4	wind_check_parms		! a function
	integer*4	init_packet_dissect_info	! a function
	integer*4	wind_tm_get_event		! a function
	integer*4	wind_get_plain_packet		! a function
	character*32	ename
	integer*4	i

	logical*4	got_a_last_packet

	wind_tm_get_previous_event = 0

	ok = wind_check_parms(rn,ch,major,minor)
	if (ok .ne. 1) goto 8

	ename = event_type
	call to_upper(ename,0,0)

	if (ename .eq. 'HK' .or. ename .eq. 'CDF') then
	   ename = 'HK'
	   major = major - 1
	   goto 200
	else if (ename .eq. 'MAJOR_FRAME') then
	   major = major - 1
	   goto 200
	else if (ename .eq. 'MINOR_FRAME') then
	   call wind_tm_decrement_mfmf(major,minor)
	   goto 200
	else if (ename .eq. 'PACKET') then
	   call wind_tm_decrement_packet(major,minor)
	   goto 200
	else
	   call wind_tm_decrement_packet(major,minor)
	end if

	! query the database for packet/event extraction information
	ok = init_packet_dissect_info(ch,major,minor,ename)
	if (ok .ne. 1) goto 10

	! find the next "last" packet of the event going backwards
	got_a_last_packet = 0
	do while(.not.got_a_last_packet)
	   ok = wind_get_plain_packet(
	1	ch,major,minor,eei(ch).packet_id,reverse,0)
	   if (ok .ne. 1) goto 20
	   i = zext(user(ch).packet.w(0))
	   got_a_last_packet = (i .and. eei(ch).last_packet_mask) .ne. 0
	   if (.not.got_a_last_packet) then
	      call wind_tm_decrement_packet(major,minor)
	   end if
	end do

	! find the next "first" packet of the event going backwards
	ok = wind_get_plain_packet(ch,major,minor,eei(ch).packet_id,reverse,1)
	if (ok .ne. 1) goto 30

 200	continue
	ok = wind_tm_get_event(ch,major,minor,ename)
	if (ok .ne. 1) goto 40

	wind_tm_get_previous_event = 1

	return
  1	format(1x,'WIND_TM_GET_PREVIOUS_EVENT: ', a, a)

  8	wind_tm_get_previous_event = ok
	return

 10	wind_tm_get_previous_event = ok
	if (user(ch).suppress_messages) return
	type 1, 'cannot get extract event info for event type: ', ename
	return

 20	wind_tm_get_previous_event = ok
	if (user(ch).suppress_messages) return
	type 1, 'cannot get last packet for event: ', ename
	return

 30	wind_tm_get_previous_event = ok
	if (user(ch).suppress_messages) return
	type 1, 'cannot get first packet for event: ', ename
	return

  40	wind_tm_get_previous_event = ok
	if (user(ch).suppress_messages) return
	type 1, 'cannot get event: ', ename
	return

	end
!------------------------------------------------------------------------------
	integer*4	function	wind_tm_get_event
	1				(ch,major,minor,u_event_type)
! This routine gathers a specified type of event from a telemetry stream.  The
! search for the specified event begins at the stream position defined by the
! major and minor frame number arguments.
! Note that packets are selected by packet type (i.e., rad1, rad2, tnr, etc.)
! and not by packet id (i.e., rad1 packet 1 of 4, rad2 packet 4 of 4, etc.),
! except for the case of the first packet.  The first packet is selected by
! packet id.
! Packet validation, with respect to event collection, is performed via
! a call to wind_validate_packet_in_event.
	implicit	none
	include		'wind_tm_user_def.for'
	include		'wind_tm_event_def.for'
	include		'wind_extra_info_def.for'
	include		'wind_return_code_def.for'
	integer*4	ch				! TM channel number
	integer*4	major				! major frame number
	integer*4	minor				! minor frame number
	character*(*)	u_event_type			! user's event type

$IF ABSOFT_FORTRAN
	character*(*)	rn
	parameter	(rn='WIND_TM_GET_EVENT')	! name of this routine
$ELSE
	parameter	rn='WIND_TM_GET_EVENT'		! name of this routine
$ENDIF

	character*36	event_type			! event type

	integer*4	ok				! retrun status variable
	integer*4	i,j,k				! misc. indexes
	integer*4	wind_check_parms		! a function
	integer*4	wind_get_hk_event		! a function
	integer*4	w_f_iiiiiib			! a function
	integer*4	w_f_iii				! a function
	integer*4	w_f_iiiiii			! a function
	integer*4	wind_validate_packet_in_event	! a function
	integer*4	wind_get_event_data_from_packet	! a function
	integer*4	set_event_name_and_pkt_id	! a function
	integer*4	init_packet_dissect_info	! a function
	integer*4	update_packet_dissect_info	! a function
	integer*4	extract_primary_header		! a function
	integer*4	extract_other_headers		! a function
	integer*4	w_get_mjr_fr_event		! a function
	integer*4	w_get_mnr_fr_event		! a function
	integer*4	w_get_packet_event		! a function
	integer*4	dbms_to_ur8			! a function
	integer*4	w_set_event_name
	external	w_set_event_name !$pragma C (w_set_event_name)
	integer*4	validation_code
	integer*4	wind_get_plain_fill_packet
	integer*4	ios

	logical*4	unexpected_first_packet
	logical*4	not_by_fill
	logical*4	boolean_value
	logical*4	w_get_msg_state_updt_pos	! a function
	logical*4	first_time /.true./
	integer*4	dummy1, dummy2
	pointer		(p1,dummy1), (p2,dummy2)
	integer*4	sz_pkt_data_area

	record /low_byte/ lb

	wind_tm_get_event = 0

	event_type = u_event_type
	call to_upper(event_type,0,0)

	ok = wind_check_parms(rn,ch,major,minor)
	if (ok .ne. 1) goto 8

	if (first_time) then
	   first_time = .false.
	   do i=1,max_channels
	      ok = w_set_event_name(i, eei(i).event_type_b)
	   end do
$IF ABSOFT_FORTRAN
	   p1 = loc(eb(1).cpn)
	   p2 = loc(eb(1).last_data_byte)
$ELSE
	   p1 = %loc(eb(1).cpn)
	   p2 = %loc(eb(1).last_data_byte)
$ENDIF
	   sz_pkt_data_area = p2 - p1 + 4
	   call w_version_i4(exi(ch).wind_lib_nver)
	end if

	! initialize the event storage area for the current channel
!xxx move area 6 of eb somewhere else.
!!!!	call init_area(eb(ch).event_completion_status, (n_extra_info_lws+2)*4)
	do i=1,12
	   exi(ch).extra_info(i) = 0
	end do
	exi(ch).ur8_scet = 0.0
	exi(ch).ur8_ert  = 0.0
	exi(ch).ur8_eoe  = 0.0
	call init_area(eei(ch), sizeof_eei)

	if (event_type .eq. 'HK' .or. event_type .eq. 'CDF') then
	   ! house keeping event
	   event_type = 'HK'
	   call init_area(eb(ch).data, max_len_hk)
	   wind_tm_get_event = wind_get_hk_event(ch,major,minor)
	   return					! return
	else if (event_type .eq. 'FILL') then
	   call init_area(eb(ch).cpn, sz_pkt_data_area)
	   not_by_fill = 0
	   ok = wind_get_plain_fill_packet(
	1          ch,major,minor,event_type,forward,.true.)
	   if (ok .ne. 1) goto 18
	else if (event_type .eq. 'MAJOR_FRAME') then
	   call init_area(eb(ch).major_frame, sizeof_major_frame)
	   wind_tm_get_event = w_get_mjr_fr_event(ch,major,minor)
	   return					! return
	else if (event_type .eq. 'MINOR_FRAME') then
	   call init_area(eb(ch).minor_frame, sizeof_minor_frame)
	   wind_tm_get_event = w_get_mnr_fr_event(ch,major,minor)
	   return					! return
	else if (event_type .eq. 'PACKET') then
	   call init_area(eb(ch).packet, size_of_packet)
	   wind_tm_get_event = w_get_packet_event(ch,major,minor)
	   return					! return
	else
	   not_by_fill = 1
	   call init_area(eb(ch).cpn, sz_pkt_data_area)
	end if

	ok = set_event_name_and_pkt_id(ch,event_type)
	if (ok .ne. 1) goto 10

	eb(ch).cpn = 0					! packet # in event
	validation_code = 0
	eei(ch).got_a_first_packet = 0
	eei(ch).got_a_last_packet  = 0
	unexpected_first_packet    = 0

	! get the first packet in the event
	if (not_by_fill) then
	   ! call the packet retrieval routine
	   ok = w_f_iiiiiib( %val(user(ch).f_get_plain_packet),
	1	ch,major,minor,eei(ch).packet_id,forward,1,user(ch).packet.w)
	   if (ok .ne. 1) goto 20
	end if
	eei(ch).got_a_first_packet = 1

	! set current position in main user structure
	user(ch).wind_record.major_frame = major
	lb.i4val = minor
	user(ch).wind_record.minor_frame = lb.b

	ok = init_packet_dissect_info(ch,major,minor,event_type)
	if (ok .ne. 1) goto 12

	do while(eei(ch).got_a_last_packet .eq. 0)

	   eb(ch).cpn = eb(ch).cpn + 1

	   if (eb(ch).cpn .gt. 1) then
	      i = zext(user(ch).packet.w(0))
	      unexpected_first_packet = (i.and.eei(ch).first_packet_mask) .ne.0
	      if (unexpected_first_packet) goto 22
	   end if

	   ok = extract_primary_header(ch,user(ch).packet)
	   if (ok .ne. 1) goto 30

	   ok = update_packet_dissect_info(ch,user(ch).packet)
	   if (ok .ne. 1) goto 40

	   ok = extract_other_headers(ch,user(ch).packet)
	   if (ok .ne. 1) goto 50

	   if (eb(ch).cpn .eq. 1) then		! update extra info
	      ok = w_f_iii(%val(user(ch).f_get_xtra_event_info),ch,major,minor)
	      if (ok .ne. 1) then
	         validation_code = validation_code .or. ok
	      end if
	   end if

	   ok = wind_validate_packet_in_event(ch,major,minor)
	   if (ok .eq. 1) then
	      validation_code = validation_code .or. ok
	      ok = wind_get_event_data_from_packet(ch,user(ch).packet)
	      if (ok .ne. 1) goto 60
	   else
	      goto 80
	   end if

	   ! check for last packet
	   i = zext(user(ch).packet.w(0))
	   boolean_value = (i .and. eei(ch).last_packet_mask) .ne. 0
	   if (boolean_value) eei(ch).got_a_last_packet = 1

	   if (eei(ch).got_a_last_packet .ne. 1) then
	      call wind_tm_increment_packet(major,minor)
	      if (not_by_fill) then
	         ok = w_f_iiiiiib( %val(user(ch).f_get_plain_packet),
	1	     ch,major,minor,eei(ch).packet_id,forward,0,user(ch).packet)
	         if (ok .ne. 1) goto 20
	      else
	         ok = wind_get_plain_fill_packet(ch,major,minor,
	1             event_type,forward,.false.)
	         if (ok .ne. 1) goto 18
	      end if
	   end if

	end do

	eb(ch).cpn = 1

	! set current position in main user structure
	user(ch).wind_record.major_frame = major
	lb.i4val = minor
	user(ch).wind_record.minor_frame = lb.b

	! now set the end-of-event ur8 time field
	ok = w_f_iiiiii( %val(user(ch).f_get_mf_scet_dbms),
	1	ch,major,minor,
	1	i,j,k)
	ok = dbms_to_ur8(i,j,k, exi(ch).ur8_eoe)

!	call w_get_offline_rec_read_stats(ch,i,j)
!	type *, 'Offline reads:', j, '  calls:', j
!	call wid_get_n_dbms_reads(i)
!	type *, 'DBMS reads:', i
!	call wid_get_n_key_reads(i)
!	type *, 'Keyfile reads:', i

	! set return status
	wind_tm_get_event = validation_code
	eb(ch).event_completion_status = wind_tm_get_event

	! increment the channel's event counter
	user(ch).event_count = user(ch).event_count + 1

	return
  1	format(1x,'WIND_TM_GET_EVENT: ', a, a12)

  8	wind_tm_get_event = ok
	return

 10	wind_tm_get_event = ok
	if (user(ch).suppress_messages) return
$IF ABSOFT_FORTRAN
	write(6,1,iostat=ios) 'cannot get packet id for event type: ',
	1	event_type
$ELSE
	write(6,1,iostat=ios) 'cannot get packet id for event type: ', event_type
$ENDIF
	return

 12	wind_tm_get_event = ok
	if (user(ch).suppress_messages) return
$IF ABSOFT_FORTRAN
	write(6,1,iostat=ios) 'cannot get extract event info
	1	for event type: ', event_type
$ELSE
	write(6,1,iostat=ios) 'cannot get extract event info for event type: ', event_type
$ENDIF
	return

 18	wind_tm_get_event = ok
	if (w_get_msg_state_updt_pos(ch,major,minor)) return
$IF ABSOFT_FORTRAN
	write(6,1,iostat=ios) 'cannot get FILL packet for event: ',
	1	event_type
$ELSE
	write(6,1,iostat=ios) 'cannot get FILL packet for event: ', event_type
$ENDIF
	return

 20	wind_tm_get_event = ok
	if (w_get_msg_state_updt_pos(ch,major,minor)) return
	write(6,1,iostat=ios) 'cannot get packet for event: ', event_type
	return

 22	wind_tm_get_event = w_bad_multipacket_seq
	if (w_get_msg_state_updt_pos(ch,major,minor)) return
	write(6,1,iostat=ios)
	1 'unexpected 1st packet in multipacket event: ', event_type
	return

 30	wind_tm_get_event = ok
	if (w_get_msg_state_updt_pos(ch,major,minor)) return
	write(6,1,iostat=ios)
	1 'cannot extract primary header for event: ', event_type
	return

 40	wind_tm_get_event = ok
	if (w_get_msg_state_updt_pos(ch,major,minor)) return
	write(6,1,iostat=ios)
	1 'cannot update packet dissection information: ', event_type
	return

 50	wind_tm_get_event = ok
	if (w_get_msg_state_updt_pos(ch,major,minor)) return
	write(6,1,iostat=ios)
	1 'cannot extract "other" headers from packet, event: ',event_type
	return

 60	wind_tm_get_event = ok
	if (w_get_msg_state_updt_pos(ch,major,minor)) return
	write(6,1,iostat=ios)
	1 'cannot get event info/data from packet, event: ', event_type
	return

 80	wind_tm_get_event = ok
	eb(ch).cpn = 1
	if (w_get_msg_state_updt_pos(ch,major,minor)) return
	write(6,1,iostat=ios) 'invalid packet for event: ', event_type
	return
	end
!------------------------------------------------------------------------------
	integer*4	function	get_instrument_version(ch, inst, buf)
	implicit	none
	include		'c_string_def.for'
	include		'wind_tm_user_def.for'
	include		'wind_tm_event_def.for'
	include		'wind_extra_info_def.for'
	include		'item_def.for'
	include		'wind_return_code_def.for'
	integer*4	ch				! TM channel number
	character*(*)	inst
	byte		buf
	integer*4	ok
	integer*4	w_get_assoc_hk_field		! a function
	integer*4	major
	integer*4	adjmjrok
	integer*4	startbit
	integer*4	bitlen
	record /c_string_16/ c16
	record /low_byte/ val

	get_instrument_version = 0
	major = exi(ch).major
	adjmjrok = 1
	bitlen = 4
	c16.c = inst//'_VERSION'//char(0)

	if (inst .eq. 'DPU') then
	   startbit = 32
	else if (inst .eq. 'FFT') then
	   startbit = 496
	else if (inst .eq. 'TDS') then
	   startbit = 344
	else
	   write(6,*)
	1  'GET_INSTRUMENT_VERSION: ERROR! invalid instrument key word.'
	   return
	end if

	ok = w_get_assoc_hk_field(ch, major, c16.b, val,
	1	startbit, bitlen, adjmjrok)

	if (ok .eq. 1) then
	   buf = val.b
	end if

	get_instrument_version = ok

	return
	end
!------------------------------------------------------------------------------
	integer*4	function	wind_get_eei()
! This routine gets the Event Extraction Information from the database.
! A number of "rules" and "givens" apply:
! 1.  The primary header is always the first thing in every packet.
! 2.  The packet id is always the first field of the primary header.
! 3.  The secondary and tertiary headers and IDP are guaranteed to be present
!     for one packet events and the first packet of multi-packet events
!     provided that event type uses secondary and/or tertiary headers
!     and/or IDP.
! 4.  For non-first packets of multi-packet events only the primary header
!     is guaranteed to exist for all packets, and the IDP is guaranteed
!     in each packet for all events requiring IDP's.
! 5.  The packet/event subtype is contained in the first field of the IDP.
! 6.  Both multi-packet and single-packet events use a first_packet_flag_bit
!     and a last_packet_flag_bit to define starting and stopping points for
!     event generation.
! 7.  A "house_keeping" event is a specially handled event.
! 8.  A "tds_fill" event is a specially handled event.
! 9.  Secondary and tertiary headers and the IDP are guaranteed to be of
!     identical size, respectively, in each packet of a multi-packet event.
!     Note that secondary and tertiary headers may or may not be present in
!     in non-first packets of multi-packet events.
!
	implicit	none
	include		'c_string_def.for'
	include		'wind_tm_user_def.for'
	include		'wind_tm_event_def.for'
	include		'wind_extra_info_def.for'
	include		'item_def.for'
	include		'wind_return_code_def.for'
	integer*4	ch				! TM channel number
	integer*4	major				! major frame number
	integer*4	minor				! minor frame number
	character*(*)	event_type			! event type

	logical*4	got_2nd				! logical flag
	logical*4	got_3rd				! logical flag
	logical*4	got_4th				! logical flag
	logical*4	got_data			! logical flag
	integer*4	set_event_name_and_pkt_id	! an entry point
	integer*4	init_packet_dissect_info	! an entry point
	integer*4	update_packet_dissect_info	! an entry point
	integer*4	extract_primary_header		! an entry point
	integer*4	extract_other_headers		! an entry point
	integer*4	n				! # i*4's written
	integer*4	ok				! return status var
	integer*4	wind_tm_get_item		! a function
	integer*4	wind_tm_get_item_from_all	! a function
$IF ABSOFT_FORTRAN
$ELSE
	integer*4	k2len				! a function
$ENDIF
	integer*4	get_instrument_version		! a function
	integer*4	w_f_iiiiii			! a function
	integer*4	w_get_item_substruct
	external	w_get_item_substruct !$pragma C( w_get_item_substruct )
	integer*4	i,j,k				! misc loop/index vars
$IF ABSOFT_FORTRAN
	integer*4	all_subtypes
	parameter	(all_subtypes='0000ffff'x)
$ELSE
	parameter	all_subtypes='0000ffff'x
$ENDIF
	integer*4	ret_size
	byte		packet(size_of_packet)
	record /c_string_32/ item
	record /c_string_32/ all_event
	record /extract/ entry
	record /low_byte/ lb
	integer*4	max_buffered_vers
	parameter	(max_buffered_vers = 4)
	logical*4	get_vers
	structure /saved_instrument_version/
	   integer*4	mjr
	   byte         dpu
	   byte		fft
	   byte		tds
	   byte		dummy
	end structure
	structure /svd_ins_ver_array/
	   record /saved_instrument_version/ vers(max_buffered_vers)
	   integer*4	i
	end structure
	record /svd_ins_ver_array/ sv(max_channels)

	structure /dissect_info/
	   character*8	event
	   record /low_byte/	pri		! entire primary header
	   integer*4	pid			! packet id
	   integer*4	h2_pres_msk		! instrument header present
	   integer*4	h3_pres_msk		! measurement header present
	   integer*4	h4_pres_msk		! packet header mask
	   integer*4	fst_pkt_msk		! first packet mask
	   integer*4	lst_pkt_msk		! last packet mask
	   integer*4	h1_bit_size
	   integer*4	pkt_subtype_msk
	   integer*4	pkt_subtype_shift
	   logical*4	ok
	end structure
	record /dissect_info/ di(max_channels)

	wind_get_eei = 0
	return

	!----------------------------------------------------------------------
	entry				set_event_name_and_pkt_id(ch,event_type)
! This routine is called once with each request for an event.
! It establishes the event name (type) in the event extraction information
! table and retrieves the associated packet_id value from the item database.

	set_event_name_and_pkt_id = 0

	all_event.c = 'GLOBAL'//char(0)
	eei(ch).event_type	= event_type
	k = 1
	j = len(eei(ch).event_type)
        i = 0
	do while(i .eq. 0)
	   if (eei(ch).event_type(k:k) .gt. ' ' .and.
	1      eei(ch).event_type(k:k) .lt. char(127)) then
	      k = k + 1
	   else
	      i = 1
	   end if
	   if (k .gt. j) then
	      k = k - 1
	      i = 1
	   end if
	end do
	eei(ch).event_type(k:k) = char(0)	! null terminate the string
	eei(ch).event_subtype	= all_subtypes

	! The packet_id is gathered here so the first "raw" packet may be
	! obtained from the stream before the packet dissect information is
	! retrieved from the item database.  In this way bad areas in offline
	! files, such as beginning of files or times when the dpu is off,
	! can be avoided.  At this writing, the packet_id item is dependant
	! only on the event name (event_type).
	if (di(ch).event .eq. eei(ch).event_type) then
	   eei(ch).packet_id = di(ch).pid
	else
	   item.c = 'PACKET_ID'//char(0)
	   ok = wind_tm_get_item(ch,
	1	'PACKET_ID',
	1	eei(ch).packet_id,
	1	1,
	1	ret_size)
	   if (ok .ne. 1) goto 50
	   di(ch).pid = eei(ch).packet_id
	   di(ch).ok = .false.
	end if

	set_event_name_and_pkt_id = 1

	return
  2	format(1x,'SET_EVENT_NAME_AND_PKT_ID: ', a, a, a)
 50	set_event_name_and_pkt_id = ok
	if (user(ch).suppress_messages) return
	type 2, 'cannot get PACKET_ID item for event: ', event_type
$IF ABSOFT_FORTRAN
	type 2, '(a,a4,a)', ' Event type "',event_type,
	1    '" is unknown or invalid.'
	type 2, '(a,a4,a)', ' Make sure "',event_type,
	1	'" exists in item database.'
$ELSE
	type '(a,a4,a)', ' Event type "',event_type, '" is unknown or invalid.'
	type '(a,a4,a)', ' Make sure "',event_type, '" exists in item database.'
$ENDIF
	return

	!----------------------------------------------------------------------
	entry				init_packet_dissect_info
	1				(ch,major,minor,event_type)
! This routine is called once with each request for an event.
! It secures the primary arguments for querying TM item extraction database,
! such as date/time, instrument version numbers,... and the lowest level
! of packet decomposition information including the size of the packet
! primary header, the locations of the bits used to signal first and
! last packets...

	init_packet_dissect_info = 0

	exi(ch).major = major
        exi(ch).minor = minor

	! get dbms time of current record
	ok = w_f_iiiiii( %val(user(ch).f_get_mf_scet_dbms),
	1	         ch,major,minor,
	1	exi(ch).ert(1),
	1	exi(ch).ert(2),
	1	exi(ch).ert1000)
	if (ok .ne. 1) goto 20
	eei(ch).dbms_date_time(1) = exi(ch).ert(1)
	eei(ch).dbms_date_time(2) = exi(ch).ert(2)
	! estimate the scet for the low level item getting
	exi(ch).scet(1)  = exi(ch).ert(1)
	exi(ch).scet(2)  = exi(ch).ert(2)
	exi(ch).scet1000 = exi(ch).ert1000

	! try to get current instrument version numbers from buffer
	get_vers = .true.
	if (sv(ch).i .ne. 0) then
	   i = 1
	   j = sv(ch).i
	   do while(i .le. max_buffered_vers .and.
	1           sv(ch).vers(j).mjr .ne. major)
	      i = i + 1
	      j = j - 1
	      if (j .le. 0) j = max_buffered_vers
	   end do
	   if (sv(ch).vers(j).mjr .eq. major) then
	      get_vers = .false.
	      exi(ch).dpu_version = sv(ch).vers(j).dpu
	      exi(ch).fft_version = sv(ch).vers(j).fft
	      exi(ch).tds_version = sv(ch).vers(j).tds
	   end if
	end if

	! get instrument version numbers from associated HK
	if (get_vers) then
	   ok = get_instrument_version(ch, 'DPU', exi(ch).dpu_version)
	   ok = get_instrument_version(ch, 'FFT', exi(ch).fft_version)
	   ok = get_instrument_version(ch, 'TDS', exi(ch).tds_version)
	   sv(ch).i = sv(ch).i + 1
	   if (sv(ch).i .gt. max_buffered_vers) sv(ch).i = 1
	   sv(ch).vers(sv(ch).i).mjr = major
	   sv(ch).vers(sv(ch).i).dpu = exi(ch).dpu_version
	   sv(ch).vers(sv(ch).i).fft = exi(ch).fft_version
	   sv(ch).vers(sv(ch).i).tds = exi(ch).tds_version
	end if

	!
	! get static header extraction information through a series of
	! data base calls
	!

	if (.not. di(ch).ok) then
	   item.c = 'PRIMARY_HEADER'	! bit size of primary header
	   ok = wind_tm_get_item_from_all( ch,
	1	item.c,
	1	di(ch).h1_bit_size,
	1	1,
	1	ret_size)
	   if (ok .ne. 1) goto 40

	   item.c = 'FIRST_PACK_FLAG'//null
	   ok = w_get_item_substruct( %val(ch-1),
	1	all_event.b,
	1	item.b,
	1	entry,
	1	%val(p_extract))
	   if (ok .ne. 1) goto 40
!	   eei(ch).first_packet_flag_bit	= entry.startbit
	   di(ch).fst_pkt_msk = 2**(entry.startbit)

	   item.c = 'LAST_PACK_FLAG'//null
	   ok = w_get_item_substruct( %val(ch-1),
	1	all_event.b,
	1	item.b,
	1	entry,
	1	%val(p_extract))
	   if (ok .ne. 1) goto 40
!	   eei(ch).last_packet_flag_bit	= entry.startbit
	   di(ch).lst_pkt_msk = 2**(entry.startbit)

	   ! packet_subtype is in the primary header
	   item.c = 'PACKET_SUBTYPE'//null
	   ok = w_get_item_substruct( %val(ch-1),
	1	all_event.b,
	1	item.b,
	1	entry,
	1	%val(p_extract))
	   if (ok .ne. 1) goto 40
	   di(ch).pkt_subtype_shift = 2**(entry.startbit)
	   j = 0
	   do i=entry.startbit,entry.startbit+entry.length-1
	      j = j .or. (2**i)
	   end do
	   di(ch).pkt_subtype_msk = j

	   ! Secondary header present field
	   item.c = 'INST_HDR_PRES'//null
	   ok = w_get_item_substruct( %val(ch-1),
	1	all_event.b,
	1	item.b,
	1	entry,
	1	%val(p_extract))
	   if (ok .ne. 1) goto 40
	   di(ch).h2_pres_msk = 2**(entry.startbit)

	   ! Tertiary header present field
	   item.c = 'MEAS_HDR_PRES'//null
	   ok = w_get_item_substruct( %val(ch-1),
	1	all_event.b,
	1	item.b,
	1	entry,
	1	%val(p_extract))
	   if (ok .ne. 1) goto 40
	   di(ch).h3_pres_msk = 2**(entry.startbit)

	   ! Quaterinary header present flag
	   item.c = 'PACK_HDR_PRES'//null
	   ok = w_get_item_substruct( %val(ch-1),
	1	all_event.b,
	1	item.b,
	1	entry,
	1	%val(p_extract))
	   if (ok .ne. 1) goto 40
	   di(ch).h4_pres_msk = 2**(entry.startbit)
	end if

	! Calculate the number of bytes in primary header.
	! Note that the headers are byte aligned.
	! Note that bits are numbered from 0 while bytes are numbered from 1.
	eei(ch).h1_start_bit  = 0
	eei(ch).h1_bit_size   = di(ch).h1_bit_size
	eei(ch).h1_byte_size  = di(ch).h1_bit_size / 8
	eei(ch).h1_start_byte = 1
	eei(ch).h1_end_byte   = eei(ch).h1_byte_size
	!
	eei(ch).first_packet_mask = di(ch).fst_pkt_msk
	eei(ch).last_packet_mask = di(ch).lst_pkt_msk
	eei(ch).h1_start_bit = 0

	init_packet_dissect_info = 1

	return
  1	format(1x,'INIT_PACKET_DISSECT_INFO: ', a, a, a)
! 10	init_packet_dissect_info = ok
!	if(user(ch).suppress_messages) return
!	type 1, 'cannot get ERT of current record.'
!	return
 20	init_packet_dissect_info = ok
	if (user(ch).suppress_messages) return
	type 1, 'cannot get ERT for event.'
	return
 40	init_packet_dissect_info = ok
	if (user(ch).suppress_messages) return
	type 1, 'cannot get event extract info for: ', item.c
	return

	!----------------------------------------------------------------------
	entry				extract_primary_header
	1				(ch,packet)
! This routine copies the primary header from the packet to the event
! information storage area for the channel.  The primary header, like all
! headers and the interactive data preamble, is guaranteed to
! be byte aligned by the author of the WIND/WAVES DPU.
!
	extract_primary_header = 0

	do i=eei(ch).h1_start_byte,eei(ch).h1_end_byte
	   eb(ch).ph(eb(ch).cpn).h1(i) = packet(i)
	end do

	extract_primary_header = 1
	return

	!----------------------------------------------------------------------
	entry				extract_other_headers
	1				(ch,packet)
! This routine copies the second, third, and fourth headers
! from the current packet to the event information storage area
! for the channel.

	extract_other_headers = 0

	!
	! extract the non-primary headers
	!

	if (got_2nd) then
	   j = 1
	   do i=eei(ch).h2_start_byte,eei(ch).h2_end_byte
	      eb(ch).ph(eb(ch).cpn).h2(j) = packet(i)
	      j = j + 1
	   end do
	end if

	if (got_3rd) then
	   j = 1
	   do i=eei(ch).h3_start_byte,eei(ch).h3_end_byte
	      eb(ch).ph(eb(ch).cpn).h3(j) = packet(i)
	      j = j + 1
	   end do
	end if

	if (got_4th) then
	   j = 1
	   do i=eei(ch).h4_start_byte,eei(ch).h4_end_byte
	      eb(ch).ph(eb(ch).cpn).h4(j) = packet(i)
	      j = j + 1
	   end do
	end if

	extract_other_headers = 1

	return

	!----------------------------------------------------------------------
	entry				update_packet_dissect_info
	1				(ch,packet)
! This routine is called with the reception of each packet in order to
! get the proper extraction information for the current packet.
! Wind_tm_get_item is called to get the packet subtype, 2nd header,
! 3rd header, and 4th header.
! All headers are guaranteed to be byte aligned.

	update_packet_dissect_info = 0

	eb(ch).ph(eb(ch).cpn).got_1st = 1

	di(ch).pri.b  = packet(1)
	di(ch).pri.b1 = packet(2)
	di(ch).pri.b2 = packet(3)
	di(ch).pri.b3 = 0

	! packet_subtype is in the primary header
	i = di(ch).pri.i4val .and. di(ch).pkt_subtype_msk
	eei(ch).event_subtype = i / di(ch).pkt_subtype_shift

	! Secondary header present field
	got_2nd = (di(ch).pri.i4val .and. di(ch).h2_pres_msk) .ne. 0

	! Tertiary header present field
	got_3rd = (di(ch).pri.i4val .and. di(ch).h3_pres_msk) .ne. 0

	! Quaterinary header present flag
	got_4th = (di(ch).pri.i4val .and. di(ch).h4_pres_msk) .ne. 0

	!
	! determine the start and end bytes of each header
	!

	! get the bit size of the second header
	if (got_2nd) then
	   item.c = 'INSTR_HEADER'//null
	   ok = wind_tm_get_item(ch,item.c, i, 1, n)
	   if (ok .ne. 1) goto 400
	   n = i / 8
	   eei(ch).h2_bit_size   = i
	   eei(ch).h2_start_byte = eei(ch).h1_end_byte + 1
	   eei(ch).h2_end_byte   = n + eei(ch).h2_start_byte - 1
	   eei(ch).h2_byte_size	 = eei(ch).h2_bit_size / 8
	end if

	! get the bit size of the third header
	if (got_3rd) then
	   item.c = 'MEASURE_HEADER'//null
	   ok = wind_tm_get_item(ch,item.c, i, 1, n)
	   if (ok .ne. 1) goto 400
	   n = i / 8
	   eei(ch).h3_bit_size = i
	   if (got_2nd) then
	      eei(ch).h3_start_byte = eei(ch).h2_end_byte + 1
	      eei(ch).h3_end_byte   = n + eei(ch).h3_start_byte - 1
	   else
	      eei(ch).h3_start_byte = eei(ch).h1_end_byte + 1
	      eei(ch).h3_end_byte   = n + eei(ch).h3_start_byte - 1
	   end if
	   eei(ch).h3_byte_size	 = eei(ch).h3_bit_size / 8
	end if

	! get the bit size of the fourth header
	if (got_4th) then
	   item.c = 'PACKET_HEADER'//null
	   ok = wind_tm_get_item(ch,item.c, i, 1, n)
	   if (ok .ne. 1) goto 400
	   n = i / 8
	   eei(ch).h4_bit_size = i
	   if (got_3rd) then
	      eei(ch).h4_start_byte = eei(ch).h3_end_byte + 1
	      eei(ch).h4_end_byte   = n + eei(ch).h4_start_byte - 1
	   else if (got_2nd) then
	      eei(ch).h4_start_byte = eei(ch).h2_end_byte + 1
	      eei(ch).h4_end_byte   = n + eei(ch).h4_start_byte - 1
	   else
	      eei(ch).h4_start_byte = eei(ch).h1_end_byte + 1
	      eei(ch).h4_end_byte   = n + eei(ch).h4_start_byte - 1
	   end if
	   eei(ch).h4_byte_size	 = eei(ch).h4_bit_size / 8
	end if

	! calculate where the data must end
	! the tds fill start byte is the start byte of the tds fill
	! as measured from the beginning of the packet using zero as the
	! index to the first packet element--note that wind_get_event stuff
	! uses one (1) as the index to the first packet element while the
	! flight software measures from byte 0 at the beginning of the packet.
	lb.i4val = 0
	lb.b = packet(3)
	lb.b1 = packet(2)
	! Use the octal form of '000001ff'x because the Sun SC0.0 f77 chokes
	! on hex constants in unconceivable ways.
	lb.i4val = lb.i4val .and. '0777'o	! octal constant
	eei(ch).tds_start_byte = lb.i4val
	eei(ch).data_end_byte = eei(ch).tds_start_byte

! commented out 11-aug-1995, jk
!	! now calculate where the data must end
!	item.c = 'TDS_FILL_POINTER'//null
!	ok = wind_tm_get_item_from_all(ch,item.c, eei(ch).tds_start_byte, 1, n)
!	if (ok .ne. 1) goto 400
!	! now the tds fill start byte is the start byte of the tds fill
!	! as measured from the beginning of the packet using zero as the
!	! index to the first packet element--note that wind_get_event stuff
!	! uses one (1) as the index to the first packet element while the
!	! flight software measures from byte 0 at the beginning of the packet.
!	eei(ch).data_end_byte = eei(ch).tds_start_byte

	! now calculate where the data must start
	if (got_4th) then
	   eei(ch).data_start_byte = eei(ch).h4_end_byte + 1
	else if (got_3rd) then
	   eei(ch).data_start_byte = eei(ch).h3_end_byte + 1
	else if (got_2nd) then
	   eei(ch).data_start_byte = eei(ch).h2_end_byte + 1
	else
	   eei(ch).data_start_byte = eei(ch).h1_end_byte + 1
	end if
	eei(ch).data_byte_size=eei(ch).data_end_byte-eei(ch).data_start_byte+1

	got_data = (eei(ch).data_end_byte - eei(ch).data_start_byte) .ge. 0

	eb(ch).ph(eb(ch).cpn).got_2nd  = got_2nd
	eb(ch).ph(eb(ch).cpn).got_3rd  = got_3rd
	eb(ch).ph(eb(ch).cpn).got_4th  = got_4th
	eb(ch).ph(eb(ch).cpn).got_data = got_data

	di(ch).ok = .true.

	update_packet_dissect_info = 1

	return
  4	format(1x,'UPDATE_PACKET_DISSECT_INFO: ', a, a, a)
 400	update_packet_dissect_info = ok
	if (user(ch).suppress_messages) return
	type 4, 'cannot get information on item: ', item.c
	return

	end
!------------------------------------------------------------------------------
	integer*4	function	wind_validate_packet_in_event
	1				(ch,major,minor)
! This routine checks:
!	1.)  that the packet id is the appropriate one, taking into
!	     account the first, middle(s), and last packets in a sequence
!	     of packets or more simply the packet id for a single packet event
!	2.)  that the packet's internal numbering number is sequential
!	     with respect to previously gotten packets in a multi-packet event
!
	implicit	none
	include		'wind_tm_user_def.for'
	include		'wind_tm_event_def.for'
	include		'wind_extra_info_def.for'
	include		'wind_return_code_def.for'
	integer*4	ch				! TM channel number
	integer*4	major
	integer*4	minor
	integer*4	ok
	integer*4	ios
	integer*4	current_packet_number
	integer*4	ret_size
	integer*4	wind_tm_get_item
	character*16	item
	logical*4	suppressing_messages

	wind_validate_packet_in_event = 0
	ok = 1

	suppressing_messages = user(ch).suppress_messages
	call wind_tm_set_messages_off(ch)

	! check packet sequence number within event
	item = 'PACKET_COUNT'
	ok = wind_tm_get_item(ch,item,current_packet_number,1,ret_size)

	if (.not. suppressing_messages) call wind_tm_set_messages_on(ch)

	if (ok .eq. 1) then
	   ! item is valid, compare packet sequence numbers
	   if (current_packet_number .ne. eb(ch).cpn) goto 10
	else
	   ! item is not valid, we are probably looking at an old file,
	   ! so, just do nothing
	end if

	wind_validate_packet_in_event = 1

	return
  1	format(1x,'WIND_VALIDATE_PACKET_IN_EVENT: ', a, a)
  2	format(1x,t2,a,i,'.',i3.3,a,i)
  3	format(1x,t2,a,i3,a,i)
 10     wind_validate_packet_in_event = w_bad_multipacket_seq
	if (user(ch).suppress_messages) return
	type 1, 'Bad multipacket sequence number, event: ',eei(ch).event_type
	write(6,2,iostat=ios) 'stream position',
	1	major,
	1	minor,
	1	', DPU ertMF:',exi(ch).dpu_major_ert
	type 3, 'expected packet sequence #',eb(ch).cpn, ' but got',
	1	zext(eb(ch).ph(eb(ch).cpn).h4(1))
	return
	end
!------------------------------------------------------------------------------
	integer*4	function	wind_get_event_data_from_packet
	1				(ch,packet)
! This routine copies the packet data to the event data buffer.
! The event data buffer holds the data in bytes because some telemetry
! data items must be extracted at the bit level and across byte or longword
! boundaries.
!
	implicit	none
	include		'wind_tm_user_def.for'
	include		'wind_tm_event_def.for'
	include		'wind_return_code_def.for'
	integer*4	ch				! TM channel number
	integer*4	i,j				! array/loop indexes
	byte		packet(size_of_packet)

	wind_get_event_data_from_packet = 0

	j = eb(ch).last_data_byte + 1
	do i = eei(ch).data_start_byte,eei(ch).data_end_byte
	   eb(ch).data(j) = packet(i)
	   j = j + 1
	end do
	eb(ch).last_data_byte = j - 1

	wind_get_event_data_from_packet = 1

	return
	end
!------------------------------------------------------------------------------
	integer*4	function	wind_get_hk_event(ch,major,minor)
! This routine builds up an HK event by calling wind_tm_get_hk to get the
! "data" portion of the event.  The various internal wind_lib flags and
! item database extraction arguments are also determined.
	implicit	none
	include		'wind_tm_user_def.for'
	include		'wind_tm_event_def.for'
	include		'wind_extra_info_def.for'
	include		'wind_return_code_def.for'
	include		'wind_hk_def.for'
	integer*4	ch				! TM channel number
	integer*4	major				! major frame number
	integer*4	minor				! minor frame number
	integer*4	i,j,k				! loop index var
	integer*4	aok				! status var
	integer*4	ok				! return status var
!	integer*4	wind_get_xtra_event_info	! a function
	integer*4	get_instrument_version
$IF ABSOFT_FORTRAN
	integer*4	all_subtypes
	parameter	(all_subtypes='0000ffff'x)
$ELSE
	parameter	all_subtypes='0000ffff'x
$ENDIF
	integer*4	longword
	byte		byte
	equivalence	(longword,byte)
	integer*4	wind_suppress_messages
	integer*4	w_f_iiii
	integer*4	w_f_iiiiii
	integer*4	w_f_iiiib
	logical*4	message_state
	integer*4	w_item_i4	!-xragma C (w_item_i4)
	record /low_byte/ v
	logical*4	is_fast_tm
	logical*4	is_slow_tm
	integer*4	a
	integer*4	dbms_to_ur8			! a function

	is_fast_tm(a) =a .eq. science_2x .or.
	1              a .eq. maneuver_2x .or.
	1	       a .eq. contingency_2x
	is_slow_tm(a) =a .eq. maneuver_1x .or.
	1	       a .eq. science_1x .or.
	1	       a .eq. contingency_1x

	wind_get_hk_event = 0

	eei(ch).event_type	= 'HK'
	eei(ch).event_type(3:3) = char(0)	! null terminate the string
	eei(ch).event_subtype	= all_subtypes

	exi(ch).major = major
	exi(ch).minor = 0

	minor = max_minor_frame_num

	aok = 1
	j = 0
	k = 0
	exi(ch).dpu_major_ert = 0

	i = 0
	j = w_last_hk_idx
	message_state = wind_suppress_messages(ch)
	call wind_set_message_state(ch, .true.)
	ok = w_f_iiiib(%val(user(ch).f_get_hk),
	1	ch,major,i,j,eb(ch).data)
	call wind_set_message_state(ch, message_state)
	! set the return code based on the availablity of the HK data at
	! this point to flag partial successes
	eb(ch).event_completion_status = ok
	if (ok .ne. 1 .and. ok .ne. w_limited_success) goto 30

	eb(ch).cpn = 1
	eb(ch).ph(1).got_data  = .true.
	eb(ch).last_data_byte  = max_len_hk

	! get the gse info
	exi(ch).sp_test_number= user(ch).wind_record.sp_test_number
	exi(ch).sp_step_number= user(ch).wind_record.sp_step_number

	! get dbms time of last record in MF
	ok = w_f_iiiiii( %val(user(ch).f_get_mf_scet_dbms),
	1	ch,major,max_minor_frame_num,
	1	exi(ch).ert(1),
	1	exi(ch).ert(2),
	1	exi(ch).ert1000)
	ok = dbms_to_ur8(
	1       exi(ch).ert(1), exi(ch).ert(2), exi(ch).ert1000,
	1	exi(ch).ur8_eoe)

	! get dbms time of current record
	ok = w_f_iiiiii( %val(user(ch).f_get_mf_scet_dbms),
	1	ch,major,min_minor_frame_num,
	1	exi(ch).ert(1),
	1	exi(ch).ert(2),
	1	exi(ch).ert1000)
	if (ok .ne. 1) goto 20
	eei(ch).dbms_date_time(1) = exi(ch).ert(1)
	eei(ch).dbms_date_time(2) = exi(ch).ert(2)
	exi(ch).scet(1)  = exi(ch).ert(1)
	exi(ch).scet(2)  = exi(ch).ert(2)
	exi(ch).scet1000 = exi(ch).ert1000

	! get the ur8 time formats
	ok = dbms_to_ur8(
	1       exi(ch).scet(1), exi(ch).scet(2), exi(ch).scet1000,
	1	exi(ch).ur8_scet)
	ok = dbms_to_ur8(
	1       exi(ch).ert(1), exi(ch).ert(2), exi(ch).ert1000,
	1	exi(ch).ur8_ert)
	exi(ch).ur8_context = exi(ch).ur8_scet

	! get instrument version numbers from associated HK
	message_state = wind_suppress_messages(ch)
	call wind_set_message_state(ch, .true.)
	ok = get_instrument_version(ch, 'DPU', exi(ch).dpu_version)
	ok = get_instrument_version(ch, 'FFT', exi(ch).fft_version)
	ok = get_instrument_version(ch, 'TDS', exi(ch).tds_version)
	call wind_set_message_state(ch, message_state)

	! get the dpu major frame number
	ok = w_item_i4(ch,'DPU_MAJOR_FRAME',exi(ch).dpu_major_ert,1,j)

	! get the sc mode
	ok = w_f_iiii( %val(user(ch).f_get_tm_mode),
	1	         ch,major,min_minor_frame_num,v)
	if (ok .ne. 1) goto 16
	exi(ch).sc_mode = v.b

	! get the bit rate
	if (is_fast_tm(v.i4val)) then
	   exi(ch).bit_rate = 1
	else if (is_slow_tm(v.i4val)) then
	   exi(ch).bit_rate = 0
	else
	   goto 18
	end if

	! indicate partial success if necessary
	if (eb(ch).event_completion_status .ne. 1) goto 31

	wind_get_hk_event = 1
	return
  1	format(1x,'WIND_GET_HK_EVENT: ', a, :, a, a)
  2	format(1x,'WIND_GET_HK_EVENT: ', a, i)
  3	format(1x,'WIND_GET_HK_EVENT: ', a, i5)

! 10	wind_get_hk_event = ok
!	if (user(ch).suppress_messages) return
!	type 1, 'cannot get ERT of current record.'
!	return

 16	wind_get_hk_event = ok
	if (user(ch).suppress_messages) return
	type 1, 'cannot get SC mode for current record.'
	return

 18	wind_get_hk_event = ok
	if (user(ch).suppress_messages) return
	type 1, 'cannot get determine bit rate for current record.'
	return

 20	wind_get_hk_event = ok
	if (user(ch).suppress_messages) return
	type 1, 'cannot convert ERT to DBMS time: '
	return

! 25	wind_get_hk_event = ok
!	if (user(ch).suppress_messages) return
!	type 1, 'cannot convert ERT to UR8 time: '
!	return

 30	wind_get_hk_event = ok
	if (user(ch).suppress_messages) return
	type 2, 'cannot get HouseKeeping data:', ok
	return

 31	wind_get_hk_event = w_partial_hk_event
	if (user(ch).suppress_messages) return
	type 2, 'partial or bad HouseKeeping event (b):', ok
	return

! 40	wind_get_hk_event = ok
!	if (user(ch).suppress_messages) return
!	type 1, 'cannot get extra event information.'
!	return

	end
!------------------------------------------------------------------------------
	integer*4	function	w_get_assoc_hk_field
	1		(ch,amajor,c_item_name,val,stbit,bitlen,adjmjrok)
! This routine attempts to extract a bit field from the HK associated with
! an event.  Originally designed for version numbers, this routine should work
! for any non-composite HK bit field of 8 bits or less contained entirely
! within a single HK word.
!
! If the desired HK field is after EOF the value is taken from the previous
! major frame.  Similarly, when the desired HK field is prior to BOF the
! value is taken from the following major frame.  The analagous BOF/EOF
! situations (recording/not_recording) with the realtime stream are handled
! in identical fashion.
!
! For dpu and/or instrument version numbers this strategy is probably
! ok--the caller must realize that this strategy may not be appropriate for
! all HK fields.
!
	implicit	none
	include		'c_string_def.for'
	include		'wind_tm_user_def.for'
	include		'wind_tm_event_def.for'
	include		'wind_return_code_def.for'
	include		'item_def.for'
	integer*4	ch				! TM channel number
	integer*4	amajor				! major frame number
	byte		c_item_name(*)
	integer*4	val
	integer*4	stbit
	integer*4	bitlen
	integer*4	adjmjrok			! adjacent MF is ok
	record /c_string_32/ event_name
	record /c_string_64/ item_name
	record /low_byte/ value
	integer*4	mf_addr
	integer*4	word_addr
	integer*4	major
	integer*4	ok
	integer*4	wind_get_hk_addr_from_bitoffset	! a function
	integer*4	w_get_item_substruct
	external	w_get_item_substruct !$pragma C( w_get_item_substruct )
	record /extract/ it
	integer*4	startbit
!	integer*4	zext_bits_to_longword		! a function
	integer*4	w_get_assoc_hk_field_		! an entry point
	logical*4	message_state
	logical*4	adjacent_format_ok
	parameter	(adjacent_format_ok=.true.)
	logical*4	first_time /.true./
	integer*4	w_f_iiiib
	integer*4	i, j, o, z
	integer*4	add
$IF ABSOFT_FORTRAN
!	integer*4	n_file_opens(max_channels)
	integer*4	w_first_hk_word,w_last_hk_word
	parameter	(w_first_hk_word=0)
	parameter	(w_last_hk_word=80)
$ELSE
	integer*4	n_file_opens(max_channels)
	parameter	w_first_hk_word=0
	parameter	w_last_hk_word=80
$ENDIF
	structure /saved_hk_words/
	   integer*4	major
	   integer*4	hkword
	   integer*4	file_number
	end structure
	record /saved_hk_words/
	1	svhkw(w_first_hk_word:w_last_hk_word,max_channels)
	structure /hk_indexes/
	   integer*4	mf
	   integer*4	wd
	end structure
	record /hk_indexes/ hki(w_first_hk_word:w_last_hk_word)
	logical*4	bv1, bv2, bv3
	logical*4	save_it
	integer*4	loop_count

! ...when n_opens != user(ch).n_opens do initialize shkv to all zeros
! ...return another argument=={-1,0,1} for "hk from prev, current, next"
!    so caller knows ==> handy for incrementing dpu_major_frame_number
	!----------------------------------------------------------------------
	entry	w_get_assoc_hk_field_
	1		(ch,amajor,c_item_name,val,stbit,bitlen,adjmjrok)

	w_get_assoc_hk_field = 0
	val = 0
	major = amajor

	! c_item_name is a null terminated string from C
	item_name.c = ' '
        i = 1
	do while (c_item_name(i) .ne. 0 .and. i .lt. 64)
	   item_name.b(i) = c_item_name(i)
	   i = i + 1
	end do

	if (first_time) then
	   first_time = .false.
	   event_name.c = 'HK'//null
	   ! initialize the hk word buffer, which saves words from the previous
	   ! or current major frame (even across file boundries)
	   do j=1,max_channels
	      do i=w_first_hk_word,w_last_hk_word
	         svhkw(i,j).major  = 0
	         svhkw(i,j).hkword = 0
	         svhkw(i,j).file_number = 0
	      end do
	   end do
	   ! pre-fetch all the hk index information
	   j = 0
	   do i=w_first_hk_word,w_last_hk_word
	      ok = wind_get_hk_addr_from_bitoffset(j, hki(i).mf, hki(i).wd)
	      if (ok .ne. 1) goto 24
	      j = j + 8
	   end do
	end if

	! reset the saved hk values when the stream changes
!	if (n_file_opens(ch) .ne. user(ch).n_file_opens) then
!	   do i=w_first_hk_word,w_last_hk_word
!	      svhkw(i,ch).major = 0
!	      svhkw(i,ch).hkword = 0
!	   end do
!	   n_file_opens(ch) = user(ch).n_file_opens
!	end if

	if (stbit .eq. 0 .and. bitlen .eq. 0) then
	   ! get the item structure for the named item from the item database
	   ok = w_get_item_substruct(%val(ch-1),
	1	event_name.b,
	1	c_item_name,
	1	it,
	1	%val(p_extract))
	   if (ok .ne. 1) goto 20
	else
	   it.startbit = stbit
	   it.length   = bitlen
	end if

	! determine the byte position of desired field in the hk array
	save_it = .true.
	value.i4val = 0
	z = it.startbit / 8
	if (.not. (z .ge. w_first_hk_word .and. z .le. w_last_hk_word)) then
	   goto 22
	end if
	if (svhkw(z,ch).major .eq. amajor .and.
	1   svhkw(z,ch).file_number .eq. user(ch).n_file_opens) then
	    ! the hk word was previously collected and saved
	   value.i4val = svhkw(z,ch).hkword
	else
	   ! determine the HK word and minor frame addresses of the field
	   loop_count = 1
	   mf_addr   = hki(z).mf
	   word_addr = hki(z).wd
	   message_state = user(ch).suppress_messages
	   user(ch).suppress_messages = .true.
	   ok = w_f_iiiib( %val(user(ch).f_get_word),
	1	ch,major,mf_addr, word_addr, value.b)
	   if ((ok .eq. w_bad_word_quality_flag) .and. (adjmjrok .eq. 1)) then
	      ! have detected a fluff value
	      bv1 = abs(major - svhkw(z,ch).major) .lt. 7
	      bv2 = svhkw(z,ch).file_number .eq. user(ch).n_file_opens
	      bv3 = svhkw(z,ch).major .gt. 0
	      if (bv1 .and. bv2 .and. bv3) then
	         value.i4val = svhkw(z,ch).hkword
	         save_it = .false.
	         ok = 1
	      else if (bv2 .and. (svhkw(z,ch).major .eq. 0)) then
	         ! either
	         if (major .gt. user(ch).first_major) then
	            ok = w_end_of_file
	         else
	            ok = w_beginning_of_file
	         end if
	      else if (major .eq. user(ch).first_major) then
	         ! bad data at beginning of file
	         if (adjmjrok .ne. 1) then
	            save_it = .false.
	         else
!	type *, '...setting loop_count...'
	            ok = w_beginning_of_file
	            loop_count = 7
	         end if
	      else
	         save_it = .false.  ! to fall thru to error message report
	      end if
	   end if
	   if (save_it .and. (adjmjrok .eq. 1)) then
	      if (ok .ne. 1) then
	         add = 0
	         ! desired hk is after EOF, get the word from the prev MF
	         if (ok .eq. w_end_of_file) add =  -1
	         ! desired hk is prior to BOF, get the word from the next MF
	         if (ok .eq. w_beginning_of_file) add = 1
	         major = major + add
	         if (add .eq. 0) save_it = .false.
	      end if
	      if (save_it) then
	         if (loop_count .eq. 1) then
	            ok = w_f_iiiib( %val(user(ch).f_get_word),
	1	         ch,major,mf_addr, word_addr, value.b)
	         else
	            ! try to advance over a bad spot at BOF
	            j = 0
	            do while (j .le. loop_count .and. ok .ne. 1)
!	type *, '...looping j,ok,major=',j,ok,major,'...'
	               ok = w_f_iiiib( %val(user(ch).f_get_word),
	1	            ch,major,mf_addr, word_addr, value.b)
	               if (ok .ne. 1) then
	                  j = j + 1
	                  major = major + 1
	               end if
	            end do
	         end if
	      end if
	   end if
	   user(ch).suppress_messages = message_state
	   if (ok .ne. 1) goto 26
	end if

	startbit = mod(it.startbit,8)
	if (startbit .eq. 0 .and. it.length .eq. 8) then
	   val = value.i4val
	else
	   if (startbit .ne. 0) then
	      value.i4val = value.i4val / (2**startbit)
	   end if
	   ! we work only with 8-bit entities so the mask is ff
	   i = '00ff'x / 2**(it.length)
	   val = i .and. value.i4val
	end if
!	val = zext_bits_to_longword(value.i4val,startbit,it.length)

	! save the word to the buffer
	if (save_it) then
	   i = it.startbit / 8
	   svhkw(i,ch).major = major
	   svhkw(i,ch).hkword = value.i4val
	   svhkw(i,ch).file_number = user(ch).n_file_opens
	end if

	w_get_assoc_hk_field = 1
	return
  1	format(1x,'W_GET_ASSOC_HK_FIELD: ', a, :, i9,'.',i3.3)
  2	format(1x,'W_GET_ASSOC_HK_FIELD: ', a, 1x, a, 1x, :, a)
  3	format(1x,'W_GET_ASSOC_HK_FIELD: ', a, i6)
  4	format(1x,'W_GET_ASSOC_HK_FIELD: ', a, a16, ', ok=',i5)
 20	w_get_assoc_hk_field = ok
	if (user(ch).suppress_messages) return
	type 2, 'cannot get item structure for: ', event_name.c, item_name.c
	return
 22	w_get_assoc_hk_field = 0
	if (user(ch).suppress_messages) return
	type 3, 'illegal HK word value:', i
	return
 24	w_get_assoc_hk_field = 0
	if (user(ch).suppress_messages) return
	type 3, 'cannot get HK addr at bit offset: ', j
	return
 26	w_get_assoc_hk_field = 0
	if (user(ch).suppress_messages) return
	write(6,1,iostat=o) 'cannot get HK word at or near MF.mf',
	1	 major, mf_addr
	write(6,4,iostat=o) 'HK sought is ', item_name.c, ok
!	type *, '...bv1,bv2,bv3: ', bv1, bv2, bv3
!	type *, '....major,major,.file#,file#=',
!	1   major, svhkw(i,ch).major,
!	1   svhkw(i,ch).file_number, user(ch).n_file_opens
	return
	end
!------------------------------------------------------------------------------
	integer*4	function	w_get_dpu_mjr_fr_num(ch,major,minor,dpu)
! Extracts the dpu major frame number from the stream at a given position.
! Attempts to estimate the value at EOF and BOF.  Restores the caller
! to the stream position at entry.
! From minor frame #44:
!	lw.b =  my_record.data(18)
!	lw.b1 = my_record.data(17)
! From minor frame #114:
!	lw.b2 = my_record.data(17)

	implicit	none
	include		'wind_tm_user_def.for'
	include		'wind_tm_event_def.for'
	include		'wind_return_code_def.for'
	integer*4	ch				! TM channel number
	integer*4	major				! major frame number
	integer*4	minor
	integer*4	dpu				! dpu major frame #
	integer*4	ok				! return status var
	integer*4	i,j
	integer*4	w_f_iiii			! a function
	integer*4	n_to_save
	parameter	(n_to_save=4)
	structure /mjr_dpu_buf/
	   integer*4	mjr	! file/stream MF
	   integer*4	dpu	! dpu MF at mjr
	   integer*4	fnu	! file number
	end structure
	record /mjr_dpu_buf/ bf(max_channels)
	logical*4	first_time /.true./
	logical*4	save_it
	logical*4	this_file
	logical*4	this_mjr
	logical*4	valid_dpu

	w_get_dpu_mjr_fr_num = 1

	if (first_time) then
	   first_time = .false.
	   do i=1,max_channels
	      bf(i).mjr = 0
	      bf(i).dpu = 0
	      bf(i).fnu = 0
	   end do
	end if

	! do we already have it in the buffer?
	this_file = bf(ch).fnu .eq. user(ch).n_file_opens
	this_mjr  = bf(ch).mjr .eq. major
	valid_dpu = bf(ch).dpu .gt. 0
	if (this_file .and. this_mjr .and. valid_dpu) then
	   dpu = bf(ch).dpu
	   return
	end if

	! not in the buffer, so fetch it
	ok = w_f_iiii( %val(user(ch).f_get_dpu_mf),
	1	         ch,major,minor,dpu)

!	type *, '...this_(file,mjr),valid_dpu,ok=',
!	1 this_file, this_mjr, valid_dpu, ok

	! was there a data dropout we can recover from?
	! Note that a dpu reset in conjunction with a dropout is
	! not caught with the current strategy...
	if (ok .eq. 1) then
	   save_it = .true.
	else if ((ok .eq. w_bad_word_quality_flag) .and.
	1   this_file .and. valid_dpu) then
	   save_it = .false.
	   j = major - bf(ch).mjr
!	type *, '...got bad_quality_flag, j=', j
	   if (abs(j) .lt. 4) then
	      dpu = dpu + j
	      return
	   end if
	end if
	if (ok .ne. 1) goto 10

	if (save_it) then
	   bf(ch).dpu = dpu
	   bf(ch).mjr = major
	   bf(ch).fnu = user(ch).n_file_opens
	end if

	w_get_dpu_mjr_fr_num = 1

	return
  1	format(1x,'W_GET_DPU_MJR_FR_NUM: ',a,:,i,'.',i3.3)
 10	w_get_dpu_mjr_fr_num = ok
	if (user(ch).suppress_messages) return
	type 1, 'cannot get DPU Major Frame (HK) at MF#', major
	return
	end
!------------------------------------------------------------------------------
	integer*4	function	w_get_ev_dpu_mfmf_and_hk_diff
	1	(ch,event_dpu_major,event_dpu_minor,
	1	assoc_hk_dpu_major,diff)
! This routine gets the event dpu MF.mf via item calls.  It also determines
! the difference in number of major frames between the event's
! dpu MF.mf (as recorded in a packet header) and the dpu MF.mf extracted
! from the HK of the major frame encompasing the first packet of said event.
! Some effort is given to reconcile an event's dpu MF that has been recorded
! with fewer than the available number of significant bits.
	implicit	none
	include		'c_string_def.for'
	include		'wind_tm_user_def.for'
	include		'wind_tm_event_def.for'
	include		'wind_extra_info_def.for'
	include		'wind_return_code_def.for'
	include		'item_def.for'
	integer*4	ch				! TM channel number
	integer*4	ok				! return status var
	integer*4	event_dpu_major
	integer*4	event_dpu_minor
	integer*4	assoc_hk_dpu_major
	integer*4	diff
	integer*4	nbits_event_dpu_major
	record	/extract/ it
$IF ABSOFT_FORTRAN
	character*(*)	major_name, minor_name
	parameter	(major_name='DPU_MAJOR_FRAME')
	parameter	(minor_name='DPU_MINOR_FRAME')
$ELSE
	parameter	major_name='DPU_MAJOR_FRAME'
	parameter	minor_name='DPU_MINOR_FRAME'
$ENDIF
	integer*4	i,j,k
	integer*4	old
	record /c_string_36/	name
	integer*4	w_get_item_substruct
	external	w_get_item_substruct !$pragma C( w_get_item_substruct )
	logical*4	wind_suppress_messages		! a function
	integer*4	wind_tm_get_item		! a function

	w_get_ev_dpu_mfmf_and_hk_diff = 0

	! get the DPU minor frame number of the event
!	ok = w_set_val_fail_msg(1)	! show individual validation messages
	ok = wind_tm_get_item(ch,minor_name,event_dpu_minor,1,i)
!	ok = w_set_val_fail_msg(0)
	if (ok .ne. 1) goto 130

	! get the DPU major frame number of the event
	ok = wind_tm_get_item(ch,major_name,event_dpu_major,1,i)
	if (ok .ne. 1) goto 120

	! determine the bit precision of the event dpu major frame number
	name.c = major_name//null
	ok = w_get_item_substruct( %val(ch-1),
	1	eei(ch).event_type_b,
	1	name.b,
	1	it,
	1	%val(p_extract))
	if (ok .ne. 1) goto 140
	nbits_event_dpu_major = it.length

	! Calculate the difference in dpu major frames between the event dpu
	! major frame number and the HK dpu major frame number from the
	! major frame encompassing the first packet of the event by ert.
	old = event_dpu_major
	if (nbits_event_dpu_major .lt. 24) then
	   ! make adjustment: assume high order bits of the instrument's event
	   ! dpu MF are the same as the high order bits of the associated
	   ! housekeeping dpu MF
	   ! i = 'FFFFFFFF'x	! does not work with SC0.0 f77
	   i = -1
	   j = ishft(i, nbits_event_dpu_major)
	   k = j .and. assoc_hk_dpu_major
	   event_dpu_major = event_dpu_major .or. k
	end if
	diff = assoc_hk_dpu_major - event_dpu_major
	if (diff .lt. 0) goto 160

	w_get_ev_dpu_mfmf_and_hk_diff = 1
	return
 1	format(1x,'W_GET_EV_DPU_MFMF_AND_HK_DIFF: ', a,a)
 2	format(1x,'W_GET_EV_DPU_MFMF_AND_HK_DIFF: ', a,i9,'.',i3.3)
 120	w_get_ev_dpu_mfmf_and_hk_diff = ok
	if (wind_suppress_messages(ch)) return
	type 1, 'cannot get item: ', major_name
	return

 130	w_get_ev_dpu_mfmf_and_hk_diff = ok
	if (wind_suppress_messages(ch)) return
	type 1, 'cannot get item: ', minor_name
	return

 140	w_get_ev_dpu_mfmf_and_hk_diff = ok
	if (wind_suppress_messages(ch)) return
	type 1, 'cannot get dbms structure for: ', major_name
	return

 160	w_get_ev_dpu_mfmf_and_hk_diff = w_no_dpu_mf_stream_synch
	if (wind_suppress_messages(ch)) return
	type 1, 'Event DPU MF and HK DPU MF are unreconcilable.'
	type *, '    Corrected Event DPU:', event_dpu_major
	type *, '     Original Event DPU:', old
	type *, '                 HK DPU:', assoc_hk_dpu_major
$IF ABSOFT_FORTRAN
	type 2, '  Event stream position MF.mf is',
	1	exi(ch).major, exi(ch).minor
$ELSE
	type 2, '  Event stream position MF.mf is', exi(ch).major, exi(ch).minor
$ENDIF
	return

	end
!------------------------------------------------------------------------------
	integer*4	function	wind_get_event_scet(ch,major,minor)
! Determines the event SCET, which is stored in an internal wind_lib buffer.
! For estimated scet, the bit rate (exi(ch).bit_rate) value must be correctly
! set and the ert time value correctly set (exi(ch).ert, exi(ch).ert1000).
	implicit	none
	include		'wind_tm_user_def.for'
	include		'wind_tm_event_def.for'
	include		'wind_extra_info_def.for'
	include		'wind_return_code_def.for'
	include		'wind_os_def.for'
	include		'ur8_def.for'
	integer*4	ch				! TM channel number
	integer*4	major				! major frame number
	integer*4	minor				! minor frame number
	integer*4	ok				! return status var
	integer*4	w_get_ev_dpu_mfmf_and_hk_diff	! a function
	integer*4	ur8_to_dbms			! a function
	integer*4	dbms_to_ur8			! a function
	real*8		ur8
	real*8		ur8delta
	integer*4	assoc_hk_dpu_major
	integer*4	event_dpu_major
	integer*4	event_dpu_minor
$IF ABSOFT_FORTRAN
	character*(*)	major_name, minor_name
	parameter	(major_name='DPU_MAJOR_FRAME')
	parameter	(minor_name='DPU_MINOR_FRAME')
$ELSE
	parameter	major_name='DPU_MAJOR_FRAME'
	parameter	minor_name='DPU_MINOR_FRAME'
$ENDIF
	integer*4	diff
	integer*4	scet_major
	integer*4	scet_minor
	logical*4	wind_suppress_messages
	logical*4	must_estimate
	logical*4	state
	integer*4	w_f_iiiiii
	integer*4	add
	integer*4	count /0/

	wind_get_event_scet = 0

! commented this out because new validation mechanism needs an event_scet
! estimate placed in exi(ch).scet by init_packet_dissect_info in order
! to retrieve items.
!	exi(ch).scet(1) = 0
!	exi(ch).scet(2) = 0

	! get the dpu major frame number from the house keeping associated
	! with the major frame containing the first packet of
	! the desired event in the TM stream
	assoc_hk_dpu_major = exi(ch).dpu_major_ert

	! get the difference in terms of minor frames between the associated
	! HK dpu MF.mf and the event's dpu MF.mf
	ok =  w_get_ev_dpu_mfmf_and_hk_diff
	1	(ch,event_dpu_major,event_dpu_minor,
	1	assoc_hk_dpu_major,diff)
	if (ok .ne. 1) goto 120

!	type *, 'SCET: ch, mjr, mnr: ', ch, major, minor
!	type *, 'SCET: assoc_hk_dpu_major: ', assoc_hk_dpu_major
!	type *, 'SCET: exi(ch).mjr, exi(ch).mnr: ',
!	1	exi(ch).major, exi(ch).minor
!	type *, 'SCET: exi(ch).ert: ',
!	1	exi(ch).ert(1), exi(ch).ert(2), exi(ch).ert1000
!	type *, 'SCET: event dpu MF.mf:', event_dpu_major, event_dpu_minor
!	type *, 'SCET: diff:', diff

	! the scet of the event can be approximated by
	! the scet of the "disk" MF.mf that corresponds to dpu MF.mf specified
	! in the event
	scet_major = major - diff
	scet_minor = event_dpu_minor
	must_estimate = 0
	! because this may often fail in realtime+not_recording, suppress
	! any error messages from wind_get_record
	state = wind_suppress_messages(ch)
	call wind_set_message_state(ch,.true.)
	ok = w_f_iiiiii( %val(user(ch).f_get_mf_scet_dbms),
	1    ch, scet_major, scet_minor,
	1    exi(ch).scet(1), exi(ch).scet(2), exi(ch).scet1000)
	call wind_set_message_state(ch, state)
	if (ok .eq. 1) then
	   wind_get_event_scet = 1
	   return
	else if (ok .eq. w_beginning_of_file) then
	   must_estimate = 1
	else if (ok .eq. w_not_recording) then
	   must_estimate = 1
	else if (ok .ne. 1) then
	   ! here we regenerate the error on purpose
	   if (.not. state) then
	      ok = w_f_iiiiii(%val(user(ch).f_get_mf_scet_dbms),
	1          ch, scet_major, scet_minor,
	1    exi(ch).scet(1), exi(ch).scet(2), exi(ch).scet1000)
	   end if
	   goto 230
	end if

	! the following code deals with estimating the event scet
!	count = count + 1
!	if (mod(count,100) .eq. 0) type *, count, ' SCET ESTIMATES MADE !!!'

	! determine the number of elapsed frames between start of event
	! and the theoretical mf at scet
	add = assoc_hk_dpu_major - event_dpu_major
	add = (add - 1) * 250
	add = add + exi(ch).minor + (250 - event_dpu_minor)
	diff = add

!	type *, 'SCET: new diff=', diff
!	type *, 'SCET: bit_rate:', exi(ch).bit_rate

	! assume the bit rate at ERT has been constant back through time
	! to the scet of the data; calculate a delta time correction
	if (exi(ch).bit_rate .eq. 0) then	! 1x speed (slow)
	   ur8delta = ur8_1x_mf_diff * diff
	else					! 2x speed (fast)
	   ur8delta = ur8_2x_mf_diff * diff
	end if

!	type *, 'SCET: ur8delta= ', ur8delta

	! convert the ert time to ur8
	ok = dbms_to_ur8(exi(ch).ert(1), exi(ch).ert(2), exi(ch).ert1000, ur8)
	if (ok .ne. 1) goto 300

!	type *, 'SCET: ert in ur8 format: ', ur8

	! apply the delta time correction
	ur8 = ur8 - ur8delta

!	type *, 'SCET: scet in ur8 format: ', ur8
!xxxxxxxjk what about exi(ch).ur8_scet
	! convert the adjusted time to dbms format
$IF ABSOFT_FORTRAN
	ok = ur8_to_dbms(ur8, exi(ch).scet(1),
	1	exi(ch).scet(2), exi(ch).scet1000)
$ELSE
	ok = ur8_to_dbms(ur8, exi(ch).scet(1), exi(ch).scet(2), exi(ch).scet1000)
$ENDIF
	if (ok .ne. 1) goto 310

!	type *, 'SCET: scet (dbms fmt): ',
!	1	exi(ch).scet(1), exi(ch).scet(2), exi(ch).scet1000

	wind_get_event_scet = 1
	return
 1	format(1x,'WIND_GET_EVENT_SCET: ', a,:,z8.8,'X')
 2	format(1x,'WIND_GET_EVENT_SCET: ', a,1x,i12,'.',i3.3)
 3	format(1x,'WIND_GET_EVENT_SCET: ', a,/,
	1	'   rate=', g10.4, ', diff=',i7, ', ERT:', a)

! 100	wind_get_event_scet = ok
!	if (wind_suppress_messages(ch)) return
!	type 1, 'cannot get associated HK for event, ok=', ok
!	return

! 110	wind_get_event_scet = ok
!	if (wind_suppress_messages(ch)) return
!	type 1, 'cannot get "DPU_MF" item from GLOBAL event entries, ok=',ok
!	return

! 114	wind_get_event_scet = ok
!	if (wind_suppress_messages(ch)) return
!	type 1, 'cannot get HK DPU MF, ok=',ok
!	return

 120	wind_get_event_scet = ok
	if (wind_suppress_messages(ch)) return
	type 1, 'cannot get event DPU MF.mf or diff, ok=', ok
	return

 230	wind_get_event_scet = ok
	if (wind_suppress_messages(ch)) return
	type 1, 'cannot get SCET of position, ok=',ok
	return

! 240	wind_get_event_scet = ok
!	if (wind_suppress_messages(ch)) return
!	type 1, 'cannot calculate the frame difference.'
!	return
!
! 242	wind_get_event_scet = 0
!	if (wind_suppress_messages(ch)) return
!	type 1, 'negative frame difference.'
!	return

! 246	wind_get_event_scet = ok
!	if (wind_suppress_messages(ch)) return
!	type 1, 'cannot get frame period, ok=', ok
!	return
!
! 248	wind_get_event_scet = ok
!	if (wind_suppress_messages(ch)) return
!	type 1, 'cannot convert real*8 time to system time.'
!	return
!
! 249	wind_get_event_scet = ok
!	if (wind_suppress_messages(ch)) return
!	type 2, 'cannot get record for estimating SCET:',major,minor
!	return
!
! 250	wind_get_event_scet = ok
!	if (wind_suppress_messages(ch)) return
!	i = sys_asctim(,str,scet,)
!	type 3, 'cannot subtract two system times', rate, diff, str
!	return
!
! 252	wind_get_event_scet = ok
!	if (wind_suppress_messages(ch)) return
!	type 1, 'cannot convert (calculated) SCET to 23-char format time.'
!	return

! 270	wind_get_event_scet = ok
!	if (wind_suppress_messages(ch)) return
!	type 1, 'cannot convert (record) SCET to 23-char format time.'
!	return

! 280	wind_get_event_scet = ok
!	if (wind_suppress_messages(ch)) return
!	type 1, 'cannot convert SCET to DBMS format time.'
!	return

! 290	wind_get_event_scet = w_bad_date_time_in_frame
!	if (wind_suppress_messages(ch)) return
!	type 1, 'cannot get fractional SCET.'
!	return

 300	wind_get_event_scet = ok
	if (wind_suppress_messages(ch)) return
	type 1, 'cannot convert DBMS fmt ERT to UR8, ok=',ok
!	type *, exi(ch).ert(1), exi(ch).ert(2), exi(ch).ert1000
	return

 310	wind_get_event_scet = ok
	if (wind_suppress_messages(ch)) return
	type 1, 'cannot convert UR8 SCET estimate to DBMS fmt, ok=',ok
	return

	end
!------------------------------------------------------------------------------
	integer*4	function	wind_get_plain_fill_packet
	1			(ch,major,minor,event_name,direction,seek_1st)
! This routine gathers up a TM packet from the "fill" of the specified stream.
! The search
! begins at the specified major,minor frame position and continues, if
! necessary, using the direction and seek_1st arguments as criteria.
! The "packet" member of the user's wind_lib internal data structure is
! filled with the gathered packet.
!
	implicit	none
	include		'wind_os_def.for'
	include		'c_string_def.for'
	include		'wind_tm_user_def.for'
	include		'wind_tm_event_def.for'
	include		'wind_return_code_def.for'

	integer*4	ch			! r
	integer*4	major			! rw
	integer*4	minor			! rw
	character*(*)	event_name		! rw, is 'FILL' on first call
	integer*4	direction		! r
	logical*4	seek_1st		! r, seek a 1st packet of event

	logical*4	waiting_for_fillidx_one
	logical*4	got_fill
	logical*4	building_fill_packet
	logical*4	looking_for_acceptable_packet

	integer*4	i,j,k
	integer*4	ok
	integer*4	w_f_iiiiiib		! a function
	integer*4	any_id
	integer*4	fillptr
	integer*4	fillidx
	record /low_byte/ lb
	integer*4	expected_fillidx
	integer*4	size_of_fill
	integer*4	wid_get_item_xlate
	external	wid_get_item_xlate !$pragma C ( wid_get_item_xlate )
$IF ABSOFT_FORTRAN
	integer*4	all_subtypes
	parameter	(all_subtypes='0000ffff'x)
$ELSE
	parameter	all_subtypes='0000ffff'x
$ENDIF
	integer*4	id
	integer*4	n_bytes_copied
	record /c_string_32/	c32
	record /c_string_16/	c16
	record /c_string_8/	c8
	byte		fillpacket(512)

	wind_get_plain_fill_packet = 0

	! get a fill packet
	any_id = -99
	looking_for_acceptable_packet = .true.
	do while(looking_for_acceptable_packet)
	   expected_fillidx = 1
	   waiting_for_fillidx_one = .true.
	   do i=1,431
	      fillpacket(i) = 0
	   end do
	   building_fill_packet = .true.
	   n_bytes_copied = 0

	   do while(building_fill_packet)
	      ok = w_f_iiiiiib( %val(user(ch).f_get_plain_packet),
!	1          ch,major,minor,any_id,direction,1,user(ch).packet.w)
	1          ch,major,minor,any_id,direction,0,user(ch).packet.w)
	      if (ok .ne. 1) goto 30
	      fillptr = zext(user(ch).packet.w(2))
	      i = zext(user(ch).packet.w(1))
	      if (btest(i,0)) fillptr = ibset(fillptr,8)
	      if (fillptr.le.428 .and. fillptr.ge.3) then
	         size_of_fill = 431 - fillptr - 2 - 1
	         lb.i4val = 0
	         lb.b  = user(ch).packet.w(fillptr)
	         lb.b1 = user(ch).packet.w(fillptr+1)
	         fillidx = lb.i4val
	         if (fillidx .eq. 1) waiting_for_fillidx_one = .false.
	         got_fill = (fillidx .gt. 0)

	         if ((.not. waiting_for_fillidx_one) .and. got_fill) then
	            ! make sure the the fill index is the expected value
	            if (expected_fillidx .ne. fillidx) then
	               goto 40
	            end if
	            expected_fillidx = fillidx + size_of_fill
	            ! copy the fill to another packet we are building up
	            j = fillidx
	            k = fillptr + 2
	            do i=1,size_of_fill
	               if (j.le.431) fillpacket(j) = user(ch).packet.w(k)
	               j = j + 1
	               k = k + 1
	            end do
	            if (j.gt.431) building_fill_packet = .false.
	            n_bytes_copied = j - 1
	         end if
	      end if
	      if (building_fill_packet) then
		 call wind_tm_increment_packet(major,minor)
	      end if
	   end do

	   if (seek_1st) then
	      ! low bit is set for 1st packet flag
!	      looking_for_acceptable_packet = .not. zext(fillpacket(1))
	      j = zext(fillpacket(1))
	      looking_for_acceptable_packet = (j .and. 1) .eq. 0
	   else
	      looking_for_acceptable_packet = .false.
	   end if
	end do

	! copy the fill packet into the user's packet buffer for this channel
	j = 0
	do i=1,431
	   user(ch).packet.w(j) = fillpacket(i)
	   j = j + 1
	end do

	if (seek_1st) then
	   ! rename the event from FILL to whatever event name corresponds
	   ! to the packet id
	   i = zext(fillpacket(1))
	   id = i/16 	! shift right 4 bits
	   c8.c = 'GLOBAL'//char(0)
	   c16.c = 'PACKET_TYPE'// char(0)
	   ok = wid_get_item_xlate(%val(ch-1), c8.b, c16.b, id,
	1	c32.b, %val(32), %val(0))
	   if (ok .ne. 1) goto 20
	   event_name = c32.c
	end if

	wind_get_plain_fill_packet = 1

  1	format(1x, 'WIND_GET_PLAIN_FILL_PACKET: ', a)
  7	format(3x, 'Expecting ', i4, ' (', z8.8,'x)',
	1          ' but got ',  i4, ' (', z8.8, 'x).' )
	return
 20	wind_get_plain_fill_packet = ok
	if (user(ch).suppress_messages) return
	type 1, 'Cannot get reverse xlate for event name.'
	type *, '  Make sure event GLOBAL, item PACKET_SUBTYPE, ',
	1	'is in the item database.'
	return
 30	wind_get_plain_fill_packet = ok
	if (user(ch).suppress_messages) return
	type 1, 'Cannot get packet to extract fill from.'
	return
 40	wind_get_plain_fill_packet = 0
	if (user(ch).suppress_messages) return
	type 1, 'Fill sequential index counter is out of sequence.'
	type 7, expected_fillidx, expected_fillidx, fillidx, fillidx
	return
	end
!------------------------------------------------------------------------------
	integer*4	function	w_get_mjr_fr_event
	1				(ch,major,minor)
! Gets "major frame" event and places it in an internal buffer.
	implicit	none
	include		'wind_tm_user_def.for'
	include		'wind_return_code_def.for'
	include		'wind_tm_event_def.for'
	include		'wind_extra_info_def.for'
	integer*4	ch
	integer*4	major
	integer*4	minor
	integer*4	w_f_iiii
	integer*4	i,j,k,m
	integer*4	o
	integer*4	num_missing
	integer*4	got_a_record
	integer*4	ok
$IF ABSOFT_FORTRAN
!	character*(*)	rn
!	parameter	(rn='W_GET_MJR_FR_EVENT')
$ELSE
!	parameter	rn='W_GET_MJR_FR_EVENT'
$ENDIF
	integer*4	get_instrument_version		! a function
	integer*4	w_get_dpu_mjr_fr_num		! a function
	integer*4	wnd_to_dbms			! a function
	integer*4	wnd_to_ur8			! a function
	integer*4	dbms_to_ur8			! a function
	logical*4	first_rec

	k = 0
	first_rec = .true.
	num_missing = 0
	w_get_mjr_fr_event = 0
	eei(ch).event_type	= 'MAJOR_FRAME'//char(0)

	do i=min_minor_frame_num,max_minor_frame_num
	   got_a_record = w_f_iiii(%val(user(ch).f_get_intrnl_rec),
	1	ch, major, i, user(ch).wind_record)
	   if (got_a_record .eq. 1) then
	      m = k
	      do j=0,255
	         eb(ch).major_frame(m) = user(ch).wind_record.data(j)
	         m = m + 1
	      end do
	      if (first_rec) then
	         ! use the first valid minor frame for event timing info,
	         ! which may not always be mf# 0.  At this writing the
	         ! "event time" for the major frame event is not critical.
	         exi(ch).minor = i
	         exi(ch).major = major
	         ok = wnd_to_dbms(user(ch).wind_record.scet,
	1	   exi(ch).scet(1), exi(ch).scet(2), exi(ch).scet1000)
	         exi(ch).ert(1) = exi(ch).scet(1)
	         exi(ch).ert(2) = exi(ch).scet(2)
	         ok = dbms_to_ur8(
	1             exi(ch).scet(1), exi(ch).scet(2), exi(ch).scet1000,
	1	      exi(ch).ur8_scet)
	         exi(ch).ur8_context = exi(ch).ur8_scet
	         exi(ch).ur8_ert     = exi(ch).ur8_scet
	         first_rec = .false.
	      end if
	   else
	      num_missing = num_missing + 1
	      do j=0,255
	         eb(ch).major_frame(k+j) = -1
	      end do
	   end if
	   k = k + 256
	end do

	! get the end-of-event time
	ok = wnd_to_ur8(user(ch).wind_record.scet, exi(ch).ur8_eoe)

	! get instrument version numbers from associated HK
	ok = get_instrument_version(ch, 'DPU', exi(ch).dpu_version)
	ok = get_instrument_version(ch, 'FFT', exi(ch).fft_version)
	ok = get_instrument_version(ch, 'TDS', exi(ch).tds_version)

	! get the DPU major frame number
	ok = w_get_dpu_mjr_fr_num(ch,major,minor,exi(ch).dpu_major_ert)

	if (num_missing .ne. 0) goto 10
	w_get_mjr_fr_event = 1

	return
  1	format(1x,'W_GET_MJR_FR_EVENT: ', a, i3)
 10	w_get_mjr_fr_event = w_missing_record
	if (user(ch).suppress_messages) return
	write(6,1,iostat=o) 'Missing minor frame(s), count=',
	1	num_missing
	return
	end
!------------------------------------------------------------------------------
	integer*4	function	w_get_mnr_fr_event
	1				(ch,major,minor)
! Gets a "minor frame" event and places it in an internal buffer.
	implicit	none
	include		'wind_tm_user_def.for'
	include		'wind_return_code_def.for'
	include		'wind_tm_event_def.for'
	include		'wind_extra_info_def.for'
	integer*4	ch
	integer*4	major
	integer*4	minor
	integer*4	w_f_iiii
	integer*4	j,k
	integer*4	o
	integer*4	num_missing
	integer*4	got_a_record
	integer*4	ok
$IF ABSOFT_FORTRAN
!	character*(*)	rn
!	parameter	(rn='W_GET_MNR_FR_EVENT')
$ELSE
!	parameter	rn='W_GET_MNR_FR_EVENT'
$ENDIF
	integer*4	get_instrument_version		! a function
	integer*4	w_get_dpu_mjr_fr_num		! a function
	integer*4	wnd_to_dbms			! a function
	integer*4	dbms_to_ur8			! a function

	k = 0
	num_missing = 0
	w_get_mnr_fr_event = 0
	eei(ch).event_type	= 'MINOR_FRAME'//char(0)

	got_a_record = w_f_iiii(%val(user(ch).f_get_intrnl_rec),
	1	ch, major, minor, user(ch).wind_record)
	if (got_a_record .eq. 1) then
	   do j=0,255
	      eb(ch).minor_frame(j) = user(ch).wind_record.data(j)
	   end do
	   exi(ch).minor = minor
	   exi(ch).major = major
	   ok = wnd_to_dbms(user(ch).wind_record.scet,
	1       exi(ch).scet(1), exi(ch).scet(2), exi(ch).scet1000)
	   exi(ch).ert(1) = exi(ch).scet(1)
	   exi(ch).ert(2) = exi(ch).scet(2)
	   ok = dbms_to_ur8(
	1       exi(ch).scet(1), exi(ch).scet(2), exi(ch).scet1000,
	1	exi(ch).ur8_scet)
	   exi(ch).ur8_context = exi(ch).ur8_scet
	   exi(ch).ur8_ert     = exi(ch).ur8_scet
	   exi(ch).ur8_eoe     = exi(ch).ur8_scet
	else
	   do j=0,255
	      eb(ch).minor_frame(j) = -1
	   end do
	end if

	! get instrument version numbers from associated HK
	ok = get_instrument_version(ch, 'DPU', exi(ch).dpu_version)
	ok = get_instrument_version(ch, 'FFT', exi(ch).fft_version)
	ok = get_instrument_version(ch, 'TDS', exi(ch).tds_version)

	! get the DPU major frame number
	ok = w_get_dpu_mjr_fr_num(ch,major,minor,exi(ch).dpu_major_ert)

	if (got_a_record .ne. 1) goto 10
	w_get_mnr_fr_event = 1

	return
  1	format(1x,'W_GET_MNR_FR_EVENT: ', a, i9,'.',i3.3)
 10	w_get_mnr_fr_event = w_missing_record
	if (user(ch).suppress_messages) return
	write(6,1,iostat=o) 'Missing minor frame at ',major, minor
	return
	end
!------------------------------------------------------------------------------
	integer*4	function	w_get_packet_event
	1				(ch,major,minor)
! Gets a "packet" event and places it in an internal buffer.
	implicit	none
	include		'wind_tm_user_def.for'
	include		'wind_return_code_def.for'
	include		'wind_tm_event_def.for'
	include		'wind_extra_info_def.for'
	integer*4	ch
	integer*4	major
	integer*4	minor
	integer*4	w_f_iiiiiib
	integer*4	i,j,k
	integer*4	o
	integer*4	num_missing
	integer*4	got_a_packet
	integer*4	ok
$IF ABSOFT_FORTRAN
!	character*(*)	rn
!	parameter	(rn='W_GET_PACKET_EVENT')
$ELSE
!	parameter	rn='W_GET_PACKET_EVENT'
$ENDIF
	integer*4	get_instrument_version		! a function
	integer*4	w_get_dpu_mjr_fr_num		! a function
$IF ABSOFT_FORTRAN
	integer*4	wnd_to_dbms			! a function
$ENDIF
	integer*4	dbms_to_ur8			! a function
	integer*4	w_f_iiiiii			! a function
	integer*4	end_minor
	record /low_byte/ lb

	k = 0
	num_missing = 0
	w_get_packet_event = 0
	eei(ch).event_type = 'PACKET'//char(0)

	! call the packet retrieval routine
	got_a_packet = w_f_iiiiiib( %val(user(ch).f_get_plain_packet),
	1	ch,major,minor,
	1	-1,forward,0,		! any pkt id, forward, not first pkt ok
	1	eb(ch).packet)
	! test for successful packet get is below

	! set the position fields for frame numbers
	end_minor = minor
	exi(ch).minor = minor
	exi(ch).major = major

	! get dbms time of first record in packet
	if (minor .ne. 0) then
	   minor = minor - (mod(minor,10))
	end if
	ok = w_f_iiiiii( %val(user(ch).f_get_mf_scet_dbms),
	1	ch,major,minor,
	1	exi(ch).ert(1),
	1	exi(ch).ert(2),
	1	exi(ch).ert1000)
	ok = dbms_to_ur8(
	1       exi(ch).ert(1), exi(ch).ert(2), exi(ch).ert1000,
	1	exi(ch).ur8_ert)
	exi(ch).scet(1) = exi(ch).ert(1)
	exi(ch).scet(2) = exi(ch).ert(2)
	exi(ch).ur8_context = exi(ch).ur8_scet
	exi(ch).ur8_ert     = exi(ch).ur8_scet

	! now set the end-of-event ur8 time field
	ok = w_f_iiiiii( %val(user(ch).f_get_mf_scet_dbms),
	1	ch,major,minor,
	1	i,j,k)
	ok = dbms_to_ur8(i,j,k, exi(ch).ur8_eoe)

	! set current position in main user structure
	user(ch).wind_record.major_frame = major
	lb.i4val = minor
	user(ch).wind_record.minor_frame = lb.b

	! get instrument version numbers from associated HK
	ok = get_instrument_version(ch, 'DPU', exi(ch).dpu_version)
	ok = get_instrument_version(ch, 'FFT', exi(ch).fft_version)
	ok = get_instrument_version(ch, 'TDS', exi(ch).tds_version)

	! get the DPU major frame number
	ok = w_get_dpu_mjr_fr_num(ch,major,minor,exi(ch).dpu_major_ert)

	! get the sc mode

	! get the current bit rate

	if (got_a_packet .ne. 1) goto 10
	w_get_packet_event = 1

	return
  1	format(1x,'W_GET_PACKET_EVENT: ', a, i9,'.',i3.3)
 10	w_get_packet_event = w_missing_record
	if (user(ch).suppress_messages) return
	write(6,1,iostat=o) 'Missing minor frame at ',major, minor
	return
	end

ext: for


text:
C     Bug: yacc stack overflow with the data list for PSTR
C     Modification: calls were eliminated to avoid increasing the source file

      SUBROUTINE HIT(COORD,ORIGIN,DIR)
      INTEGER COORD(4),DIR,ORIGIN
C
      INTEGER DIMS
      PARAMETER (DIMS=4)
      PARAMETER ( L1=12, L2=12, L3=12, L4=12 )
      PARAMETER ( MBAR=18*L1*L2*L3 )
      INTEGER UMAX
      PARAMETER ( UMAX=72*L1*L2*L3*L4 )
      INTEGER LATT(DIMS),LATT1(DIMS),MOV(DIMS),ROT(DIMS),WHICH(13,13)
      REAL WLOOP(13,13),RES(13,13,6),BETA,LEGS(MBAR)
      COMMON /COMSYS/ BETA,WLOOP,RES,LEGS,LATT,LATT1,MOV,ROT,WHICH
C
      REAL U1(UMAX)
      COMMON /COMU1/ U1
C
      INTEGER OTHEND,SITE,CNT
      INTEGER PU
      REAL ST(18,6)
      INTEGER PTEMP(24)
C
      INTEGER PSTR(24,4)
      SAVE PSTR
C
      DATA PSTR/ 2,5,6,14,6,5,2,14,3,5,7,14,7,5,3,14,4,5,8,14,8,5,4,14,
     .           1,6,5,14,5,6,1,14,3,6,7,14,7,6,3,14,4,6,8,14,8,6,4,14,
     .           1,7,5,14,5,7,1,14,2,7,6,14,6,7,2,14,4,7,8,14,8,7,4,14,
     .           1,8,5,14,5,8,1,14,2,8,6,14,6,8,2,14,3,8,7,14,7,8,3,14 /
C
C      CALL CPYMAT(PTEMP,PSTR(1,DIR+1),24) LPOINTER 4-3-89
C      CALL ICPYMT(PTEMP,PSTR(1,DIR+1),24)
C
      IF(COORD(DIR+1).EQ.LATT1(DIR+1)) THEN
        OTHEND = 0
      ELSE
        OTHEND = COORD(DIR+1)+1
      ENDIF
C
      COORD(DIR+1) = OTHEND
      SITE = COORD(1)*MOV(1)+COORD(2)*MOV(2)+COORD(3)*MOV(3)+
     .           COORD(4)*MOV(4)
      CNT = 1
      DO 1 J=1,6
        COORD(DIR+1) = OTHEND
C        CALL SYSLOP(COORD,SITE,PTEMP(CNT),ST(1,J),NCHAR)
        CNT = NCHAR+CNT
    1 CONTINUE
C
      PU = ORIGIN+ROT(DIR+1)
C      CALL CHOOS(ST(1,1),U1(PU+1))
C
      RETURN
      END

ext: f


text:
      SUBROUTINE EMG
C
C     ELEMENT-MATRIX-GENERATOR MAIN DRIVING ROUTINE.
C
C     DMAP SEQUENCE
C
C     EMG, EST,CSTM,MPT,DIT,GEOM2, /KMAT,KDICT, MMAT,MDICT, BMAT,BDICT/
C          V,N,NOKGG/V,N,NOMGG/V,N,NOBGG/V,N,NOK4GG/V,N,NOKDGG/
C          C,Y,COUPMASS/C,Y,CPBAR/C,Y,CPROD/C,Y,CPQUAD1/C,Y,CPQUAD2/
C          C,Y,CPTRIA1/C,Y,CPTRIA2/C,Y,CPTUBE/C,Y,CQDPLT/C,Y,CPTRPLT/
C          C,Y,CPTRBSC/V,Y,VOLUME/V,Y,SURFACE $
C
      LOGICAL         ERROR, ANYCON, NOGO, HEAT, LINEAR
      INTEGER         Z, EST, CSTM, DIT, GEOM2, DICTN
      INTEGER         PRECIS, CMASS, FLAGS, NAME(2)
      DIMENSION       IBUF(7),MCB(7)
      COMMON /BLANK / NOK, NOM, NOB, NOK4GG, NOKDGG, CMASS
      COMMON /EMGPRM/ ICORE, JCORE, NCORE, ICSTM, NCSTM, IMAT, NMAT,
     1                IHMAT, NHMAT, IDIT, NDIT, ICONG, NCONG, LCONG,
     2                ANYCON, FLAGS(3), PRECIS, ERROR, HEAT, ICMBAR,
     3                LCSTM, LMAT, LHMAT, KFLAGS(3), L38
      COMMON /ZZZZZZ/ Z(1)
      COMMON /EMGFIL/ EST, CSTM, MPT, DIT, GEOM2, MATS(3), DICTN(3)
      COMMON /HMATDD/ SKP(4), LINEAR
      COMMON /SYSTEM/ KSYSTM(65)
      COMMON /MACHIN/ MACH
      EQUIVALENCE     (KSYSTM(3),NOGO), (KSYSTM(55),IPRECI),
     1                (KSYSTM(2),NOUT), (KSYSTM(56),NOHEAT)
      DATA    NAME  / 4HEMG ,4H     /
C
C     SET EMG PRECISION FLAG TO SYSTEM PRECISION FLAG
C
      PRECIS = IPRECI
C
C     IF .NOT.1 .AND. .NOT.2 DEFAULT EMG PRECISION TO SINGLE
C
      IF (PRECIS.LT.1 .OR. PRECIS.GT.2) PRECIS = 1
C
C     HEAT  FORMULATION
C
      HEAT   = .FALSE.
      IF (NOHEAT .LE. 0) GO TO 2
      HEAT   = .TRUE.
      LINEAR = .TRUE.
      NOKDGG = -1
C
C     TEST FOR NO SIMPLE ELEMENTS
C
    2 NOGO   = .FALSE.
      MCB(1) = 101
      CALL RDTRL (MCB)
      IF (MCB(1) .LT. 0) GO TO 3
      IF (MCB(2).NE.0 .OR. MCB(5).NE.0 .OR. MCB(6).NE.0 .OR.
     1    MCB(7).NE.0) GO TO 5
    3 NOK = -1
      NOM = -1
      NOB = -1
      NOK4GG = -1
      RETURN
C
C     SET OPEN CORE
C
    5 NCORE = KORSZ(Z(1))
      ICORE = 3
      IF (MACH.EQ.3 .OR. MACH.EQ.4) CALL EMGSOC (ICORE,NCORE,HEAT)
      NCORE = NCORE - 1
      JCORE = ICORE
C
C     SET WORKING CORE TO ALL ZEROS
C
      DO 10 I = ICORE,NCORE
      Z(I) = 0
   10 CONTINUE
C
C     THIS MODULE WILL SET NOK4GG = -1 . IF DURING EXECUTION A NON-ZERO
C     DAMPING CONSTANT IS DETECTED IN A DICTIONARY BY EMGOUT, NOK4GG
C     WILL BE SET TO 1
C
C     A DMAP DETERMINATION CAN THEN BE MADE WHETHER OR NOT TO HAVE EMA
C     FORM THE K4GG MATRIX
C
      NOK4GG = -1
C
C     SET GINO FILE NUMBERS
C
      EST    = 101
      CSTM   = 102
      MPT    = 103
      DIT    = 104
      GEOM2  = 105
      DO 20 I = 1,3
      MATS(I) = 199 + 2*I
      DICTN(I) = MATS(I) + 1
   20 CONTINUE
      ERROR = .FALSE.
C
C     IF DIAG 38 IS ON, PRINT TOTAL TIME (IN SECONDS) USED BY EMGPRO
C     AND MESSAGES 3113 AND 3107  WHILE PRPCESSING ELEMENTS
C
      CALL SSWTCH (38,L38)
C
C     READ AND SETUP INTO CORE MISC. TABLES.
C     E.G. MPT, CSTM, DIT, ETC.
C
      CALL EMGTAB
C
C     PROCESS ANY CONGRUENT DATA CARDS AND BUILD TABLE IN OPEN CORE.
C
      CALL EMGCNG
C
C     SETUP BALANCE OF CORE WITH REQUIRED BUFFERS AND OPEN
C     REQUIRED DATA BLOCKS.
C
      CALL EMGCOR (IBUF)
C
C     PASS THE EST AND WRITE THE OUTPUT DATA BLOCKS.
C
      IF (L38 .EQ. 1) CALL KLOCK (I)
      CALL EMGPRO (IBUF)
      IF (L38 .EQ. 0) GO TO 40
      CALL KLOCK (J)
      J = J - I
      WRITE  (NOUT,30) J
   30 FORMAT (///,34H *** EMG ELEMENT PROCESSING TIME =,I10,8H SECONDS)
C
C     WRAP-UP OPERATIONS.
C
   40 CALL EMGFIN
      IF (NOGO .OR. ERROR) CALL MESAGE (-37,0,NAME)
      RETURN
      END


text:
Chris Impulse must own Impulse Recording Studio, or else his name is pure coincidence.

20140716 13:30:12 nbsp Hi Chris! Welcome to the wiki!

To upload a photo on a page…

Edit the page
Look for a box near the bottom that says upload files.
A new window opens up, pick an image file from your computer and upload it.
On this same window, a new line will appear with red text.
Copy that text and paste it into the edit page of the Impulse studio.
Preview the changes, and hit save if all is well.

There are other little tags you can add to change the scale of the photos or their placement on the page.
Image(sample.jpg, right, thumbnail, 300,This would be a caption)    Remove that

Users/ToddKaiser

max_stars_repo_name: voflo/Search

max_issues_repo_name: voflo/Search

max_forks_repo_name: voflo/Search


text:
	SUBROUTINE SFMOVR  ( sx, sy, ox, oy, npt, offxy, iret )
C************************************************************************
C* SFMOVR								*
C*									*
C* This subroutine determines if a station overlaps earlier stations.	*
C*									*
C* SFMOVR  ( SX, SY, OX, OY, OFFXY, IER )				*
C*									*
C* Input parameters:							*
C*	SX		REAL		Station x (N coord)		*
C*	SY		REAL		Station y (N coord)		*
C*	OX (NPT)	REAL		Previous x (N coord)		*
C*	OY (NPT)	REAL		Previous y (N coord)		*
C*	NPT		INTEGER		Number of previous stations	*
C*	OFFXY(*)	REAL		Size of station model (N coord)	*
C*									*
C* Output parameters:							*
C*	IRET		INTEGER		Return code			*
C*					  0 = no overlap		*
C*					 -1 = overlap			*
C**									*
C* Log:									*
C* I. Graffman/RDS	12/84						*
C* M. desJardins/GSFC	 6/88	Added looping within program		*
C* G. Huffman/GSC	 1/89	N coord., change IER to IRET		*
C************************************************************************
	REAL		offxy (*), ox (*), oy (*)
C------------------------------------------------------------------------
	iret = 0
C
C*	Set bounds for station.
C
	gslef = sx - offxy (1)
	gsrt  = sx + offxy (2)
	gsup  = sy + offxy (3)
	gsdwn = sy - offxy (4)
C
C*	Loop through all stations.
C
	istn = 1
	DO WHILE  ( ( istn .le. npt ) .and. ( iret .eq. 0 ) )
C
C*	    Set bounds for possible overlapping station.
C
	    oslef = ox (istn) - offxy (1)
	    osrt  = ox (istn) + offxy (2)
	    osup  = oy (istn) + offxy (3)
	    osdwn = oy (istn) - offxy (4)
C
C*	    Check for overlap
C
	    IF  ((((oslef .ge. gslef) .and. (oslef .le. gsrt)) .or.
     +		  ((osrt  .ge. gslef) .and. (osrt  .le. gsrt))) .and.
     +		 (((osup  .ge. gsdwn) .and. (osup  .le. gsup)) .or.
     +		  ((osdwn .ge. gsdwn) .and. (osdwn .le. gsup))))  THEN
		iret = -1
	    END IF
C*
	    istn = istn + 1
	END DO
C*
	RETURN
	END

max_stars_repo_name: oxelson/gempak

max_issues_repo_name: oxelson/gempak

max_forks_repo_name: oxelson/gempak


text:
!! https://gcc.gnu.org/bugzilla/show_bug.cgi?id=54070
!! this example marked a duplicate of https://gcc.gnu.org/bugzilla/show_bug.cgi?id=50221
!!
!! Compiles with 5.2 and 6.0 20151025, but both return the wrong result:
!! barbar (expect "foobar")
!!

program main
  character(:), pointer :: s(:)
  allocate(character(3)::s(2))
  s(1) = 'foo'; s(2) = 'bar'
  print '(2a)', s ! expect foobar
end program

max_stars_repo_name: dhnza/fortran-compiler-tests

max_issues_repo_name: dhnza/fortran-compiler-tests

max_forks_repo_name: dhnza/fortran-compiler-tests