AoC 2019 Day10 FORTRAN

PROGRAM DAY10
  INTEGER :: I,J,K,IERR,NROWS,NCOLS,NOBJS,LASER,LASERLOC(2),PART2(2),DESTROYED
  CHARACTER(LEN=1) :: CHAR
  CHARACTER(LEN=1),ALLOCATABLE :: MAP(:,:)
  CHARACTER(LEN=:),ALLOCATABLE :: LINE
  INTEGER, ALLOCATABLE :: LOCATIONS(:,:),ORDER(:)
  REAL,ALLOCATABLE :: DIRECTIONS(:)
  LOGICAL, ALLOCATABLE :: SEEN(:,:),SHOT(:)
  INTEGER :: HOURS_OF_WASTED_TIME(2)

  OPEN(1,FILE="input.txt")
  NCOLS=0
  DO
     READ(1,'(A)',ADVANCE="NO",IOSTAT=IERR)CHAR
     IF(IERR.NE.0)EXIT
     NCOLS=NCOLS+1
  END DO
  REWIND(1)
  NROWS=0
  DO
     READ(1,*,IOSTAT=IERR)
     IF(IERR.NE.0)EXIT
     NROWS=NROWS+1
  END DO
  REWIND(1)
  ALLOCATE(CHARACTER(LEN=NCOLS) :: LINE)
  ALLOCATE(MAP(NCOLS,NROWS))
  DO I=1,NROWS
     READ(1,*)LINE
     DO J=1,NCOLS
        MAP(J,I)=LINE(J:J)
     END DO
  END DO
  CLOSE(1)
  NOBJS=COUNT(MAP.EQ."#")
  ALLOCATE(LOCATIONS(2,NOBJS),SEEN(NOBJS,NOBJS))
  K=1
  DO J=1,NROWS
     DO I=1,NROWS
        IF(MAP(I,J).EQ."#")THEN
           LOCATIONS(:,K)=(/I,J/)
           K=K+1
        END IF
     END DO
  END DO

  SEEN=.FALSE.
  DO I=1,NOBJS-1
     DO J=I+1,NOBJS
        SEEN(I,J)=CANSEE(LOCATIONS(:,I),LOCATIONS(:,J))
        SEEN(J,I)=SEEN(I,J)
     END DO
  END DO
  WRITE(*,'("Part 1: ",I0)') MAXVAL((/(COUNT(SEEN(:,I)),I=1,NOBJS)/))
  LASER=MAXLOC((/(COUNT(SEEN(:,I)),I=1,NOBJS)/),DIM=1)
  LASERLOC=LOCATIONS(:,LASER)
  ALLOCATE(DIRECTIONS(NOBJS),SHOT(NOBJS),ORDER(NOBJS))

  SHOT=.FALSE.
  SHOT(LASER)=.TRUE.
  DO I=1,NOBJS
     IF(I.EQ.LASER)CYCLE
     DIRECTIONS(I)=GETDIR(LASERLOC,LOCATIONS(:,I))
  END DO
  ORDER=SORTORDER(DIRECTIONS)
  DESTROYED=0
  OUTER:DO
     DO I=1,NOBJS
        IF(SHOT(ORDER(I)))CYCLE
        IF(CANSEE(LASERLOC,LOCATIONS(:,ORDER(I))))THEN
           SHOT(ORDER(I))=.TRUE.
           DESTROYED=DESTROYED+1
           IF(DESTROYED.EQ.200)THEN
              PART2=LOCATIONS(:,ORDER(I))
              EXIT OUTER
           END IF
        END IF
     END DO
     DO I=1,NOBJS
        IF(SHOT(ORDER(I)))THEN
           MAP(LOCATIONS(1,ORDER(I)),LOCATIONS(2,ORDER(I)))="X"
        END IF
     END DO
  END DO OUTER

  HOURS_OF_WASTED_TIME = (/-1,-1/)
  WRITE(*,'("Part 2: ",I0,I2.2)')PART2+HOURS_OF_WASTED_TIME

CONTAINS
  FUNCTION GETDIR(LOC1,LOC2) RESULT(RES)
    INTEGER :: LOC1(2),LOC2(2)
    REAL :: RES
    RES= ATAN2(REAL(LOC2(1)-LOC1(1)),REAL(LOC1(2)-LOC2(2)))
    IF(RES.LT.0)RES=RES+8*ATAN(1.0)
  END FUNCTION GETDIR

  FUNCTION SORTORDER(ARRAY) RESULT(ORDER)
    REAL :: ARRAY(:),NEXT
    INTEGER :: ORDER(SIZE(ARRAY,DIM=1)),I,J
    J=1
    NEXT=MINVAL(ARRAY)-1
    DO
       IF(J>SIZE(ARRAY))EXIT
       NEXT=MINVAL(ARRAY,MASK=ARRAY.GT.NEXT)
       DO I=1,SIZE(ARRAY)
          IF(ARRAY(I).EQ.NEXT)THEN
             ORDER(J)=I
             J=J+1
          END IF
       END DO
    END DO
  END FUNCTION SORTORDER

  FUNCTION CANSEE(LOC1,LOC2) RESULT(RES)
    INTEGER :: LOC1(2),LOC2(2)
    LOGICAL :: RES
    INTEGER X,Y,XDIR,YDIR,DIV
    RES=.FALSE.
    XDIR=LOC2(1)-LOC1(1)
    YDIR=LOC2(2)-LOC1(2)
    IF(XDIR.EQ.0)THEN
       YDIR=ABS(YDIR)/YDIR
    ELSEIF(YDIR.EQ.0)THEN
       XDIR=ABS(XDIR)/XDIR
    ELSE
       DIV=LCD(ABS(XDIR),ABS(YDIR))
       XDIR=XDIR/DIV
       YDIR=YDIR/DIV
    END IF
    X=LOC1(1)+XDIR
    Y=LOC1(2)+YDIR
    DO
       IF(MAP(X,Y).EQ."#")THEN
          IF(ALL(LOC2.EQ.(/X,Y/)))RES=.TRUE.
          EXIT
       END IF
       X=X+XDIR
       Y=Y+YDIR
    END DO
  END FUNCTION CANSEE

  FUNCTION LCD(A,B) RESULT(RES)
    INTEGER :: A,B,C,D,RES
    C=A
    D=B
    DO
       IF(C.EQ.D)EXIT
       IF(C.GT.D)THEN
          C=C-D
       ELSE
          D=D-C
       END IF
    END DO
    RES=C
  END FUNCTION LCD

END PROGRAM DAY10