;+
; NAME:
;	flt_read
; PURPOSE:
;	Read 2D float array from ASCII file
; CATEGORY:
;	I/O
; CALLING SEQUENCE:
	FUNCTION flt_read, InFile, Array		, $
		nx				= NX				, $
		ny				= NY				, $
		exponent		= exponent			, $
		stopboost		= stopboost 		, $
		header			= header			, $
		atleast 		= atleast			, $
		silent			= silent			, $
		NoCheck 		= NoCheck			, $
		timer			= timer 			, $
		fmts			= fmts				, $
		errormessage	= errormessage		, $
		crumbs			= Crumbs			, $
		skipfmt 		= skipfmt			, $
		comments		= Comments			, $
		usefstat		= UseFSTAT			, $
		double_precision= double_precision	, $
		integer			= integer			, $
		delay			= delay 			, $
		padvalue		= padvalue			, $
		xfora			= xfora 			, $
		bad 			= bad				, $
		modify_format	= modify_format 	, $
		mask_string 	= mask_string		, $
		comment_char	= comment_char
; INPUTS:
;	FILE		char	name of ASCII file
; OPTIONAL INPUTS:
;	nx=NX		1st dimension of output array Array (if omitted
;				the number of elements in the 1st record is used)
;	ny=NY		2nd dimension of output array Array (if omitted NY is
;				set to the numbers of records in the file)
;	atleast=atleast	only records with at least 'atleast' numbers in them are
;				accepted
;	/exponent	the records read from FILE are checked for exponents
;				(see href=flt_string= procedure)
;	/stopboost	only the first NY records are read
;	/nocheck	reduces double-checking in href=flt_clean=
;	/skipfmt	analyze each record with href=flt_string=, i.e. do NOT try
;				the accumulated formats used to read previous records
;	mask_string=mask_string
;				scalar; type: string
;					see href=flt_string=.
;	/modify_format
;				activates a call to href=flt_format= in all calls to
;				flt_string. This shortens the format specifiers returned
;				in keyword fmts.
;
;				The reason for introducing this keyword is that there
;				apparently is a limit on the length of format statements.
;				E.g. if a file was written with format
;					(I1,4F7.2,I4,183(I8,F7.2))
;				then flt_read without the /modify_format keyword will try
;				to read it with a really long format with 183 pairs of
;				I8,F7.2 in it. The long version of the format causes an
;				error when it is used in a read/write statement.
;				However the short version also has a problem when it is
;				used to read the whole file with a single read statement.
;
;				While
;					readf, iu, format='(F6.1,F10.1,F7.2,F10.1,F7.2)', tmp
;				works correctly, the shorter version
;					readf, iu, format='(F6.1,2(F10.1,F7.2))', tmp
;				results in an error (IDL 6.0 and 6.1beta on Linux).
;				This change in format is exactly what /modify_format
;				accomplishes. No error occurs when the latter format is
;				used to read the file record by record. 
;	silent=silent
;				scalar; type: integer; default: 0
;				controls display of informational messages.
;				Set silent=-1 to generate lots of messages
;	/timer		displays timer information (testing purposes only)
;	/double_precision
;				if set then a double precision array is returned
;					(default: single precision)
;	comment_char=comment_char
;				scalar; type: string; default: ';'
;				lines starting with this character are skipped
; OUTPUTS:
;	RtnVal		0: some error occurred (check 'errormessage')
;				1: file properly read
;	Array		array[n,m]; type: float or double
;				2D array of floating point numbers
;				if something goes wrong Array = -1 is returned
;	Crumbs		string	2D array containing the character substrings
;				not converted into numbers
;				This array will be complete only if /skipfmt is set
;				(processing all records separately). If skipfmt is not
;				set only then usually only the crumbs for the first
;				record is returned.
;	errormessage	= '' (null string) if the file is properly read
;				= string describing error is something goes wrong
; OPTIONAL OUTPUT PARAMETERS:
;	NX,NY		dimensions of Array
; INCLUDE:
	@compile_opt.pro		; On error, return to caller
; CALLS:
;	InitVar, boost, flt_string, flt_clean, stopwatch, hide_env, do_file
;	IsType, gunzip_file
; COMMON BLOCKS:
	common flt_read_common, old_time
