Advertisement
autid

AoC 2019 Day7 FORTRAN (for day9 intcode)

Dec 9th, 2019
1,762
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. PROGRAM DAY7
  2.   USE MPI
  3.  
  4.   INTEGER :: I,N,IERR
  5.   INTEGER(8) :: A,B,C,D,E,PART1,PART2,RES,INIT
  6.   CHARACTER(LEN=1) CHAR
  7.   INTEGER, ALLOCATABLE :: PROG(:)
  8.   INTEGER :: IERROR, NPROC, ICOMM, IRANK, INTERCOMM,ERRCODES(5)
  9.   LOGICAL :: AMROOT
  10.   INTEGER :: STATUS(MPI_STATUS_SIZE)
  11.  
  12.   CALL MPI_INIT(IERROR)
  13.   ICOMM = MPI_COMM_WORLD
  14.   CALL MPI_COMM_SIZE(ICOMM,NPROC,IERROR)
  15.   CALL MPI_COMM_RANK(ICOMM, IRANK, IERROR)
  16.   CALL MPI_COMM_SPAWN("./intcode",MPI_ARGV_NULL,5,MPI_INFO_NULL,0,ICOMM,INTERCOMM,ERRCODES,IERROR)
  17.  
  18.   OPEN(1,FILE="input.txt")
  19.   N=1
  20.   DO
  21.      READ(1,'(A1)',IOSTAT=IERR,ADVANCE="NO")CHAR
  22.      IF(IERR.NE.0)EXIT
  23.      IF(CHAR.EQ.",")N=N+1
  24.   END DO
  25.   REWIND(1)
  26.   ALLOCATE(PROG(0:N-1))
  27.   READ(1,*)PROG
  28.   DO I=0,4
  29.      CALL MPI_SEND(N,1,MPI_INTEGER,I,0,INTERCOMM,IERROR)
  30.      CALL MPI_SEND(PROG,N,MPI_INTEGER,I,1,INTERCOMM,IERROR)
  31.   END DO
  32.   INIT=0
  33.   PART1=0
  34.   DO A=0,4
  35.      DO B=0,4
  36.         IF(B.EQ.A)CYCLE
  37.         DO C=0,4
  38.            IF(ANY((/A,B/).EQ.C))CYCLE
  39.            DO D=0,4
  40.               IF(ANY((/A,B,C/).EQ.D))CYCLE
  41.               DO E=0,4
  42.                  IF(ANY((/A,B,C,D/).EQ.E))CYCLE
  43.                  CALL MPI_SEND(A,1,MPI_DOUBLE_PRECISION,0,2,INTERCOMM,IERROR)
  44.                  CALL MPI_SEND(INIT,1,MPI_DOUBLE_PRECISION,0,3,INTERCOMM,IERROR)
  45.                  CALL MPI_SEND(B,1,MPI_DOUBLE_PRECISION,1,2,INTERCOMM,IERROR)
  46.                  CALL MPI_SEND(C,1,MPI_DOUBLE_PRECISION,2,2,INTERCOMM,IERROR)
  47.                  CALL MPI_SEND(D,1,MPI_DOUBLE_PRECISION,3,2,INTERCOMM,IERROR)
  48.                  CALL MPI_SEND(E,1,MPI_DOUBLE_PRECISION,4,2,INTERCOMM,IERROR)
  49.                  CALL MPI_RECV(RES,1,MPI_DOUBLE_PRECISION,0,999,INTERCOMM,STATUS,IERROR)
  50.                  PART1=MAX(PART1,RES)
  51.               END DO
  52.            END DO
  53.         END DO
  54.      END DO
  55.   END DO
  56.  
  57.   PART2=0
  58.   DO A=5,9
  59.      DO B=5,9
  60.         IF(B.EQ.A)CYCLE
  61.         DO C=5,9
  62.            IF(ANY((/A,B/).EQ.C))CYCLE
  63.            DO D=5,9
  64.               IF(ANY((/A,B,C/).EQ.D))CYCLE
  65.               DO E=5,9
  66.                  IF(ANY((/A,B,C,D/).EQ.E))CYCLE
  67.                  CALL MPI_SEND(A,1,MPI_DOUBLE_PRECISION,0,2,INTERCOMM,IERROR)
  68.                  CALL MPI_SEND(INIT,1,MPI_DOUBLE_PRECISION,0,3,INTERCOMM,IERROR)
  69.                  CALL MPI_SEND(B,1,MPI_DOUBLE_PRECISION,1,2,INTERCOMM,IERROR)
  70.                  CALL MPI_SEND(C,1,MPI_DOUBLE_PRECISION,2,2,INTERCOMM,IERROR)
  71.                  CALL MPI_SEND(D,1,MPI_DOUBLE_PRECISION,3,2,INTERCOMM,IERROR)
  72.                  CALL MPI_SEND(E,1,MPI_DOUBLE_PRECISION,4,2,INTERCOMM,IERROR)
  73.                  CALL MPI_RECV(RES,1,MPI_DOUBLE_PRECISION,0,999,INTERCOMM,STATUS,IERROR)
  74.                  PART2=MAX(PART2,RES)
  75.               END DO
  76.            END DO
  77.         END DO
  78.      END DO
  79.   END DO
  80.   WRITE(*,'("Part 1: ",I0)') PART1
  81.   WRITE(*,'("Part 2: ",I0)') PART2
  82.   DO I=0,4
  83.      CALL MPI_SEND(-1,1,MPI_DOUBLE_PRECISION,I,2,INTERCOMM,IERROR)
  84.   END DO
  85.   CALL MPI_FINALIZE(IERROR)
  86.  
  87. END PROGRAM DAY7
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement