AoC 2019 Day5 FORTRAN

PROGRAM DAY5
  TYPE OP
     PROCEDURE(), POINTER, NOPASS :: OP
     INTEGER :: NARGS
  END TYPE OP
  INTEGER :: I,N,IERR,MODES,OPCODE
  CHARACTER(LEN=1) CHAR
  INTEGER, ALLOCATABLE :: PROG(:)
  TYPE(OP) :: OPS(8)

  OPS(1)%NARGS=3
  OPS(1)%OP => ADD
  OPS(2)%NARGS=3
  OPS(2)%OP => MULTIPLY
  OPS(3)%NARGS=1
  OPS(3)%OP => INPUT
  OPS(4)%NARGS=1
  OPS(4)%OP => OUTPUT
  OPS(5)%NARGS=2
  OPS(5)%OP => JUMP_IF_TRUE
  OPS(6)%NARGS=2
  OPS(6)%OP => JUMP_IF_FALSE
  OPS(7)%NARGS=3
  OPS(7)%OP => LESS_THAN
  OPS(8)%NARGS=3
  OPS(8)%OP => EQUALS

  OPEN(1,FILE="input.txt")
  N=1
  DO
     READ(1,'(A1)',IOSTAT=IERR,ADVANCE="NO")CHAR
     IF(IERR.NE.0)EXIT
     IF(CHAR.EQ.",")N=N+1
  END DO
  REWIND(1)
  ALLOCATE(PROG(0:N-1))
  READ(1,*)PROG

  I=0
  DO
     MODES=PROG(I)/100
     OPCODE=MODULO(PROG(I),100)
     IF(OPCODE.EQ.99)EXIT
     CALL OPS(OPCODE)%OP(MODES,PROG(I+1:I+OPS(OPCODE)%NARGS),I)
  END DO



CONTAINS
  SUBROUTINE ADD(MODES,PARAMS,I)
    INTEGER, INTENT(IN) :: MODES, PARAMS(3)
    INTEGER :: A,B
    INTEGER, INTENT(INOUT) :: I
    I=I+4

    IF(MODULO(MODES,10).EQ.0)THEN
       A=PROG(PARAMS(1))
    ELSE
       A=PARAMS(1)
    END IF
    IF(MODULO(MODES,100)/10.EQ.0)THEN
       B=PROG(PARAMS(2))
    ELSE
       B=PARAMS(2)
    END IF
    PROG(PARAMS(3))=A+B
  END SUBROUTINE ADD

  SUBROUTINE MULTIPLY(MODES,PARAMS,I)
    INTEGER, INTENT(IN) :: MODES, PARAMS(3)
    INTEGER :: A,B
    INTEGER, INTENT(INOUT) :: I
    I=I+4

    IF(MODULO(MODES,10).EQ.0)THEN
       A=PROG(PARAMS(1))
    ELSE
       A=PARAMS(1)
    END IF
    IF(MODULO(MODES,100)/10.EQ.0)THEN
       B=PROG(PARAMS(2))
    ELSE
       B=PARAMS(2)
    END IF
    PROG(PARAMS(3))=A*B
  END SUBROUTINE MULTIPLY

  SUBROUTINE INPUT(MODES,PARAMS,I)
    INTEGER, INTENT(IN) :: MODES, PARAMS(3)
    INTEGER :: A
    INTEGER, INTENT(INOUT) :: I
    I=I+2

    WRITE(*,'(A)',ADVANCE="NO") "Enter input: "
    READ(*,*)A
    PROG(PARAMS(1))=A
  END SUBROUTINE INPUT

  SUBROUTINE OUTPUT(MODES,PARAMS,I)
    INTEGER, INTENT(IN) :: MODES, PARAMS(3)
    INTEGER :: A,B
    INTEGER, INTENT(INOUT) :: I
    I=I+2

    IF(MODULO(MODES,10).EQ.0)THEN
       A=PROG(PARAMS(1))
    ELSE
       A=PARAMS(1)
    END IF
    IF(MODULO(MODES,100)/10.EQ.0)THEN
       B=PROG(PARAMS(2))
    ELSE
       B=PARAMS(2)
    END IF
    WRITE(*,'(A,I0)') "Output: ", A
  END SUBROUTINE OUTPUT

  SUBROUTINE JUMP_IF_TRUE(MODES,PARAMS,I)
    INTEGER, INTENT(IN) :: MODES, PARAMS(2)
    INTEGER :: A,B
    INTEGER, INTENT(INOUT) :: I

    IF(MODULO(MODES,10).EQ.0)THEN
       A=PROG(PARAMS(1))
    ELSE
       A=PARAMS(1)
    END IF
    IF(MODULO(MODES,100)/10.EQ.0)THEN
       B=PROG(PARAMS(2))
    ELSE
       B=PARAMS(2)
    END IF
    IF(A.NE.0)THEN
       I=B
    ELSE
       I=I+3
    END IF
  END SUBROUTINE JUMP_IF_TRUE

  SUBROUTINE JUMP_IF_FALSE(MODES,PARAMS,I)
    INTEGER, INTENT(IN) :: MODES, PARAMS(2)
    INTEGER :: A,B
    INTEGER, INTENT(INOUT) :: I

    IF(MODULO(MODES,10).EQ.0)THEN
       A=PROG(PARAMS(1))
    ELSE
       A=PARAMS(1)
    END IF
    IF(MODULO(MODES,100)/10.EQ.0)THEN
       B=PROG(PARAMS(2))
    ELSE
       B=PARAMS(2)
    END IF
    IF(A.EQ.0)THEN
       I=B
    ELSE
       I=I+3
    END IF
  END SUBROUTINE JUMP_IF_FALSE

  SUBROUTINE LESS_THAN(MODES,PARAMS,I)
    INTEGER, INTENT(IN) :: MODES, PARAMS(3)
    INTEGER :: A,B
    INTEGER, INTENT(INOUT) :: I
    I=I+4

    IF(MODULO(MODES,10).EQ.0)THEN
       A=PROG(PARAMS(1))
    ELSE
       A=PARAMS(1)
    END IF
    IF(MODULO(MODES,100)/10.EQ.0)THEN
       B=PROG(PARAMS(2))
    ELSE
       B=PARAMS(2)
    END IF
    IF(A<B)THEN
       PROG(PARAMS(3))=1
    ELSE
       PROG(PARAMS(3))=0
    END IF
  END SUBROUTINE LESS_THAN

  SUBROUTINE EQUALS(MODES,PARAMS,I)
    INTEGER, INTENT(IN) :: MODES, PARAMS(3)
    INTEGER :: A,B
    INTEGER, INTENT(INOUT) :: I
    I=I+4

    IF(MODULO(MODES,10).EQ.0)THEN
       A=PROG(PARAMS(1))
    ELSE
       A=PARAMS(1)
    END IF
    IF(MODULO(MODES,100)/10.EQ.0)THEN
       B=PROG(PARAMS(2))
    ELSE
       B=PARAMS(2)
    END IF
    IF(A.EQ.B)THEN
       PROG(PARAMS(3))=1
    ELSE
       PROG(PARAMS(3))=0
    END IF
  END SUBROUTINE EQUALS

END PROGRAM DAY5