C IMPLICIT REAL(A-H,O-Z) REAL T(100),XZ(100,2) DATA GRAV,V0,ANGLE/9.8,30.0,45.0/ DATA T0,VINT,TMAX/0.0,0.5,7.5/ PI=ATAN(1.0)*4.0 R=ANGLE*PI/180.0 C DO 10 I=1,50,1 T(I)=REAL(I-1)*VINT IF(T(I).GT.TMAX)THEN STOP END IF XZ(I,1)=V0*COS(R)*T(I) XZ(I,2)=-0.5*GRAV*T(I)**2+V0*SIN(R)*T(I) 10 CONTINUE S=AREA(T,X,Z,T0,TMAX,R,GRAV) CALL OUTPUT(T,X,Z,S) STOP END
C FUNCTION AREA (T,X,Z,T0,TMAX,R,GRAV) IMPLICIT REAL(A-H,O-Z) XMAX=V0*0.5*COS(R)*TMAX X0=V0*0.5*COS(R)*T0 DO 20 I=1,16 AREA=0.0 DX=(XMAX-X0)/REAL(I) T=REAL(I-1)*VINT X1=V0*COS(R)*T X2=X1+DX Z1=TAN(R)*X1-0.5*(GRAV/(V0*(COS(R))**2))*X1**2 Z2=TAN(R)*X2-0.5*(GRAV/(V0*(COS(R))**2))*X2**2 AREA=AREA+(Z1+Z2)*DX*0.5 20 CONTINUE RETURN END
C SUBROUTINE OUTPUT(T,X,Z,S) IMPLICIT REAL(A-H,O-Z) INTEGER NO(100) REAL T(100),XZ(100,2) C OPEN(16,FILE='menseki2.res') WRITE(16,'(A)')' TIME CX CZ SPACE' DO 30 I=1,16 WRITE(16,'(F5.1,2F10.2)') T(I),(XZ(I,J),J=1,2) WRITE(16,'(F10.2)') S 30 CONTINUE CLOSE(16,STATUS='KEEP') RETURN END
