      INCLUDE 'VICMAIN_FOR'
C**********************************************************************
      SUBROUTINE MAIN44
C
C     DEMLOGA:
C
C    THIS PROGRAM WILL LOG USGS DEM FILES THAT ARE IN THE FORMAT DESCRIBED
C	IN THE USGS NATIONAL MAPPING DIVISION OPEN-FILE REPORT 86-004
C	"STANDARDS FOR DIGITAL ELEVATION MODELS"
C
C    THIS FORMAT DIFFERS FROM THE ONE KNOWN TO VDEMLOG; IT INVOLVES
C	UNLABELLED TAPES WITH FIXED LENGTH BLOCKSIZE OF 4096 BYTES.
C	ALL DATA ARE STORED AS ASCII CHARACTERS IN 1024 BYTE LOGICAL
C	RECORDS.
C
C	WRITTEN BY RON ALLEY, NOV 1986
C	MODIFIED TO INCLUDE BLOCKING FACTOR PARAMETER, AUG 1987
C	converted to unix, Ron Alley, November 1994
C	modified to handle <CR> delimited records,  Ron Alley,  April, 1997
C
	REAL*8 CORNER(2,4),ZMIN,ZMAX,ANGLE,YLOC,OFFSET
	INTEGER*2 LEVEL,IPATTERN,ISYSTEM,IZONE,IXY,IZ,NSIDES
	INTEGER*2 NROWS,NCOLS,NUMREC,NPTS,IBUF2(10000),IOUT(10000)
	INTEGER*2 IZERO/0/
	CHARACTER*32768 XBUF
	CHARACTER*60 NAME
	CHARACTER*132 PRT
	CHARACTER*11 UNITS(5)/'Radians','Feet','Meters','Arc-Seconds',
     +			      ' '/
C							  get blocking factor
	CALL XVPARM('BLOCK',IBLKFAC,ICNT,IDEF,0)
	IF (IBLKFAC .EQ. 0) THEN
	    NSIN = 1025
	ELSE
	    NSIN = 1024 * IBLKFAC
	ENDIF
C
C							     open input file
	CALL XVUNIT(INUNIT,'INP',1,ISTAT,' ')
	CALL XVOPEN(INUNIT,ISTAT,'OPEN_ACT','SA','IO_ACT','SA',
     +		    'U_NS',NSIN,'COND','NOLABELS',' ')
C
	CALL XVREAD(INUNIT,XBUF,ISTAT,' ')
	READ (XBUF,100) NAME,LEVEL,IPATTERN,ISYSTEM,IZONE,IXY,IZ,
     +		NSIDES,CORNER,ZMIN,ZMAX,ANGLE,DX,DY,DZ,NROWS,NCOLS
  100	FORMAT(A60,84X,4I6,360X,3I6,4(2D24.15),3D24.15,6X,3E12.6,2I6)
	IF ((IXY.GT.4) .OR. (IXY.LT.0)) IXY=4
	IF ((IZ.GT.2) .OR. (IZ.LT.1)) IXY=4
C							report to screen/log
	CALL XVMESSAGE(NAME,' ')
	WRITE (PRT,102) ZMIN,ZMAX,UNITS(IZ+1)
  102	FORMAT('Range =',F7.1,' to',F7.1,' ',A11)
	CALL XVMESSAGE(PRT,' ')
C
C					Check for the oddball cases that 
C					this version won't handle.
C
	IF (IPATTERN.NE.1) THEN
	    CALL XVMESSAGE(
     +		' Random pattern logging not implemented.',' ')
	    CALL ABEND
	ENDIF
	IF (NSIDES.NE.4) THEN
	    CALL XVMESSAGE(
     +	 ' Logging of non-quadrilateral regions is not implemented.',' ')
	    CALL ABEND
	ENDIF
	IF (NROWS.NE.1) THEN
	    CALL XVMESSAGE(
     +	     ' Logging of multiple row profiles is not implemented.',' ')
	    CALL ABEND
	ENDIF
C
	XBASE = MIN(CORNER(1,1),CORNER(1,2),CORNER(1,3),CORNER(1,4))
	XTOP = MAX(CORNER(1,1),CORNER(1,2),CORNER(1,3),CORNER(1,4))
	YBASE = MIN(CORNER(2,1),CORNER(2,2),CORNER(2,3),CORNER(2,4))
	YTOP = MAX(CORNER(2,1),CORNER(2,2),CORNER(2,3),CORNER(2,4))
	NS = (YTOP-YBASE)/DY + 1
	NL = NCOLS
C								Open output file
	CALL XVUNIT(IOUTUNIT,'OUT',1,ISTAT,' ')
	CALL XVOPEN(IOUTUNIT,ISTAT,'OPEN_ACT','SA','IO_ACT','SA',
     +		    'OP','WRITE','U_NL',NL,'U_NS',NS,'U_FORMAT','HALF',
     +		    'O_FORMAT','HALF',' ')
C
C						Add location name to VICAR label
	CALL XLADD(IOUTUNIT,'HISTORY','LOCATION',NAME,ISTAT,
     +		   'FORMAT','STRING',' ')
