Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations strongm on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

image processing libraries for Fortran 2003

Status
Not open for further replies.

ya0037

Programmer
Oct 7, 2010
30
DE
Hi !,

Does any one know about image processing libraries for Fortran 2003. I
want to read images, convert it into a matrix, do some manipulation and
save it back as images. Even ideas about how to do this will be appreciated.

Many thanks,
 
Depends on what you mean by image processing, 3D or just 2D?

I once read a bitmap (binary file, the specs of bitmaps can be found on the net) and did some things (filters) on the colours and then saved it as bitmap again.

I don't have that code right here, neither am I sure whether I'm allowed to share it, but the bitmap format is the one I would use for reading and writing.
 
Thanks a lot for your answer.
I mean 3D image processing and I am dealing with tiff images.
I want to read tiff images do some operations and write them back.
Please someone give me an idea.

Best regards,

 
But Tiff is a 2D format, isn't it? That's just a bunch of pixels and a colour for each pixel, I even think it's the same as bmp, the only thing that differs is the extra info about dpi.

I used this at the time:

And have been writing fractal pictures with it as well, worked fine.

(I would call stl 3D or iges or step)
 
Hi ya0037

Here is program that reads a BMP-file and writes the result into three files (111.txt, 333.txt and 444.txt).
You are welcome to use it or some parts of it.

Code:
	Program BMP

	implicit none

	character*4000 str
	character*24 skra,skraL,skraR
	integer*4 lskra,lskraL,lskraR

	integer*4 l,k,i,n,j,m,k1,k2,k3,ik1,ik2,ik3,mm
!	integer*2 r(256),g(256),b(256),s(256)
	byte r(256),g(256),b(256),s(256)
	integer*2 ir,ig,ib,is
	integer*4 leng,lengU
	real*8 T

	byte string(4000)

	byte C,D,E
	integer*2 iC
	byte X(1000,500)
	integer*4 ix,iz
	integer*4 sizeA,sizeB,sizeZ

	structure /BitmapFileheader/
	   integer*2 bfType
	   integer*4 bfSize
	   integer*2 bfReserved1
	   integer*2 bfReserved2
	   integer*4 bfOffsetBits
	end structure
	record /BitmapFileheader/ bmfH

	structure /BitmapInfoheader/
	   integer*4 biSize
	   integer*4 biWidth
	   integer*4 biHeight
	   integer*2 biPlanes
	   integer*2 biBitCount
	   integer*4 biCompression
	   integer*4 biSizeImage
	   integer*4 biXPixelPerMeter
	   integer*4 biYPixelPerMeter
	   integer*4 biClrUsed
	   integer*4 biClrImportant
	end structure
	record /BitmapInfoheader/ bmiH

	structure /RGBQuad/
	   byte rgbBlue
	   byte rgbGreen
	   byte rgbRed
	   byte rgbReserved
	end structure
c	record /RGBQuad/ bmiC(1)
	record /RGBQuad/ bmiC(256)

c	structure /BitmapInfo/
c	   record /BitmapInfoheader/ bmiH
c	   record /RGBQuad/ bmiC(1)
c	end structure
c	record /BitmapInfo/ bmpI

	write(*,'(1x,a,$)') 'BMP-file: '
	read(*,'(a)') skra
	k = index(skra,'.')
	if(k.eq.0) then
	   str = skra
	   l = len_trim(str)
	   skra = str(1:l)//'.BMP'
	   skraL = str(1:l)//'.LGO'
	   skraR = str(1:l)//'.LGR'
	else
	   skraL = skra(1:(k-1))//'.LGO'
	   skraR = skra(1:(k-1))//'.LGR'
	endif
	lskra = len_trim(skra)
	lskraL = len_trim(skraL)
	lskraR = len_trim(skraR)

	open(unit=1,file=skra(1:lskra),form='binary',status='old')

	read(1) bmfH
	read(1) bmiH

	if(bmfH.bfType.ne.'BM') then			! 'BM' = 19778
	   write(*,'(1x,a)') 'Not a BMP-file'
	   goto 99
	endif

