AoC 2018 Day15 FORTRAN

PROGRAM DAY15
  TYPE GOBLIN
     INTEGER :: POSITION(2)
     INTEGER :: ATTACK=3
     INTEGER :: HEALTH=200
  END TYPE GOBLIN
  TYPE ELF
     INTEGER :: POSITION(2)
     INTEGER :: ATTACK=3
     INTEGER :: HEALTH=200
  END TYPE ELF
  INTEGER :: I,J,K,E,G,X,Y,IERR,STEPS,A
  CHARACTER(LEN=1),ALLOCATABLE :: GRID(:,:),STARTGRID(:,:)
  LOGICAL, ALLOCATABLE :: MOVED(:,:),TARGETSQUARE(:,:)
  INTEGER, ALLOCATABLE :: DISTANCES(:,:)
  CHARACTER(LEN=1) :: TEST
  CHARACTER(LEN=:), ALLOCATABLE :: INLINE
  TYPE(GOBLIN), ALLOCATABLE,TARGET :: GOBLINS(:)
  TYPE(ELF), ALLOCATABLE,TARGET :: ELVES(:)

  OPEN(1,FILE='INPUT.TXT')
  X=0
  DO
     READ(1,'(A)',ADVANCE='NO',IOSTAT=IERR)TEST
     IF(IERR.NE.0)EXIT
     X=X+1
  END DO
  REWIND(1)
  Y=0
  DO
     READ(1,*,IOSTAT=IERR)
     IF(IERR.NE.0)EXIT
     Y=Y+1
  END DO
  REWIND(1)
  ALLOCATE(GRID(X,Y),DISTANCES(X,Y),MOVED(X,Y),TARGETSQUARE(X,Y),STARTGRID(X,Y))
  ALLOCATE(CHARACTER(LEN=X) :: INLINE)
  E=0
  G=0
  DO J=1,Y
     READ(1,'(A)')INLINE
     DO I=1,X
        GRID(I,J)=INLINE(I:I)
        IF(INLINE(I:I).EQ.'E')E=E+1
        IF(INLINE(I:I).EQ.'G')G=G+1
     END DO
  END DO
  CLOSE(1)
  ALLOCATE(ELVES(E),GOBLINS(G))

  A=3
  STARTGRID=GRID
  DO
     GRID=STARTGRID
     E=1
     G=1
     DO J=1,Y
        DO I=1,X
           IF(GRID(I,J).EQ.'E')THEN
              ELVES(E)%POSITION=(/I,J/)
              ELVES(E)%HEALTH=200
              ELVES(E)%ATTACK=A
              E=E+1
           ELSEIF(GRID(I,J).EQ.'G')THEN
              GOBLINS(G)%POSITION=(/I,J/)
              GOBLINS(G)%HEALTH=200
              G=G+1
           END IF
        END DO
     END DO
     MOVED=.FALSE.
     STEPS=0
     OUTER:DO
        DO J=1,Y
           DO I=1,X
              IF(SCAN(GRID(I,J),'.#').NE.0)CYCLE
              IF(MOVED(I,J))CYCLE
              CALL MOVE((/I,J/),GRID(I,J))
              IF(COUNT(GRID.EQ.'E').EQ.0)EXIT OUTER
              IF(COUNT(GRID.EQ.'G').EQ.0)EXIT OUTER
           END DO
        END DO
        MOVED=.FALSE.
        STEPS=STEPS+1

     END DO OUTER
     J=0
     DO I=1,SIZE(ELVES,DIM=1)
        IF(ELVES(I)%HEALTH>0)J=J+ELVES(I)%HEALTH
     END DO
     DO I=1,SIZE(GOBLINS,DIM=1)
        IF(GOBLINS(I)%HEALTH>0)J=J+GOBLINS(I)%HEALTH
     END DO
     IF(A.EQ.3)WRITE(*,'("PART 1: ",I0)') STEPS*J
     IF(ALL((/(ELVES(I)%HEALTH,I=1,SIZE(ELVES,DIM=1))/)>0))EXIT
     A=A+1
  END DO
  WRITE(*,'("PART 2: ",I0)') STEPS*J