C
C					    Add geographic coordinates to label
	IF (ISYSTEM.LE.1) THEN
	    IF (ISYSTEM.EQ.1) THEN
		WRITE (PRT,110) IZONE
  110		FORMAT(I4)
		CALL XLADD(IOUTUNIT,'HISTORY','UTM_ZONE',PRT,ISTAT,
     +			   'FORMAT','STRING',' ')
	    END IF
	    WRITE (PRT,120) YBASE,YTOP
  120	    FORMAT(2F14.1)
	    CALL XLADD(IOUTUNIT,'HISTORY','NORTHING',PRT,ISTAT,
     +		   'FORMAT','STRING',' ')
	    WRITE (PRT,120) XBASE,XTOP
	    CALL XLADD(IOUTUNIT,'HISTORY','EASTING',PRT,ISTAT,
     +		   'FORMAT','STRING',' ')
	ELSE IF (ISYSTEM.EQ.2) THEN
	    WRITE (PRT,130) IZONE
  130	    FORMAT(I6)
	    CALL XLADD(IOUTUNIT,'HISTORY','ST_CODE',PRT,ISTAT,
     +		   'FORMAT','STRING',' ')
	ELSE
	    WRITE (PRT,130) ISYSTEM
	    CALL XLADD(IOUTUNIT,'HISTORY','PROJECT',PRT,ISTAT,
     +		   'FORMAT','STRING',' ')
	END IF
C						     Put pixel spacing in label
	IF (DX .EQ. DY) THEN
	    WRITE (PRT,150) DX,UNITS(IXY+1)
  150	    FORMAT(F8.2,' ',A11)
	ELSE
	    WRITE (PRT,160) DX,DY,UNITS(IXY+1)
  160	    FORMAT(F8.2,' by',F8.2,' ',A11)
	END IF
	CALL XLADD(IOUTUNIT,'HISTORY','1_PIXEL',PRT,ISTAT,
     +			'FORMAT','STRING',' ')
C							Put elevation resolution
C							in label
	WRITE (PRT,170) DZ,UNITS(IZ+1)
  170	FORMAT(F8.2,' ',A11)
	CALL XLADD(IOUTUNIT,'HISTORY','1_DN',PRT,ISTAT,
     +			'FORMAT','STRING',' ')
C							Put elevation range in
C							label
	WRITE (PRT,180) ZMIN,ZMAX
  180	FORMAT(F8.2,' -',F8.2)
	CALL XLADD(IOUTUNIT,'HISTORY','RANGE',PRT,ISTAT,
     +			'FORMAT','STRING',' ')
C							Put quality level code
C							in label
	WRITE (PRT,190) LEVEL
  190   FORMAT(I2)
	CALL XLADD(IOUTUNIT,'HISTORY','LEVEL',PRT,ISTAT,
     +			'FORMAT','STRING',' ')
C							Put rotation angle in
C							label, if not 0
	IF (ANGLE.NE.0) THEN
	    WRITE (PRT,195) ANGLE
  195	    FORMAT(F7.2)
	    CALL XLADD(IOUTUNIT,'HISTORY','ROTATION',PRT,ISTAT,
     +			'FORMAT','STRING',' ')
	END IF
C							Build image
	N = 2
	DO LINE=1,NL
	    IF (N.GT.IBLKFAC) THEN
		CALL XVREAD(INUNIT,XBUF,ISTAT,' ')
		N = 1
	    END IF
	    READ(XBUF(1024*(N-1)+1:1024*N),200) NUMREC,NPTS,YLOC,OFFSET,
     +					(IBUF2(I), I=1,146)
  200	    FORMAT(6X,2I6,30X,2D24.15,48X,146I6)
	    N = N+1
	    NBUF = 146
	    IF (NUMREC.NE.LINE) THEN
		CALL XVMESSAGE(' Record sequence error.',' ')
		CALL ABEND
	    ENDIF
	    DO WHILE (NPTS.GT.NBUF)
		IF (N.GT.IBLKFAC) THEN
		    CALL XVREAD(INUNIT,XBUF,ISTAT,' ')
		    N = 1
		END IF
		READ (XBUF(1024*(N-1)+1:1024*N),210) (IBUF2(I), 
     +						      I=NBUF+1,NBUF+170)
  210		FORMAT (170I6)
		N = N+1
		NBUF = NBUF+170
	    END DO
	    IF (OFFSET.NE.0.0) THEN
		DO I=1,NPTS
		    IBUF2(I) = IBUF2(I)+OFFSET+0.5
		END DO
	    END IF
	    NPAD = (YLOC-YBASE)/DY
	    IF (NPAD .NE. 0) THEN
		DO LOC=1,NPAD
		    IOUT(LOC) = IZERO
		END DO
	    END IF
	    DO LOC=1,NPTS
		LOC2 = LOC + NPAD
		IOUT(LOC2) = IBUF2(LOC)
	    END DO
	    NUM = NPAD+NPTS
	    IF (LOC2 .LT. NS) THEN
		DO LOC=LOC2+1,NS
		    IOUT(LOC) = IZERO
		END DO
	    END IF
	    CALL XVWRIT(IOUTUNIT,IOUT,ISTAT,' ')
	END DO
	RETURN
	END
