PROGRAM HTRPARAM



C	To Compile:	$ FORTRAN/NOI4/CHECK=NOOVERFLOW HTRPARAM
C	To Link:	$ LINK/NOTRACE HTRPARAM


	CHARACTER*80	IOTYPE
	LOGICAL*2	DISK_IO


	WRITE(*,10)
10	FORMAT(' [HTRPARAM    5-JAN-1989]')
	WRITE(*,20)
20	FORMAT(' READ from TAPE or DISK? [TAPE]  ',$)
	READ(*,30)IOTYPE
30	FORMAT(A)
	DISK_IO = ((IOTYPE(1:1).EQ.'D').OR.(IOTYPE(1:1).EQ.'d'))
	IF(DISK_IO)THEN
		CALL DISKHTR
	ELSE
		CALL TAPEHTR
	ENDIF


	END




C	***********************************************************************

	SUBROUTINE DISKHTR


	STRUCTURE	/X_RAYS/		!Record Length = 256 bytes
		INTEGER*2	X11(16)		!X-RAY detectors (1.024 sec)
		INTEGER*2	X12(16)
		INTEGER*2	X13(16)
		INTEGER*2	X14(16)
		INTEGER*2	X21(16)
		INTEGER*2	X22(16)
		INTEGER*2	X23(16)
		INTEGER*2	X24(16)
	END STRUCTURE

	STRUCTURE	/HE_MATRIX/		!Record Length = 288 bytes
		INTEGER*2	H56(8)		!HEM elements (2.048 sec)
		INTEGER*2	H57(8)
		INTEGER*2	H58(8)
		INTEGER*2	H59(8)
		INTEGER*2	H60(8)
		INTEGER*2	H61(8)
		INTEGER*2	H62(8)
		INTEGER*2	H63(8)
		INTEGER*2	H64(8)
		INTEGER*2	H65(8)
		INTEGER*2	H66(8)
		INTEGER*2	H67(8)
		INTEGER*2	H68(8)
		INTEGER*2	H69(8)
		INTEGER*2	H70(8)
		INTEGER*2	H71(8)
		INTEGER*2	H72(8)
		INTEGER*2	H73(8)
	END STRUCTURE

	STRUCTURE	/MC_WINDOWS/		!Record Length = 48 bytes
		INTEGER*2	MCW1(8)		!Main Channel Windows
		INTEGER*2	MCW2(8)		!(2.048 sec)
		INTEGER*2	MCW3(8)
	END STRUCTURE

	STRUCTURE	/OBC_PARAM/		!Record Length = 36 bytes
		INTEGER*2	ALT		!Spacecraft Altitude
		INTEGER*2	RA		!Spacecraft Right Ascension
		INTEGER*2	DEC		!Spacecraft Declination
		INTEGER*2	RAS		!Sun Right Ascension
		INTEGER*2	DECS		!Sun Declination
		INTEGER*2	ASP		!Aspect Angle w.r.t. Earth
		INTEGER*2	ROLL		!Roll Angle
		INTEGER*2	SCLA		!Spacecraft Latitude
		INTEGER*2	SCLO		!Spacecraft Longitude
		INTEGER*2	MAG		!Magnetic Field Total
		INTEGER*2	MX		!Magnetic Field x-axis
		INTEGER*2	MY		!Magnetic Field y-axis
		INTEGER*2	RIG		!Rigidity
		INTEGER*2	FACT		!Flare Activity Rate
		INTEGER*2	SAA		!S. American Anomaly det. rate
		INTEGER*2	HXRB		!HXRBS rate > 300 KeV
		INTEGER*2	FLR		!Flare Flag from HXIS
		INTEGER*2	MAXI		!Flare Intensity from HXIS
	END STRUCTURE

	STRUCTURE	/ANN_VALUES/		!Record length = 32 bytes
		INTEGER*2	ANN1(2)		!Annulus "Low" values
		INTEGER*2	ANN2(2)
		INTEGER*2	ANN3(2)
		INTEGER*2	ANN4(2)
		INTEGER*2	ANH1(2)		!Annulus "High" values
		INTEGER*2	ANH2(2)
		INTEGER*2	ANH3(2)
		INTEGER*2	ANH4(2)
	END STRUCTURE

	STRUCTURE	/P_REC/			!Record Length = 1444 bytes
		INTEGER*2	YEAR		!current YEAR
		INTEGER*2	DOY		!DAY of YEAR
		INTEGER*2	HOUR		!HOUR of DAY
		INTEGER*2	MINUTE		!MINUTE of HOUR
		INTEGER*2	SECOND		!SECOND of MINUTE
		INTEGER*2	MSEC		!MILLISECONDS of SECOND
		INTEGER*2	DATATYPE	!MF1 Data Type
		REAL*4		TIME		!TIME of each USER record
		REAL*4		OBCTIME		!OBC TIME 16.384 sec resolution
		REAL*4		SHIELDTIME(2)	!8.192 sec resolution
		REAL*4		ANNTIME(2)
		REAL*4		MCWTIME(8)	!2.048 sec resolution
		REAL*4		HEMTIME(8)
		REAL*4		XRAYTIME(16)	!1.024 sec resolution
		RECORD		/X_RAYS/XRAYS	!X-Ray Detectors
		RECORD		/OBC_PARAM/OBC	!OBC Parameters
		RECORD		/ANN_VALUES/ANNULUS!Annulus values
		RECORD		/MC_WINDOWS/MCW	!Main Channel Windows
		RECORD		/HE_MATRIX/HEM	!High Energy Matrix
		INTEGER*4	HEM_L25(8)	!HEM < 25 := H65 + H70
		INTEGER*4	HEM_G25(8)	!HEM > 25 := SUM of rest
		INTEGER*4	MCWSUM(8)	!MCW1 + MCW2 + MCW3 sum
		INTEGER*2	SHIELD(2)	!Total Shield counts
		INTEGER*4	MC10_90T	!MC spectrum sum channels 10-90
		INTEGER*2	LIVETIME	!MC Live Time
		INTEGER*2	BURST_WNDW(256)	!BURST WINDOW
	END STRUCTURE


	RECORD		/P_REC/P_ARRAY(6000)	!PARAM output record ARRAY
	INTEGER*4	NREC,FILES,NFILES
	CHARACTER*80	VOLUME_LABEL
	CHARACTER*80	VOLUME_SET
	CHARACTER*80	ZEROTH
	CHARACTER*80	FILENAME
	CHARACTER*80	TEMPNAME
	CHARACTER*2	CHARFILE
	LOGICAL*2	SINGLEFILE


	WRITE(*,5)
5	FORMAT(' 5-Digit DOY of DISK Volume Set?  ')
	WRITE(*,10)
10	FORMAT(' [Enter 5-digit DOY for a complete Volume Set, ',
     1  'or 1 for a single file] ',$)
	READ(*,20)VOLUME_SET
20	FORMAT(A)
	SINGLEFILE = (VOLUME_SET.EQ.'1')
	IF(SINGLEFILE)GO TO 50
	ZEROTH = VOLUME_SET(1:5)//'F00.UNH'
	OPEN(11,FILE=ZEROTH,STATUS='OLD',FORM='FORMATTED')
	READ(11,21,END=30)VOLUME_LABEL
21	FORMAT(A)
	READ(11,25,END=30)NFILES
25	FORMAT(I)
	CLOSE(11)
	GO TO 50

30	WRITE(*,*)'%ERROR:  Error reading ZEROTH file'
	RETURN

50	CONTINUE
	NREC = 0
	FILES = 0
	IF(SINGLEFILE)THEN
		WRITE(*,60)
60		FORMAT(' Name of USER file?  ',$)
		READ(*,20)FILENAME
		CALL RMSHTR(FILENAME,P_ARRAY,NREC)
	ELSE
		DO WHILE (FILES.LT.NFILES)
			FILES = FILES + 1
			IF(FILES.LT.10)THEN
				CHARFILE = '0'//CHAR(FILES+ICHAR('0'))
			ELSE
				CALL INT2CHAR(FILES,CHARFILE,2)
			ENDIF
			FILENAME(1:12) = VOLUME_SET(1:5)//'F'//CHARFILE
     1	//'.UNH'
			CALL RMSHTR(FILENAME,P_ARRAY,NREC)
		END DO
	ENDIF
	TEMPNAME = 'HTRTEMP.DAT'
	WRITE(*,*)
	WRITE(*,*)'Writing Output File:  ',TEMPNAME(1:12)
	WRITE(*,*)
	CALL WRITEPARAM2(P_ARRAY,NREC,TEMPNAME)	!write out data to TEMP FILE


	RETURN
	END



C	***********************************************************************

	SUBROUTINE RMSHTR(FILENAME,P_ARRAY,NREC)

