2023-04-13

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


No comments:

Post a Comment