bitmap-file issues, continued

Hi!

First a positive message: I managed to make a bitmap file for a global height dataset with the following code, based on Mats suggestion:

program test_bmp
!
! Read a height map of the Earth and make a nice bitmap image file
!
  implicit none
  integer rv, nx, ny, x, y
  REAL :: Dum,z
  LOGICAL :: IsLand
  integer, allocatable, dimension(:,:) :: rarray, garray, barray
!
! Interfacing with the external C-routine from bmp_io.c
!
  interface
    integer function bmp_write(file,NX,NY,rarr,garr,barr)
      character(*), intent(in) :: file
      integer, intent(in) :: NX, NY
      integer, dimension(:,:), intent(in) :: rarr, garr, barr
    end function bmp_write
  end interface
!
! Initialize specs for global 1*1 degree map
!
  nx = 360
  ny = 180

  allocate(rarray(nx,ny))
  allocate(garray(nx,ny))
  allocate(barray(nx,ny))
!
! Open the height datafile
!
  OPEN(13,FILE='height.dat',FORM='FORMATTED')
!
! In 1 go, read the height and construct a nice colour
!
  do y = 1, ny
    do x = 1, nx
!
! Read height
!      
      READ(13,*) Dum,Dum,z

      IF (z.LT.1.) THEN
	rarray(x,y) = 128
	garray(x,y) = 128
	barray(x,y) = 255
      ELSE IF (z.LT.100.) THEN
	rarray(x,y) = 255
	garray(x,y) = 165
	barray(x,y) = 79
      ELSE IF (z.LT.500.) THEN
	rarray(x,y) = 92
	garray(x,y) = 64
	barray(x,y) = 51
      ELSE IF (z.LT.1000.) THEN
	rarray(x,y) = 0
	garray(x,y) = 128
	barray(x,y) = 0
      ELSE IF (z.LT.4000.) THEN
	rarray(x,y) = 100
	garray(x,y) = 100
	barray(x,y) = 100
      ELSE
	rarray(x,y) = 255
	garray(x,y) = 255
	barray(x,y) = 255
      ENDIF
    end do
  end do
!
! Close height datafile
!
  CLOSE(13)
!
! Make a bitmap image file
!
  rv = bmp_write ( 'test.bmp'//char(0), %VAL(nx), %VAL(ny), rarray, garray, barray)
!
! Tidy up leftovers
!
  deallocate(rarray)
  deallocate(garray)
  deallocate(barray)
!
end program test_bmp

Then I constructed a module that provides new datatypes: GridType, for storing gridded data plus specifications, and BMPSpecsType, for storing specs of a bitmap image (Palette number and filename). In the same module, I placed a routine to handle the full bitmap making. Palette-issues are deferred to a next version.

MODULE LibBMP
IMPLICIT NONE
PRIVATE
PUBLIC :: Float,GridSpecsType,GridType,BMPSpecsType,Grid2BMP

   INTEGER, PARAMETER :: Float = 4
!
! For passing specs of a picture to this MODULE, the following types are used
!
   TYPE GridSpecsType
     INTEGER :: NGridX, NGridY  
     REAL(Float) :: XMin,XMax,YMin,YMax
   END TYPE GridSpecsType

   TYPE GridType
     TYPE(GridSpecsType) :: GridSpecs
     REAL(Float), ALLOCATABLE, DIMENSION(:,:) :: Values
   END TYPE GridType

   TYPE BMPSpecsType ! not yet used...
     INTEGER :: Palette
     REAL(Float) :: ZMin,ZMax
   END TYPE BMPSpecsType
!
! Interfacing with C-routine from file "bmp_io.c"
!
   INTERFACE
     INTEGER FUNCTION Bmp_Write(File,Nx,Ny,RArr,GArr,BArr)
       CHARACTER(*), INTENT(IN) :: File
       INTEGER, INTENT(IN) :: NX, NY
       INTEGER, DIMENSION(:,:), INTENT(IN) :: RArr, GArr, BArr
     END FUNCTION Bmp_Write
   END INTERFACE
!
! Below this line you'll get the real implementations
!
CONTAINS

   SUBROUTINE Grid2BMP(Grid,BMPSpecs,OutName)
!
! Write a grid to .bmp-file
!
   TYPE(GridType), INTENT(IN) :: Grid
   TYPE(BMPSpecsType), INTENT(IN) :: BMPSpecs
   CHARACTER, INTENT(IN) :: OutName*120

   INTEGER :: i,j,Rv,NX,NY
   REAL(Float) :: z
   INTEGER, ALLOCATABLE, DIMENSION(:,:) :: RedC,GreenC,BlueC
!
! Make RGB arrays
!
   NX = Grid%GridSpecs%NGridX
   NY = Grid%GridSpecs%NGridY

   ALLOCATE(RedC  (NX,NY))
   ALLOCATE(GreenC(NX,NY))
   ALLOCATE(BlueC (NX,NY))
   
   DO j = 1, NY
      DO i = 1, NX
        z = Grid%Values(i,j)
	IF (z.LT.1.) THEN ! sea
	  RedC(  i,j) = 128
	  GreenC(i,j) = 128
	  BlueC( i,j) = 255
	ELSE ! land
	  RedC(  i,j) = 0
	  GreenC(i,j) = 0
	  BlueC( i,j) = 0
	ENDIF
      ENDDO
   ENDDO
!
! Make a call to C-routine bmp_write from file bmp_io.c
!
   Rv = BMP_Write(OutName//CHAR(0),%VAL(NX),%VAL(NY),RedC,GreenC,BlueC)
!
! Tidy up leftovers
!
   DEALLOCATE(RedC)
   DEALLOCATE(GreenC)
   DEALLOCATE(BlueC)
!
   END SUBROUTINE Grid2BMP

END MODULE LibBMP

This module was used in the following sample program:

PROGRAM Test
   USE LibBMP
   IMPLICIT NONE
   TYPE(GridType) :: Grid
   INTEGER :: i,j
   REAL(Float) :: Dum
   CHARACTER :: OutName*120
   TYPE(BMPSpecsType) :: BMPSpecs
!
! Initialize the grid (should be done with file-header...)
!
   Grid%GridSpecs = GridSpecsType(360,180,-179.5,179.5,-89.5,89.5)
   ALLOCATE(Grid%Values(Grid%GridSpecs%NGridX,Grid%GridSpecs%NGridY))
!
! Read the data
!
   OPEN(13,FILE='height.dat',FORM='FORMATTED')
   DO j=1,Grid%GridSpecs%NGridY
     DO i=1,Grid%GridSpecs%NGridY
       READ(13,*) Dum,Dum,Grid%Values(i,j)
     ENDDO
   ENDDO
   CLOSE(13)
!
! Dump grid to .BMP-file
!   
   OutName = 'height.bmp'
   BMPSpecs = BMPSpecsType(3,-4000.,4000.)
   CALL Grid2BMP(Grid,BMPSpecs,OutName)
!
! Clean up the leftovers
!
   DEALLOCATE(Grid%Values)
END PROGRAM Test

Together, these two files are not really much more than the example at the start of this message. The outputfile of the last program was still a valid .bmp-file, but only the left half of the image was filled with continent/sea mask, and only data from the southern hemisphere was shown over the full height. Moreover, the contours of Australia and South America overlapped. (as you can see, the program does not incorporate continent-drift… ;-) )

–> Question: what’s wrong with the transition to MODULE LibBMP?

Regards,


Arjan
E-mail: Arjan.van.Dijk@RIVM.nl

Me and my big mouth: the second program reads the data in a loop where BOTH x and y run from 1 to NY. One of them should be to NX…

Sorry!

Arjan