C		READ and EXTRACT parameters from one USER disk file.


	INCLUDE		'SYS$LIBRARY:FORSYSDEF($IODEF)/NOLIST'
	INCLUDE		'SYS$LIBRARY:FORSYSDEF($SSDEF)/NOLIST'
	INCLUDE		'SYS$LIBRARY:FORSYSDEF($SYSSRVNAM)/NOLIST'
	INCLUDE		'SYS$LIBRARY:FORSYSDEF($RMSDEF)/NOLIST'
	INCLUDE		'SYS$LIBRARY:FORSYSDEF($FABDEF)/NOLIST'
	INCLUDE		'SYS$LIBRARY:FORSYSDEF($RABDEF)/NOLIST'



	STRUCTURE	/X_RAYS/		!Record Length = 256 bytes
		INTEGER*2	X11(16)		!X-RAY detectors (1.024 sec)
		INTEGER*2	X12(16)
		INTEGER*2	X13(16)
		INTEGER*2	X14(16)
		INTEGER*2	X21(16)
		INTEGER*2	X22(16)
		INTEGER*2	X23(16)
		INTEGER*2	X24(16)
	END STRUCTURE

	STRUCTURE	/HE_MATRIX/		!Record Length = 288 bytes
		INTEGER*2	H56(8)		!HEM elements (2.048 sec)
		INTEGER*2	H57(8)
		INTEGER*2	H58(8)
		INTEGER*2	H59(8)
		INTEGER*2	H60(8)
		INTEGER*2	H61(8)
		INTEGER*2	H62(8)
		INTEGER*2	H63(8)
		INTEGER*2	H64(8)
		INTEGER*2	H65(8)
		INTEGER*2	H66(8)
		INTEGER*2	H67(8)
		INTEGER*2	H68(8)
		INTEGER*2	H69(8)
		INTEGER*2	H70(8)
		INTEGER*2	H71(8)
		INTEGER*2	H72(8)
		INTEGER*2	H73(8)
	END STRUCTURE

	STRUCTURE	/MC_WINDOWS/		!Record Length = 48 bytes
		INTEGER*2	MCW1(8)		!Main Channel Windows
		INTEGER*2	MCW2(8)		!(2.048 sec)
		INTEGER*2	MCW3(8)
	END STRUCTURE

	STRUCTURE	/OBC_PARAM/		!Record Length = 36 bytes
		INTEGER*2	ALT		!Spacecraft Altitude
		INTEGER*2	RA		!Spacecraft Right Ascension
		INTEGER*2	DEC		!Spacecraft Declination
		INTEGER*2	RAS		!Sun Right Ascension
		INTEGER*2	DECS		!Sun Declination
		INTEGER*2	ASP		!Aspect Angle w.r.t. Earth
		INTEGER*2	ROLL		!Roll Angle
		INTEGER*2	SCLA		!Spacecraft Latitude
		INTEGER*2	SCLO		!Spacecraft Longitude
		INTEGER*2	MAG		!Magnetic Field Total
		INTEGER*2	MX		!Magnetic Field x-axis
		INTEGER*2	MY		!Magnetic Field y-axis
		INTEGER*2	RIG		!Rigidity
		INTEGER*2	FACT		!Flare Activity Rate
		INTEGER*2	SAA		!S. American Anomaly det. rate
		INTEGER*2	HXRB		!HXRBS rate > 300 KeV
		INTEGER*2	FLR		!Flare Flag from HXIS
		INTEGER*2	MAXI		!Flare Intensity from HXIS
	END STRUCTURE

	STRUCTURE	/ANN_VALUES/		!Record length = 32 bytes
		INTEGER*2	ANN1(2)		!Annulus "Low" values
		INTEGER*2	ANN2(2)
		INTEGER*2	ANN3(2)
		INTEGER*2	ANN4(2)
		INTEGER*2	ANH1(2)		!Annulus "High" values
		INTEGER*2	ANH2(2)
		INTEGER*2	ANH3(2)
		INTEGER*2	ANH4(2)
	END STRUCTURE

	STRUCTURE	/P_REC/			!Record Length = 1444 bytes
		INTEGER*2	YEAR		!current YEAR
		INTEGER*2	DOY		!DAY of YEAR
		INTEGER*2	HOUR		!HOUR of DAY
		INTEGER*2	MINUTE		!MINUTE of HOUR
		INTEGER*2	SECOND		!SECOND of MINUTE
		INTEGER*2	MSEC		!MILLISECONDS of SECOND
		INTEGER*2	DATATYPE	!MF1 Data Type
		REAL*4		TIME		!TIME of each USER record
		REAL*4		OBCTIME		!OBC TIME 16.384 sec resolution
		REAL*4		SHIELDTIME(2)	!8.192 sec resolution
		REAL*4		ANNTIME(2)
		REAL*4		MCWTIME(8)	!2.048 sec resolution
		REAL*4		HEMTIME(8)
		REAL*4		XRAYTIME(16)	!1.024 sec resolution
		RECORD		/X_RAYS/XRAYS	!X-Ray Detectors
		RECORD		/OBC_PARAM/OBC	!OBC Parameters
		RECORD		/ANN_VALUES/ANNULUS!Annulus values
		RECORD		/MC_WINDOWS/MCW	!Main Channel Windows
		RECORD		/HE_MATRIX/HEM	!High Energy Matrix
		INTEGER*4	HEM_L25(8)	!HEM < 25 := H65 + H70
		INTEGER*4	HEM_G25(8)	!HEM > 25 := SUM of rest
		INTEGER*4	MCWSUM(8)	!MCW1 + MCW2 + MCW3 sum
		INTEGER*2	SHIELD(2)	!Total Shield counts
		INTEGER*4	MC10_90T	!MC spectrum sum channels 10-90
		INTEGER*2	LIVETIME	!MC Live Time
		INTEGER*2	BURST_WNDW(256)	!BURST WINDOW
	END STRUCTURE


	RECORD		/P_REC/P_ARRAY(6000)	!PARAM output record ARRAY
	INTEGER*2	USERBUFF(1450)		!current USER buffer
	LOGICAL*2	EOF			!EOF check flag
	INTEGER*4	NREC			!count of records processed
	CHARACTER*80	FILENAME		!USER disk file name
	INTEGER*2	LENGTH			!LENGTH of RMS record read
	INTEGER*4	STATUS			!RMS return status
	INTEGER*4	RMS_GET			!file read function using RMS
	INTEGER*4	FOR$RAB
	INTEGER*4	LIB$SIGNAL

	EXTERNAL	RMSOPEN


	WRITE(*,*)'Reading File:  ',FILENAME(1:12)
	OPEN(UNIT=10,FILE=FILENAME,FORM='UNFORMATTED',STATUS='OLD',
     1	USEROPEN=RMSOPEN)

	EOF = .FALSE.
	DO WHILE (.NOT.EOF)
		STATUS = RMS_GET(%VAL(FOR$RAB(10)),!Address of RAB
     1					USERBUFF,!I/O data buffer
     2					LENGTH)	!length of record read
		IF(STATUS)THEN
			NREC = NREC + 1
			CALL SWAPBYTE(USERBUFF,LENGTH)
			CALL GETPARAM(USERBUFF,	!current USER buffer
     1				LENGTH,		!LENGTH of buffer
     2				P_ARRAY(NREC))	!current PARAM record
		ELSE
			IF(STATUS.EQ.RMS$_EOF)THEN
				EOF = .TRUE.
			ELSE
				CALL LIB$SIGNAL(%VAL(STATUS))!Signal RMS error
			ENDIF
		ENDIF
	END DO
	CLOSE(10)


	RETURN
	END




C	***********************************************************************

	SUBROUTINE TAPEHTR

