fortran常用程序演算法集
⑴ 求一個fortran主程序，用來計算矩陣方程AX+XB=C的。方程的演算法已經有了，是個子例行程序。
有一個叫做徐士良 Fortran常用演算法程序集的東西，裡面有很多編好的子程序，用不同的方式解矩陣方程的子程序也有，很好用，你可以參考。
⑵ 用fortran軟體編製程序，計算矩陣的行列式。要求使用子程序進行模塊化編程
求矩陣行列式是一個復雜的過程。有很多很多演算法來做，但是各有適用性。有的不適合病態矩陣等等。
以下是一個簡單的全選主元高斯消去法。
摘自徐世良的《Fortran常用演算法集》
Program Main
Implicit None
Real(8) :: rm(3,3) = reshape( (/1,2,4,5,7,3,13,5,7/) , (/3,3/) )
Real(8) :: rDet
call BSDet( rm , 3 , rDet )
write(*,*) rDet
End Program Main
SUBROUTINE BSDET(A,N,DET)
DIMENSION A(N,N)
DOUBLE PRECISION A,DET,F,D,Q
F=1.0
DET=1.0
DO 100 K=1,N-1
Q=0.0
DO 10 I=K,N
DO 10 J=K,N
IF (ABS(A(I,J)).GT.Q) THEN
Q=ABS(A(I,J))
IS=I
JS=J
END IF
10 CONTINUE
IF (Q+1.0.EQ.1.0) THEN
DET=0.0
RETURN
END IF
IF (IS.NE.K) THEN
F=-F
DO 20 J=K,N
D=A(K,J)
A(K,J)=A(IS,J)
A(IS,J)=D
20 CONTINUE
END IF
IF (JS.NE.K) THEN
F=-F
DO 30 I=K,N
D=A(I,JS)
A(I,JS)=A(I,K)
A(I,K)=D
30 CONTINUE
END IF
DET=DET*A(K,K)
DO 50 I=K+1,N
D=A(I,K)/A(K,K)
DO 40 J=K+1,N
40 A(I,J)=A(I,J)-D*A(K,J)
50 CONTINUE
100 CONTINUE
DET=F*DET*A(N,N)
RETURN
END
⑶ 求書~~~Visual Fortran 常用數值演算法集
http://www.toopoo.com/book/tushu/03-010217-7_mulu.html
電子數下載地址
http://download.csdn.net/source/393882
⑷ fortran中階乘演算法
http://www.fcode.cn/algorithm-50-1.html
我也不太理解，我是問的大神，論壇那有專門的講解，你看看吧
⑸ fortran 程序(應該是很簡單的小程序)
Fortran源自於「公式翻譯」（英語：FormulaTranslation）的縮寫，是一種編程語言。
它是世界上最早出現的計算機高級程序設計語言，廣泛應用於科學和工程計算領域。FORTRAN語言以其特有的功能在數值、科學和工程計算領域發揮著重要作用。
⑹ fortran語言矩陣求逆
! aa為原矩陣，b為存放aa的逆矩陣，n為矩陣aa的維數
subroutine nizhen(aa,b,n)
integer n,i,j,k
real:: aa(n,n),b(n,n),a(n,n)
a=aa
do i=1,n
b(i,i)=1
enddo
do i=1,n
b(i,:)=b(i,:)/a(i,i)
a(i,i:n)=a(i,i:n)/a(i,i)
do j=i+1,n
do k=1,n
b(j,k)=b(j,k)-b(i,k)*a(j,i)
enddo
a(j,i:n)=a(j,i:n)-a(i,i:n)*a(j,i)
enddo
enddo
do i=n,1,-1
do j=i-1,1,-1
do k=1,n
b(j,k)=b(j,k)-b(i,k)*a(j,i)
enddo
enddo
enddo
end
⑺ 用直接消去法解方程組的程序如何編寫(Fortran程序）
!高斯消去法
subroutine agaus(a,b,n,x,l,js)
dimension a(n,n),x(n),b(n),js(n)
double precision a,b,x,t
l=1 !邏輯變數
do k=1,n-1
d=0.0
do i=k,n
do j=k,n
if (abs(a(i,j))>d) then
d=abs(a(i,j))
js(k)=j
is=i
end if
end do
end do !把行絕對值最大的元素換到主元位置
if (d+1.0==1.0) then
l=0
else !最大元素為0無解
if(js(k)/=k) then
do i=1,n
t=a(i,k)
a(i,k)=a(i,js(k))
a(i,js(k))=t
end do !最大元素不在K行，K行
end if
if(is/=k) then
do j=k,n
t=a(k,j)
a(k,j)=a(is,j)
a(is,j)=t !交換到K列
end do
t=b(k)
b(k)=b(is)
b(is)=t
end if !最大元素在主對角線上
end if !消去
if (l==0) then
write(*,100)
return
end if
do j=k+1,n
a(k,j)=a(k,j)/a(k,k)
end do
b(k)=b(k)/a(k,k) !求三角矩陣
do i=k+1,n
do j=k+1,n
a(i,j)=a(i,j)-a(i,k)*a(k,j)
end do
b(i)=b(i)-a(i,k)*b(k)
end do
end do
if (abs(a(n,n))+1.0==1.0) then
l=0
write(*,100)
return
end if
x(n)=b(n)/a(n,n)
do i=n-1,1,-1
t=0.0
do j=i+1,n
t=t+a(i,j)*x(j)
end do
x(i)=b(i)-t
end do
100 format(1x,'fail')
js(n)=n
do k=n,1,-1
if (js(k)/=k) then
t=x(k)
x(k)=x(js(k))
x(js(k))=t
end if
end do
return
end
program main
dimension a(4,4),b(4),x(4),js(4)
double precision a,b,x
real m1,m2,j
open(1,file="laiyi.txt")
read(1,*)m1,m2,j
close(1)
n=4
print*,m1,m2,j
a(1,1)=m1*cos(3.14159*j/180)
a(1,2)=-m1
a(1,3)=-sin(3.14159*j/180)
a(1,4)=0
a(2,1)=m1*sin(3.14159*j/180)
a(2,2)=0
a(2,3)=cos(3.14159*j/180)
a(2,4)=0
a(3,1)=0
a(3,2)=m2
a(3,3)=-sin(3.14159*j/180)
a(3,4)=0
a(4,1)=0
a(4,2)=0
a(4,3)=-cos(3.14159*j/180)
a(4,4)=1
b(1)=0
b(2)=m1*9.8
b(3)=0
b(4)=m2*9.8
call agaus(a,b,n,x,l,js)
if (l/=0) then
write(*,*)"a1=",x(1),"a2=",x(2) ,"n1=",x(3),"n2=",x(4)
end if
end
!逆矩陣求解
SUBROUTINE qiuni(A,N,L,IS,JS)
DIMENSION A(N,N),IS(N),JS(N)
DOUBLE PRECISION A,T,D
L=1
DO K=1,N
D=0.0
DO I=K,N
DO J=K,N
IF(ABS(A(I,J)).GT.D) THEN !把最大的元素給D
D=ABS(A(I,J))
IS(K)=I
JS(K)=J
END IF
END DO
END DO
IF (D+1.0.EQ.1.0)THEN
L=0
WRITE(*,200)
RETURN
END IF
200 FORMAT(1X,'ERR**NOT INV')
DO J=1,N
T=A(K,J)
A(K,J)=A(IS(K),J)
A(IS(K),J)=T
END DO
DO I=1,N
T=A(I,K)
A(I,K)=A(I,JS(K))
A(I,JS(K))=T
END DO
A(K,K)=1/A(K,K)
DO J=1,N
IF(J.NE.K)THEN
A(K,J)=A(K,J)*A(K,K)
END IF
END DO
DO I=1,N
IF(I.NE.K)THEN
DO J=1,N
IF(J.NE.K)THEN
A(I,J)=A(I,J)-A(I,K)*A(K,J)
END IF
END DO
END IF
END DO
DO I=1,N
IF(I.NE.K)THEN
A(I,K)=-A(I,K)*A(K,K)
END IF
END DO
END DO
DO K=N,1,-1
DO J=1,N
T=A(K,J)
A(K,J)=A(JS(K),J)
A(JS(K),J)=T
END DO
DO I=1,N
T=A(I,K)
A(I,K)=A(I,IS(K))
A(I,IS(K))=T
END DO
END DO
RETURN
END
SUBROUTINE BRMUL(A,B,N,C)
DIMENSION A(N,N),B(N),C(N)
DOUBLE PRECISION A,B,C
DO I=1,N
DO J=1,N
C(I)=0.0
DO L=1,N
C(I)=C(I)+A(I,L)*B(L)
END DO
END DO
END DO
RETURN
END
program main
DIMENSION A(4,4),B(4,1),C(4,1),IS(4),JS(4)
DOUBLE PRECISION A,B,C
REAL M1,M2,JD
OPEN(1,FILE='LAIYI.TXT')
READ(1,*) M1,M2,JD
PRINT*,M1,M2,JD
CLOSE(1)
A(1,1)=M1*COS(3.14*JD/180)
A(1,2)=-M1
A(1,3)=-SIN(3.14*JD/180)
A(1,4)=0
A(2,1)=M1*SIN(3.14*JD/180)
A(2,2)=0
A(2,3)=COS(3.14*JD/180)
A(2,4)=0
A(3,1)=0
A(3,2)=M2
A(3,3)=-SIN(3.14*JD/180)
A(3,4)=0
A(4,1)=0
A(4,2)=0
A(4,3)=-COS(3.14*JD/180)
A(4,4)=1
B(1,1)=0
B(2,1)=M1*9.8
B(3,1)=0
B(4,1)=M2*9.8
CALL QIUNI(A,4,L,IS,JS)
CALL BRMUL(A,B,4,C)
WRITE(*,*) (C(I,1),I=1,4)
END
畫圖
USE MSFLIB
INTEGER status
TYPE(xycoord) xy
status=SETCOLORRGB(#FFFFFF)
status1=SETCOLORRGB(#0000FF)
OPEN(1,FILE="G.TXT")
READ(1,*) G1,G2,G3,G4
OPEN(2,FILE="N.TXT")
READ(2,*) N1,N2,N3,N4
CALL MOVETO(INT(20),INT(20),xy)
status=LINETO(INT(40),INT(G1))
status=LINETO(INT(80),INT(G2))
status=LINETO(INT(120),INT(G3))
status=LINETO(INT(160),INT(G4))
CALL SETLINESTYLE(#FF00)
CALL MOVETO(INT(20),INT(20),xy)
status1=LINETO(INT(40),INT(N1))
status1=LINETO(INT(80),INT(N2))
status1=LINETO(INT(120),INT(N3))
status1=LINETO(INT(160),INT(N4))
READ(*,*)
END
如果對您有幫助，請記得採納為滿意答案，謝謝！祝您生活愉快！
⑻ 求fortran實現FFT（快速傅里葉變換）程序。
徐士良的《fortran常用演算法程序集》中有fft代碼，直接可以用的那種
⑼ FORTRAN語言程序問題
#include? " iostream "
using ? namespace ?std;
class ?Matrix
{
private :
? double ** ?A;?????? // 矩陣A
? double ? * b;??????? // 向量b
public :
? int ?size;
?Matrix( int ?);
? ~ Matrix();
friend? double * ?Dooli(Matrix & ?);
? void ?Input();
? void ?Disp();
} ;
Matrix::Matrix( int ?x)
{
?size = x;
? // 為向量b分配空間並初始化為0
?b = new ? double ?[x];
? for ( int ?j = 0 ;j < x;j ++ )
??b[j] = 0 ;
? // 為向量A分配空間並初始化為0
?A = new ? double * ?[x];
? for ( int ?i = 0 ;i < x;i ++ )
??A[i] = new ? double ?[x];
? for ( int ?m = 0 ;m < x;m ++ )
?? for ( int ?n = 0 ;n < x;n ++ )
???A[m][n] = 0 ;
}
Matrix:: ~ Matrix()
{
????cout << " 正在析構中~~~~ " << endl;
????delete?b;
???? for ( int ?i = 0 ;i < size;i ++ )
????????delete?A[i];
????delete?A;
}
void ?Matrix::Disp()
{
? for ( int ?i = 0 ;i < size;i ++ )
? {
?? for ( int ?j = 0 ;j < size;j ++ )
???cout << A[i][j] << " ?? " ;
??cout << endl;
?}
}
void ?Matrix::Input()
{
?cout << " 請輸入A: " << endl;
? for ( int ?i = 0 ;i < size;i ++ )
?? for ( int ?j = 0 ;j < size;j ++ ) {
???cout << " 第 " << i + 1 << " 行 " << " 第 " << j + 1 << " 列: " << endl;
??cin >> A[i][j];
??}
???cout << " 請輸入b: " << endl;
? for ( int ?j = 0 ;j < size;j ++ ) {
??cout << " 第 " << j + 1 << " 個: " << endl;
???cin >> b[j];
?}
?
}
?
double * ?Dooli(Matrix & ?A)
{
? double ? * Xn = new ? double ?[A.size];
?Matrix?L(A.size),U(A.size);
? // 分別求得U，L的第一行與第一列
??? for ( int ?i = 0 ;i < A.size;i ++ )
??????U.A[ 0 ][i] = A.A[ 0 ][i];
??? for ( int ?j = 1 ;j < A.size;j ++ )
??????L.A[j][ 0 ] = A.A[j][ 0 ] / U.A[ 0 ][ 0 ];
// 分別求得U，L的第r行，第r列
????? double ?temp1 = 0 ,temp2 = 0 ;
? for ( int ?r = 1 ;r < A.size;r ++ ) {
????? // U
????? for ( int ?i = r;i < A.size;i ++ ) {
????????? for ( int ?k = 0 ;k < r - 1 ;k ++ )
????????????temp1 = temp1 + L.A[r][k] * U.A[k][i];?
????????????U.A[r][i] = A.A[r][i] - temp1;
?????}
????? // L
????? for ( int ?i = r + 1 ;i < A.size;i ++ ) {
?????????? for ( int ?k = 0 ;k < r - 1 ;k ++ )
????????????temp2 = temp2 + L.A[i][k] * U.A[k][r];
?????????????L.A[i][r] = (A.A[i][r] - temp2) / U.A[r][r];
?????}
?}
?cout << " 計算U得: " << endl;
?U.Disp();
?cout << " 計算L的: " << endl;
?L.Disp();
?
? double ? * Y = new ? double ?[A.size];
?Y[ 0 ] = A.b[ 0 ];
? for ( int ?i = 1 ;i < A.size;i ++ ?) {
????? double ?temp3 = 0 ;
????? for ( int ?k = 0 ;k < i - 1 ;k ++ )
?????????temp3 = temp3 + L.A[i][k] * Y[k];
?????Y[i] = A.b[i] - temp3;
?}
?Xn[A.size - 1 ] = Y[A.size - 1 ] / U.A[A.size - 1 ][A.size - 1 ];
? for ( int ?i = A.size - 1 ;i >= 0 ;i -- ) {
????? double ?temp4 = 0 ;
????? for ( int ?k = i + 1 ;k < A.size;k ++ )
?????????temp4 = temp4 + U.A[i][k] * Xn[k];
?????Xn[i] = (Y[i] - temp4) / U.A[i][i];
?}
?
return ?Xn;
}
?
int ?main()
{
?Matrix?B( 4 );
?B.Input();
? double ? * X;
?X = Dooli(B);
?cout << " ~~~~解得: " << endl;
? for ( int ?i = 0 ;i < B.size;i ++ )
?????cout << " X[ " << i << " ]: " << X[i] << " ? " ;
?cout << endl << " 呵呵呵呵呵 " ;
? return ? 0 ;
}
總結：
在VC2005下編譯通過的，VC6.0的
將高斯消去法改寫為緊湊形式，可以直接從矩陣 A 的元素的導計算 L ， U 元素的遞推公式，而不需任何中間步驟，一旦實現了矩陣 A 的 U ， L 分解那麼就等價於求解兩個三角形方程組。
? 注意： 編成語言中的數組以 』0』 為首元素，數組的一位偏移最容易出錯；
???????????? 注意變數的作用域；
⑽ 求FORTRAN程序設計的電子書，最好是權威出版社的，清晰版本
彭國倫《Fortran95程序設計》用於入門，學習基本的語法
徐士良_Fortran常用演算法程序集－第二版，用於具體的數值計算，可查詢常用的演算法
這兩本書的電子書和代碼都給你發網路消息了，請查閱。