      PROGRAM GRDREM
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
C  PROGRAM CONVERTS USGS STD. GRID FILES TO REMAPP IMAGE FILES
C  ***  NOTE: GRID Files start at bottom of image  ***
C             REMAPP images start at top of image
C     SCALES GRID REAL*4 DATA TO 8 BITS/PIXEL  (DN = 0-255)
C        & flip image bottom to top
C
C  LINK WITH DISKIO, PACK, REMLOG, DATE, TIME, EXIT
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
      REAL*4 ROW(8192),VMIN,VMAX,DVAL
      REAL*4 m, b, XO, DXO, YO, DYO, rtemp,DUM
      INTEGER*2 IROW(8192)
      INTEGER*4 OFCB(256), ICOL, NCOL, NROW, NW, I, J, ICOUNT
      CHARACTER*56 ID
      CHARACTER*8 PGM
      CHARACTER FILENAME*80

      DVAL = 1E30
      VMIN = 1E38
      VMAX = -1E38

      CALL REMLOG('--- *** Grid -> Remapp   (REMGRD) *** ---')
c.....open grid file
      WRITE(6,80)
80    FORMAT(1X,'GRID FILENAME = ',\)
      READ(5,90) FILENAME
90    FORMAT(80A)
      OPEN(13,FILE=FILENAME,STATUS='OLD',ACCESS='SEQUENTIAL',
     & FORM='UNFORMATTED')
      WRITE(4,*) 'GRID file opened: ', filename
      READ(13) ID,PGM,NCOL,NROW,NW,XO,DXO,YO,DYO
      write(4,*) 'id,pgm,ncol,nrow,nw,xo,dxo,yo,dyo ='
      write(6,*) 'id,pgm,ncol,nrow,nw,xo,dxo,yo,dyo ='
      write(4,*) id,pgm,ncol,nrow,nw,xo,dxo,yo,dyo
      write(6,*) id,pgm,ncol,nrow,nw,xo,dxo,yo,dyo
c
c.....create remapp file
c
      ICOL=NCOL
      IF(ICOL.LT.100) ICOL=100
      OFCB(1)=8
      OFCB(2)=ICOL
      OFCB(13)=1
      CALL DISKIO(0,12,IROW,OFCB)
      IF(OFCB(1) .LT. 0) CALL EXIT(3)
c.....change standard grid to remapp file
c     calc slope (m) and offset (b)

      DO 110 I=1, NROW
         READ(13,END=110) DUM, (ROW(J),J=1,NCOL)
         DO 100 J=1, NCOL
            IF(ROW(J) .LT. DVAL) THEN
               IF(ROW(J) .LT. VMIN)  VMIN = ROW(J)
               IF(ROW(J) .GT. VMAX)  VMAX = ROW(J)
            ELSE
               ICOUNT = ICOUNT + 1
            ENDIF
100      CONTINUE
110   CONTINUE

c      write(6,*) 'Enter Minimum and Maximum Grid Data Values '
c      read(5,*) vmin, vmax

      write(4,*) 'Minimum Values:  REMAPP DN = 1    Grid = ', vmin
      write(4,*) 'Maximum Values:  REMAPP DN = 255  Grid = ', vmax
      write(6,*) 'Minimum Values:  REMAPP DN = 1    Grid = ', vmin
      write(6,*) 'Maximum Values:  REMAPP DN = 255  Grid = ', vmax
      write(4,*) 'Number of DVALs in Grid = ', ICOUNT
      write(6,*) 'Number of DVALs in Grid = ', ICOUNT

c  calc slope and intercept for linear interpolation

      if((vmax - vmin) .eq. 0) then
         write(6,*) 'NO RANGE in Minimum and Maximum Grid values '
         stop
      endif

      m = real(255 - 1)/(vmax - vmin)
      b = real(1) - (m * vmin)

      write(4,*) 'REMAPP DN = INT (GRID Value * ', m, ' + ', b, ' + .5)'
      write(6,*) 'REMAPP DN = INT (GRID Value * ', m, ' + ', b, ' + .5)'
c.....open grid file
      REWIND 13
      READ(13) ID,PGM,NCOL,NROW,NW,XO,DXO,YO,DYO
c.....loop

      DO 15 J=NROW, 1, -1
         READ(13,END=7) DUM,(ROW(I),I=1,NCOL)
         DO 6 I=1, NCOL
            RTEMP = ROW(I)
            IF(ROW(I) .GT. VMAX) RTEMP = VMAX
            IF(ROW(I) .LT. VMIN) RTEMP = VMIN
            IROW(I) = INT((RTEMP * m) + b + .5)
            IF(ROW(I) .GE. DVAL) IROW(I) = 0
6        CONTINUE
         OFCB(14) = J + 1
         CALL PACK(IROW,OFCB)
         CALL DISKIO(10,12,IROW,OFCB)
         IF(OFCB(1) .LT. 0) CALL EXIT(3)
         I = J
15    CONTINUE

7     IF(I .NE. 1) THEN
         DO 20 J=1, NCOL
            IROW(J)=0
20       CONTINUE
         CALL PACK(IROW,OFCB)
         DO 25 J=I-1, 1, -1
            OFCB(14) = I + 1
            CALL DISKIO(13,12,IROW,OFCB)
25       CONTINUE
      ENDIF

      OFCB(24) = NROW
      OFCB(3) = OFCB(24)
      OFCB(26) = OFCB(24)

C.....CLOSE FILES
      CALL DISKIO(6,12,IROW,OFCB)
      CLOSE(13)

      STOP
      END