C		Read entire day's data from TAPE.


	INCLUDE		'SYS$LIBRARY:FORSYSDEF($IODEF)/NOLIST'
	INCLUDE		'SYS$LIBRARY:FORSYSDEF($SSDEF)/NOLIST'
	INCLUDE		'SYS$LIBRARY:FORSYSDEF($SYSSRVNAM)/NOLIST'
	INCLUDE		'SYS$LIBRARY:FORSYSDEF($RMSDEF)/NOLIST'
	INCLUDE		'SYS$LIBRARY:FORSYSDEF($FABDEF)/NOLIST'
	INCLUDE		'SYS$LIBRARY:FORSYSDEF($RABDEF)/NOLIST'



	STRUCTURE	/X_RAYS/		!Record Length = 256 bytes
		INTEGER*2	X11(16)		!X-RAY detectors (1.024 sec)
		INTEGER*2	X12(16)
		INTEGER*2	X13(16)
		INTEGER*2	X14(16)
		INTEGER*2	X21(16)
		INTEGER*2	X22(16)
		INTEGER*2	X23(16)
		INTEGER*2	X24(16)
	END STRUCTURE

	STRUCTURE	/HE_MATRIX/		!Record Length = 288 bytes
		INTEGER*2	H56(8)		!HEM elements (2.048 sec)
		INTEGER*2	H57(8)
		INTEGER*2	H58(8)
		INTEGER*2	H59(8)
		INTEGER*2	H60(8)
		INTEGER*2	H61(8)
		INTEGER*2	H62(8)
		INTEGER*2	H63(8)
		INTEGER*2	H64(8)
		INTEGER*2	H65(8)
		INTEGER*2	H66(8)
		INTEGER*2	H67(8)
		INTEGER*2	H68(8)
		INTEGER*2	H69(8)
		INTEGER*2	H70(8)
		INTEGER*2	H71(8)
		INTEGER*2	H72(8)
		INTEGER*2	H73(8)
	END STRUCTURE

	STRUCTURE	/MC_WINDOWS/		!Record Length = 48 bytes
		INTEGER*2	MCW1(8)		!Main Channel Windows
		INTEGER*2	MCW2(8)		!(2.048 sec)
		INTEGER*2	MCW3(8)
	END STRUCTURE

	STRUCTURE	/OBC_PARAM/		!Record Length = 36 bytes
		INTEGER*2	ALT		!Spacecraft Altitude
		INTEGER*2	RA		!Spacecraft Right Ascension
		INTEGER*2	DEC		!Spacecraft Declination
		INTEGER*2	RAS		!Sun Right Ascension
		INTEGER*2	DECS		!Sun Declination
		INTEGER*2	ASP		!Aspect Angle w.r.t. Earth
		INTEGER*2	ROLL		!Roll Angle
		INTEGER*2	SCLA		!Spacecraft Latitude
		INTEGER*2	SCLO		!Spacecraft Longitude
		INTEGER*2	MAG		!Magnetic Field Total
		INTEGER*2	MX		!Magnetic Field x-axis
		INTEGER*2	MY		!Magnetic Field y-axis
		INTEGER*2	RIG		!Rigidity
		INTEGER*2	FACT		!Flare Activity Rate
		INTEGER*2	SAA		!S. American Anomaly det. rate
		INTEGER*2	HXRB		!HXRBS rate > 300 KeV
		INTEGER*2	FLR		!Flare Flag from HXIS
		INTEGER*2	MAXI		!Flare Intensity from HXIS
	END STRUCTURE

	STRUCTURE	/ANN_VALUES/		!Record length = 32 bytes
		INTEGER*2	ANN1(2)		!Annulus "Low" values
		INTEGER*2	ANN2(2)
		INTEGER*2	ANN3(2)
		INTEGER*2	ANN4(2)
		INTEGER*2	ANH1(2)		!Annulus "High" values
		INTEGER*2	ANH2(2)
		INTEGER*2	ANH3(2)
		INTEGER*2	ANH4(2)
	END STRUCTURE

	STRUCTURE	/P_REC/			!Record Length = 1444 bytes
		INTEGER*2	YEAR		!current YEAR
		INTEGER*2	DOY		!DAY of YEAR
		INTEGER*2	HOUR		!HOUR of DAY
		INTEGER*2	MINUTE		!MINUTE of HOUR
		INTEGER*2	SECOND		!SECOND of MINUTE
		INTEGER*2	MSEC		!MILLISECONDS of SECOND
		INTEGER*2	DATATYPE	!MF1 Data Type
		REAL*4		TIME		!TIME of each USER record
		REAL*4		OBCTIME		!OBC TIME 16.384 sec resolution
		REAL*4		SHIELDTIME(2)	!8.192 sec resolution
		REAL*4		ANNTIME(2)
		REAL*4		MCWTIME(8)	!2.048 sec resolution
		REAL*4		HEMTIME(8)
		REAL*4		XRAYTIME(16)	!1.024 sec resolution
		RECORD		/X_RAYS/XRAYS	!X-Ray Detectors
		RECORD		/OBC_PARAM/OBC	!OBC Parameters
		RECORD		/ANN_VALUES/ANNULUS!Annulus values
		RECORD		/MC_WINDOWS/MCW	!Main Channel Windows
		RECORD		/HE_MATRIX/HEM	!High Energy Matrix
		INTEGER*4	HEM_L25(8)	!HEM < 25 := H65 + H70
		INTEGER*4	HEM_G25(8)	!HEM > 25 := SUM of rest
		INTEGER*4	MCWSUM(8)	!MCW1 + MCW2 + MCW3 sum
		INTEGER*2	SHIELD(2)	!Total Shield counts
		INTEGER*4	MC10_90T	!MC spectrum sum channels 10-90
		INTEGER*2	LIVETIME	!MC Live Time
		INTEGER*2	BURST_WNDW(256)	!BURST WINDOW
	END STRUCTURE


	RECORD		/P_REC/P_ARRAY(6000)	!PARAM output record ARRAY
	INTEGER*2	USERBUFF(1450)		!current USER buffer
	LOGICAL*2	EOF,EOT			!EOF and EOT check flags
	INTEGER*4	NREC			!count of records processed
	INTEGER*4	NFILES,FILECOUNT	!count of USER files processed
	INTEGER*2	IOCHANNEL		!tape I/O channel
	INTEGER*2	IOSB(4)			!tape I/O status block
	LOGICAL*2	DISK_IO			!Should we use disk I/O?
	CHARACTER*80	FILENAME		!IDL TEMP file name
	CHARACTER*80	DEVICE			!Physical Tape Drive name
	INTEGER*4	LENGTH
	INTEGER*4	ERRORS
	INTEGER*4	LIB$SIGNAL


	WRITE(*,20)
20	FORMAT(' What PHYSICAL Tape Device should I READ from?  ',$)
	READ(*,30)DEVICE
30	FORMAT(A)
	CALL VAXOPEN(DEVICE,IOCHANNEL)		!get USER tape I/O channel

	EOF = .FALSE.
	EOT = .FALSE.
	NREC = 0
	FILECOUNT = 0
	ERRORS = 0
	DO WHILE (.NOT.EOT)
		CALL VAXREAD(IOCHANNEL,IOSB,USERBUFF,2900)
		IF(IOSB(1))THEN
			ERRORS = 0
			EOF = .FALSE.
			NREC = NREC + 1
			CALL SWAPBYTE(USERBUFF,IOSB(2))
			CALL GETPARAM(USERBUFF,	!current USER buffer
     1				IOSB(2),	!LENGTH of buffer
     2				P_ARRAY(NREC))	!current PARAM record
		ELSE
			IF((IOSB(1).EQ.SS$_ENDOFFILE).OR.(IOSB(1).EQ.
     1			SS$_ENDOFTAPE))THEN
				IF(EOF.OR.(IOSB(1).EQ.SS$_ENDOFTAPE))
     1				THEN
					EOT = .TRUE.
					TYPE *,'[EOT]'
				ELSE
					FILECOUNT = FILECOUNT + 1
					TYPE *,'File ',FILECOUNT,
     1						' processed'
				ENDIF
				EOF = .TRUE.
			ELSE
				IF((IOSB(1).EQ.SS$_DRVERR).OR.(IOSB(1)
     1				.EQ.SS$_DATAOVERUN))THEN
					CALL READERROR
					ERRORS = ERRORS + 1
					IF(ERRORS.GT.16)THEN
						CALL FATALREAD
						EOT = .TRUE.
					ENDIF
				ELSE
					CALL LIB$SIGNAL(%VAL(IOSB(1)))
				ENDIF
			ENDIF
		ENDIF
	END DO
	FILENAME = 'HTRTEMP.DAT'
	WRITE(*,*)
	WRITE(*,*)'Writing File:  ',FILENAME(1:12)
	WRITE(*,*)
	CALL WRITEPARAM2(P_ARRAY,NREC,FILENAME)	!write out data to HTRTEMP.DAT


	RETURN
	END