; RESTRICTIONS:
;	For each record in the file all formats are tried that were established
;	from preceding records. If the record can be read successfully with
;	one of these formats than the result is accepted and flt_string is not called
;	to analyze the record. This depends on IDL returning an error when a
;	record does not fit the record. However, IDL is too tolerant about matching
;	formats to strings resulting in wrong results, e.g.
;		x = fltarr(2)
;		reads, '123,456', format='(I2,1X,I3)', x
;		print, x
;			12.0000  0.00000
;	I.e. no error is generated !!! For uniformly formatted files this is
;	usually not a problem. But for irregularly formatted files this pitfall is
;	best avoided by setting the /skipfmt keyword.
; PROCEDURE:
; >	Empty records and records starting with a semi-colon (;) are ignored
; >	The function href=flt_string= is used to convert a record read from FILE as
;	a string into a floating point array
; >	Only the first NX numbers of each record are stored in subsequent rows
;	of Array. NX is explicitly given as input or, if omitted, is set equal
;	to the number of elements in the first record of FILE
; >	If less than NX numbers are found in a record, the corresponding
;	row in Array is padded with zeros.
; >	A buffer array of size NX by NY is initialized before reading
;	the file, where NY is explicitly input or set to # records in the file.
;	If FILE contains more than NY records, records following record NY are
;	appended to Array by the 'boost' procedure (this is slow for big arrays)
;	unless the keyword /stopboost is set.
; MODIFICATION HISTORY:
;	OCT-1992, Paul Hick (UCSD/CASS)
;	FEB-1995, Paul Hick (UCSD/CASS)
;		Added the 'crumbs' option
;	MAR-2000, Paul Hick (UCSD/CASS)
;		Added /double_precision keyword
;	JAN-2002, Paul Hick (UCSD/CASS)
;		Added /status keyword
;	NOV-2002, Paul Hick (UCSD/CASS)
;		Added padvalue keyword
;	MAY-2003, Paul Hick (UCSD/CASS)
;		More strict interpretation of /skipfmt: if set then every record
;		is processed separately by flt_string. No attempt is made anymore to read
;		read more than one record at a time with a single format.
;	JUN-2003, Paul Hick (UCSD/CASS)
;		Added option to process .gz files transparently
;	OCT-2003, Paul Hick (UCSD/CASS)
;		Added 'bad' keyword.
;	SEP-2004, Paul Hick (UCSD/CASS
;		Added /modify_format keyword.
;	FEB-2007, Paul Hick (UCSD/CASS)
;		Minor change in processing of /xfora keyword
;		Added check for presense of Crumbs keyword before trying
;		a direct read (the direct read does not fill the Crumbs
;		array).
;	AUG-2008, Paul Hick (UCSD/CASS)
;		Empty files now return an status code of zero, instead of
;		aborting.
;	JUN-2011, Paul Hick (UCSD/CASS; pphick@ucsd.edu)
;		Added keyword comment_char
;-

InitVar, double_precision	, /key
InitVar, integer			, /key
InitVar, silent 			, 0
InitVar, timer				, /key
InitVar, skipfmt			, /key
InitVar, UseFSTAT			, /key
InitVar, atleast			, 1
InitVar, stopboost			, /key
InitVar, padvalue			, 0.0
InitVar, header				, /key
InitVar, xfora				, /key
InitVar, modify_format		, /key
InitVar, comment_char 		, ';'

IF double_precision	THEN padvalue = double(padvalue)
IF integer			THEN padvalue = long64(padvalue)

status = 0
Array = -1

; If InFile is blank then file_search returns a list of all file names in the
; working dir (maybe we should also check for wildcards in InFile here???)

IF strcompress(InFile, /rem) EQ '' THEN BEGIN
	errormessage = 'blank file name specified'
	IF silent LE 0 THEN message, /info, errormessage
	RETURN, status
ENDIF

; If file found then unzip if necessary.
; If file not found try adding .gz extension.

fi = (file_search(InFile))[0]

fi_env = InFile+(['','.gz'])[fi eq '']

gzipped = gunzip_file(fi_env, rawfile, check=fi eq '',isgz=isgz)
fi_env = hide_env(fi_env)

CASE gzipped OF
0: IF isgz THEN fi = ''
1: fi = rawfile
ENDCASE

IF fi EQ '' THEN BEGIN
	errormessage = 'file not found or unzip error: '+hide_env(InFile)
	IF silent LE 0 THEN message, /info, errormessage
	RETURN, status
ENDIF

CASE IsType(delay,/defined) OF
0: IF silent LE 1 THEN message, /info , fi_env
1: BEGIN
	new_time = systime(/seconds)
	IF IsType(old_time,/undefined) THEN old_time = new_time-2*delay
	IF new_time-old_time GT delay THEN message, /info, '... '+fi_env
	old_time = new_time
END
ENDCASE

IF timer THEN stopwatch, /set

; Open file read only. Stop on error.

openr, /get_lun, IU, fi, error=I

IF I NE 0 THEN BEGIN
	errormessage = !error_state.msg	; Open error: stop
	IF silent LE 0 THEN message, /info, errormessage
	IF gzipped THEN tmp = do_file(/delete, rawfile, /silent)
	RETURN, status
ENDIF

status = 1
errormessage = ''

on_ioerror, IOERROR				; Establish IO error handler

; Read header records until the first non-empty record which does not start
; with a semi-colon is found

destroyvar, Comments

iREC = 0L
iCOM = -1
STREC = ''						; STREC must exist for READF
REPEAT BEGIN

	IF eof(IU) THEN BEGIN
		status = 0
		errormessage = 'empty: '+fi_env
		IF silent LE 0 THEN message, /info, errormessage
		free_lun, IU
		on_ioerror, NULL
		IF gzipped THEN tmp = do_file(/delete, rawfile, /silent)
		RETURN, status
	ENDIF
	readf, IU, STREC
	iREC += 1
	IF strmid(strtrim(STREC,1),0,1) EQ comment_char THEN $
		boost, Comments, STREC

ENDREP UNTIL strcompress(STREC,/rem) NE '' AND strmid(strtrim(STREC,1),0,1) NE comment_char

IF header THEN BEGIN			; Return Array=-1, var 'comments' contains header
	free_lun, IU
	on_ioerror, NULL
	IF gzipped THEN tmp = do_file(/delete, rawfile, /silent)
	RETURN, status
ENDIF

; Interpret 1st data record. Set array dimensions if not supplied as keyword.

REC = flt_string(STREC,exponent=exponent,fmt=FMT,numfmt=numfmt, 	$
		lenfmt=lenfmt, strcrumbs=StrCrumbs, numcrumbs=nCrumbs,		$
		double_precision=double_precision, integer=integer, modify_format=modify_format, $
		mask_string=mask_string, xfora=xfora)

WHILE numfmt LT atleast DO BEGIN		; While no numbers in record
	boost, Comments, STREC

	IF silent LE -1 THEN message, /info,	$
		'record'+strcompress(iREC)+' rejected: only'+strcompress(numfmt)+' numbers'
	readf, IU, STREC
	iREC += 1
	REC = flt_string(STREC,exponent=exponent,fmt=FMT,numfmt=numfmt, $
		lenfmt=lenfmt, strcrumbs=StrCrumbs, numcrumbs=nCrumbs,		$
		double_precision=double_precision, integer=integer, modify_format=modify_format, $
		mask_string=mask_string, xfora=xfora)
ENDWHILE

; XforA format is needed for direct read attempt

CASE 1-xfora OR arg_present(crumbs) OF
0: FMTXforA = FMT
1: NREC = flt_string(STREC,exponent=exponent,fmt=FMTXforA,	$
		double_precision=double_precision, integer=integer, /xfora, modify_format=modify_format,mask_string=mask_string)
ENDCASE

NREC = n_elements(REC)
IF NOT keyword_set(NX) THEN NX = NREC	; X-dimension

iYs = 0
nZs = 0L

CASE keyword_set(NY) OF
0: BEGIN								; Y-dimension
	NY = 0L
	IF UseFSTAT THEN BEGIN
		SZ = (fstat(IU)).size
		NY = SZ/(lenfmt+2)
		IF NY*(lenfmt+2) NE SZ THEN NY = (SZ+2)/(lenfmt+2)
		IF NY*(lenfmt+2) NE SZ THEN NY = 0L
	ENDIF

	CASE NY OF
	0: BEGIN

		point_lun, -IU, FilePos			; Save file pointer

		NY  = 1L						; # remaining records
		nYs = NY
		bYs = 0B
		WHILE NOT eof(IU) DO BEGIN
			readf, IU, STREC

			OK = strcompress(STREC,/rem) NE '' AND strmid(strtrim(STREC,1),0,1) NE comment_char

			; This is overkill: if flt_string is called then might as wel set /skipfmt
	
			;if OK then begin
			;	OK = flt_string(STREC,exponent=exponent,numfmt=numfmt,double_precision=double_precision,mask_string=mask_string)
			;	OK = numfmt ge atleast
			;endif

			IF OK THEN BEGIN
				NY += 1

				IF bYs THEN BEGIN
					iYs += 1
					nYs = [nYs,0]
					nZs = [nZs,0]
					bYs = 0B
				ENDIF
				nYs[iYs] += 1

			ENDIF ELSE BEGIN

				nZs[iYs] += 1
				bYs = 1B

			ENDELSE
		ENDWHILE

		point_lun, IU, FilePos			; Reset file pointer

	END
	ELSE: nYs = NY
	ENDCASE
END
1: nYs = NY
ENDCASE

; Create array. The type of array (float or double) is set by padvalue

Array = make_array( dim=[NX,NY], value=padvalue )

nCrumbsMax = nCrumbs
IF nCrumbs GT 0 THEN Crumbs = strarr(nCrumbs,NY)

IF silent LE -1 THEN message, /info, 	$
    'created array A('+strcompress(NX,/rem)+','+strcompress(NY,/rem)+')'
boosted = 0

fmts    = FMT
NUMSFMT = numfmt
LENSFMT = lenfmt 
IF silent LE -1 THEN message, /info, 'record'+strcompress(iREC)+', new format : '+FMT

; Fill in 1st row in output array

iROW = 0L
Ix = (n_elements(REC) < NX) - 1		; Fill 1st row of array
IF iROW LT NY THEN BEGIN
	Array[0:Ix,iROW] = REC[0:Ix]
	IF nCrumbs*nCrumbsMax NE 0 THEN BEGIN
		I = (nCrumbs < nCrumbsMax)-1
		Crumbs[0:I,iROW] = StrCrumbs[0:I]
	ENDIF
ENDIF ELSE BEGIN					; Can never happen ???
	CASE stopboost OF
	0: BEGIN
		boost, /push, Array, REC[0:Ix], value=padvalue
		IF nCrumbs*nCrumbsMax NE 0 THEN BEGIN
			I = (nCrumbs < nCrumbsMax)-1
			boost, /push, Crumbs, StrCrumbs[0:I]
		ENDIF
		NY += 1
		boosted = 1
	END
	1: goto, DONE
	ENDCASE
ENDELSE

; Skip the direct read section if skipfmt is set
; Also skip the direct read section if the Crumbs keyword is set.
; (this output array will not be filled by a direct read).

IF NOT skipfmt AND NOT arg_present(Crumbs) THEN BEGIN

	on_ioerror, DIRECT_FAIL				; Establish IO error handler

	; Try using a single read to file the array (works hopefully only when
	; all records match the same format FMT

	IF silent LE -1 THEN message, /info, 'reading file with format : '+FMTXforA

	nYs[0] -= 1							; nYs[0] always at least 1 ??

	FOR i=0,iYs DO BEGIN

		point_lun, -IU, FilePos			; Save file pointer, in case read error occurs

		IF nYs[i] GT 0 THEN BEGIN
			tmp = Array[*,iROW+1:iROW+nYs[i]]
			;mFMT = strmid(FMTXforA,1,strlen(FMTXforA)-2)
			;mFMT = '('+strcompress(nYs[i]-1,/rem)+'('+multilineFMT+',/),'+multilineFMT+')'
			;print, mFMT
			;readf, IU, form=mFMT, tmp
			readf, IU, form=FMTXforA, tmp
			Array[*,iROW+1:iROW+nYs[i]] = tmp
			iROW += nYs[i]
		ENDIF

		FOR jj=1,nZs[i] DO BEGIN
			readf, IU, STREC
			IF strmid(strtrim(STREC,1),0,1) EQ comment_char THEN boost, Comments, STREC	;Comments = [Comments,STREC]
		ENDFOR

	ENDFOR

	free_lun, IU
	on_ioerror, NULL

	IF NX LT NREC THEN message, /info, 'Output array is probably garbage. Try reading without NX keyword'

	goto, GOT_DATA


	DIRECT_FAIL:


	on_ioerror, IOERROR					; Re-establish IO handler
	IF silent LE 0 THEN message, /info, '(warning only) '+!error_state.msg

	point_lun, IU, FilePos				; Reset file pointer to where read error occurred

ENDIF

; Now comes the hard work:
; Read the remaining records until eof is reached

WHILE NOT eof(IU) DO BEGIN

	readf, IU, STREC

	iREC += 1

	IF strcompress(STREC,/rem) NE '' AND strmid( strtrim(STREC,1) ,0,1) NE comment_char then begin

		try_flt = 1

		IF NOT skipfmt THEN BEGIN

			on_ioerror, NEXT_FMT			; Loop over all accumulated formats

			I = -1

			WHILE try_flt AND I LT n_elements(fmts)-1 DO BEGIN

				I += 1

				IF strpos(fmts[I],'A') NE -1 THEN BEGIN
					flt_clean, STREC, fmts[I], STRECtmp, FMTtmp, NoCheck=NoCheck,$
						strcrumbs=StrCrumbs, numcrumbs=nCrumbs
				ENDIF ELSE BEGIN
					STRECtmp = STREC
					FMTtmp   = fmts[I]
					nCrumbs  = 0
				ENDELSE

				IF FMTtmp NE '()' THEN BEGIN

					numfmt = NUMSFMT[I]
					IF integer THEN REC = lon64arr(numfmt,/nozero) ELSE IF double_precision THEN REC = dblarr(numfmt,/nozero) ELSE REC = fltarr(numfmt,/nozero)
					reads, STRECtmp, format=FMTtmp, REC

					IF silent LE -1 THEN message, /info, 'record'+strcompress(iREC)+', read with : '+fmts[I]
					try_flt = 0			; If format fits, break loop and skip flt_string

				ENDIF

				NEXT_FMT:

			ENDWHILE

		ENDIF

		on_ioerror, IOERROR

		IF try_flt THEN BEGIN			; None of the formats fits, or skipfmt is set; use flt_string

			REC = flt_string(STREC,exponent=exponent,fmt=FMT,numfmt=numfmt, $
				lenfmt=lenfmt, strcrumbs=StrCrumbs,numcrumbs=nCrumbs,		$
				double_precision=double_precision, integer=integer, modify_format=modify_format,mask_string=mask_string)
			I = where (FMT EQ fmts)
			IF I[0] EQ -1 THEN BEGIN		; Save the format, if it's a new one
				fmts    = [fmts,   FMT]
				NUMSFMT = [NUMSFMT,numfmt]
				LENSFMT = [LENSFMT,lenfmt]
				I = rotate(sort(LENSFMT),5)	; Reverse the array: longest format first
				fmts    = fmts[I]
				NUMSFMT = NUMSFMT[I]
				LENSFMT = LENSFMT[I]
			ENDIF

			IF silent LE -1 then message, /info, 'record'+strcompress(iREC)+', new format : '+FMT

		ENDIF

		IF numfmt GE atleast THEN BEGIN		; Record contains numbers
			REC = REC[0:(n_elements(REC) < NX)-1]
			iROW += 1
			Ix = (n_elements(REC) < NX) - 1
			IF iROW LT NY THEN BEGIN
				Array[0:Ix,iROW] = REC[0:Ix]
				IF nCrumbs*nCrumbsMax NE 0 THEN BEGIN
					I = (nCrumbs < nCrumbsMax)-1
					Crumbs[0:I,iROW] = StrCrumbs[0:I]
				ENDIF
			ENDIF ELSE BEGIN
				CASE stopboost OF
				0: BEGIN
					boost, /push, Array, REC[0:Ix], value=padvalue
					IF nCrumbs*nCrumbsMax NE 0 THEN BEGIN
						I = (nCrumbs < nCrumbsMax)-1
						boost, /push, Crumbs, StrCrumbs[0:I]
					ENDIF
					NY += 1
					boosted = 1
				END
				1: goto, DONE
				ENDCASE
			ENDELSE

		ENDIF

	ENDIF

ENDWHILE

; Close file, cancel I/O error handler
; Remove empty trailing rows in output array (if present)

DONE:

free_lun, IU
on_ioerror, NULL

iROW += 1
IF iROW LT NY THEN BEGIN
	Array = Array[*,0:iROW-1]
	IF nCrumbsMax NE 0 THEN Crumbs = Crumbs[*,0:iROW-1]
	NY = iROW
	IF silent LE 0 THEN message, /info,	$
		'Array truncated to A('+strcompress(NX,/rem)+','+strcompress(NY,/rem)+')'
ENDIF ELSE IF boosted THEN BEGIN
	IF silent LE 0 then message, /info,	$
		'Array boosted to A('+strcompress(NX,/rem)+','+strcompress(NY,/rem)+')'
ENDIF

GOT_DATA:

IF timer THEN stopwatch,/stop

IF gzipped THEN tmp = do_file(/delete, rawfile, /silent)

FOR I=0,n_elements(bad)-1 DO BEGIN
	tmp = where(Array eq bad[I])
	IF tmp[0] NE -1 THEN BEGIN
		Array[tmp] = BadValue(Array)
		IF silent LE 0 then message, /info, strcompress(n_elements(tmp),/rem)+	$
			' '+strcompress(bad[I],/rem)+' elements flagged as bad'
	ENDIF
ENDFOR

RETURN, status

IOERROR:			; I/O error label

status = 0
Array  = -1
errormessage = !error_state.msg
IF silent LE 0 then message, /info, errormessage

free_lun, IU
on_ioerror, NULL

IF gzipped THEN tmp = do_file(/delete, rawfile, /silent)

RETURN, status  &  END