!	skraL = '222.txt'
!	lskraL = len_trim(skraL)

	open(unit=2,file='111.txt',status='unknown')
	open(unit=3,file=skraL(1:lskraL),status='unknown')
	open(unit=4,file='333.txt',status='unknown')
	open(unit=5,file='444.txt',status='unknown')
	open(unit=6,file=skraR(1:lskraR),status='unknown')

	write(*,'(1x)')
	write(2,'(1x,a,a)') 'File: ',skra

	write(*,'(1x,a,i10)') 'Type:           ',bmfH.bfType
	write(*,'(1x,a,i10)') 'Size:           ',bmfH.bfSize
	write(*,'(1x,a,i10)') 'Reserved1:      ',bmfH.bfReserved1
	write(*,'(1x,a,i10)') 'Reserved2:      ',bmfH.bfReserved2
	write(*,'(1x,a,i10)') 'OffsetBits:     ',bmfH.bfOffsetBits
	write(*,'(1x)')

	write(*,'(1x,a,i10)') 'Size:           ',bmiH.biSize
	write(*,'(1x,a,i10)') 'Width:          ',bmiH.biWidth
	write(*,'(1x,a,i10)') 'Height:         ',bmiH.biHeight
	write(*,'(1x,a,i10)') 'Planes:         ',bmiH.biPlanes
	write(*,'(1x,a,i10)') 'BitCount:       ',bmiH.biBitCount
	write(*,'(1x,a,i10)') 'Compression:    ',bmiH.biCompression
	write(*,'(1x,a,i10)') 'SizeImage:      ',bmiH.biSizeImage
	write(*,'(1x,a,i10)') 'XPixelPerMeter: ',bmiH.biXPixelPerMeter
	write(*,'(1x,a,i10)') 'YPixelPerMeter: ',bmiH.biYPixelPerMeter
	write(*,'(1x,a,i10)') 'ClrUsed:        ',bmiH.biClrUsed
	write(*,'(1x,a,i10)') 'ClrImportant:   ',bmiH.biClrImportant
	write(*,'(1x)')

	write(2,'(1x)')

	write(2,'(1x,a,i10)') 'Type:           ',bmfH.bfType
	write(2,'(1x,a,i10)') 'Size:           ',bmfH.bfSize
	write(2,'(1x,a,i10)') 'Reserved1:      ',bmfH.bfReserved1
	write(2,'(1x,a,i10)') 'Reserved2:      ',bmfH.bfReserved2
	write(2,'(1x,a,i10)') 'OffsetBits:     ',bmfH.bfOffsetBits
	write(2,'(1x)')

	write(2,'(1x,a,i10)') 'Size:           ',bmiH.biSize
	write(2,'(1x,a,i10)') 'Width:          ',bmiH.biWidth
	write(2,'(1x,a,i10)') 'Height:         ',bmiH.biHeight
	write(2,'(1x,a,i10)') 'Planes:         ',bmiH.biPlanes
	write(2,'(1x,a,i10)') 'BitCount:       ',bmiH.biBitCount
	write(2,'(1x,a,i10)') 'Compression:    ',bmiH.biCompression
	write(2,'(1x,a,i10)') 'SizeImage:      ',bmiH.biSizeImage
	write(2,'(1x,a,i10)') 'XPixelPerMeter: ',bmiH.biXPixelPerMeter
	write(2,'(1x,a,i10)') 'YPixelPerMeter: ',bmiH.biYPixelPerMeter
	write(2,'(1x,a,i10)') 'ClrUsed:        ',bmiH.biClrUsed
	write(2,'(1x,a,i10)') 'ClrImportant:   ',bmiH.biClrImportant
	write(2,'(1x)')

	if(bmiH.biBitCount.eq.24) goto 50	! 24

	n = 2**bmiH.biBitCount			! 1, 4 ,8, 24

	write(*,'(1x,a,i10)') 'n:              ',n
	write(*,'(1x)')

	write(2,'(1x,a,i10)') 'n:              ',n
	write(2,'(1x)')

