AoC 2019 Day12 FORTRAN

PROGRAM DAY12
  INTEGER(8) :: I,J,K,N,IERR,ENERGY,PART2,STEPS
  CHARACTER(LEN=30) :: INLINE
  INTEGER(8) :: CHANGE(3),P2(3)
  INTEGER(8),ALLOCATABLE :: POS(:,:),VEL(:,:),POS2(:,:),VEL2(:,:)
  LOGICAL :: DONE(3)

  OPEN(1,FILE="input.txt")
  N=0
  DO
     READ(1,*,IOSTAT=IERR)
     IF(IERR.NE.0)EXIT
     N=N+1
  END DO
  ALLOCATE(POS(3,N),VEL(3,N),POS2(3,N),VEL2(3,N))
  REWIND(1)
  DO I=1,N
     READ(1,'(A)') INLINE
     K=0
     DO J=1,3
        K=K+SCAN(INLINE(K+1:),"=")+1
        READ(INLINE(K:K+SCAN(INLINE(K+1:),",>")-1),*) POS(J,I)
     END DO
  END DO
  CLOSE(1)
  VEL=0
  POS2=POS
  VEL2=VEL
  STEPS=0
  DONE=.FALSE.

  DO
     STEPS=STEPS+1
     DO I=1,N-1
        DO J=I+1,N
           CHANGE=(POS(:,J)-POS(:,I))
           WHERE(CHANGE.NE.0)
              CHANGE=CHANGE/ABS(CHANGE)
           END WHERE
           VEL(:,I)=VEL(:,I)+CHANGE
           VEL(:,J)=VEL(:,J)-CHANGE
        END DO
     END DO
     POS=POS+VEL
     DO I=1,3
        IF(DONE(I))CYCLE
        IF(ALL(POS(I,:).EQ.POS2(I,:)).AND.ALL(VEL(I,:).EQ.VEL2(I,:)))THEN
           P2(I)=STEPS
           DONE(I)=.TRUE.
        END IF
     END DO
     IF(STEPS.EQ.1000)THEN
        WRITE(*,'("Part 1: ",I0)') SUM((/(SUM(ABS(POS(:,I)))*SUM(ABS(VEL(:,I))),I=1,3)/))
     END IF
     IF(STEPS.GE.1000.AND.ALL(DONE))EXIT
  END DO

  PART2=P2(1)
  DO I=2,3
     PART2=PART2*(P2(I)/GCD(PART2,P2(I)))
  END DO
  WRITE(*,'("Part 2: ",I0)') PART2

CONTAINS
  FUNCTION GCD(A,B) RESULT(C)
    INTEGER(8) A,B,C,D
    C=A
    D=B
    DO
       IF(C.EQ.D)EXIT
       IF(C>D)THEN
          C=C-D
       ELSE
          D=D-C
       END IF
    END DO
  END FUNCTION GCD

END PROGRAM DAY12