CONTAINS
  SUBROUTINE MOVE(POS,TEAM)
    INTEGER, INTENT(IN) :: POS(2)
    CHARACTER(LEN=1), INTENT(IN) :: TEAM
    CHARACTER(LEN=1) :: OPPOSITION
    INTEGER :: I,J,K,NEWPOS(2)
    IF(TEAM.EQ.'E')OPPOSITION='G'
    IF(TEAM.EQ.'G')OPPOSITION='E'
    NEWPOS=POS
    IF(.NOT.ANY((/GRID(POS(1)-1:POS(1)+1,POS(2)),GRID(POS(1),POS(2)-1:POS(2)+1)/).EQ.OPPOSITION))THEN
       TARGETSQUARE=.FALSE.
       DO J=2,Y-1
          DO I=2,X-1
             IF(GRID(I,J).EQ.OPPOSITION)THEN
                IF(GRID(I-1,J).EQ.'.')TARGETSQUARE(I-1,J)=.TRUE.
                IF(GRID(I+1,J).EQ.'.')TARGETSQUARE(I+1,J)=.TRUE.
                IF(GRID(I,J-1).EQ.'.')TARGETSQUARE(I,J-1)=.TRUE.
                IF(GRID(I,J+1).EQ.'.')TARGETSQUARE(I,J+1)=.TRUE.
             END IF
          END DO
       END DO
       DISTANCES=X*Y
       WHERE(TARGETSQUARE)DISTANCES=0
       DO K=1,COUNT(GRID.EQ.'.')
          DO J=2,Y-1
             DO I=2,X-1
                IF(GRID(I,J).EQ.'.')THEN
                   DISTANCES(I,J)=MIN(DISTANCES(I,J),MINVAL((/DISTANCES(I-1:I+1,J),DISTANCES(I,J-1:J+1)/))+1)
                END IF
             END DO
          END DO
       END DO
       K=MINVAL((/DISTANCES(POS(1)-1:POS(1)+1,POS(2)),DISTANCES(POS(1),POS(2)-1:POS(2)+1)/))
       IF(DISTANCES(POS(1),POS(2)).EQ.K)THEN

       ELSEIF(DISTANCES(POS(1),POS(2)-1).EQ.K)THEN
          NEWPOS=POS+(/0,-1/)
       ELSEIF(DISTANCES(POS(1)-1,POS(2)).EQ.K)THEN
          NEWPOS=POS+(/-1,0/)
       ELSEIF(DISTANCES(POS(1)+1,POS(2)).EQ.K)THEN
          NEWPOS=POS+(/1,0/)
       ELSEIF(DISTANCES(POS(1),POS(2)+1).EQ.K)THEN
          NEWPOS=POS+(/0,+1/)
       END IF
    END IF
    GRID(POS(1),POS(2))='.'
    GRID(NEWPOS(1),NEWPOS(2))=TEAM
    IF(TEAM.EQ.'E')THEN
       DO I=1,SIZE(ELVES,DIM=1)
          IF(ALL(ELVES(I)%POSITION.EQ.POS))ELVES(I)%POSITION=NEWPOS
       END DO
    ELSE
       DO I=1,SIZE(GOBLINS,DIM=1)
          IF(ALL(GOBLINS(I)%POSITION.EQ.POS))GOBLINS(I)%POSITION=NEWPOS
       END DO
    END IF
    CALL ATTACK(NEWPOS,TEAM,OPPOSITION)
    MOVED(NEWPOS(1),NEWPOS(2))=.TRUE.
  END SUBROUTINE MOVE

  SUBROUTINE ATTACK(POS,TEAM,OPPOSITION)
    INTEGER, INTENT(IN) :: POS(2)
    CHARACTER(LEN=1), INTENT(IN) :: TEAM,OPPOSITION
    TYPE(ELF),POINTER :: ELFO
    TYPE(GOBLIN), POINTER :: GOBBO
    INTEGER :: LOWESTHEALTH,I,J,K

    ELFO=>NULL()
    GOBBO=>NULL()
    LOWESTHEALTH = MAXVAL((/GOBLINS%HEALTH,ELVES%HEALTH/))+1
    IF(TEAM.EQ.'E')THEN
       DO I=1,SIZE(ELVES,DIM=1)
          IF(ALL(ELVES(I)%POSITION.EQ.POS))ELFO => ELVES(I)
       END DO
       DO J=-1,1
          DO I=-1,1
             IF((I.NE.0).AND.(J.NE.0))CYCLE
             IF(GRID(POS(1)+I,POS(2)+J).NE.'G')CYCLE
             DO K=1,SIZE(GOBLINS,DIM=1)
                IF(ANY(GOBLINS(K)%POSITION.NE.(/POS(1)+I,POS(2)+J/)))CYCLE
                IF(GOBLINS(K)%HEALTH<LOWESTHEALTH)THEN
                   GOBBO => GOBLINS(K)
                   LOWESTHEALTH = GOBBO%HEALTH
                END IF
             END DO
          END DO
       END DO
       IF(ASSOCIATED(GOBBO))THEN
          GOBBO%HEALTH=GOBBO%HEALTH-ELFO%ATTACK
          IF(GOBBO%HEALTH.LE.0)THEN
             GRID(GOBBO%POSITION(1),GOBBO%POSITION(2))='.'
             GOBBO%POSITION=(/0,0/)
          END IF
       END IF
    ELSE
       DO I=1,SIZE(GOBLINS,DIM=1)
          IF(ALL(GOBLINS(I)%POSITION.EQ.POS))GOBBO => GOBLINS(I)
       END DO
       DO J=-1,1
          DO I=-1,1
             IF((I.NE.0).AND.(J.NE.0))CYCLE
             IF(GRID(POS(1)+I,POS(2)+J).NE.'E')CYCLE
             DO K=1,SIZE(ELVES,DIM=1)
                IF(ANY(ELVES(K)%POSITION.NE.(/POS(1)+I,POS(2)+J/)))CYCLE
                IF(ELVES(K)%HEALTH<LOWESTHEALTH)THEN
                   ELFO => ELVES(K)
                   LOWESTHEALTH = ELFO%HEALTH
                END IF
             END DO
          END DO
       END DO
       IF(ASSOCIATED(ELFO))THEN
          ELFO%HEALTH=ELFO%HEALTH-GOBBO%ATTACK
          IF(ELFO%HEALTH.LE.0)THEN
             GRID(ELFO%POSITION(1),ELFO%POSITION(2))='.'
             ELFO%POSITION=(/0,0/)
          END IF
       END IF
    END IF
  END SUBROUTINE ATTACK
END PROGRAM DAY15