!!	pause

	do i=1,n
	   read(1) bmiC(i)
	   b(i) = bmiC(i).rgbBlue
	   g(i) = bmiC(i).rgbGreen
	   r(i) = bmiC(i).rgbRed
	   s(i) = bmiC(i).rgbReserved
	   ib = #ff .and. b(i)
	   ig = #ff .and. g(i)
	   ir = #ff .and. r(i)
	   is = #ff .and. s(i)
	   write(*,201) 'RGB:  ',ir,ig,ib,is,r(i),g(i),b(i),s(i)
	   write(2,201) 'RGB:  ',ir,ig,ib,is,r(i),g(i),b(i),s(i)
201	   format(1x,a,4i5,3x,4(2x,z))
	enddo

	write(2,'(1x)')

50	continue


	if(bmiH.biBitCount.eq.1) then
!!	   ix = bmiH.biWidth /32
!!	   T = real(bmiH.biWidth)/32.
!!	   if(ix.lt.T) ix=ix+1
!!	   ix = 4*ix
	   ix = bmiH.biSizeImage / bmiH.biHeight
	   do j=1,bmiH.biHeight
	      do i=1,ix
	         read(1) C
	         X(i,j) = C
	         iC = C .and. #ff
	      enddo
	   enddo
!	   iz = (16*(bmiH.biWidth/16))/8
	   iz = 4*(bmiH.biWidth/4)/8
	   sizeA = bmiH.biWidth * bmiH.biHeight
	   sizeB = bmiH.biSizeImage
	   sizeZ = (2*iz+2)*bmiH.biHeight + 3
!	   write(3,'(3(i9,a))') bmiH.biBitCount
!	   write(3,'(3(i9,a))') bmiH.biWidth,',',bmiH.biHeight,',',sizeA
!	   write(3,'(3(i9,a))') 8*ix,',',bmiH.biHeight,',',sizeB
!	   write(3,'(3(i9,a))') 8*iz,',',bmiH.biHeight,',',sizeZ
	   write(3,'(a,i6)') '   << /Type /XObject'
	   write(3,'(a,i6)') '      /Subtype /Image'
	   write(3,'(a,i6)') '      /Width ', 8*iz
	   write(3,'(a,i6)') '      /Height', bmiH.biHeight
	   write(3,'(a,i6)') '      /ColorSpace /DeviceGray'
	   write(3,'(a,i3)') '      /BitsPerComponent', bmiH.biBitCount
	   write(3,'(a,i8)') '      /Length', sizeZ
	   write(3,'(a,i6)') '      /Filter /ASCIIHexDecode'
	   write(3,'(a,i6)') '   >>'
	   write(3,'(a,i6)') 'stream'
	   lengU = 0
	   do j = bmiH.biHeight,1,-1
	      write(3,'(4000Z)') (X(m,j),m=1,iz)
	      mm = 0
	      do m=1,iz
	         mm = mm+1
	         string(mm) = X(m,j)
	      enddo
	      leng = 0
	      call RunLengthEncode(0,iz,leng,lengU,string)
	   enddo
	   write(3,'(a)') '>'
	   write(3,'(a)') 'endstream'
	   leng = 0
	   call RunLengthEncode(1,iz,leng,lengU,string)
	   lengU = lengU + 3
	   close(5)
	   write(6,'(a,i6)') '   << /Type /XObject'
	   write(6,'(a,i6)') '      /Subtype /Image'
	   write(6,'(a,i6)') '      /Width ', 8*iz
	   write(6,'(a,i6)') '      /Height', bmiH.biHeight
	   write(6,'(a,i6)') '      /ColorSpace /DeviceGray'
	   write(6,'(a,i3)') '      /BitsPerComponent', bmiH.biBitCount
	   write(6,'(a,i8)') '      /Length', lengU
	   write(6,'(6x,a)') '/Filter [/ASCIIHexDecode /RunLengthDecode]'
	   write(6,'(a,i6)') '   >>'
	   write(6,'(a,i6)') 'stream'
	   open(unit=5,file='444.txt',status='unknown')
	      do while(.true.)
	         read (5,'(a)',end=22) str
	         write(6,'(a)') str(1:len_trim(str))
	      enddo