C	***********************************************************************

	SUBROUTINE GETPARAM(USERBUFF,UBUFLENGTH,P)


	STRUCTURE	/X_RAYS/		!Record Length = 256 bytes
		INTEGER*2	X11(16)		!X-RAY detectors (1.024 sec)
		INTEGER*2	X12(16)
		INTEGER*2	X13(16)
		INTEGER*2	X14(16)
		INTEGER*2	X21(16)
		INTEGER*2	X22(16)
		INTEGER*2	X23(16)
		INTEGER*2	X24(16)
	END STRUCTURE

	STRUCTURE	/HE_MATRIX/		!Record Length = 288 bytes
		INTEGER*2	H56(8)		!HEM elements (2.048 sec)
		INTEGER*2	H57(8)
		INTEGER*2	H58(8)
		INTEGER*2	H59(8)
		INTEGER*2	H60(8)
		INTEGER*2	H61(8)
		INTEGER*2	H62(8)
		INTEGER*2	H63(8)
		INTEGER*2	H64(8)
		INTEGER*2	H65(8)
		INTEGER*2	H66(8)
		INTEGER*2	H67(8)
		INTEGER*2	H68(8)
		INTEGER*2	H69(8)
		INTEGER*2	H70(8)
		INTEGER*2	H71(8)
		INTEGER*2	H72(8)
		INTEGER*2	H73(8)
	END STRUCTURE

	STRUCTURE	/MC_WINDOWS/		!Record Length = 48 bytes
		INTEGER*2	MCW1(8)		!Main Channel Windows
		INTEGER*2	MCW2(8)		!(2.048 sec)
		INTEGER*2	MCW3(8)
	END STRUCTURE

	STRUCTURE	/OBC_PARAM/		!Record Length = 36 bytes
		INTEGER*2	ALT		!Spacecraft Altitude
		INTEGER*2	RA		!Spacecraft Right Ascension
		INTEGER*2	DEC		!Spacecraft Declination
		INTEGER*2	RAS		!Sun Right Ascension
		INTEGER*2	DECS		!Sun Declination
		INTEGER*2	ASP		!Aspect Angle w.r.t. Earth
		INTEGER*2	ROLL		!Roll Angle
		INTEGER*2	SCLA		!Spacecraft Latitude
		INTEGER*2	SCLO		!Spacecraft Longitude
		INTEGER*2	MAG		!Magnetic Field Total
		INTEGER*2	MX		!Magnetic Field x-axis
		INTEGER*2	MY		!Magnetic Field y-axis
		INTEGER*2	RIG		!Rigidity
		INTEGER*2	FACT		!Flare Activity Rate
		INTEGER*2	SAA		!S. American Anomaly det. rate
		INTEGER*2	HXRB		!HXRBS rate > 300 KeV
		INTEGER*2	FLR		!Flare Flag from HXIS
		INTEGER*2	MAXI		!Flare Intensity from HXIS
	END STRUCTURE

	STRUCTURE	/ANN_VALUES/		!Record length = 32 bytes
		INTEGER*2	ANN1(2)		!Annulus "Low" values
		INTEGER*2	ANN2(2)
		INTEGER*2	ANN3(2)
		INTEGER*2	ANN4(2)
		INTEGER*2	ANH1(2)		!Annulus "High" values
		INTEGER*2	ANH2(2)
		INTEGER*2	ANH3(2)
		INTEGER*2	ANH4(2)
	END STRUCTURE

	STRUCTURE	/P_REC/			!Record Length = 1444 bytes
		INTEGER*2	YEAR		!current YEAR
		INTEGER*2	DOY		!DAY of YEAR
		INTEGER*2	HOUR		!HOUR of DAY
		INTEGER*2	MINUTE		!MINUTE of HOUR
		INTEGER*2	SECOND		!SECOND of MINUTE
		INTEGER*2	MSEC		!MILLISECONDS of SECOND
		INTEGER*2	DATATYPE	!MF1 Data Type
		REAL*4		TIME		!TIME of each USER record
		REAL*4		OBCTIME		!OBC TIME 16.384 sec resolution
		REAL*4		SHIELDTIME(2)	!8.192 sec resolution
		REAL*4		ANNTIME(2)
		REAL*4		MCWTIME(8)	!2.048 sec resolution
		REAL*4		HEMTIME(8)
		REAL*4		XRAYTIME(16)	!1.024 sec resolution
		RECORD		/X_RAYS/XRAYS	!X-Ray Detectors
		RECORD		/OBC_PARAM/OBC	!OBC Parameters
		RECORD		/ANN_VALUES/ANNULUS!Annulus values
		RECORD		/MC_WINDOWS/MCW	!Main Channel Windows
		RECORD		/HE_MATRIX/HEM	!High Energy Matrix
		INTEGER*4	HEM_L25(8)	!HEM < 25 := H65 + H70
		INTEGER*4	HEM_G25(8)	!HEM > 25 := SUM of rest
		INTEGER*4	MCWSUM(8)	!MCW1 + MCW2 + MCW3 sum
		INTEGER*2	SHIELD(2)	!Total Shield counts
		INTEGER*4	MC10_90T	!MC spectrum sum channels 10-90
		INTEGER*2	LIVETIME	!MC Live Time
		INTEGER*2	BURST_WNDW(256)	!BURST WINDOW
	END STRUCTURE


	RECORD		/P_REC/P		!PARAM output record
	INTEGER*2	USERBUFF(1450)		!current USER buffer
	INTEGER*2	UBUFLENGTH		!LENGTH of USER buffer
	INTEGER*2	GETDTYPE		!data type FUNCTION
	REAL*4		TIME			!TIME value in decimal hours
	INTEGER*4	INDEX


	CALL CLEAR(P)				!clear PARAM output record
	CALL USERTIME(USERBUFF,			!Extract TIME values from
     1			P.YEAR,			!current USER record in
     2			P.DOY,			!YEAR DOY HH:MM:SS.MSEC
     3			P.HOUR,			!format
     4			P.MINUTE,
     5			P.SECOND,
     6			P.MSEC)
	TIME = FLOAT(P.HOUR) + FLOAT(P.MINUTE)/60.0 +
     1		FLOAT(P.SECOND)/3600.0 + FLOAT(P.MSEC)/3600000.0
	P.TIME = TIME				!16.384 sec resolution
	P.OBCTIME = TIME
	P.SHIELDTIME(1) = TIME			!8.192 sec resolution
	P.SHIELDTIME(2) = TIME + 8.192/3600.0
	P.ANNTIME(1) = P.SHIELDTIME(1)
	P.ANNTIME(2) = P.SHIELDTIME(2)

	DO 100,INDEX=1,8			!2.048 sec resolution
		P.MCWTIME(INDEX) = TIME + FLOAT(INDEX-1)*2.048/3600.0
		P.HEMTIME(INDEX) = P.MCWTIME(INDEX)
100	CONTINUE
	DO 200,INDEX=1,16			!1.024 sec resolution
		P.XRAYTIME(INDEX) = TIME + FLOAT(INDEX-1)*1.024/3600.0
200	CONTINUE

	P.DATATYPE = GETDTYPE(USERBUFF)		!extract MF1 Data Type
	IF(UBUFLENGTH.EQ.2900)THEN
		CALL GETNORMAL(USERBUFF,P)	!Handle NORMAL record
		CALL GETOBCS(USERBUFF,P.OBC,1380)
	ELSE
		IF(UBUFLENGTH.EQ.130)THEN
			P.DATATYPE = 6		!Handle LOW POWER record
			CALL GETOBCS(USERBUFF,P.OBC,35)
		ELSE
			TYPE *,'%ERROR:  USER record length = ',
     1				UBUFLENGTH,' bytes'
			CALL EXIT
		ENDIF
	ENDIF


	RETURN
	END




C	***********************************************************************

	SUBROUTINE USERTIME(USERBUFF,YEAR,DOY,HOUR,MINUTE,SECOND,MSEC)

C		Extract YEAR, DOY, HOUR:MINUTE:SECOND.MSEC from current
C	USER record.

	INTEGER*2	USERBUFF(1450)		!current USER buffer
	INTEGER*2	YEAR
	INTEGER*2	DOY
	INTEGER*2	HOUR
	INTEGER*2	MINUTE
	INTEGER*2	SECOND
	INTEGER*2	MSEC


	YEAR = USERBUFF(2)			!extract YEAR, DOY
	DOY = USERBUFF(3)
	HOUR = IBITS(USERBUFF(4),8,8)		!extract HH:MM:SS.MSEC
	MINUTE = IBITS(USERBUFF(4),0,8)
	SECOND = IBITS(USERBUFF(5),8,8)
	MSEC = USERBUFF(6)


	RETURN
	END




C	***********************************************************************

	SUBROUTINE GETNORMAL(USERBUFF,P)



	STRUCTURE	/X_RAYS/		!Record Length = 256 bytes
		INTEGER*2	X11(16)		!X-RAY detectors (1.024 sec)
		INTEGER*2	X12(16)
		INTEGER*2	X13(16)
		INTEGER*2	X14(16)
		INTEGER*2	X21(16)
		INTEGER*2	X22(16)
		INTEGER*2	X23(16)
		INTEGER*2	X24(16)
	END STRUCTURE

	STRUCTURE	/HE_MATRIX/		!Record Length = 288 bytes
		INTEGER*2	H56(8)		!HEM elements (2.048 sec)
		INTEGER*2	H57(8)
		INTEGER*2	H58(8)
		INTEGER*2	H59(8)
		INTEGER*2	H60(8)
		INTEGER*2	H61(8)
		INTEGER*2	H62(8)
		INTEGER*2	H63(8)
		INTEGER*2	H64(8)
		INTEGER*2	H65(8)
		INTEGER*2	H66(8)
		INTEGER*2	H67(8)
		INTEGER*2	H68(8)
		INTEGER*2	H69(8)
		INTEGER*2	H70(8)
		INTEGER*2	H71(8)
		INTEGER*2	H72(8)
		INTEGER*2	H73(8)
	END STRUCTURE

	STRUCTURE	/MC_WINDOWS/		!Record Length = 48 bytes
		INTEGER*2	MCW1(8)		!Main Channel Windows
		INTEGER*2	MCW2(8)		!(2.048 sec)
		INTEGER*2	MCW3(8)
	END STRUCTURE

	STRUCTURE	/OBC_PARAM/		!Record Length = 36 bytes
		INTEGER*2	ALT		!Spacecraft Altitude
		INTEGER*2	RA		!Spacecraft Right Ascension
		INTEGER*2	DEC		!Spacecraft Declination
		INTEGER*2	RAS		!Sun Right Ascension
		INTEGER*2	DECS		!Sun Declination
		INTEGER*2	ASP		!Aspect Angle w.r.t. Earth
		INTEGER*2	ROLL		!Roll Angle
		INTEGER*2	SCLA		!Spacecraft Latitude
		INTEGER*2	SCLO		!Spacecraft Longitude
		INTEGER*2	MAG		!Magnetic Field Total
		INTEGER*2	MX		!Magnetic Field x-axis
		INTEGER*2	MY		!Magnetic Field y-axis
		INTEGER*2	RIG		!Rigidity
		INTEGER*2	FACT		!Flare Activity Rate
		INTEGER*2	SAA		!S. American Anomaly det. rate
		INTEGER*2	HXRB		!HXRBS rate > 300 KeV
		INTEGER*2	FLR		!Flare Flag from HXIS
		INTEGER*2	MAXI		!Flare Intensity from HXIS
	END STRUCTURE

	STRUCTURE	/ANN_VALUES/		!Record length = 32 bytes
		INTEGER*2	ANN1(2)		!Annulus "Low" values
		INTEGER*2	ANN2(2)
		INTEGER*2	ANN3(2)
		INTEGER*2	ANN4(2)
		INTEGER*2	ANH1(2)		!Annulus "High" values
		INTEGER*2	ANH2(2)
		INTEGER*2	ANH3(2)
		INTEGER*2	ANH4(2)
	END STRUCTURE

	STRUCTURE	/P_REC/			!Record Length = 1444 bytes
		INTEGER*2	YEAR		!current YEAR
		INTEGER*2	DOY		!DAY of YEAR
		INTEGER*2	HOUR		!HOUR of DAY
		INTEGER*2	MINUTE		!MINUTE of HOUR
		INTEGER*2	SECOND		!SECOND of MINUTE
		INTEGER*2	MSEC		!MILLISECONDS of SECOND
		INTEGER*2	DATATYPE	!MF1 Data Type
		REAL*4		TIME		!TIME of each USER record
		REAL*4		OBCTIME		!OBC TIME 16.384 sec resolution
		REAL*4		SHIELDTIME(2)	!8.192 sec resolution
		REAL*4		ANNTIME(2)
		REAL*4		MCWTIME(8)	!2.048 sec resolution
		REAL*4		HEMTIME(8)
		REAL*4		XRAYTIME(16)	!1.024 sec resolution
		RECORD		/X_RAYS/XRAYS	!X-Ray Detectors
		RECORD		/OBC_PARAM/OBC	!OBC Parameters
		RECORD		/ANN_VALUES/ANNULUS!Annulus values
		RECORD		/MC_WINDOWS/MCW	!Main Channel Windows
		RECORD		/HE_MATRIX/HEM	!High Energy Matrix
		INTEGER*4	HEM_L25(8)	!HEM < 25 := H65 + H70
		INTEGER*4	HEM_G25(8)	!HEM > 25 := SUM of rest
		INTEGER*4	MCWSUM(8)	!MCW1 + MCW2 + MCW3 sum
		INTEGER*2	SHIELD(2)	!Total Shield counts
		INTEGER*4	MC10_90T	!MC spectrum sum channels 10-90
		INTEGER*2	LIVETIME	!MC Live Time
		INTEGER*2	BURST_WNDW(256)	!BURST WINDOW
	END STRUCTURE


	RECORD		/P_REC/P		!PARAM output record
	INTEGER*2	USERBUFF(1450)		!current USER buffer
	INTEGER*4	SUMCHANNELS		!MC spectrum summing function
	INTEGER*4	MCSPECTRUM(476)		!Main Channel Spectrum
	INTEGER*2	FPS(2),BPS(2),HE1(2)	!Dummy variables
	INTEGER*4	INDEX,I


	CALL GETXRAYS(USERBUFF,P.XRAYS)		!Extract X-RAYS
	CALL GETMCWS(USERBUFF,P.MCW)		!Extract Main Channel Windows
	CALL GETBURSTWINDOW(USERBUFF,P.BURST_WNDW)!Extract Burst Window
	DO 100,INDEX = 1,8
		P.MCWSUM(INDEX) = ZEXT(P.MCW.MCW1(INDEX))
     1		+ ZEXT(P.MCW.MCW2(INDEX)) + ZEXT(P.MCW.MCW3(INDEX))
