C+
C NAME:
C	iFltArr
C PURPOSE:
C	Read 2D-array ('map') from ASCII of BINARY file
C CALLING SEQUENCE:
	function iFltArr(cFile,nAct,W1,W2,fncW,ZFlag,N,nX,nY,nPad,Z)
C INPUTS:
C	cFile		character*(*)	file to be read
C	nAct		integer		each decimal digit is used to set some
C					action. Least-significant digit is 0, etc.:
C		Digit 0 : 0=read ASCII file,1=Byte,2=Int2,3=Int4,4=Real4
C		Digit 1 : determines the orientation of the array (see PROCEDURE)
C		Digit 2 : 0/1=treat values ZFlag in file as valid/invalid fnc-value (see PROCEDURE)
C		Digit 3 : 1=the file is pre-read to determine # records
C		Digit 4 : 1=swap bytes if nType > 0
C		Digit 5 : 1=forces use of MVBITS for nType > 0
C	W1,W2		real		`weighting factors'. Output array Z
C					is a `weighted mean' of input array
C					Z and the array ZR read from the file:
C					Z(out) = W1*Z(in)+W2*ZR
C					(e.g. if W1=0 and W2=1 then Z(out)=ZR)
C	fncW		real		external function
C					if W1=W2=0 then the external function
C					fncW is used to evaluate Z(out)
C					fncW is a real function of two real 
C					arguments: Z(out) = fncW(Z(in),ZR)
C	ZFlag		real		value used to indicate 'no fnc-value
C					available' (see PROCEDURE)
C	N		integer		maximum permitted array size
C	nX, nY		integer		requested array dimension of output
C					array. If set to 0, values are 
C					determined from the file (see PROCEDURE)
C	nPad(4)		integer		info on padding of rows and columns 
C					using BadR4(): 0=Left,1=Right,2=Bottom,3=Top
C OUTPUTS:
C	iFltArr		integer		0=Failure, or length of file name
C	cFile		character*(*)	if iFltArr .ne. 0: full file name
C	nX, nY		integer		array dimensions
C	Z(nX,nY)	real		array read from file
C INCLUDE:
	include		'filparts.h'
	include		'openfile.h'
	include		'str2str_inc.h'