22	   continue
	   close(5)
	   write(6,'(a)') '>'
	   write(6,'(a)') 'endstream'
	   close(6)
	endif


	if(bmiH.biBitCount.eq.4) then
	   ix = bmiH.biSizeImage / bmiH.biHeight
	   do j=1,bmiH.biHeight
	      do i=1,ix
	         read(1) C
	         k1 = 2*(i-1)+1
	         k2 = k1+1
	         X(k1,j) = #0f .and. ishft(C,-4)
	         X(k2,j) = #0f .and. C
	         ik1 = X(k1,j)
	         ik2 = X(k2,j)
	         write(2,'(2i6,2i4,2x,3(2x,Z),2i3,4x,4(z,2x),2x,4(z,2x))') 
     *                  j,i,k1,k2,C,X(k1,j),X(k2,j),ik1,ik2,
     *                  r(ik1+1),g(ik1+1),b(ik1+1),s(ik1+1),
     *                  r(ik2+1),g(ik2+1),b(ik2+1),s(ik2+1)

	      enddo
	   enddo
	   iz = bmiH.biWidth
	   sizeA = bmiH.biWidth * bmiH.biHeight
	   sizeB = bmiH.biSizeImage
	   sizeZ = (6*iz+2)*bmiH.biHeight + 3
!	   write(3,'(3(i9,a))') bmiH.biBitCount
!	   write(3,'(3(i9,a))') bmiH.biWidth,',',bmiH.biHeight,',',sizeA
!	   write(3,'(3(i9,a))') 2*ix,',',bmiH.biHeight,',',sizeB
!	   write(3,'(3(i9,a))') iz,',',bmiH.biHeight,',',sizeZ
	   write(3,'(a,i6)') '   << /Type /XObject'
	   write(3,'(a,i6)') '      /Subtype /Image'
	   write(3,'(a,i6)') '      /Width ', iz
	   write(3,'(a,i6)') '      /Height', bmiH.biHeight
	   write(3,'(a,i6)') '      /ColorSpace /DeviceRGB'
	   write(3,'(a,i3)') '      /BitsPerComponent', 8
	   write(3,'(a,i8)') '      /Length', sizeZ
	   write(3,'(a,i6)') '      /Filter /ASCIIHexDecode'
	   write(3,'(a,i6)') '   >>'
	   write(3,'(a,i6)') 'stream'
	   lengU = 0
	   do j = bmiH.biHeight,1,-1
	      write(3,'(4000Z)') (r(x(m,j)+1),g(x(m,j)+1),b(x(m,j)+1)
     *                           ,m=1,iz)
	      mm = 0
	      do m=1,iz
	         mm = mm+1
	         string(mm) = r(x(m,j)+1)
	         mm = mm+1
	         string(mm) = g(x(m,j)+1)
	         mm = mm+1
	         string(mm) = b(x(m,j)+1)
	      enddo
!!	      write(3,'(4000Z)') (string(m),m=1,3*iz)
	      leng = 0
	      call RunLengthEncode(0,3*iz,leng,lengU,string)
	   enddo
	   write(3,'(a)') '>'
	   write(3,'(a)') 'endstream'
	   leng = 0
	   call RunLengthEncode(1,3*iz,leng,lengU,string)
	   lengU = lengU + 3
	   close(5)
	   write(6,'(a,i6)') '   << /Type /XObject'
	   write(6,'(a,i6)') '      /Subtype /Image'
	   write(6,'(a,i6)') '      /Width ', iz
	   write(6,'(a,i6)') '      /Height', bmiH.biHeight
	   write(6,'(a,i6)') '      /ColorSpace /DeviceRGB'
	   write(6,'(a,i3)') '      /BitsPerComponent', 8
	   write(6,'(a,i8)') '      /Length', lengU
	   write(6,'(6x,a)') '/Filter [/ASCIIHexDecode /RunLengthDecode]'
	   write(6,'(a,i6)') '   >>'
	   write(6,'(a,i6)') 'stream'
	   open(unit=5,file='444.txt',status='unknown')
	      do while(.true.)
	         read (5,'(a)',end=33) str
	         write(6,'(a)') str(1:len_trim(str))
	      enddo