100	CONTINUE

	CALL GETHEMATRIX(USERBUFF,P.HEM)	!Extract High-Energy Matrix
	DO 200,I=1,8
		P.HEM_L25(I) = ZEXT(P.HEM.H65(I)) + ZEXT(P.HEM.H70(I))
		P.HEM_G25(I) = ZEXT(P.HEM.H56(I)) + ZEXT(P.HEM.H57(I))
     1			+ ZEXT(P.HEM.H58(I)) + ZEXT(P.HEM.H59(I))
     2			+ ZEXT(P.HEM.H60(I)) + ZEXT(P.HEM.H61(I))
     3			+ ZEXT(P.HEM.H62(I)) + ZEXT(P.HEM.H63(I))
     4			+ ZEXT(P.HEM.H64(I)) + ZEXT(P.HEM.H66(I))
     5			+ ZEXT(P.HEM.H67(I)) + ZEXT(P.HEM.H68(I))
     6			+ ZEXT(P.HEM.H69(I)) + ZEXT(P.HEM.H71(I))
     7			+ ZEXT(P.HEM.H72(I)) + ZEXT(P.HEM.H73(I))
200	CONTINUE

	CALL GETANNULUS(USERBUFF,P.ANNULUS)	!Get ANNULUS values
	CALL GETSHIELD(USERBUFF,P.SHIELD,FPS,BPS,HE1)!Get SHIELD values
	CALL MCTOTALS(USERBUFF,MCSPECTRUM)	!Extract MC Totals spectrum
	P.MC10_90T = SUMCHANNELS(MCSPECTRUM,10,90)!Sum spectrum channels 10-90
	P.LIVETIME = USERBUFF(502)		!Extract MC Live Time

C	!-------------------------------------------------------------!
C	!	Make modifications here to handle                     !
C	!	future data requests from a NORMAL USER               !
C	!	record.                                               !
C	!-------------------------------------------------------------!


	RETURN
	END




C	***********************************************************************

	SUBROUTINE GETOBCS(USERBUFF,OBC,OFFSET)

C		Extract Spacecraft OBC parameters.  16.384 sec resolution.
C	OFFSET = 1380 for a NORMAL USER record.  OFFSET = 35 for a LOW POWER
C	USER record.


	STRUCTURE	/OBC_PARAM/		!Record Length = 36 bytes
		INTEGER*2	ALT		!Spacecraft Altitude
		INTEGER*2	RA		!Spacecraft Right Ascension
		INTEGER*2	DEC		!Spacecraft Declination
		INTEGER*2	RAS		!Sun Right Ascension
		INTEGER*2	DECS		!Sun Declination
		INTEGER*2	ASP		!Aspect Angle w.r.t. Earth
		INTEGER*2	ROLL		!Roll Angle
		INTEGER*2	SCLA		!Spacecraft Latitude
		INTEGER*2	SCLO		!Spacecraft Longitude
		INTEGER*2	MAG		!Magnetic Field Total
		INTEGER*2	MX		!Magnetic Field x-axis
		INTEGER*2	MY		!Magnetic Field y-axis
		INTEGER*2	RIG		!Rigidity
		INTEGER*2	FACT		!Flare Activity Rate
		INTEGER*2	SAA		!S. American Anomaly det. rate
		INTEGER*2	HXRB		!HXRBS rate > 300 KeV
		INTEGER*2	FLR		!Flare Flag from HXIS
		INTEGER*2	MAXI		!Flare Intensity from HXIS
	END STRUCTURE

	RECORD		/OBC_PARAM/OBC		!Spacecraft OBC parameters
	INTEGER*2	USERBUFF(1450)		!current USER buffer
	INTEGER*2	OFFSET			!OFFSET of OBC's in buffer


	OBC.ALT		=	USERBUFF(OFFSET+1)
	OBC.RA		=	USERBUFF(OFFSET+2)
	OBC.DEC		=	USERBUFF(OFFSET+3)
	OBC.RAS		=	USERBUFF(OFFSET+4)
	OBC.DECS	=	USERBUFF(OFFSET+5)
	OBC.ASP		=	USERBUFF(OFFSET+6)
	OBC.ROLL	=	USERBUFF(OFFSET+7)
	OBC.SCLA	=	USERBUFF(OFFSET+8)
	OBC.SCLO	=	USERBUFF(OFFSET+9)
	OBC.MAG		=	USERBUFF(OFFSET+10)
	OBC.MX		=	USERBUFF(OFFSET+11)
	OBC.MY		=	USERBUFF(OFFSET+12)
	OBC.RIG		=	USERBUFF(OFFSET+13)
	OBC.FACT	=	USERBUFF(OFFSET+14)
	OBC.SAA		=	USERBUFF(OFFSET+15)
	OBC.HXRB	=	USERBUFF(OFFSET+16)
	OBC.FLR		=	USERBUFF(OFFSET+17)
	OBC.MAXI	=	USERBUFF(OFFSET+18)


	RETURN
	END



C	***********************************************************************

	INTEGER*2 FUNCTION GETDTYPE(USERBUFF)

C		Extract DATA TYPE from MF1 status word in USER buffer

	INTEGER*2	USERBUFF(1450)		!USER buffer
	INTEGER*2	DTYP,TEMPDT		!temp variable


	DTYP = IBITS(USERBUFF(13),0,8)		!extract MF1 status value

	TEMPDT = 0				!0 = undefined
	IF(DTYP.EQ.160)TEMPDT = 3   		!night normal
	IF(DTYP.EQ.184)TEMPDT = 2   		!night ifc
	IF(DTYP.EQ.164)TEMPDT = 1   		!day normal
	IF(DTYP.EQ.176)TEMPDT = 4   		!day ifc
	GETDTYPE = TEMPDT


	RETURN
	END




C	***********************************************************************

	SUBROUTINE GETSHIELD(USERBUFF,SHIELD,FPS,BPS,HE1)

C		Extract SHIELD counts.	8.192 sec resolution

	INTEGER*2	USERBUFF(1450)		!USER buffer
	INTEGER*2	SHIELD(2)		!SHIELD counts
	INTEGER*2	FPS(2)			!Front Plastic Shield
	INTEGER*2	BPS(2)			!Back Plastic Shield
	INTEGER*2	HE1(2)			!Back CsI shield


	SHIELD(1) = USERBUFF(1376)		!Extract Total Shield counts
	SHIELD(2) = USERBUFF(1377)
	FPS(1) = USERBUFF(1261)			!Extract Front Plastic Shield
	FPS(2) = USERBUFF(1277)
	BPS(1) = USERBUFF(1262)			!Extract Back Plastic Shield
	BPS(2) = USERBUFF(1278)
	HE1(1) = USERBUFF(1235)			!Extract Back CsI Shield counts
	HE1(2) = USERBUFF(1251)


	RETURN
	END



