[Fortran] 纯文本查看 复制代码
SUBROUTINE BMATCH (SM,LAM,A1,A3,S,T,E,V,W,NN,LR,FLOAD,FAMP)
IMPLICIT REAL*8 (A-H,O-Z)
COMPLEX*16 SM(1),LAM(1),A1(1),A3(1),S(1),T(1),E(NN)
COMPLEX*16 V(NN,NN),W(NN,NN),C,CC,D,DD
COMPLEX*16 FLOAD(1),FAMP(1)
COMMON /LRCHK/ NCOMF
N1=NN-1
N2=NN-2
N3=NN-3
F=.5D0
DO 30 J=1,NN
C=E(J)*(0.0D0,1.0D0)
DO 30 I=1,NN
30 W(I,J)=V(I,J)*C
DO 60 J=1,NN
S(1)=A1(1)*W(1,J)+A3(1)*W(3,J)
S(2)=A1(2)*W(2,J)+A3(2)*W(4,J)
S(N1)=A1(N1)*W(N1,J)+A3(N3)*W(N3,J)
S(NN)=A1(NN)*W(NN,J)+A3(N2)*W(N2,J)
DO 50 I=3,N2
50 S(I)=A3(I-2)*W(I-2,J)+A1(I)*W(I,J)+A3(I)*W(I+2,J)
DO 60 I=1,NN
60 W(I,J)=S(I)
CALL INVERT (V,NN,NN,S,T,DET) 错误定位在这一行,说S的类型不对。
DO 80 I=1,NN
DO 70 J=I,NN
S(J)=(0.0D0,0.0D0)
DO 70 K=1,NN
70 S(J)=S(J)+W(I,K)*V(K,J)
DO 80 J=I,NN
80 W(I,J)=S(J)
CC=(0.0D0,0.0D0)
DD=(0.0D0,0.0D0)
M=0
DO 100 I=2,N2,2
K=I-1
M=M+1
C=F*LAM(M)
D=F*SM(M)
W(K,I)=W(K,I)+C-CC
W(K,K+3)=W(K,K+3)-C
W(I,I+1)=W(I,I+1)-D
CC=C
100 DD=D
W(N1,NN)=W(N1,NN)-CC+F*LAM(M+1)
DO 105 I=1,NN
DO 105 J=I,NN
105 W(J,I)=W(I,J)
L=0
DO 150 J=1,NN
DO 150 I=1,J
L=L+1
V(L,1)=W(I,J)
150 W(L,1)=V(L,1)
M=0
K=-2
DO 200 I=1,NN,2
K=K+4
L=M+1
M=L+K
N=L+1
DO 180 J=N,M,2
IF (NCOMF.EQ.0) GO TO 181
W(J,1)=-W(J,1)
GO TO 180
181 CONTINUE
V(J,1)=-V(J,1)
180 CONTINUE
200 CONTINUE
READ (24) (FAMP(LK),LK=1,NN)
IF (LR-2) 300,400,300
300 WRITE (23) M, (W(J,1),J=1,M)
CALL FVECT(NN,FLOAD,W,FAMP)
IF (LR .EQ. 3) GO TO 400
RETURN
400 WRITE (23) M, (V(J,1),J=1,M)
CALL FVECT(NN,FLOAD,V,FAMP)
RETURN
END