33	   continue
	   close(5)
	   write(6,'(a)') '>'
	   write(6,'(a)') 'endstream'
	   close(6)
	endif


	if(bmiH.biBitCount.eq.24) then
	   iz = bmiH.biWidth
	   ix = (8*bmiH.biWidth)/32
	   T = real(8*bmiH.biWidth)/32.
	   if(ix.lt.T) ix=ix+1
!	   ix = 4*ix - iz - 2
	   ix = 4*ix - iz
	   do j=1,bmiH.biHeight
	      do i=1,iz
	         read(1) C,D,E
	         k1 = 3*(i-1)+1
	         k2 = k1+1
	         k3 = k1+2
	         X(k1,j) = E
	         X(k2,j) = D
	         X(k3,j) = C
	         ik1 = #ff .and. X(k1,j)
	         ik2 = #ff .and. X(k2,j)
	         ik3 = #ff .and. X(k3,j)
	         write(2,'(2i6,2x,3i4,4x,3(z,2x),3i4)') 
     *                 j,i,k1,k2,k3,X(k1,j),X(k2,j),X(k3,j),ik1,ik2,ik3
 	      enddo
	      if(ix.gt.0) then
	         do i=1,ix
	            read(1) C
	            ik1 = #ff .and. C
	         write(2,'(2i6,2x,12x,4x,z,10x,i4)') j,(i+iz),C,ik1
	         enddo
	      endif
	   enddo

	   iz = bmiH.biWidth
	   sizeA = bmiH.biWidth * bmiH.biHeight
	   sizeB = bmiH.biSizeImage
	   sizeZ = (6*iz+2)*bmiH.biHeight + 3
!	   write(3,'(3(i9,a))') bmiH.biBitCount
!	   write(3,'(3(i9,a))') bmiH.biWidth,',',bmiH.biHeight,',',sizeA
!	   write(3,'(3(i9,a))') 2*ix,',',bmiH.biHeight,',',sizeB
!	   write(3,'(3(i9,a))') iz,',',bmiH.biHeight,',',sizeZ
	   write(3,'(a,i6)') '   << /Type /XObject'
	   write(3,'(a,i6)') '      /Subtype /Image'
	   write(3,'(a,i6)') '      /Width ', iz
	   write(3,'(a,i6)') '      /Height', bmiH.biHeight
	   write(3,'(a,i6)') '      /ColorSpace /DeviceRGB'
	   write(3,'(a,i3)') '      /BitsPerComponent', 8
	   write(3,'(a,i8)') '      /Length', sizeZ
	   write(3,'(a,i6)') '      /Filter /ASCIIHexDecode'
	   write(3,'(a,i6)') '   >>'
	   write(3,'(a,i6)') 'stream'
	   lengU = 0
	   do j = bmiH.biHeight,1,-1
