      subroutine bmpread(filename,biBitCount,ncol,nrow,nclr,rgb,data,
     $                   error)
      implicit none

c*****************************************************************************
c*                                                                           *
c*     (C) Copyright 1993 by Enlightened Solutions. All rights reserved.     *
c*                                                                           *
c*                           Enlightened Solutions                           *
c*                           1503 Linda Rosa Avenue                          *
c*                           Los Angeles, CA  90041-2210                     *
c*                           Phone: 213-255-3932                             *
c*                           CIS ID: 70704,3067                              *
c*                                                                           *
c*    This software is distributed free-of-charge, but is NOT released to    *
c*    the public domain. If you make any changes, please do so on a copy,    *
c*    and include the originals in any distribution, with copyright notices  *
c*    intact.                                                                *
c*                                                                           *
c*****************************************************************************

c     This subroutine reads a Windows Bitmap v3.0 graphic file. Note that
c  "v3.0" does not refer to Windows 3.0, but rather Bitmap 3.0, as described
c  in the file BMP30FMT.TXT. Bitmap v3.0 files are compatible with Windows
c  3.x. Compressed (RLE) bitmap formats are not supported. This subroutine
c  has been succesfully compiled under MS FORTRAN v5.1 and MS Powerstation
c  FORTRAN (32 bit), although the Powerstation compiler will issue a warning
c  that the [huge] attribute of the "data" array will be ignored, which is ok.

c     The required inputs and return values are described below. The other
c  variables in the bitmap header (as described in BMP30FMT.TXT) are seldom
c  needed or used, but could be returned if desired.
c
c  filename - Character*(*), input. The name of the bitmap file to be read,
c             including path if necessary. If the file doesn't exist, the
c             subroutine displays an informational message, sets "error" 
c             = .true., and returns.
c  biBitCount - Integer*2, output. The number of bits/pixel of the "data" 
c               array. Valid values are 1,4,8, and 24 (representing maximum 
c               colors of 2,16,256, and 16.8 million, respectively).
c  ncol - Integer*4, output. Number of pixels in the horizontal direction.
c  nrow - Integer*4, output. Number of pixels in the vertical direction.
c  nclr - Integer*4, output. Number of colors in palette.
c  rgb - Byte(3,*), output. An array to hold the red, green, and blue 
c        components of the "nclr" colors of the palette. *EXCEPTION* It
c        would be impractical to specify 16.8 million color palette for a 
c        24 bit image, therefore these images specify the colors directly 
c        by the data itself, i.e. the three bytes of data specify the red, 
c        green, and blue components of that particular pixel. In this case, 
c        array "rgb" is returned unaltered.
c  data - [huge]byte(*), output. An array to hold the data for the bitmap. 
c         "biBitCount" specifies how many bits/pixel. The array is one-dimen-
c         sional here, but may be two (or more) dimensions in the calling 
c         program. The first pixel in this array will correspond to the
c         lower left corner of the image. If you prefer a different orienta-
c         tion, then make this array 2D here, and alter the read statement
c         to suit yourself. 
c  error - Logical*4, output. If an error occurred, usually during opening
c          or reading the file, "error" is set to .true., an informational
c          message is displayed, and control is returned to the calling 
c          program.

c  Bitmap File-Header variables. See "BMP30FMT.TXT" for more info.
      
      character*2 bfType
      integer*4 bfSize,bfOffBits
      integer*2 bfReserved1,bfReserved2

c  Bitmap Info-Header variables. See "BMP30FMT.TXT" for more info.
      
      integer*2 biPlanes,biBitCount
      integer*4 biSize,biWidth,biHeight,biCompression,biSizeImage
      integer*4 biXPelsPerMeter,biYPelsPerMeter,biClrUsed,biClrImportant

c  RGBQuad variables. See "BMP30FMT.TXT" for more info.
      
      byte rgb(3,*),rgbReserved

c  Other passed and local variables.
      
      byte data[huge](*),buffer(4)
      integer*2 getlen,nbytes_read,nbuf
      integer*4 ncol_bytes,ncol,nrow,nclr,ioerr,iu,i,j,j0
      logical*4 error,open,exist
      character*(*) filename