C CALLS:
C	BadR4, bOpenFile, iFreeLun, FlipFlop, Say, Str2StrSet, Int2StrSet, Int2Str, Str2Str
C	Flt2Str, Str2Flt, Str2Flt_Exp, Str2Flt_Format, ArrI4Zero, ArrR4Constant,
C	ArrR4GetMinMax, ArrR4Mask, MVBITS
C PROCEDURE:
C >	The specified file is opened using the bOpenFile procedure.
C	Digit0 = 0: open as a sequential, formatted file (ascii file)
C	Digit0 > 0: open as a sequential, unformatted file (binary file)
C >	Digit1 = 0,..,7: determines how the records in the file are
C	mapped to the array. For Digit1<4 records are associated with rows
C	in the output array. For Digit1>=4 records are associated with columns.
C	In addition the value mod(Digit1,4) is used to flip the array upside
C	down, or produce a mirror image, or both.
C	If z(j,i) (j=1..nx,i=1..ny) is the j-th number in the i-th record
C	(i.e. the file contains ny records with nx numbers each) and 
C	if Z(j,i) (j=1..NX,i=1..NY) is the number in the J-th column and
C	the I-th row of the output array.
C	Digit1	= 0:	nx=NX, ny=NY;	z(j,i) -> Z(j,i)
C		= 1:			z(j,i) -> Z(j,i) -> Z(NX+1-j,i)
C		= 2:			z(j,i) -> Z(j,i) -> Z(j     ,NY+1-i)
C		= 3:			Z(j,i) -> Z(j,i) -> Z(NX+1-j,NY+1-i)
C	Digit1	= 4:	nx=NY, ny=NX;	z(j,i) -> Z(i,j)
C		= 5:			z(j,i) -> Z(i,j) -> Z(NX+1-i,j)
C		= 6:			z(j,i) -> Z(i,j) -> Z(i     ,NY+1-j)
C		= 7:			z(j,i) -> Z(i,j) -> Z(NX+1-i,NY+1-j)
C >	Digit2 = 0: ZFlag is not used
C	!! Special case: if Digit2=0, ZFlag=BadR4(), W1=0 and W2 nonzero,
C	!! then the minimum in the file is determined and all values equal to this
C	!!  minimum are set to BadR4().
C	Digit2 = 1: values read from the file are checked for the value ZFlag.
C	If the input Z is NOT BadR4() and the value from file is NOT ZFlag will
C	the weighting W1,W2 or the function fncW be applied. Otherwise the ouput Z is
C	set to BadR4().
C >	Digit 3 = 1: the file structure (nH by nV) is determined by pre-reading
C	the file. nH is determined from the record length (binary files) or from
C	a call to Str2Flt using the 1st record (ascii files). nV is set to
C	the number of records in the file.
C	Digit 3 = 0: no pre-read, nV=0 (IMPORTANT: if nX=0 or nY=0, or if nPad(i)=-1
C	(i=1,2,3 or 4), then the file always be a pre-read to determine.
C	nX,nY and nPad will be set using nH and nV.
C MODIFICATION HISTORY:
C	JUL-1995, Paul Hick (UCSD/CASS)
C	OCT-1997, Paul Hick (UCSD/CASS; pphick@ucsd.edu), complete overhaul
C	JUL-2005, Paul Hick (UCSD/CASS; pphick@ucsd.edu)
C	    Changed declarations of iRec1, iTmp1 and bTmp from (unsigned)
C	    'byte' to (signed) 'integer*1'.
C-
	    character	cFile*(*)
	    integer	nAct
	    real	W1
	    real	W2
	    real	fncW
	    real	ZFlag
	    integer	N
	    integer	nX
	    integer	nY
	    integer	nPad(4)			! Left,right,bottom,top
	    real	Z(N)

	parameter	(NMAX = 512)

	integer*1	iRec1(NMAX*4)
	integer*1	iTmp1(4)
	integer*2	iRec2(NMAX*2)
	integer*2	iTmp2(2)
	integer		iRec4(NMAX  )
	integer		iTmp4
	real		rRec4(NMAX  )
	real		rTmp4
	equivalence	(iRec1,iRec2),(iRec1,iRec4),(iRec1,rRec4)
	equivalence	(iTmp1,iTmp2),(iTmp1,iTmp4),(iTmp1,rTmp4)

	integer		LType(0:4)	/4,1,2,4,4/
	character	cType(0:4)*9	/'ASCII','BYTE','SHORT INT','LONG INT','REAL'/

	logical		bExp		/.TRUE./
	logical		bOpenFile
	logical		bBadMin

	integer		i12(0:3)	/0,1,0,1/
	integer		i34(0:3)	/0,0,1,1/

	integer*1	bTmp
	character	cTmp
	equivalence	(bTmp,cTmp)

	character	cFmt0*100
	character	cFmt *100
	character	cRec *2048
	integer		iPad(4)
	integer		Flt2Str
	integer		Str2Str
	integer		Str2StrSet

	ip()  = K0+iZ/KL*(nX*(1-nFlip)+nFlip)+mod(iZ,KL)*(nX*nFlip+1-nFlip)
	mm(I) = min(4,max(1,I))

	iFltArr = 0
	Bad	= BadR4()

	nType	= mod(nAct/10**0,10)	! 0,..,4
	nO	= mod(nAct/10**1,10)	! 0,..,7
	nFlag	= mod(nAct/10**2,10)
	nGuess	= mod(nAct/10**3,10)
	nSwap	= mod(nAct/10**4,10)*min(1,nType) ! Swap bytes if nType > 0
	nBits	= mod(nAct/10**5,10)*min(1,nType) ! Use MVBITS if nType > 0
	nFixFmt	= mod(nAct/10**6,10)

	nFlip	= nO/4				! nFlip=+/-1
	nO	= mod(nO,4)
	if (nX*nY .eq. 0 .or. min(nPad(1),nPad(2),nPad(3),nPad(4)) .lt. 0) nGuess = 1

	bBadMin = nFlag .eq. 0 .and. ZFlag .eq. Bad .and. W1 .eq. 0 .and. W2 .ne. 0

	iDirt	= 0			! For real*4 (nType=5)
	iNaN	= 0

	nV = 0				! Stays 0 if nGuess=0
	if (nType .eq. 0) then		! Ascii files
	    if (.not. bOpenFile(OPN__REOPEN+OPN__TEXT+OPN__READONLY,iU,cFile,iRecl)) return

	    read (iU,'(A)',iostat=I) cRec
	    do while (I .eq. 0 .and. (cRec(:1) .eq. ';' .or. itrim(cRec) .eq. 0))
		read (iU,'(A)',iostat=I) cRec
	    end do
	    if (I .ne. 0) then
	        cFmt = cFile
		call Say('iFltArr','W','ReadError','on file '//cFmt)
		iU = iFreeLun(iU)
		return
	    end if

	    nH = NMAX
	    call Str2Flt_Exp(bExp)
	    call Str2Flt(cRec,nH,rRec4)		! # values/record
	    call Str2Flt_Format(cFmt0)
	    call Say('iFltArr','I','Format',cFmt0)

	else					! Binary files: Sequential, unformatted
	    if (.not. bOpenFile(OPN__REOPEN+OPN__BINARY+OPN__READONLY,iU,cFile,iRecl)) return

	    inquire (iU,recl=nH)		! # long words/record
	    nH = nH*4/LType(nType)		! # values/record

	    if (nH .gt. NMAX) then
	    	kStr = Str2StrSet(STR__NOTRIM)
	    	kInt = Int2StrSet(STR__TRIM)
	    	I = 0
		I = I+Int2Str(nH*LType(nType)	,cRec(I+1:))
		I = I+Str2Str(' bytes/record ='	,cRec(I+1:))
		I = I+Int2Str(nH		,cRec(I+1:))
		I = I+Str2Str(' values (max. allowed: ',cRec(I+1:))
		I = I+Int2Str(NMAX		,cRec(I+1:))
		I = I+Str2Str(')'		,cRec(I+1:))
		kStr = Str2StrSet(kStr)
		kInt = Int2StrSet(kInt)
		call Say('iFltArr','W','NMAXTooSmall',cRec)
		iU = iFreeLun(iU)
		return
	    end if

	    read (iU,iostat=I) bTmp		! Count records

	end if

	if (nGuess .eq. 1) then			! Pre-read
	    call Say('iFltArr','I','PreRead','to determine number of records')
	    do while (I .eq. 0)			! Count records
		nV = nV+1
		if (nType .eq. 0) read (iU,'(A)',iostat=I) cTmp ! cRec
		if (nType .ne. 0) read (iU,iostat=I) bTmp
	    end do
	end if

	rewind (iU)
	cFmt = cFile
	call Say('iFltArr','I','Reading',cType(nType)(:itrim(cType(nType)))//' array from '//cFmt)

	!-------
	! nH is the number of values in the first record of the file. nV is the number of
	! records in the file (may be zero if nGuess=0). The output array should have
	! dimension nX by nY. If nX or nY is zero, set it using values of nH,nV

	if (nX .eq. 0) nX = nH+(nV-nH)*nFlip
	if (nY .eq. 0) nY = nV+(nH-nV)*nFlip
	if (nX*nY .eq. 0) then
	    call Say('iFltArr','W','NoDim','unable to determine array dimensions')
	    iU = iFreeLun(iU)
	    return
	end if

	call FlipFlop(nO,nX,nY,Z)		! Needed to accumulate from multiple files.

	call ArrI4Zero(4,iPad)
	do I=1,4
	    if (nPad(I) .eq. -1) then
		iPad(I) = 1-mod(I-1,2)*iPad(mm(I-1))
		nPad(I) = 0
	    end if
	end do

	I = (1*iPad(1)+2*iPad(2))*(1-nFlip)+(3*iPad(3)+4*iPad(4))*nFlip
	if (I .ne. 0) nPad(I) = max(0, (nX-nPad(mm(3-I)))*(1-nFlip)+(nY-nPad(mm(7-I)))*nFlip-nH )

	I = (1*iPad(1)+2*iPad(2))*nFlip+(3*iPad(3)+4*iPad(4))*(1-nFlip)
	if (I .ne. 0) nPad(I) = max(0, (nY-nPad(mm(7-I)))*(1-nFlip)+(nX-nPad(mm(3-I)))*nFlip-nV )

	K0 = nPad(3+i34(nO))*nX+nPad(1+i12(nO))+1 	! K0,KL: used by ip()
	KL = (nX-nPad(1)-nPad(2))*(1-nFlip)+(nY-nPad(3)-nPad(4))*nFlip
	nZ = (nX-nPad(1)-nPad(2))*(nY-nPad(3)-nPad(4))	! # Z elements to be filled from file

	!-------
	! Flag borders of arrays as set by nPad array. The areas flagged are:
	!  Z(           1..nX     ,           1..nPad(3)   ) 'bottom' : first nPad(3) rows
	!  Z(           1..nX     ,nY-nPad(4)+1..nY        ) 'top'    : last  nPad(4) rows
	!  Z(           1..nPad(3),   nPad(3)+1..nY-nPad(4)) 'left'   : first nPad(1) elements of each row
	!  Z(nX-nPad(2)+1..nX     ,   nPad(3)+1..nY-nPad(4)) 'right'  : last  nPad(2) elements of each row

	call ArrR4Constant(nPad(3+i34(nO))*nX+nPad(1+i12(nO)),Bad,Z)	! Bottom + 1st left side row
	do iZ=(nPad(3+i34(nO))+1)*nX-nPad(2-i12(nO))+1,(nY-nPad(4-i34(nO))-1)*nX-nPad(2-i12(nO))+1,nX	! 1st right side .. last left side
	    call ArrR4Constant(nPad(2)+nPad(1),Bad,Z(iZ))
	end do
	if (iZ .le. nX*nY) call ArrR4Constant(nPad(2-i12(nO))+nPad(4-i34(nO))*nX,Bad,Z(iZ))! Last right side row + top

	!-------
	! Data from the file are used to fill in the center area of the area:
	!  Z(nPad(1)+1..nX-nPad(2),nPad(3)+1..nY-nPad(4))
	! For nFlip=0 numbers from the file are mapped left to right, top to bottom:
	! rows (nX-nPad(1)-nPad(2) #/row) are filled starting from the bottom of the array.
	! For nFlip=1 numbers from the file are mapped top to bottom, left to right:
	! columns (nY-nPad(3)-nPad(4) #/column) are filled starting from the left side of the array.
	! A total of (nX-nPad(1)-nPad(2))*(nY-nPad(3)-nPad(4)) numbers fill up the array.

	nD = 1-nBits+LType(nType)*8*nBits ! # number/number (=1), or # bits/number
	nS = nH*nD			! # values/record, or # bits/record
	iS = nS				! Last Rec number or bit processed (iS=nS forces read)
  	iZ = 0				! Last Z element filled
	iD = 0				! Binary: last bit in number iZ+1 filled
					! ASCII: 0 or 1
	do while (iZ .lt. nZ)

	    if (iS .eq. nS) then	! Whole record processed: read new one

		if (nType .eq. 0) then
		    read (iU,'(A)',iostat=I) cRec
		    if (cRec(:1) .eq. ';') then
			nS = 0		! Skip comments: force another read
		    else if (nFixFmt .eq. 1) then
			nS = nH*nD	! Use single format for whole file
			read (cRec,cFmt0) (rRec4(iS),iS=1,nS)
		    else		! Determine new format for each record
			nS = NMAX	! Empty records: nS=0: skipped
			call Str2Flt_Exp(bExp)
			call Str2Flt(cRec,nS,rRec4)	! Sets nS for current record
			call Str2Flt_Format(cFmt)	! Extract format used
			if (cFmt .ne. cFmt0) then
			    call Say('iFltArr','I','Format',cFmt)
			    cFmt0 = cFmt
			end if

			if (nS .gt. KL) then		! Safety belt
			    I = 1			! Simulate read error
			    call Say('iFltArr','W','NotAsc','Probably not an ASCII file')
			end if
		    end if
		else
		    read (iU,iostat=I) (iRec1(J),J=1,nH*LType(nType))
		end if

		if (I .ne. 0) then			! Read error
		    call Say('iFltArr','W','Incmplt','Incomplete array read from file')
		    do while (iZ .lt. nZ)		! Flag rest of array
			Z(ip()) = Bad
			iZ = iZ+1
		    end do
		end if

		iS = 0   	   			! Reset iRec1,rRec4 pointer
	    end if
							! Ascii: # unprocessed numbers in rRec4
	    I = nS-iS					! Binary: # unprocessed bits in iRec1
	    if (iZ .lt. nZ .and. I .gt. 0) then
							! Ascii : nD=1; iD=0; nD-iD = 1
		I = min(I,nD-iD)			! Binary: nD-iD = # bits needed to fill iTmp1(4)
		if (nType .eq. 0) then
		    rTmp4 = rRec4(iS+1)
		else if (nBits .eq. 1) then
		    call MVBITS(iRec4(1),iS,I,iTmp4,iD)	! Move I bits from iRec1 to iTmp1
		else if (nType .eq. 1) then		! (G77 requires all args to be integer*4)
		    iTmp1(1) = iRec1(iS+1)
		else if (nType .eq. 2) then
		    iTmp2(1) = iRec2(iS+1)
		else if (nType .eq. 3) then
		    iTmp4    = iRec4(iS+1)
		else if (nType .eq. 4) then
		    rTmp4    = rRec4(iS+1)
		end if
		iS = iS+I				! Update iRec1,rRec4 pointer
		iD = iD+I				! Update iTmp1,rTmp4 pointer

		if (iD .eq. nD) then			! iTmp,rTmp4 is complete

		    if (nSwap .eq. 1) then		! Swap bytes (for int*2,int*4 only)
			do I=1,LType(nType)/2
			    J = LType(nType)-I+1
			    bTmp     = iTmp1(I)
			    iTmp1(I) = iTmp1(J)
			    iTmp1(J) = bTmp
			end do
		    end if

		    if (nType .eq. 1) then		! Byte
			rTmp4 = iTmp1(1)		! rTmp4 and iTmp1 are equivalenced
			if (rTmp4 .lt. 0) rTmp4 = 256+rTmp4! Switch to unsigned byte
		    else if (nType .eq. 2) then		! Integer*2
			rTmp4 = iTmp2(1)		! rTmp4 and iTmp2 are equivalenced
		    else if (nType .eq. 3) then		! Integer*4
			rTmp4 = iTmp4			! rTmp4 and iTmp4 are equivalenced
		    else if (nType .eq. 4) then		! Real*4
			if (iCleanNaN(rTmp4) .eq. 1) then
			    iNaN = iNaN+1
			    rTmp4 = Bad
			else if (iClean0(rTmp4) .eq. 1) then
			    iDirt = iDirt+1
			    rTmp4 = Bad
			end if
		    end if

		    I = ip()
		    if (rTmp4 .eq. Bad) then		! Dirty zero or NaN
			Z(I) = Bad
		    else if (nFlag .eq. 1 .and. (Z(I) .eq. Bad .or. rTmp4 .eq. ZFlag)) then
			Z(I) = Bad
		    else if (W1 .eq. 0 .and. W2 .eq. 0) then
			Z(I) = fncW(Z(I),rTmp4)
		    else
			Z(I) = W1*Z(I)+W2*rTmp4
		    end if

		    iZ = iZ+1				! Update Z counter
		    iD = 0				! Reset iTmp1 pointer
        				
		end if
        			
	    end if

	end do

	if (bBadMin) then
	    call ArrR4GetMinMax(nX*nY,Z,Zmin,Zmax)
	    call ArrR4Mask(nX*nY,Z,Zmin,Bad,0.,0.,1.,Z)
	end if

	kStr = Str2StrSet(STR__NOTRIM)
	kInt = Int2StrSet(STR__TRIM)
	if (iDirt+iNaN .ne. 0) then
	    I = Int2Str(iDirt,cRec)
	    I = I+Str2Str(' dirty zeros and ',cRec(I+1:))
	    I = I+Int2Str(iNaN,cRec(I+1:))
	    I = I+Str2Str(' NaN values to ',cRec(I+1:))
	    I = I+Flt2Str(Bad,4,cRec(I+1:))
	    call Say('iFltArr','W','DirtNaN',cRec)
	end if

	I = Int2Str(nH,cRec)
	I = I+Str2Str('x',cRec(I+1:))
	I = I+Int2Str(nV,cRec(I+1:))
	I = I+Str2Str(' file in ',cRec(I+1:))
	I = I+Int2Str(nX,cRec(I+1:))
	I = I+Str2Str('x',cRec(I+1:))
	I = I+Int2Str(nY,cRec(I+1:))
	I = I+Str2Str(' array',cRec(I+1:))
	
	kStr = Str2StrSet(kStr)
	kInt = Int2StrSet(kInt)

	call Say('iFltArr','W','Stored',cRec)

	iU = iFreeLun(iU)
	call FlipFlop(nO,nX,nY,Z)

	iFltArr = itrim(cFile)

	return
	end