!	      write(3,'(4000Z)') x((3*(m-1)+1),j),x((3*(m-1)+2),j),
!     *                           x((3*(m-1)+3),j),m=1,iz)
	      mm = 0
	      do m=1,iz
	         k1 = 3*(m-1)+1
	         k2 = k1+1
	         k3 = k1+2
	         mm = mm+1
	         string(mm) = x(k1,j)
	         mm = mm+1
	         string(mm) = x(k2,j)
	         mm = mm+1
	         string(mm) = x(k3,j)
	      enddo
	      write(3,'(4000Z)') (string(m),m=1,3*iz)
	      leng = 0
	      call RunLengthEncode(0,3*iz,leng,lengU,string)
	   enddo
	   write(3,'(a)') '>'
	   write(3,'(a)') 'endstream'
	   leng = 0
	   call RunLengthEncode(1,3*iz,leng,lengU,string)
	   lengU = lengU + 3
	   close(5)
	   write(6,'(a,i6)') '   << /Type /XObject'
	   write(6,'(a,i6)') '      /Subtype /Image'
	   write(6,'(a,i6)') '      /Width ', iz
	   write(6,'(a,i6)') '      /Height', bmiH.biHeight
	   write(6,'(a,i6)') '      /ColorSpace /DeviceRGB'
	   write(6,'(a,i3)') '      /BitsPerComponent', 8
	   write(6,'(a,i8)') '      /Length', lengU
	   write(6,'(6x,a)') '/Filter [/ASCIIHexDecode /RunLengthDecode]'
	   write(6,'(a,i6)') '   >>'
	   write(6,'(a,i6)') 'stream'
	   open(unit=5,file='444.txt',status='unknown')
	      do while(.true.)
	         read (5,'(a)',end=44) str
	         write(6,'(a)') str(1:len_trim(str))
	      enddo
44	   continue
	   close(5)
	   write(6,'(a)') '>'
	   write(6,'(a)') 'endstream'
	   close(6)
	endif

99	continue

	end

!	-------------------------------------------------------------

	subroutine RunLengthEncode(E,len,leng,lengU,string)

	implicit none

	byte string(4000)
	byte RLenc(4000)
	byte a,b,EOF
!	byte a1,b2,c1,a2,b2,c2
	integer*4 E,len,i,n,m,mm
	byte nf
	integer*4 leng,lengU

	if(E.eq.1) then
	   EOF = 128
	   write(4,'(10x,2x,Z)') EOF
	   write(5,'(Z)') EOF
	   leng = 2 + 2
	   lengU = lengU + leng
	   write(4,'(i10)') lengU
	   goto 99
	endif

!	write(4,'(4000Z)') (string(i),i=1,len)

	a = string(1)
	n = 1

	mm = 0

	do i=2,len
	   b = string(i)
	   if(a.eq.b) then
	      n = n+1
	   else
!	      write(4,'(i10,2x,Z)') n,a
	      if(n.gt.128) then
	         m = 128
	         do while(n.gt.m)
	            nf = 129
	            write(4,'(i10,2x,Z,2x,Z)') m,nf,a
	            n = n-m
	            mm = mm+1
	            RLenc(mm) = nf
	            mm = mm+1
	            RLenc(mm) = a
	         enddo
	      endif
	      nf = 257-n
	      if(n.eq.1) nf = 0
	      write(4,'(i10,2x,Z,2x,Z)') n,nf,a
	      mm = mm+1
	      RLenc(mm) = nf
	      mm = mm+1
	      RLenc(mm) = a
	      a = b
	      n = 1
	   endif
	enddo

	if(n.gt.128) then
	   m = 128
	   do while(n.gt.m)
	      nf = 129
	      write(4,'(i10,2x,Z,2x,Z)') m,nf,a
	      n = n-m
	      mm = mm+1
	      RLenc(mm) = nf
	      mm = mm+1
	      RLenc(mm) = a
	   enddo
	endif
	nf = 257-n
	if(n.eq.1) nf = 0
	write(4,'(i10,2x,Z,2x,Z)') n,nf,a
	mm = mm+1
	RLenc(mm) = nf
	mm = mm+1
	RLenc(mm) = a

	write(4,'(1x)')

	if(mm.gt.4000) stop
	write(5,'(4000Z)') (RLenc(i),i=1,mm)
	leng = 2*mm + 2
	lengU = lengU + leng

99	continue

	return
	end

!	-------------------------------------------------------------

 
Dear gullipe,

thanks a lot for the code, but I am wondering whether the TIFF format would be the same as bmp, I mean the procedure in both format is the same or not.
I have also found a library, libtiff, for reading and writing TIFF images, which is in c, I am wondering whether we have anything like this in FORTRAN or not!

Cheers,
 
Hi ya0037

I don't think that the TIFF format is the same as BMP, but you can convert the TIFF file to a BMP file with some image converter, and then work on the BMP file.
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top