C	***********************************************************************

	SUBROUTINE GETANNULUS(USERBUFF,ANNULUS)

C		Extract ANNULUS values.		8.192 sec resolution

	STRUCTURE	/ANN_VALUES/		!Record length = 32 bytes
		INTEGER*2	ANN1(2)		!Annulus "Low" values
		INTEGER*2	ANN2(2)
		INTEGER*2	ANN3(2)
		INTEGER*2	ANN4(2)
		INTEGER*2	ANH1(2)		!Annulus "High" values
		INTEGER*2	ANH2(2)
		INTEGER*2	ANH3(2)
		INTEGER*2	ANH4(2)
	END STRUCTURE


	INTEGER*2	USERBUFF(1450)		!current USER buffer
	RECORD		/ANN_VALUES/ANNULUS	!Annulus HI/LO values


	ANNULUS.ANH1(1) = USERBUFF(1237)	!Extract "HIGH" values
	ANNULUS.ANH1(2) = USERBUFF(1253)
	ANNULUS.ANH2(1) = USERBUFF(1238)
	ANNULUS.ANH2(2) = USERBUFF(1254)
	ANNULUS.ANH3(1) = USERBUFF(1239)
	ANNULUS.ANH3(2) = USERBUFF(1255)
	ANNULUS.ANH4(1) = USERBUFF(1240)
	ANNULUS.ANH4(2) = USERBUFF(1256)

	ANNULUS.ANN1(1) = USERBUFF(1241)	!Extract "LOW" values
	ANNULUS.ANN1(2) = USERBUFF(1257)
	ANNULUS.ANN2(1) = USERBUFF(1242)
	ANNULUS.ANN2(2) = USERBUFF(1258)
	ANNULUS.ANN3(1) = USERBUFF(1243)
	ANNULUS.ANN3(2) = USERBUFF(1259)
	ANNULUS.ANN4(1) = USERBUFF(1244)
	ANNULUS.ANN4(2) = USERBUFF(1260)


	RETURN
	END



C	***********************************************************************

	SUBROUTINE GETMCWS(USERBUFF,MCW)

C		Extract Main Channel Window values.  2.048 sec resolution.


	STRUCTURE	/MC_WINDOWS/		!Record Length = 48 bytes
		INTEGER*2	MCW1(8)		!Main Channel Windows
		INTEGER*2	MCW2(8)		!(2.048 sec)
		INTEGER*2	MCW3(8)
	END STRUCTURE

	RECORD		/MC_WINDOWS/MCW		!Main Channel Windows
	BYTE		USERBUFF(0:2899)	!Current USER buffer


	MCW.MCW1(1) = ZEXT(USERBUFF(2533))	!extract MCW1 values
	MCW.MCW1(2) = ZEXT(USERBUFF(2534))
	MCW.MCW1(3) = ZEXT(USERBUFF(2539))
	MCW.MCW1(4) = ZEXT(USERBUFF(2540))
	MCW.MCW1(5) = ZEXT(USERBUFF(2545))
	MCW.MCW1(6) = ZEXT(USERBUFF(2546))
	MCW.MCW1(7) = ZEXT(USERBUFF(2551))
	MCW.MCW1(8) = ZEXT(USERBUFF(2552))

	MCW.MCW2(1) = ZEXT(USERBUFF(2532))	!extract MCW2 values
	MCW.MCW2(2) = ZEXT(USERBUFF(2537))
	MCW.MCW2(3) = ZEXT(USERBUFF(2538))
	MCW.MCW2(4) = ZEXT(USERBUFF(2543))
	MCW.MCW2(5) = ZEXT(USERBUFF(2544))
	MCW.MCW2(6) = ZEXT(USERBUFF(2549))
	MCW.MCW2(7) = ZEXT(USERBUFF(2550))
	MCW.MCW2(8) = ZEXT(USERBUFF(2555))

	MCW.MCW3(1) = ZEXT(USERBUFF(2535))	!extract MCW3 values
	MCW.MCW3(2) = ZEXT(USERBUFF(2536))
	MCW.MCW3(3) = ZEXT(USERBUFF(2541))
	MCW.MCW3(4) = ZEXT(USERBUFF(2542))
	MCW.MCW3(5) = ZEXT(USERBUFF(2547))
	MCW.MCW3(6) = ZEXT(USERBUFF(2548))
	MCW.MCW3(7) = ZEXT(USERBUFF(2553))
	MCW.MCW3(8) = ZEXT(USERBUFF(2554))


	RETURN
	END






C	***********************************************************************

	SUBROUTINE GETHEMATRIX(USERBUFF,HEM)

C		Extract HEM elements.	2.048 sec resolution


	STRUCTURE	/HE_MATRIX/		!Record Length = 288 bytes
		INTEGER*2	H56(8)		!HEM elements (2.048 sec)
		INTEGER*2	H57(8)
		INTEGER*2	H58(8)
		INTEGER*2	H59(8)
		INTEGER*2	H60(8)
		INTEGER*2	H61(8)
		INTEGER*2	H62(8)
		INTEGER*2	H63(8)
		INTEGER*2	H64(8)
		INTEGER*2	H65(8)
		INTEGER*2	H66(8)
		INTEGER*2	H67(8)
		INTEGER*2	H68(8)
		INTEGER*2	H69(8)
		INTEGER*2	H70(8)
		INTEGER*2	H71(8)
		INTEGER*2	H72(8)
		INTEGER*2	H73(8)
	END STRUCTURE

	RECORD		/HE_MATRIX/HEM		!High Energy Matrix Elements
	BYTE		USERBUFF(0:2899)	!Current USER buffer
	BYTE		TEMP
	INTEGER*4	K,L


	DO 50,L=2556,2698,2
		TEMP=USERBUFF(L)
		USERBUFF(L)=USERBUFF(L+1)
		USERBUFF(L+1)=TEMP
50	CONTINUE

	DO 100,K=0,7
		HEM.H56(K+1) = ZEXT(USERBUFF(2556+K*18))
		HEM.H57(K+1) = ZEXT(USERBUFF(2557+K*18))
		HEM.H58(K+1) = ZEXT(USERBUFF(2558+K*18))
		HEM.H59(K+1) = ZEXT(USERBUFF(2559+K*18))
		HEM.H60(K+1) = ZEXT(USERBUFF(2560+K*18))
		HEM.H61(K+1) = ZEXT(USERBUFF(2561+K*18))
		HEM.H62(K+1) = ZEXT(USERBUFF(2562+K*18))
		HEM.H63(K+1) = ZEXT(USERBUFF(2563+K*18))
		HEM.H64(K+1) = ZEXT(USERBUFF(2564+K*18))
		HEM.H65(K+1) = ZEXT(USERBUFF(2565+K*18))
		HEM.H66(K+1) = ZEXT(USERBUFF(2566+K*18))
		HEM.H67(K+1) = ZEXT(USERBUFF(2567+K*18))
		HEM.H68(K+1) = ZEXT(USERBUFF(2568+K*18))
		HEM.H69(K+1) = ZEXT(USERBUFF(2569+K*18))
		HEM.H70(K+1) = ZEXT(USERBUFF(2570+K*18))
		HEM.H71(K+1) = ZEXT(USERBUFF(2571+K*18))
		HEM.H72(K+1) = ZEXT(USERBUFF(2572+K*18))
		HEM.H73(K+1) = ZEXT(USERBUFF(2573+K*18))
100	CONTINUE


	RETURN
	END




C	***********************************************************************

	SUBROUTINE GETXRAYS(USERBUFF,XRAYS)

C		Extract X-RAY detector channels.	1.024 sec resolution


	STRUCTURE	/X_RAYS/		!Record Length = 256 bytes
		INTEGER*2	X11(16)		!X-RAY detectors (1.024 sec)
		INTEGER*2	X12(16)
		INTEGER*2	X13(16)
		INTEGER*2	X14(16)
		INTEGER*2	X21(16)
		INTEGER*2	X22(16)
		INTEGER*2	X23(16)
		INTEGER*2	X24(16)
	END STRUCTURE

	RECORD		/X_RAYS/XRAYS		!X-Ray Detectors
	BYTE		USERBUFF(0:2899)	!current USER buffer
	INTEGER*2	IDLFIX			!IDL's "FIX" function
	INTEGER*4	J


	DO 100,J=0,15
		XRAYS.X11(J+1) = IDLFIX(USERBUFF,1956+16*J)
		XRAYS.X12(J+1) = IDLFIX(USERBUFF,1958+16*J)
		XRAYS.X13(J+1) = IDLFIX(USERBUFF,1960+16*J)
		XRAYS.X14(J+1) = IDLFIX(USERBUFF,1962+16*J)
		XRAYS.X21(J+1) = IDLFIX(USERBUFF,1964+16*J)
		XRAYS.X22(J+1) = IDLFIX(USERBUFF,1966+16*J)
		XRAYS.X23(J+1) = IDLFIX(USERBUFF,1968+16*J)
		XRAYS.X24(J+1) = IDLFIX(USERBUFF,1970+16*J)
100	CONTINUE


	RETURN
	END




C	***********************************************************************

	SUBROUTINE GETBURSTWINDOW(UBUFF,BURST_WINDOW)

