中南大学FORTRAN程序设计实验设计及报告.doc

PROGRAM MAINDIMENSION X(10),Y(10),S(9)REAL(8) S1(6,6),S2(6),A(6),JS(6)REAL(8) X,Y,S,RN=5K=1OPEN(10,FILE=X.TXT,FORM=FORMATTED,ACCESS=DIRECT,RECL=10)DO I=1,10X(I)=10.0*IWRITE(10,100,REC=I)X(I)END DOOPEN(20,FILE=Y.TXT,FORM=FORMATTED,ACCESS=DIRECT,RECL=10)WRITE(20,200,REC=1)6.0WRITE(20,200,REC=2)14.0WRITE(20,200,REC=3)26.0WRITE(20,200,REC=4)33.0WRITE(20,200,REC=5)46.0WRITE(20,200,REC=6)54.0WRITE(20,200,REC=7)67.0WRITE(20,200,REC=8)75.0WRITE(20,200,REC=9)84.0WRITE(20,200,REC=10)100.0OPEN(30,FILE=S.TXT,FORM=FORMATTED,ACCESS=DIRECT,RECL=10)DO I=1,9S(I)=5.0+10.0*IWRITE(30,100,REC=I)S(I)END DOOPEN(10,FILE=X.TXT,FORM=FORMATTED,ACCESS=DIRECT,RECL=10)DO I=1,10READ(10,100,REC=I)X(I)END DOOPEN(20,FILE=Y.TXT,FORM=FORMATTED,ACCESS=DIRECT,RECL=10)DO I=1,10READ(20,200,REC=I)Y(I)END DOOPEN(30,FILE=S.TXT,FORM=FORMATTED,ACCESS=DIRECT,RECL=10)DO I=1,9READ(30,200,REC=I)S(I)END DOCLOSE(10)CLOSE(20)CLOSE(30)100 FORMAT(F5.1)200 FORMAT(F6.1)DO I=1,9CALL LAGRANGE(X,Y,10,S(I),R)WRITE(*,400)S(I),RENDDO400 FORMAT(1X,压力P(KN)=,F5.1,10X,变形(mm)=,F5.1)DO I=1,N+1DO J=1,N+1CALL SUM1(S1(I,J),X,I+J-2)END DOEND DOS1(1,1)=K+1DO I=1,N+1CALL SUM2(S2(I),X,Y,I-1)END DOCALL GUASS(S1,S2,N+1,A,JS)OPEN(1,FILE=4.TXT)DO I=1,N+1WRITE(1,*)A(I)END DOWRITE(*,*)拟合曲线函数的六个系数为:DO I=1,N+1WRITE(*,*)A(I)END DOWRITE(*,*)拟合曲线函数表达式为:WRITE(*,*)Y=,A(1),+,A(2),*X+,A(3),*X*2+,A(4),*X*3+,A(5),*X*4+,A(6),*X*5ENDSUBROUTINE SUM1(S,X,N)DIMENSION X(10)REAL(8) X,SDO I=1,10S=S+X(I)*NEND DOENDSUBROUTINE LAGRANGE(X,Y,N,S,R)DIMENSION X(N),Y(N)REAL(8):X,Y,S,RR=0.0IF(N=0) THENPRINT*,ERROREND IFIF(N=1) R=Y(1)IF(N=2) R=(S-X(2)/(Y(1)-Y(2)+ (S-X(1)/(Y(2)-Y(1)I=1DO WHILE(x(i)=s)I=I+1ENDDOK=I-4if(K=N) M=NDO J=K,MT=1.0DO L=K,MIF(L/=J) T=T*(S-X(L)/(X(J)-X(L)ENDDOR=R+T*Y(J)ENDDOENDSUBROUTINE SUM2(S,X,Y,N)DIMENSION X(10),Y(10)REAL(8) X,Y,SDO I=1,10S=S+Y(I)*X(I)*NEND DOENDSUBROUTINE GUASS(A,B,N,X,JS)REAL(8) A(N,N),B(N),X(N),JS(N)REAL(8) T,DDO K=1,N-1D=0.0DO I=K,NDO J=K,NIF(ABS(A(I,J) D)THEND=ABS(A(I,J)JS(k)=J IS=I END IFEND DOEND DOIF (D = 0.0)THENWRITE(*,*) FAILSTOPELSEIF (IS /= K) THENDO J=K,NT=A(K,J)A(K,J)=A(IS,J)A(IS,J)=TEND DOT=B(K)B(K)=B(IS)B(IS)=TEND IFIF (JS(K) /= K) THENDO I=1,NT=A(I,K)A(I,K)=A(I,JS(K)A(I,JS(K)=TEND DOEND IFEND IFDO I=K+1,NA(I,K)=A(I,K)/A(K,K)END DODO I=K+1,NDO J=K+1,NA(I,J)=A(I,J)-A(I,K)*A(K,J)END DOB(I)=B(I)-A(I,K)*B(K)END DOEND DOX(N)=B(N)/A(N,N)DO I=N-1,1,-1T=0DO J=I+1