Dear Ladies and Gentlemen,
gfortran --version gives:
GNU Fortran (Ubuntu 13.3.0-6ubuntu2~24.04.1) 13.3.0
Copyright (C) 2023 Free Software Foundation, Inc.
This is free software; see the source for copying conditions. There is NO
warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
The Error Messages when trying to compile via
gfortran -c MFloodFill.f90:
wb@wb049-Ubuntu:~$ gfortran -c MFloodFill.f90 > Bla
MFloodFill.f90:178:58:
142 | CALL xyzFill( ix= jxp1, iy= jy , iz= jz )
| 2
......
178 | DO jy= LBOUND(Pixel, DIM= 2), UBOUND(Pixel, DIM= 2)
| 1
Error: Index variable ‘jy’ redefined at (1) in procedure ‘xyzfill’
called from within DO loop at (2)
MFloodFill.f90:179:61:
142 | CALL xyzFill( ix= jxp1, iy= jy , iz= jz )
| 2
......
179 | DO jx= LBOUND(Pixel, DIM= 1), UBOUND(Pixel, DIM= 1)
| 1
Error: Index variable ‘jx’ redefined at (1) in procedure ‘xyzfill’
called from within DO loop at (2)
MFloodFill.f90:178:58:
143 | CALL xyzFill( ix= jxm1, iy= jy , iz= jz )
| 2
......
178 | DO jy= LBOUND(Pixel, DIM= 2), UBOUND(Pixel, DIM= 2)
| 1
Error: Index variable ‘jy’ redefined at (1) in procedure ‘xyzfill’
called from within DO loop at (2)
MFloodFill.f90:179:61:
143 | CALL xyzFill( ix= jxm1, iy= jy , iz= jz )
| 2
......
179 | DO jx= LBOUND(Pixel, DIM= 1), UBOUND(Pixel, DIM= 1)
| 1
Error: Index variable ‘jx’ redefined at (1) in procedure ‘xyzfill’
called from within DO loop at (2)
MFloodFill.f90:178:58:
144 | CALL xyzFill( ix= jx , iy= jyp1, iz= jz )
| 2
......
178 | DO jy= LBOUND(Pixel, DIM= 2), UBOUND(Pixel, DIM= 2)
| 1
Error: Index variable ‘jy’ redefined at (1) in procedure ‘xyzfill’
called from within DO loop at (2)
MFloodFill.f90:179:61:
144 | CALL xyzFill( ix= jx , iy= jyp1, iz= jz )
| 2
..........................
And more... similar.
The MFloodFill.f90 is attached.
Sincerely,
Warner Bruns
!2345678901234567890123456789012345678901234567890123456789012345678901234567890
MODULE MFloodFill
IMPLICIT NONE
INTEGER, PARAMETER :: iik1 = SELECTED_INT_KIND(2)
INTEGER, PARAMETER :: ii4 = SELECTED_INT_KIND(9)
INTEGER, PARAMETER :: ii8 = SELECTED_INT_KIND(16)
INTEGER, PARAMETER :: iiknd = ii4
INTEGER, PARAMETER :: iLen8 = MAX(ii8, KIND(0)) ! ubound(, KIND= iLen8)
PUBLIC
CONTAINS
! ****
RECURSIVE SUBROUTINE FloodFill( Pixel, ix, iy, iColour, iOld, ir, iCount )
INTEGER(KIND= iiknd), POINTER, DIMENSION(:,:) :: Pixel
INTEGER(KIND= iiknd), INTENT(IN) :: ix, iy, iColour, iOld, ir
INTEGER(KIND= iiknd), INTENT(INOUT) :: iCount
INTEGER(KIND= iiknd) :: jx
LOGICAL(KIND= iik1), ALLOCATABLE, DIMENSION(:) :: Filled
if (0 == 1) then
if (ir == 0) then
write (*,*) ' Flood: ix,iy, ir:', ix, iy, ir
write (*,*) ' lBounds:', lbound(Pixel)
write (*,*) ' uBounds:', ubound(Pixel)
end if
end if
IF (ix < LBOUND(Pixel, DIM= 1)) RETURN
IF (ix > UBOUND(Pixel, DIM= 1)) RETURN
IF (iy < LBOUND(Pixel, DIM= 2)) RETURN
IF (iy > UBOUND(Pixel, DIM= 2)) RETURN
IF (Pixel(ix,iy) /= iOld) RETURN
ALLOCATE(Filled(LBOUND(Pixel, DIM= 1):UBOUND(Pixel, DIM= 1)))
Filled= .FALSE._iik1
! Horizontal nach rechts faerben.
DO jx= ix, UBOUND(Filled, DIM= 1)
IF (Pixel(jx,iy) == iOld) THEN
Filled(jx)= .TRUE._iik1
Pixel(jx,iy)= iColour
iCount= iCount + 1
ELSE
EXIT
END IF
END DO
! Horizontal nach links faerben.
DO jx= ix-1, LBOUND(Filled, DIM= 1), -1
IF (Pixel(jx,iy) == iOld) THEN
Filled(jx)= .TRUE._iik1
Pixel(jx,iy)= iColour
iCount= iCount + 1
ELSE
EXIT
END IF
END DO
!
! Ausgehend von allen frisch horizontal gefaerbten Pixeln
! vertikal nach oben und unten faerben.
!
DO jx= LBOUND(Filled, DIM= 1), UBOUND(Filled, DIM= 1)
IF (Filled(jx)) THEN
CALL FloodFill( Pixel, jx, iy+1_iiknd, iColour, iOld, &
ir+1_iiknd, iCount )
CALL FloodFill( Pixel, jx, iy-1_iiknd, iColour, iOld, &
ir+1_iiknd, iCount )
END IF
END DO
DEALLOCATE(Filled)
END SUBROUTINE FloodFill
! *******
SUBROUTINE FloodFill3D( Pixel, ix, iy, iz, iColour, iOld, &
iLevel, MaxLevel, iCount )
INTEGER(KIND= iik1), POINTER, DIMENSION(:,:,:) :: Pixel
INTEGER(KIND= iiknd), INTENT(IN) :: ix, iy, iz, iColour, iOld
INTEGER(KIND= iiknd), INTENT(INOUT) :: iLevel, MaxLevel
INTEGER(KIND= iLen8), INTENT(INOUT) :: iCount
CHARACTER(LEN= *), PARAMETER :: MyName= 'FloodFill3D'
INTEGER(KIND= iiknd) :: jx, jy, jz, jxp1, jxm1, jyp1, jym1, jzp1, jzm1
LOGICAL(KIND= iik1), ALLOCATABLE, DIMENSION(:,:,:) :: Filled, WasFilled
LOGICAL(KIND= iik1), ALLOCATABLE, DIMENSION(:) :: SomePixelFilledAt, &
WasSomePixelFilledAt
LOGICAL(KIND= iik1) :: SomePixelFilled, SomePixelFilledAtXY
INTEGER(KIND= iLen8) :: iCountBefore
IF (ix < LBOUND(Pixel, DIM= 1)) RETURN ! Not needed.
IF (ix > UBOUND(Pixel, DIM= 1)) RETURN ! Not needed.
IF (iy < LBOUND(Pixel, DIM= 2)) RETURN ! Not needed.
IF (iy > UBOUND(Pixel, DIM= 2)) RETURN ! Not needed.
IF (iz < LBOUND(Pixel, DIM= 3)) RETURN
IF (iz > UBOUND(Pixel, DIM= 3)) RETURN
IF (Pixel(ix,iy,iz) /= iOld) RETURN
if (1 == 1) then
write (*,*) MyName, ': ix,iy,iz, iLevel:', ix, iy, iz, iLevel
write (*,*) ' lBound(Pixel):', lbound(Pixel)
!! write (*,*) ' uBounds:', ubound(Pixel)
end if
ALLOCATE(Filled(LBOUND(Pixel, DIM= 1):UBOUND(Pixel, DIM= 1), &
LBOUND(Pixel, DIM= 2):UBOUND(Pixel, DIM= 2), &
LBOUND(Pixel, DIM= 3):UBOUND(Pixel, DIM= 3)), &
wasFilled(LBOUND(Pixel, DIM= 1):UBOUND(Pixel, DIM= 1), &
LBOUND(Pixel, DIM= 2):UBOUND(Pixel, DIM= 2), &
LBOUND(Pixel, DIM= 3):UBOUND(Pixel, DIM= 3)))
Filled= .FALSE._iik1
ALLOCATE(SomePixelFilledAt(LBOUND(Pixel, DIM= 2):UBOUND(Pixel, DIM= 2)), &
WasSomePixelFilledAt(LBOUND(Pixel, DIM= 2):UBOUND(Pixel, DIM= 2)))
iCountBefore= iCount
CALL xyzFill( ix= ix, iy= iy, iz= iz )
DO WHILE (iCountBefore /= iCount)
iCountBefore= iCount
iLevel= iLevel + 1
write (*,*) MyName, ': iLevel, iCount:', iLevel, iCount
WasFilled= Filled
Filled= .FALSE._iik1
!
! Suchen eines Pixels, dass gefuellt wurde.
!
DO jz= LBOUND(Pixel, DIM= 3), UBOUND(Pixel, DIM= 3)
jzp1= jz + 1
jzm1= jz - 1
DO jy= LBOUND(Pixel, DIM= 2), UBOUND(Pixel, DIM= 2)
jyp1= jy + 1
jym1= jy - 1
DO jx= LBOUND(Pixel, DIM= 1), UBOUND(Pixel, DIM= 1)
jxp1= jx + 1
jxm1= jx - 1
IF (WasFilled(jx,jy,jz)) THEN
CALL xyzFill( ix= jxp1, iy= jy , iz= jz )
CALL xyzFill( ix= jxm1, iy= jy , iz= jz )
CALL xyzFill( ix= jx , iy= jyp1, iz= jz )
CALL xyzFill( ix= jx , iy= jym1, iz= jz )
CALL xyzFill( ix= jx , iy= jy , iz= jzp1 )
CALL xyzFill( ix= jx , iy= jy , iz= jzm1 )
END IF
END DO
END DO
END DO
END DO
DEALLOCATE( SomePixelFilledAt, WasSomePixelFilledAt )
DEALLOCATE(Filled, WasFilled)
MaxLevel= MAX(MaxLevel, iLevel)
CONTAINS
SUBROUTINE xyzFill( ix, iy, iz )
INTEGER(KIND= iiknd), INTENT(IN) :: ix, iy, iz
INTEGER(KIND= iiknd) :: izp1, izm1
IF (ix < LBOUND(Pixel, DIM= 1)) RETURN
IF (ix > UBOUND(Pixel, DIM= 1)) RETURN
IF (iy < LBOUND(Pixel, DIM= 2)) RETURN
IF (iy > UBOUND(Pixel, DIM= 2)) RETURN
IF (iz < LBOUND(Pixel, DIM= 3)) RETURN
IF (iz > UBOUND(Pixel, DIM= 3)) RETURN
IF (Pixel(ix,iy,iz) /= iOld) RETURN
CALL xyFill( ix= ix, iy= iy, iz= iz, &
SomePixelFilledAtXY= SomePixelFilledAtXY )
izp1= iz + 1
izm1= iz - 1
DO jy= LBOUND(Pixel, DIM= 2), UBOUND(Pixel, DIM= 2)
DO jx= LBOUND(Pixel, DIM= 1), UBOUND(Pixel, DIM= 1)
IF (Filled(jx,jy,iz)) THEN
CALL zFill( ix= jx, iy= jy, iz= izp1 )
CALL zFill( ix= jx, iy= jy, iz= izm1 )
END IF
END DO
END DO
END SUBROUTINE xyzFill
!---
SUBROUTINE xyFill( ix, iy, iz, SomePixelFilledAtXY )
INTEGER(KIND= iiknd), INTENT(IN) :: ix, iy, iz
LOGICAL(KIND= iik1), INTENT(OUT) :: SomePixelFilledAtXY
INTEGER(KIND= iiknd) :: jy, iyp1, iym1
CALL xFill( ix= ix, iy= iy, iz= iz, &
SomePixelFilled= SomePixelFilledAtXY )
DO jy= iy, UBOUND(Filled, DIM= 2) - 1
iyp1= jy + 1
!
! Ausgehend von allen frisch horizontal gefaerbten Pixeln
! vertikal nach oben faerben.
!
DO jx= LBOUND(Filled, DIM= 1), UBOUND(Filled, DIM= 1)
IF (Filled(jx,jy,iz)) THEN
CALL xFill( ix= jx, iy= iyp1, iz= iz, &
SomePixelFilled= SomePixelFilledAt(iyp1) )
END IF
END DO
END DO
DO jy= iy, LBOUND(Filled, DIM= 2) + 1, -1
iym1= jy - 1
!
! Ausgehend von allen frisch horizontal gefaerbten Pixeln
! vertikal nach unten faerben.
!
DO jx= LBOUND(Filled, DIM= 1), UBOUND(Filled, DIM= 1)
IF (Filled(jx,jy,iz)) THEN
CALL xFill( ix= jx, iy= iym1, iz= iz, &
SomePixelFilled= SomePixelFilledAt(iym1) )
END IF
END DO
END DO
DO WHILE (ANY(SomePixelFilledAt))
SomePixelFilledAtXY= .TRUE._iik1
WasSomePixelFilledAt= SomePixelFilledAt
SomePixelFilledAt= .FALSE._iik1
DO jy= LBOUND(Filled, DIM= 2), UBOUND(Filled, DIM= 2) - 1
IF (WasSomePixelFilledAt(jy)) THEN
iyp1= jy + 1
DO jx= LBOUND(Filled, DIM= 1), UBOUND(Filled, DIM= 1)
IF (Filled(jx,jy,iz)) THEN
CALL xFill( ix= jx, iy= iyp1, iz= iz, &
SomePixelFilled= SomePixelFilledAt(iyp1) )
END IF
END DO
END IF
END DO
DO jy= LBOUND(Filled, DIM= 2) + 1, UBOUND(Filled, DIM= 2)
IF (WasSomePixelFilledAt(jy)) THEN
iym1= jy - 1
DO jx= LBOUND(Filled, DIM= 1), UBOUND(Filled, DIM= 1)
IF (Filled(jx,jy,iz)) THEN
CALL xFill( ix= jx, iy= iym1, iz= iz, &
SomePixelFilled= SomePixelFilledAt(iym1) )
END IF
END DO
END IF
END DO
END DO
END SUBROUTINE xyFill
!---
SUBROUTINE xFill( ix, iy, iz, SomePixelFilled )
INTEGER(KIND= iiknd), INTENT(IN) :: ix, iy, iz
LOGICAL(KIND= iik1), INTENT(OUT) :: SomePixelFilled
INTEGER(KIND= iiknd) :: jx
INTEGER(KIND= iLen8) :: iCountBefore
iCountBefore= iCount
! Horizontal nach rechts faerben.
DO jx= ix, UBOUND(Filled, DIM= 1)
IF (Pixel(jx,iy,iz) == iOld) THEN
Filled(jx,iy,iz)= .TRUE._iik1
Pixel(jx,iy,iz)= iColour
iCount= iCount + 1
ELSE
EXIT
END IF
END DO
! Horizontal nach links faerben.
DO jx= ix - 1, LBOUND(Filled, DIM= 1), -1
IF (Pixel(jx,iy,iz) == iOld) THEN
Filled(jx,iy,iz)= .TRUE._iik1
Pixel(jx,iy,iz)= iColour
iCount= iCount + 1
ELSE
EXIT
END IF
END DO
SomePixelFilled= iCount /= iCountBefore
END SUBROUTINE xFill
!---
SUBROUTINE zFill( ix, iy, iz )
INTEGER(KIND= iiknd), INTENT(IN) :: ix, iy, iz
INTEGER(KIND= iiknd) :: jz
DO jz= iz, UBOUND(Filled, DIM= 3)
IF (Pixel(ix,iy,jz) == iOld) THEN
Filled(ix,iy,jz)= .TRUE._iik1
Pixel(ix,iy,jz)= iColour
iCount= iCount + 1
ELSE
EXIT
END IF
END DO
DO jz= iz - 1, LBOUND(Filled, DIM= 3), -1
IF (Pixel(ix,iy,jz) == iOld) THEN
Filled(ix,iy,jz)= .TRUE._iik1
Pixel(ix,iy,jz)= iColour
iCount= iCount + 1
ELSE
EXIT
END IF
END DO
END SUBROUTINE zFill
END SUBROUTINE FloodFill3D
! *******
RECURSIVE SUBROUTINE wFloodFill3D( Pixel, ix, iy, iz, iColour, iOld, &
iLevel, MaxLevel, iCount )
INTEGER(KIND= iik1), POINTER, DIMENSION(:,:,:) :: Pixel
INTEGER(KIND= iiknd), INTENT(IN) :: ix, iy, iz, iColour, iOld
INTEGER(KIND= iiknd), INTENT(INOUT) :: iLevel, MaxLevel
INTEGER(KIND= iLen8), INTENT(INOUT) :: iCount
INTEGER(KIND= iiknd) :: jx, jy, iyp1, iym1, izp1, izm1, iLevelP
LOGICAL(KIND= iik1), ALLOCATABLE, DIMENSION(:,:) :: Filled
LOGICAL(KIND= iik1), ALLOCATABLE, DIMENSION(:) :: SomePixelFilledAt, &
WasSomePixelFilledAt
LOGICAL(KIND= iik1) :: SomePixelFilled
IF (ix < LBOUND(Pixel, DIM= 1)) RETURN ! Not needed.
IF (ix > UBOUND(Pixel, DIM= 1)) RETURN ! Not needed.
IF (iy < LBOUND(Pixel, DIM= 2)) RETURN ! Not needed.
IF (iy > UBOUND(Pixel, DIM= 2)) RETURN ! Not needed.
IF (iz < LBOUND(Pixel, DIM= 3)) RETURN
IF (iz > UBOUND(Pixel, DIM= 3)) RETURN
IF (Pixel(ix,iy,iz) /= iOld) RETURN
if (1 == 1) then
write (*,*) ' Flood: ix,iy,iz, iLevel:', ix, iy, iz, iLevel
!! write (*,*) ' lBounds:', lbound(Pixel)
!! write (*,*) ' uBounds:', ubound(Pixel)
end if
ALLOCATE(Filled(LBOUND(Pixel, DIM= 1):UBOUND(Pixel, DIM= 1), &
LBOUND(Pixel, DIM= 2):UBOUND(Pixel, DIM= 2)))
Filled= .FALSE._iik1
ALLOCATE(SomePixelFilledAt(LBOUND(Pixel, DIM= 2):UBOUND(Pixel, DIM= 2)), &
WasSomePixelFilledAt(LBOUND(Pixel, DIM= 2):UBOUND(Pixel, DIM= 2)))
SomePixelFilledAt= .FALSE._iik1
CALL LeftRightFill( ix= ix, iy= iy, SomePixelFilled= SomePixelFilled )
DO jy= iy, UBOUND(Filled, DIM= 2) - 1
iyp1= jy + 1
!
! Ausgehend von allen frisch horizontal gefaerbten Pixeln
! vertikal nach oben faerben.
!
DO jx= LBOUND(Filled, DIM= 1), UBOUND(Filled, DIM= 1)
IF (Filled(jx,jy)) THEN
CALL LeftRightFill( ix= jx, iy= iyp1, &
SomePixelFilled= SomePixelFilledAt(iyp1) )
END IF
END DO
END DO
DO jy= iy, LBOUND(Filled, DIM= 2) + 1, -1
iym1= jy - 1
!
! Ausgehend von allen frisch horizontal gefaerbten Pixeln
! vertikal nach unten faerben.
!
DO jx= LBOUND(Filled, DIM= 1), UBOUND(Filled, DIM= 1)
IF (Filled(jx,jy)) THEN
CALL LeftRightFill( ix= jx, iy= iym1, &
SomePixelFilled= SomePixelFilledAt(iym1) )
END IF
END DO
END DO
DO WHILE (ANY(SomePixelFilledAt))
WasSomePixelFilledAt= SomePixelFilledAt
SomePixelFilledAt= .FALSE._iik1
DO jy= LBOUND(Filled, DIM= 2), UBOUND(Filled, DIM= 2) - 1
IF (WasSomePixelFilledAt(jy)) THEN
iyp1= jy + 1
DO jx= LBOUND(Filled, DIM= 1), UBOUND(Filled, DIM= 1)
IF (Filled(jx,jy)) THEN
CALL LeftRightFill( ix= jx, iy= iyp1, &
SomePixelFilled= SomePixelFilledAt(iyp1) )
END IF
END DO
END IF
END DO
DO jy= LBOUND(Filled, DIM= 2) + 1, UBOUND(Filled, DIM= 2)
IF (WasSomePixelFilledAt(jy)) THEN
iym1= jy - 1
DO jx= LBOUND(Filled, DIM= 1), UBOUND(Filled, DIM= 1)
IF (Filled(jx,jy)) THEN
CALL LeftRightFill( ix= jx, iy= iym1, &
SomePixelFilled= SomePixelFilledAt(iym1) )
END IF
END DO
END IF
END DO
END DO
DEALLOCATE( SomePixelFilledAt, WasSomePixelFilledAt )
iLevelP= iLevel + 1
izp1= iz + 1
izm1= iz - 1
DO jy= LBOUND(Filled, DIM= 2), UBOUND(Filled, DIM= 2)
DO jx= LBOUND(Filled, DIM= 1), UBOUND(Filled, DIM= 1)
IF (Filled(jx,jy)) THEN
CALL wFloodFill3D( Pixel, jx, jy, izm1, &
iColour, iOld, iLevelP, MaxLevel, iCount )
CALL wFloodFill3D( Pixel, jx, jy, izp1, &
iColour, iOld, iLevelP, MaxLevel, iCount )
END IF
END DO
END DO
DEALLOCATE(Filled)
MaxLevel= MAX(MaxLevel, iLevel)
CONTAINS
SUBROUTINE LeftRightFill( ix, iy, SomePixelFilled )
INTEGER(KIND= iiknd), INTENT(IN) :: ix, iy
LOGICAL(KIND= iik1), INTENT(OUT) :: SomePixelFilled
INTEGER(KIND= iiknd) :: jx
INTEGER(KIND= iLen8) :: iCountBefore
iCountBefore= iCount
! Horizontal nach rechts faerben.
DO jx= ix, UBOUND(Filled, DIM= 1)
IF (Pixel(jx,iy,iz) == iOld) THEN
Filled(jx,iy)= .TRUE._iik1
Pixel(jx,iy,iz)= iColour
iCount= iCount + 1
ELSE
EXIT
END IF
END DO
! Horizontal nach links faerben.
DO jx= ix-1, LBOUND(Filled, DIM= 1), -1
IF (Pixel(jx,iy,iz) == iOld) THEN
Filled(jx,iy)= .TRUE._iik1
Pixel(jx,iy,iz)= iColour
iCount= iCount + 1
ELSE
EXIT
END IF
END DO
SomePixelFilled= iCount /= iCountBefore
END SUBROUTINE LeftRightFill
END SUBROUTINE wFloodFill3D
! *******
END MODULE MFloodFill