C		Extract BURST WINDOW information from current USER buffer.

	INTEGER*2	UBUFF(1450)		!current USER buffer
	INTEGER*2	BURST_WINDOW(256)	!output to PARAM record
	INTEGER*2	INDEX,I			!index into arrays


	I = 1
	DO 100,INDEX=1107,1234
		BURST_WINDOW(I) = IBITS(UBUFF(INDEX),8,8)
		BURST_WINDOW(I+1) = IBITS(UBUFF(INDEX),0,8)
		I = I + 2
100	CONTINUE


	RETURN
	END



C	***********************************************************************

	SUBROUTINE MCTOTALS(USERBUFF,MCSPECT)

C		Extract 476 channel MC spectrum from current USER buffer.

	INTEGER*2	USERBUFF(1450)		!current USER buffer
	INTEGER*4	MCSPECT(476)		!MC spectrum channels 1-476
	INTEGER*4	CHANNEL			!MC spectrum channel


	DO 100,CHANNEL=1,476
		MCSPECT(CHANNEL) = ZEXT(USERBUFF(25+CHANNEL)) +	!singles +
     1				ZEXT(USERBUFF(502+CHANNEL))	!multiples
100	CONTINUE						!= sums

	
	RETURN
	END





C	***********************************************************************

	SUBROUTINE MCSINGLES(USERBUFF,MCSPECT)

C		Extract 476 channel MC spectrum from current USER buffer.
C	MCSINGLES extracts only the SINGLES spectrum.

	INTEGER*2	USERBUFF(1450)		!current USER buffer
	INTEGER*4	MCSPECT(476)		!MC spectrum channels 1-476
	INTEGER*4	CHANNEL			!MC spectrum channel


	DO 100,CHANNEL=1,476
		MCSPECT(CHANNEL) = ZEXT(USERBUFF(502+CHANNEL))
100	CONTINUE

	
	RETURN
	END




C	***********************************************************************

	INTEGER*4 FUNCTION SUMCHANNELS(MCSPECTRUM,STARTCHAN,ENDCHAN)

C		Sum given parts of 476 channel MC spectrum and place result in
C	MCSUM.

	INTEGER*4	MCSPECTRUM(476)		!MC spectrum
	INTEGER*4	MCSUM			!variable for result
	INTEGER*4	STARTCHAN,ENDCHAN	!STARTing, ENDing channels
	INTEGER*4	CHANNEL			!channel number index


	MCSUM = 0				!clear spectrum sum
	DO 100,CHANNEL=STARTCHAN,ENDCHAN	!sum over given channels
		MCSUM = MCSUM + MCSPECTRUM(CHANNEL)
100	CONTINUE
	SUMCHANNELS = MCSUM


	RETURN
	END



C	***********************************************************************

	SUBROUTINE WRITEPARAM2(PA,NREC,FILENAME)

C		Write out each variable's contents to an UNFORMATTED,
C	SEGMENTED record disk file that can be read by IDL.


	STRUCTURE	/X_RAYS/		!Record Length = 256 bytes
		INTEGER*2	X11(16)		!X-RAY detectors (1.024 sec)
		INTEGER*2	X12(16)
		INTEGER*2	X13(16)
		INTEGER*2	X14(16)
		INTEGER*2	X21(16)
		INTEGER*2	X22(16)
		INTEGER*2	X23(16)
		INTEGER*2	X24(16)
	END STRUCTURE

	STRUCTURE	/HE_MATRIX/		!Record Length = 288 bytes
		INTEGER*2	H56(8)		!HEM elements (2.048 sec)
		INTEGER*2	H57(8)
		INTEGER*2	H58(8)
		INTEGER*2	H59(8)
		INTEGER*2	H60(8)
		INTEGER*2	H61(8)
		INTEGER*2	H62(8)
		INTEGER*2	H63(8)
		INTEGER*2	H64(8)
		INTEGER*2	H65(8)
		INTEGER*2	H66(8)
		INTEGER*2	H67(8)
		INTEGER*2	H68(8)
		INTEGER*2	H69(8)
		INTEGER*2	H70(8)
		INTEGER*2	H71(8)
		INTEGER*2	H72(8)
		INTEGER*2	H73(8)
	END STRUCTURE

	STRUCTURE	/MC_WINDOWS/		!Record Length = 48 bytes
		INTEGER*2	MCW1(8)		!Main Channel Windows
		INTEGER*2	MCW2(8)		!(2.048 sec)
		INTEGER*2	MCW3(8)
	END STRUCTURE

	STRUCTURE	/OBC_PARAM/		!Record Length = 36 bytes
		INTEGER*2	ALT		!Spacecraft Altitude
		INTEGER*2	RA		!Spacecraft Right Ascension
		INTEGER*2	DEC		!Spacecraft Declination
		INTEGER*2	RAS		!Sun Right Ascension
		INTEGER*2	DECS		!Sun Declination
		INTEGER*2	ASP		!Aspect Angle w.r.t. Earth
		INTEGER*2	ROLL		!Roll Angle
		INTEGER*2	SCLA		!Spacecraft Latitude
		INTEGER*2	SCLO		!Spacecraft Longitude
		INTEGER*2	MAG		!Magnetic Field Total
		INTEGER*2	MX		!Magnetic Field x-axis
		INTEGER*2	MY		!Magnetic Field y-axis
		INTEGER*2	RIG		!Rigidity
		INTEGER*2	FACT		!Flare Activity Rate
		INTEGER*2	SAA		!S. American Anomaly det. rate
		INTEGER*2	HXRB		!HXRBS rate > 300 KeV
		INTEGER*2	FLR		!Flare Flag from HXIS
		INTEGER*2	MAXI		!Flare Intensity from HXIS
	END STRUCTURE

	STRUCTURE	/ANN_VALUES/		!Record length = 32 bytes
		INTEGER*2	ANN1(2)		!Annulus "Low" values
		INTEGER*2	ANN2(2)
		INTEGER*2	ANN3(2)
		INTEGER*2	ANN4(2)
		INTEGER*2	ANH1(2)		!Annulus "High" values
		INTEGER*2	ANH2(2)
		INTEGER*2	ANH3(2)
		INTEGER*2	ANH4(2)
	END STRUCTURE

	STRUCTURE	/P_REC/			!Record Length = 1444 bytes
		INTEGER*2	YEAR		!current YEAR
		INTEGER*2	DOY		!DAY of YEAR
		INTEGER*2	HOUR		!HOUR of DAY
		INTEGER*2	MINUTE		!MINUTE of HOUR
		INTEGER*2	SECOND		!SECOND of MINUTE
		INTEGER*2	MSEC		!MILLISECONDS of SECOND
		INTEGER*2	DATATYPE	!MF1 Data Type
		REAL*4		TIME		!TIME of each USER record
		REAL*4		OBCTIME		!OBC TIME 16.384 sec resolution
		REAL*4		SHIELDTIME(2)	!8.192 sec resolution
		REAL*4		ANNTIME(2)
		REAL*4		MCWTIME(8)	!2.048 sec resolution
		REAL*4		HEMTIME(8)
		REAL*4		XRAYTIME(16)	!1.024 sec resolution
		RECORD		/X_RAYS/XRAYS	!X-Ray Detectors
		RECORD		/OBC_PARAM/OBC	!OBC Parameters
		RECORD		/ANN_VALUES/ANNULUS!Annulus values
		RECORD		/MC_WINDOWS/MCW	!Main Channel Windows
		RECORD		/HE_MATRIX/HEM	!High Energy Matrix
		INTEGER*4	HEM_L25(8)	!HEM < 25 := H65 + H70
		INTEGER*4	HEM_G25(8)	!HEM > 25 := SUM of rest
		INTEGER*4	MCWSUM(8)	!MCW1 + MCW2 + MCW3 sum
		INTEGER*2	SHIELD(2)	!Total Shield counts
		INTEGER*4	MC10_90T	!MC spectrum sum channels 10-90
		INTEGER*2	LIVETIME	!MC Live Time
		INTEGER*2	BURST_WNDW(256)	!BURST WINDOW
	END STRUCTURE


	RECORD		/P_REC/PA(0:5999)	!PARAM output record ARRAY
	INTEGER*4	I			!USER record count
	INTEGER*4	INDEX,ROW,COL		!Index into arrays
	INTEGER*4	NREC
	CHARACTER*80	FILENAME


	IF(NREC.LE.0)RETURN

	I = NREC
	OPEN(10,FILE=FILENAME//'2',STATUS='UNKNOWN',FORM='UNFORMATTED',
     1RECORDTYPE='SEGMENTED')


	WRITE(10)I

	DO 707 ROW=0,I-1
	WRITE(10)PA(ROW)
707	CONTINUE

	CLOSE(10)


	RETURN
	END



C	***********************************************************************

	INTEGER*2 FUNCTION IDLFIX(IARRAY,OFFSET)

C		IDLFIX mimicks IDL's "FIX" function which extracts a desired
C	INTEGER*2 value from the given BYTE array.  All arrays in IDL by
C	default start with an offset of ZERO.   An array of any data type in
C	IDL containing "I" elements will be numbered from [0..I-1].

	INTEGER*4	OFFSET			!OFFSET of byte in array
	BYTE		IARRAY(0:65534)		!byte array to extract from


	IDLFIX = ZEXT(IARRAY(OFFSET)) + ZEXT(IARRAY(OFFSET+1))*256


	RETURN
	END




