RosettaCodeData/Task/Vector/Fortran/vector.f

99 lines
2.8 KiB
Fortran

MODULE ROSETTA_VECTOR
IMPLICIT NONE
TYPE VECTOR
REAL :: X, Y
END TYPE VECTOR
INTERFACE OPERATOR(+)
MODULE PROCEDURE VECTOR_ADD
END INTERFACE
INTERFACE OPERATOR(-)
MODULE PROCEDURE VECTOR_SUB
END INTERFACE
INTERFACE OPERATOR(/)
MODULE PROCEDURE VECTOR_DIV
END INTERFACE
INTERFACE OPERATOR(*)
MODULE PROCEDURE VECTOR_MULT
END INTERFACE
CONTAINS
FUNCTION VECTOR_ADD(VECTOR_1, VECTOR_2)
TYPE(VECTOR), INTENT(IN) :: VECTOR_1, VECTOR_2
TYPE(VECTOR) :: VECTOR_ADD
VECTOR_ADD%X = VECTOR_1%X+VECTOR_2%X
VECTOR_ADD%Y = VECTOR_1%Y+VECTOR_2%Y
END FUNCTION VECTOR_ADD
FUNCTION VECTOR_SUB(VECTOR_1, VECTOR_2)
TYPE(VECTOR), INTENT(IN) :: VECTOR_1, VECTOR_2
TYPE(VECTOR) :: VECTOR_SUB
VECTOR_SUB%X = VECTOR_1%X-VECTOR_2%X
VECTOR_SUB%Y = VECTOR_1%Y-VECTOR_2%Y
END FUNCTION VECTOR_SUB
FUNCTION VECTOR_DIV(VEC, SCALAR)
TYPE(VECTOR), INTENT(IN) :: VEC
REAL, INTENT(IN) :: SCALAR
TYPE(VECTOR) :: VECTOR_DIV
VECTOR_DIV%X = VEC%X/SCALAR
VECTOR_DIV%Y = VEC%Y/SCALAR
END FUNCTION VECTOR_DIV
FUNCTION VECTOR_MULT(VEC, SCALAR)
TYPE(VECTOR), INTENT(IN) :: VEC
REAL, INTENT(IN) :: SCALAR
TYPE(VECTOR) :: VECTOR_MULT
VECTOR_MULT%X = VEC%X*SCALAR
VECTOR_MULT%Y = VEC%Y*SCALAR
END FUNCTION VECTOR_MULT
FUNCTION FROM_RTHETA(R, THETA)
REAL :: R, THETA
TYPE(VECTOR) :: FROM_RTHETA
FROM_RTHETA%X = R*SIN(THETA)
FROM_RTHETA%Y = R*COS(THETA)
END FUNCTION FROM_RTHETA
FUNCTION FROM_XY(X, Y)
REAL :: X, Y
TYPE(VECTOR) :: FROM_XY
FROM_XY%X = X
FROM_XY%Y = Y
END FUNCTION FROM_XY
FUNCTION PRETTY_PRINT(VEC)
TYPE(VECTOR), INTENT(IN) :: VEC
CHARACTER(LEN=100) PRETTY_PRINT
WRITE(PRETTY_PRINT,"(A, F0.5, A, F0.5, A)") "[", VEC%X, ", ", VEC%Y, "]"
END FUNCTION PRETTY_PRINT
END MODULE ROSETTA_VECTOR
PROGRAM VECTOR_DEMO
USE ROSETTA_VECTOR
IMPLICIT NONE
TYPE(VECTOR) :: VECTOR_1, VECTOR_2
REAL, PARAMETER :: PI = 4*ATAN(1.0)
REAL :: SCALAR
SCALAR = 2.0
VECTOR_1 = FROM_XY(2.0, 3.0)
VECTOR_2 = FROM_RTHETA(2.0, PI/6.0)
WRITE(*,*) "VECTOR_1 (X: 2.0, Y: 3.0) : ", PRETTY_PRINT(VECTOR_1)
WRITE(*,*) "VECTOR_2 (R: 2.0, THETA: PI/6) : ", PRETTY_PRINT(VECTOR_2)
WRITE(*,*) NEW_LINE('A')
WRITE(*,*) "VECTOR_1 + VECTOR_2 = ", PRETTY_PRINT(VECTOR_1+VECTOR_2)
WRITE(*,*) "VECTOR_1 - VECTOR_2 = ", PRETTY_PRINT(VECTOR_1-VECTOR_2)
WRITE(*,*) "VECTOR_1 / 2.0 = ", PRETTY_PRINT(VECTOR_1/SCALAR)
WRITE(*,*) "VECTOR_1 * 2.0 = ", PRETTY_PRINT(VECTOR_1*SCALAR)
END PROGRAM VECTOR_DEMO