!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! Program file name: motion.f90 ! ! ! ! © Tao Pang 2006 ! ! ! ! Last modified: June 2, 2006 ! ! ! ! (1) This F90 program is created for the book, "An Introduction to ! ! Computational Physics, 2nd Edition," written by Tao Pang and ! ! published by Cambridge University Press on January 19, 2006. ! ! ! ! (2) No warranties, express or implied, are made for this program. ! ! ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! PROGRAM MOTION ! ! An example of studying the motion of a particle in ! one dimension under an elastic force. ! IMPLICIT NONE INTEGER, PARAMETER :: N=10000, J=200 INTEGER :: I REAL :: PI, DT, T, JDT REAL, DIMENSION (N+1):: X, V ! ! Assign time step and initial position and velocity ! PI = 4*ATAN(1.0) DT = 2*PI/N X(1) = 0 V(1) = 1 ! ! Calculate other position and velocity recursively ! DO I = 1, N X(I+1) = X(I)+V(I)*DT V(I+1) = V(I)-X(I)*DT END DO ! ! Output the result in every J time steps ! T = 0 JDT = J*DT DO I = 1, N, J WRITE (6,"(3F16.8)") T, X(I), V(I) T = T + JDT END DO ! END PROGRAM MOTION