C	***********************************************************************

	SUBROUTINE CLEAR(BUFF)

C		CLEAR contents of current PARAM output record.

	INTEGER*2	BUFF(32767)		!array to clear
	INTEGER*4	INDEX			!INDEX into array


	DO 10,INDEX=1,32767
		BUFF(INDEX) = 0
10	CONTINUE


	RETURN
	END





C	***********************************************************************

	SUBROUTINE READERROR

C		Write out tape read error message.

	WRITE(*,10)
10	FORMAT(' %WARNING:  Tape READ ERROR, One Record was LOST')


	RETURN
	END



C	***********************************************************************

	SUBROUTINE FATALREAD

C		Write out FATAL READ ERROR message.

	WRITE(*,10)
10	FORMAT(' %ERROR:  Unable to READ Tape Beyond This Point')


	RETURN
	END



C	***********************************************************************

	INTEGER*2 FUNCTION EASTWEST(LONGITUDE,TIME)

C		EASTWEST determines if the spacecraft is on the EAST or WEST
C	side of the Earth.  EASTWEST returns a value of 1 if the spacecraft
C	is on the EAST side of the Earth, and returns a value of 0 otherwise.


	REAL*4		TIME,SC_POSITION
	INTEGER*2	LONGITUDE


	SC_POSITION = TIME*15.0 + FLOAT(LONGITUDE)
	IF(SC_POSITION.GE.360.0)SC_POSITION=SC_POSITION-360.0
	IF(SC_POSITION.GE.180.0)THEN
		EASTWEST = 1
	ELSE
		EASTWEST = 0
	ENDIF


	RETURN
	END




C	***********************************************************************

	SUBROUTINE INT2CHAR(INTVAL,CHARSTR,N)

C		INT2CHAR converts the INTEGER*4 value INTVAL to an equivalent
C	CHARACTER*N string.  N is the number of digits in the INTEGER*4 value
C	to be converted; if N is larger than the number of digits in INTVAL,
C	the resulting character string will be padded with trailing zeros.


	CHARACTER*(*)	CHARSTR			!output CHARACTER string
	INTEGER*4	INTVAL			!input INTEGER*4 value
	INTEGER*4	N			!number of DIGITS to convert
	INTEGER*4	ITEMP,I
	REAL*8		TEMP


	TEMP = DFLOAT(INTVAL)
	DO 100,I=1,N
		TEMP = TEMP/10.0
		ITEMP = NINT(10.0*(TEMP - DFLOAT(INT(TEMP))))
		TEMP = DFLOAT(INT(TEMP))
		CHARSTR(N+1-I:N+1-I) = CHAR(ITEMP + ICHAR('0'))
100	CONTINUE


	RETURN
	END




C	***********************************************************************

	SUBROUTINE SWAPBYTE(IARRAYB,LENGTH)

C		SWAPBYTE swaps the high- and low-order bytes in an integer
C	variable or array.  Since SWAPBYTE treats the variable passed to it
C	simply as a string of bytes, SWAPBYTE can handle REAL*4 (4 bytes),
C	REAL*8 (8 bytes), CHARACTER, INTEGER*2 (2 bytes), INTEGER*4 (4 bytes),
C	and BYTE data types, as long as the LENGTH of each data structure
C	(SCALAR or ARRAY) is correctly passed to SWAPBYTE.  The MAXIMUM length
C	of any data structure allowed is 65535 bytes.  SWAPBYTE currently can
C	only handle arrays of 32767 bytes or less.

C		IARRAYB:	SCALAR or ARRAY variable to be swapped
C		LENGTH:		LENGTH of SCALAR or ARRAY variable in bytes


	BYTE		IARRAYB(65535)		!BYTE array to SWAP
	BYTE		TEMP			!TEMPORARY byte storage
	INTEGER*2	LENGTH			!LENGTH of BYTE array
	INTEGER*4	INDEX			!INDEX into BYTE array


	INDEX=1
	DO WHILE (INDEX.LE.LENGTH)
		TEMP = IARRAYB(INDEX)
		IARRAYB(INDEX) = IARRAYB(INDEX+1)
		IARRAYB(INDEX+1) = TEMP
		INDEX = INDEX+2
	END DO


	RETURN
	END






C	************************************************************************

	SUBROUTINE VAXOPEN(DEVICE,IOCHANNEL)

C		VAXOPEN assigns an I/O channel to the given physical
C	TAPE device.

	INCLUDE	'SYS$LIBRARY:FORSYSDEF($IODEF)/NOLIST'
	INCLUDE	'SYS$LIBRARY:FORSYSDEF($SSDEF)/NOLIST'


	INTEGER*2	IOCHANNEL		!Device I/O channel
	INTEGER*4	SYS$ASSIGN		!VMS ASSIGN System Service
	INTEGER*4	LIB$SIGNAL		!VMS Condition Handler
	INTEGER*4	ASSIGNSTATUS		!Status of ASSIGN operation
	CHARACTER*80	DEVICE			!PHYSICAL device name on system


	ASSIGNSTATUS = SYS$ASSIGN(DEVICE,IOCHANNEL,,)!Get device I/O channel
	IF(.NOT.ASSIGNSTATUS)CALL LIB$SIGNAL(%VAL(ASSIGNSTATUS))!Check status


	RETURN
	END



C	************************************************************************

	SUBROUTINE VAXREAD(IOCHANNEL,IOSTATUS,IOBUFFER,LENGTH)

C		VAXREAD reads ONE record from TAPE.

	INCLUDE	'SYS$LIBRARY:FORSYSDEF($IODEF)/NOLIST'
	INCLUDE	'SYS$LIBRARY:FORSYSDEF($SSDEF)/NOLIST'


	BYTE		IOBUFFER(65535)		!I/O buffer
	INTEGER*2	IOSTATUS(4)		!SYSTEM I/O status block
	INTEGER*2	IOCHANNEL		!Device I/O channel
	INTEGER*4	QIOSTATUS		!System Service Return Status
	INTEGER*4	SYS$QIOW,LIB$SIGNAL	!System Service Definitions
	INTEGER*4	LENGTH			!LENGTH of I/O Transfer (bytes)


	QIOSTATUS = SYS$QIOW(,%VAL(IOCHANNEL),	!I/O channel
     1			%VAL(IO$_READLBLK),	!I/O READ operation
     2			IOSTATUS,,,		!I/O status block
     3			IOBUFFER,		!I/O buffer
     4			%VAL(LENGTH),,,,)	!LENGTH of I/O transfer
	IF(.NOT.QIOSTATUS)CALL LIB$SIGNAL(%VAL(QIOSTATUS))!Check QIO status


	RETURN
	END





C	***********************************************************************

	INTEGER*4 FUNCTION RMSOPEN(FAB,RAB,LUN)

C	RMSOPEN is a user-written subroutine that works along with the
C	FORTRAN OPEN statement to allow access to VAX RMS I/O facilities
C	that are otherwise not available to FORTRAN programs.


	INCLUDE		'($SYSSRVNAM)'		!Get System Service definitions
	INCLUDE		'($RMSDEF)'		!Get RMS definitions
	INCLUDE		'($FABDEF)'		!Get FAB definitions
	INCLUDE		'($RABDEF)'		!Get RAB definitions

	RECORD		/FABDEF/FAB		!File Access Block
	RECORD		/RABDEF/RAB		!Record Access Block
	INTEGER*4	LUN			!FORTRAN Logical Unit Number


	RMSOPEN = SYS$OPEN(FAB)			!OPEN the file
	IF(.NOT.RMSOPEN)RETURN			!RETURN immediately if failure
	RMSOPEN = SYS$CONNECT(RAB)		!CONNECT file to RAB and LUN
	IF(.NOT.RMSOPEN)RETURN			!RETURN if error


	RETURN
	END




C	***********************************************************************

	INTEGER*4 FUNCTION RMS_GET(RAB,INPUT_BUFFER,INPUT_LENGTH)

C	RMS_GET reads records from a file using RMS RECORD mode I/O.
C	Parameters:	RAB		!Address of RMS RAB.  Fields of the
C					!RAB are updated by SYS$GET.
C			INPUT_BUFFER	!INPUT BUFFER to fill
C			INPUT_LENGTH	!LENGTH of record read (BYTES)
C
C	Function Values Returned:	Status returned by SYS$GET
C					(SUCCESS or FAILURE)
C
	INCLUDE		'($SYSSRVNAM)'		!Get System Service definitions
	INCLUDE		'($RMSDEF)'		!Get RMS definitions
	INCLUDE		'($FABDEF)'		!Get FAB definitions
	INCLUDE		'($RABDEF)'		!Get RAB definitions

	RECORD		/FABDEF/FAB		!File Access Block
	RECORD		/RABDEF/RAB		!Record Access Block
	BYTE		INPUT_BUFFER(65535)
	INTEGER*2	INPUT_LENGTH


	RAB.RAB$L_UBF = %LOC(INPUT_BUFFER)	!Set buffer pointer in RAB
	RAB.RAB$W_USZ = 65535			!Set size of buffer (bytes)

	RMS_GET = SYS$GET(RAB)			!GET a record from file
	IF(.NOT.RMS_GET)RETURN			!Check return status
	INPUT_LENGTH = RAB.RAB$W_RSZ		!Extract and return record size


	RETURN
	END