autid

AoC 2019 Day4 FORTRAN

Dec 4th, 2019
1,636
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. PROGRAM DAY4
  2.   INTEGER :: A,B,C,D,E,F,PASSWORD(6)
  3.   INTEGER :: LOWER, UPPER,PART1,PART2,POWERS(6)
  4.   LOGICAL :: OK(2)
  5.   CHARACTER(LEN=13) :: INLINE
  6.  
  7.   OPEN(1,FILE="input.txt")
  8.   READ(1,*)INLINE
  9.   CLOSE(1)
  10.   READ(INLINE(1:6),*)LOWER
  11.   READ(INLINE(8:),*)UPPER
  12.   PART1=0
  13.   PART2=0
  14.   POWERS=(/(10**I,I=5,0,-1)/)
  15.  
  16.   OUTER:DO A=LOWER/10**5,UPPER/10**5
  17.      DO B=A,9
  18.         DO C=B,9
  19.            DO D=C,9
  20.               DO E=D,9
  21.                  DO F=E,9
  22.                     PASSWORD=(/A,B,C,D,E,F/)
  23.                     IF(SUM(PASSWORD*POWERS)<LOWER)CYCLE
  24.                     IF(SUM(PASSWORD*POWERS)>UPPER)EXIT OUTER
  25.                     OK=CHECK(PASSWORD)
  26.                     IF(OK(1))PART1=PART1+1
  27.                     IF(OK(2))PART2=PART2+1
  28.                  END DO
  29.               END DO
  30.            END DO
  31.         END DO
  32.      END DO
  33.   END DO OUTER
  34.  
  35.   WRITE(*,'("Part 1: ",I0)') PART1
  36.   WRITE(*,'("Part 2: ",I0)') PART2
  37.  
  38. CONTAINS
  39.   FUNCTION CHECK(PASSDIGITS) RESULT(RES)
  40.     INTEGER :: PASSDIGITS(6),I
  41.     LOGICAL :: RES(2)
  42.     RES=.FALSE.
  43.     DO I=1,5
  44.        IF(PASSDIGITS(I).EQ.PASSDIGITS(I+1))THEN
  45.           RES(1)=.TRUE.
  46.           IF(I.EQ.1.OR.PASSDIGITS(I-1).NE.PASSDIGITS(I))THEN
  47.              IF(I.EQ.5.OR.PASSDIGITS(I+2).NE.PASSDIGITS(I))THEN
  48.                 RES(2)=.TRUE.
  49.                 EXIT
  50.              END IF
  51.           END IF
  52.        END IF
  53.     END DO
  54.   END FUNCTION CHECK
  55. END PROGRAM DAY4
Advertisement
Add Comment
Please, Sign In to add comment