find and modify highest n values in a 2D array in fortran
I have a 2D real number array and I want to locate the n highest values and assign these highest values to 1 and all others to 0.
The following code does this correctly by using MAXLOC inside a loop to find a maximum value, change it to -9999, thus excluding it from the next iteration of the loop. At the end all the -9999 values are assigned to 1. The problem is that this approach is unworkably slow. It's fine for this sample dataset which has 8604 cells, of which the highest 50 are selected, but the real data have 108183756 cells, of which I need to find the highest 1672137. I'd appreciate any help.
PROGRAM mapalgebra
IMPLICIT NONE
REAL, DIMENSION(64,126) :: n
REAL, DIMENSION(64,126) :: a
REAL, DIMENSION(64,126) :: r
REAL, DIMENSION(64,126) :: ine
REAL, DIMENSION(64,126) :: s
REAL, DIMENSION(64,126) :: p
REAL, DIMENSION(64,126) :: TTP
INTEGER, DIMENSION(64,126) :: newlu
INTEGER :: row,col,max_rows,max_cols,i, j,demand, si
INTEGER, ALLOCATABLE :: AR1(:)
newlu = 0
max_rows=64
max_cols=126
OPEN(UNIT=1, FILE="urb.txt")
OPEN(UNIT=2, FILE="acc.txt")
OPEN(UNIT=4, FILE="ran.txt")
OPEN(UNIT=5, FILE="lu1.txt")
OPEN(UNIT=7, FILE="suit.txt")
OPEN(UNIT=8, FILE="pob.txt")
DO row = 1,max_rows
READ(1,*) (n(row,col),col=1,max_cols)
END DO
DO row = 1,max_rows
READ(2,*) (a(row,col),col=1,max_cols)
END DO
DO row = 1,max_rows
READ(4,*) (r(row,col),col=1,max_cols)
END DO
DO row = 1,max_rows
READ(5,*) (ine(row,col),col=1,max_cols)
END DO
DO row = 1,max_rows
READ(7,*) (s(row,col),col=1,max_cols)
END DO
DO row = 1,max_rows
READ(8,*) (p(row,col),col=1,max_cols)
END DO
demand = 50
print *, "Land use demand is : ", demand
TTP = (ine+n+r+a+s)*p !population weighted model, (inertia+nhood+randomness+accessibility+suitability)*population
si = SIZE(SHAPE(TTP)) ! Get number of dimensions
! in array
print *, "TTP has : ", si , " dimensions"
ALLOCATE (AR1(si)) ! Allocate AR1 to number
! of dimensions in array
DO i=1,demand
AR1=MAXLOC (TTP)
!print *, "MAXLOC (TTP) : ", AR1
TTP(AR1(1),AR1(2)) = -9999
newlu(AR1(1),AR1(2)) = 1
END DO
OPEN(UNIT=3, FILE="output.txt", ACTION="write", STATUS="replace")
WRITE(3,11) 'ncols 126'
WRITE(3,11) 'nrows 64'
WRITE(3,11) 'xllcorner 461229.21505206'
WRITE(3,11) 'yllcorner 4478822.89048722'
WRITE(3,11) 'cellsize 99.38142966 '
WRITE(3,11) 'NODATA_value 0 '
11 format(A,I3)
DO i=1,max_rows
WRITE(3,*) (newlu(i,j), j=1,max_cols)
END DO
CLOSE (1)
CLOSE (2)
CLOSE (3)
CLOSE (4)
CLOSE (5)
CLOSE (7)
CLOSE (8)
END PROGRAM mapalgebra
Comments
Post a Comment