c---------------------------------------------------------------------------

      error = .false.

c  Make sure file exists.

      inquire(file=filename,exist=exist)
      if(.not.exist)  then
       write(*,522)  filename(1:getlen(filename))
522    format(/,' BMPREAD - ',a,' does not exist.',/)
       error = .true.
       return
      endif

c  Find available unit # and open file.

      iu = 0
      open = .true.
      do while (open)
       iu = iu + 1
       inquire(unit=iu,opened=open)
      enddo
      open(iu,file=filename,status='old',form='binary',mode='read',
     $     iostat=ioerr,err=98)

c  Read BitmapFileHeader
      
      read(iu,iostat=ioerr,err=98)  bfType,bfSize,bfReserved1,
     $                              bfReserved2,bfOffBits

c  Read BitmapInfoHeader
      
      read(iu,iostat=ioerr,err=98)  biSize,biWidth,biHeight,biPlanes,
     $                              biBitCount,biCompression,
     $                              biSizeImage,biXPelsPerMeter,
     $                              biYPelsPerMeter,biClrUsed,
     $                              biClrImportant
      
      if(biCompression.ne.0)  then
       write(*,'(/,'' BMPREAD - Compressed bitmaps not supported.'',/)')
       error = .true.
       return
      endif

      ncol = biWidth
      nrow = biHeight
      nclr = 2**biBitCount
      ncol_bytes = ncol*biBitCount/8

c  Read color table. The bitmap file stores the red, green, blue triplet
c  as blue, green, red; hence the descending counter in the read statement
c  in order that array rgb be true to its name. 

      if(biBitCount.lt.24)  then
       read(iu,iostat=ioerr,err=98)  
     $                        ((rgb(j,i),j=3,1,-1),rgbReserved,i=1,nclr)
       nbytes_read = 54 + 4*nclr
      else
       nbytes_read = 54
      endif

c  Advance to the beginning of the image data. Chances are that 
c  bfOffBits = nbytes_read, and this read statement will not execute. 
c  "buffer(1)" is NOT a typo.

      read(iu,iostat=ioerr,err=98) (buffer(1),i=1,bfOffBits-nbytes_read)

c  Read data. Note that this program does not expand 1 or 4 bit/pixel
c  values to occupy one byte. The user is left to do that themselves.
c  For 24 bit/pixel data, array "data" contains successive red, green,
c  blue bytes. Since each scanline (row) must end at a 4-byte boundary,
c  read the padded bytes at the end of each row, if necessary. Note that
c  the only reason there is a different read statment for the nbuf.eq.0 
c  case is that it's faster.

      nbuf = mod(4 - mod(ncol_bytes,4),4)
      if(nbuf.ne.0)  then
       do 2 i = 1,nrow
        j0 = (i - 1)*ncol_bytes + 1
        read(iu,iostat=ioerr,err=98)  (data(j),j=j0,j0+ncol_bytes-1),
     $                                (buffer(j),j=1,nbuf)
2      continue
      else
       read(iu,iostat=ioerr,err=98)  (data(j),j=1,ncol_bytes*nrow)
      endif
      close(iu)
      return

c  If here, there was an open or read error. Inform, and return with 
c  error = .true..

98    error = .true.
      if(ioerr.eq.-1)  then
       write(*,222)  filename(1:getlen(filename))
222    format(/,' BMPREAD - End-of-file encountered reading ',a,/)
      else if(ioerr.gt.0)  then 
       write(*,322)  ioerr,filename(1:getlen(filename))
322    format(/,' BMPREAD - Error #',i5,' opening or reading ',a,/)
      endif
      
      close(iu)
      return
      end
c****************************************************************************      
      integer*2 function getlen(word)
      integer*2 ic
      character*(*) word

      getlen = len(word) + 1
11    getlen = getlen - 1
      if(getlen.eq.0)  return
      ic = ichar(word(getlen:getlen))
      if(ic.eq.32 .or. ic.eq.0)  go to 11
 
      return
      end
