📄 程序.f90
字号:
B(2*I,2*J-1)=H21/XA(LL)
B(2*I,2*J)=H22/XA(LL)
50 CONTINUE
DO 52 I=1,6
FK(I)=0.0
52 CONTINUE
DO 55 I=1,3
J2=ME(I)
DO 55 J=1,2
J3=2*(I-1)+J
NN(J3)=JR(J,J2)
55 CONTINUE
DO 60 I=1,6
DO 60 J=1,6
NJ=NN(J)
IF (NJ.EQ.0) GOTO 60
FK(I)=FK(I)+B(I,J)*R(NJ)
60 CONTINUE
! WRITE(6,61) (FK(I),I=1,6)
! 61 FORMAT (25X,'FK**='//5X,3E16.6)
DO 65 I=1,3
J2=ME(I)
DO 65 J=1,2
K1=2*(I-1)+J
NJ=JR(J,J2)
IF (NJ.GT.0) RD(NJ,LL)=RD(NJ,LL)-FK(K1)
65 CONTINUE
10 CONTINUE
! WRITE(6,64) ((RD(I,J),J=1,NV),I=1,N)
! 64 FORMAT(25X,'RD********='//(5X,5E14.6))
DO 18 I=1,N
R1(I)=R(I)
18 CONTINUE
DO 70 I=1,NV
DO 75 J=1,N
R(J)=RD(J,I)
75 CONTINUE
CALL FOBA(SK,MA,NH,N)
DO 80 J=1,N
RD(J,I)=R(J)
80 CONTINUE
70 CONTINUE
! WRITE(6,71)((RD(I,J),J=1,NV),I=1,N)
! 71 FORMAT(25X,'RD*******J='//(5X,5E14.6))
IF(NI.LT.0) GOTO 444
CALL RI1(GY,AE,X,Y,MEO,RD,GA,A,SQ,AS,N,NP,NE,NM,NV)
GOTO 555
444 CALL RI2(GY,AE,X,Y,MEO,RD,GA,A,SQ,AS,N,NP,NE,NM,NV)
555 BB=0.0
DO 175 I=1,NV
BB=BB+YA(I)*YA(I)
175 CONTINUE
BB=SQRT(BB)
WRITE(6,177) BB
177 FORMAT(25X,'RELIABILITY-INDEX'/25X,'*****************'/25X, &
'BB=',F16.8)
WRITE(6,185) (XA(I),I=1,NV)
185 FORMAT(10X,'XXXXX'//(10X,5F13.4))
! IF (XA(1).LE.DH) GOTO 182
! XA(1)=DH
! WRITE(6,181) XA(1)
! 181 FORMAT(10X,'XA(1)=DH***',F15.5)
WRITE(6,190) (YA(I),I=1,NV)
190 FORMAT(10X,'YYYYY'//(10X,5F13.4))
WRITE(6,192) (GA(I),I=1,NV)
192 FORMAT(10X,'GGGAAA'//(10X,5F13.4))
WRITE(6,195) GY
195 FORMAT(20X,'GY=',F13.6)
RETURN
END
! ****************************************************************
SUBROUTINE RI1(GY,AE,X,Y,MEO,RD,GA,A,SQ,AS,KN,KP,KE,KM,KV)
DIMENSION AE(4,KM),X(KP),Y(KP),MEO(2,KE),RD(KN,KV),A(KV,KV), &
SQ(KV,KV),AS(KV,KV),RP(20),RE(20,6),S1(6,3),RS(20,3), &
DCG(3),RC(20),GA(KV),XA(20),YA(20),BI(3),CI(3),B1(3), &
RSS(20,3)
COMMON/CA/NP,NE,NM,NR,NI,NL,NG,ND,NC,NA,NN1,DH,NV,NS
COMMON/CC/N,NH,JR(2,800),R(1600)
COMMON/CB/EO,VO,W,T,S,H11,H12,H21,H22,ME(3),BI,CI,ER,TA1, &
TA2,NB,L
COMMON/CD/EE(20),SS(20),A1(6),XA,YA,JA(20),SD(20), &
ED(20),SP(20),EP(20),A2(6,50),KL1,KL2,CH(4),KL
! B1(1)=(CH(4)-CH(2))*(CH(4)-CH(3))/(CH(1)-CH(2))/(CH(1)-CH(3))
! B1(2)=(CH(4)-CH(1))*(CH(4)-CH(3))/(CH(2)-CH(1))/(CH(2)-CH(3))
! B1(3)=(CH(4)-CH(1))*(CH(4)-CH(2))/(CH(3)-CH(1))/(CH(3)-CH(2))
DO 20 I=1,NV
DO 20 J=1,3
RS(I,J)=0.0
20 CONTINUE
! DO 115 IE=KL1,KL2
! JJ=(IE-KL1)/2+1
! JJ=(IE-1)/2+1
! CALL DIV(IE,AE,X,Y,MEO,NM,NP,NE)
CALL DIV(2,AE,X,Y,MEO,NM,NP,NE)
DO 85 J1=1,NV
DO 90 I=1,3
J2=ME(I)
DO 90 K=1,2
K1=2*(I-1)+K
NJ=JR(K,J2)
IF(NJ.GT.0) GOTO 92
GOTO 94
92 RE(J1,K1)=RD(NJ,J1)
GOTO 90
94 RE(J1,K1)=0.0
90 CONTINUE
85 CONTINUE
WRITE(6,82)((RE(I,J),J=1,6),I=1,NV)
82 FORMAT(25X,'RE(I,J)*****='//(5X,5E14.6))
V1=VO/(1.0-VO)
V2=EO/(1.0-VO*VO)
A11=V2/2.0/S/(1.0-V1*V1)
A22=(1.0-V1)/2.0
DO 100 J=1,3
K1=2*J-1
K2=2*J
S1(K1,1)=A11*BI(J)
S1(K2,1)=A11*CI(J)*V1
S1(K1,2)=A11*BI(J)*V1
S1(K2,2)=A11*CI(J)
S1(K1,3)=A11*CI(J)*A22
S1(K2,3)=A11*BI(J)*A22
100 CONTINUE
WRITE(6,102)((S1(I,J),J=1,3),I=1,6)
102 FORMAT(25X,'S1********='//(5X,5E14.6))
DO 105 I=1,NV
DO 105 K=1,3
! RSS(I,K)=0.0
RS(I,K)=0.0
DO 110 J=1,6
! RSS(I,K)=RSS(I,K)+RE(I,J)*S1(J,K)
RS(I,K)=RS(I,K)+RE(I,J)*S1(J,K)
110 CONTINUE
105 CONTINUE
! LL=2*(L+1)
! J=IE-KL1+1
DO 125 I=1,3
! RSS(LL,I)=RSS(LL,I)+A2(I,J)/XA(LL)
RS(4,I)=RS(4,I)+A1(I)/XA(4)
125 CONTINUE
! DO 128 I=1,NV
! DO 128 J=1,3
! RS(I,J)=RS(I,J)+RSS(I,J)*B1(JJ)/2.0
! 128 CONTINUE
! 115 CONTINUE
WRITE(6,116)((RS(I,J),J=1,3),I=1,NV)
116 FORMAT(25X,'RS**='//(5X,5F12.4))
IF (NI.GT.0) GOTO 120
DCG(1)=0.5+(A1(1)-A1(2))/4/SQRT(((A1(1)-A1(2))/2)**2+A1(3)**2)
DCG(2)=0.5+(A1(2)-A1(1))/4/SQRT(((A1(1)-A1(2))/2)**2+A1(3)**2)
DCG(3)=A1(3)/SQRT(((A1(1)-A1(2))/2)**2+A1(3)**2)
GOTO 130
120 DCG(1)=0.5-(A1(1)-A1(2))/4/SQRT(((A1(1)-A1(2))/2)**2+A1(3)**2)
DCG(2)=0.5-(A1(2)-A1(1))/4/SQRT(((A1(1)-A1(2))/2)**2+A1(3)**2)
DCG(3)=-A1(3)/SQRT(((A1(1)-A1(2))/2)**2+A1(3)**2)
130 DO 145 I=1,NV
RC(I)=0.0
DO 150 J=1,3
RC(I)=RC(I)+RS(I,J)*DCG(J)
150 CONTINUE
145 CONTINUE
IF (NI.GT.0) GOTO 154
DO 155 I=1,NV
RC(I)=-RC(I)
155 CONTINUE
! RC(NV)=1.0+RC(NV)
RC(5)=1.0+RC(5)
GOTO 158
! 154 RC(NV)=RC(NV)+1.0
154 RC(5)=RC(5)+1.0
158 WRITE(6,156)(RC(I),I=1,NV)
156 FORMAT(2X,'PARSURE XX'/(5X,5F12.4))
GG=0.0
IF(NI.GT.0) GOTO 162
GY=XA(NV)-A1(4)
GOTO 161
! 162 GY=XA(NV)+A1(5)
162 GY=XA(5)+A1(5)
161 IF(NS.NE.0) GOTO 400
CALL RI3(GY,RC,GA)
GOTO 440
400 DO 160 I=1,NV
RC(I)=RC(I)*SP(I)
160 CONTINUE
DO 200 I=1,NV
DO 200 J=1,NV
AS(I,J)=0.0
AS(I,J)=SQRT(A(I,I))*SQ(J,I)
200 CONTINUE
DO 220 I=1,NV
RP(I)=0.0
220 CONTINUE
DO 300 I=1,NV
DO 300 J=1,NV
RP(I)=RP(I)+AS(I,J)*RC(J)
300 CONTINUE
WRITE(6,301)(RP(I),I=1,NV)
301 FORMAT(2X,'PARSURE ZZ'/(5X,5F12.4))
DO 330 I=1,NV
GG=GG+RP(I)*RP(I)
330 CONTINUE
GG=SQRT(GG)
DO 164 I=1,NV
GA(I)=-RP(I)/GG
YA(I)=SD(I)*YA(I)/SP(I)+(ED(I)-EP(I))/SP(I)
164 CONTINUE
WRITE(6,190) (YA(I),I=1,NV)
190 FORMAT(10X,'YYYYY'//(10X,5F13.4))
Y1=0.0
DO 165 I=1,NV
Y1=Y1+YA(I)*GA(I)
165 CONTINUE
Y1=Y1+GY/GG
DO 170 I=1,NV
YA(I)=GA(I)*Y1
170 CONTINUE
DO 350 I=1,NV
RC(I)=0.0
DO 350 J=1,NV
RC(I)=RC(I)+AS(J,I)*YA(J)
350 CONTINUE
DO 180 I=1,NV
XA(I)=RC(I)*SP(I)+EP(I)
180 CONTINUE
440 CONTINUE
RETURN
END
! ****************************************************************
SUBROUTINE RI2(GY,AE,X,Y,MEO,RD,GA,A,SQ,AS,KN,KP,KE,KM,KV)
DIMENSION AE(4,KM),X(KP),Y(KP),MEO(2,KE),RD(KN,KV),A(KV,KV), &
SQ(KV,KV),AS(KV,KV),RP(20),RE(20,6),S1(6,3),RS(20,3), &
RC(20),GA(KV),XA(20),YA(20),BI(3),CI(3)
COMMON/CA/NP,NE,NM,NR,NI,NL,NG,ND,NC,NA,NN1,DH,NV,NS
COMMON/CC/N,NH,JR(2,800),R(1600)
COMMON/CB/EO,VO,W,T,S,H11,H12,H21,H22,ME(3),BI,CI,ER,TA1, &
TA2,NB,L
COMMON/CD/EE(20),SS(20),A1(6),XA,YA,JA(20),SD(20), &
ED(20),SP(20),EP(20),A2(6,50),KL1,KL2
DO 240 I=1,NV
240 RC(I)=0.0
GY=0.0
NX=NV-2
DO 260 II=KL1,KL2,2
IQ=II-KL1+1
IF(A2(2,IQ)) 50,260,260
50 CALL DIV(II,AE,X,Y,MEO,NM,NP,NE)
DO 85 J1=1,NX
DO 90 I=1,3
J2=ME(I)
DO 90 K=1,2
K1=2*(I-1)+K
NJ=JR(K,J2)
IF(NJ.GT.0) GOTO 92
GOTO 94
92 RE(J1,K1)=RD(NJ,J1)
GOTO 90
94 RE(J1,K1)=0.0
90 CONTINUE
85 CONTINUE
! WRITE(6,82) II,((RE(I,J),J=1,6),I=1,NX)
! 82 FORMAT(20X,'II=',I3,5X,'RE(I,J)====='//(5X,5E14.6))
V1=VO/(1.0-VO)
V2=EO/(1.0-VO*VO)
A11=V2/2.0/S/(1.0-V1*V1)
A22=(1.0-V1)/2.0
DO 100 J=1,3
K1=2*J-1
K2=2*J
S1(K1,1)=A11*BI(J)
S1(K2,1)=A11*CI(J)*V1
S1(K1,2)=A11*BI(J)*V1
S1(K2,2)=A11*CI(J)
S1(K1,3)=A11*CI(J)*A22
S1(K2,3)=A11*BI(J)*A22
100 CONTINUE
! WRITE(6,102)((S1(I,J),J=1,3),I=1,6)
!102 FORMAT(25X,'S1************='//(5X,5F12.4))
DO 105 I=1,NX
DO 105 K=1,3
RS(I,K)=0.0
DO 110 J=1,6
RS(I,K)=RS(I,K)+RE(I,J)*S1(J,K)
110 CONTINUE
105 CONTINUE
LL=2*(L+1)
DO 115 I=1,3
RS(LL,I)=RS(LL,I)+A2(I,IQ)/XA(LL)
115 CONTINUE
! WRITE(6,116)((RS(I,J),J=1,3),I=1,NX)
!116 FORMAT(25X,'RS(I,J)=*****'//(5X,5F12.4))
CB=ABS(CI(1))
IF(NB.NE.2) GOTO 55
CB=ABS(CI(2))
55 DO 216 I=1,NX
RC(I)=RC(I)-CB*(XA(NX+1)*RS(I,2)+RS(I,3))
216 CONTINUE
RC(NX+1)=RC(NX+1)+ABS(A2(2,IQ))*CB
RC(NX+2)=RC(NX+2)+CB
GY=GY+CB*(XA(NX+1)*ABS(A2(2,IQ))+XA(NX+2)-A2(3,IQ))
! WRITE (6,266) (RC(I),I=1,NV)
!266 FORMAT(2X,'PARSURE XX'/(5X,6F11.4))
260 CONTINUE
IF(NS.NE.0) GOTO 122
CALL RI3(GY,RC,GA)
GOTO 550
122 DO 160 I=1,NV
160 RC(I)=RC(I)*SP(I)
DO 200 I=1,NV
DO 200 J=1,NV
AS(I,J)=0.0
AS(I,J)=SQRT(A(I,I))*SQ(J,I)
200 CONTINUE
DO 220 I=1,NV
RP(I)=0.0
220 CONTINUE
DO 300 I=1,NV
DO 300 J=1,NV
RP(I)=RP(I)+AS(I,J)*RC(J)
300 CONTINUE
! WRITE(6,262) (RP(I),I=1,NV)
!262 FORMAT(2X,'PARSURE ZZ'/(5X,6F11.4))
GG=0.0
DO 330 I=1,NV
GG=GG+RP(I)*RP(I)
330 CONTINUE
GG=SQRT(GG)
DO 164 I=1,NV
GA(I)=-RP(I)/GG
YA(I)=SD(I)*YA(I)/SP(I)+(ED(I)-EP(I))/SP(I)
164 CONTINUE
WRITE(6,190) (YA(I),I=1,NV)
190 FORMAT(10X,'YYYYY'//(10X,5F13.4))
Y1=0.0
DO 165 I=1,NV
Y1=Y1+YA(I)*GA(I)
165 CONTINUE
Y1=Y1+GY/GG
DO 170 I=1,NV
YA(I)=GA(I)*Y1
170 CONTINUE
DO 350 I=1,NV
RC(I)=0.0
DO 350 J=1,NV
RC(I)=RC(I)+AS(J,I)*YA(J)
350 CONTINUE
DO 180 I=1,NV
XA(I)=RC(I)*SP(I)+EP(I)
180 CONTINUE
550 CONTINUE
RETURN
END
! *****************************************************************
SUBROUTINE RI3(GY,RC,GA)
DIMENSION RC(20),GA(20),XA(20),YA(20)
COMMON/CA/NP,NE,NM,NR,NI,NL,NG,ND,NC,NA,NN1,DH,NV,NS
COMMON/CD/EE(20),SS(20),A1(6),XA,YA,JA(20),SD(20), &
ED(20),SP(20),EP(20)
GG=0.0
DO 160 I=1,NV
RC(I)=RC(I)*SP(I)
GG=GG+RC(I)**2
160 CONTINUE
GG=SQRT(GG)
DO 164 I=1,NV
GA(I)=-RC(I)/GG
YA(I)=SD(I)*YA(I)/SP(I)+(ED(I)-EP(I))/SP(I)
164 CONTINUE
WRITE(6,190)(YA(I),I=1,NV)
190 FORMAT(10X,'YYYYY'//(10X,5F13.4))
Y1=0.0
DO 165 I=1,NV
Y1=Y1+YA(I)*GA(I)
165 CONTINUE
Y1=Y1+GY/GG
DO 170 I=1,NV
YA(I)=GA(I)*Y1
170 CONTINUE
DO 180 I=1,NV
XA(I)=YA(I)*SP(I)+EP(I)
180 CONTINUE
RETURN
END
! *****************************************************************
SUBROUTINE COV(N1,A,SQ,EO)
DIMENSION A(N1,N1),SQ(N1,N1)
READ(5,*)((A(I,J),I=1,N1),J=1,N1)
WRITE(6,6)((A(I,J),I=1,N1),J=1,N1)
6 FORMAT(10X,'A(I,J)='/(5X,5F13.5))
DO 10 I=1,N1
DO 10 J=1,N1
SQ(I,J)=0.0
10 CONTINUE
DO 15 I=1,N1
SQ(I,I)=1.0
15 CONTINUE
G=0.0
DO 40 I=2,N1
I1=I-1
DO 40 J=1,I1
G=G+2.0*A(I,J)**2
40 CONTINUE
! WRITE(6,42) G
!42 FORMAT(5X,'G=',F13.5)
S1=SQRT(G)
FN=FLOAT(N1)
S2=EO*S1/FN
! WRITE (6,45) S2
S3=S1
!45 FORMAT (10X,'S2=',F13.5)
L=0
50 S3=S3/FN
! WRITE (6,55) S3
!55 FORMAT (10X,'S3=',F13.5)
60 DO 130 IQ=2,N1
IQ1=IQ-1
DO 130 IP=1,IQ1
IF(ABS(A(IP,IQ)).LT.S3) GOTO 130
L=1
V1=A(IP,IP)
V2=A(IP,IQ)
V3=A(IQ,IQ)
U=0.5*(V1-V3)
! WRITE(6,65) V1,V2,V3,U
!65 FORMAT(10X,'V1*V2*V3*U=',4F13.5)
IF(U) 70,80,90
70 B=-1.0
GOTO 100
90 B=1.0
100 G=-B*V2/SQRT(V2*V2+U*U)
GOTO 105
80 IF(V2.GT.S3) GOTO 85
G=1.0
GOTO 105
85 G=-1.0
105 ST=G/SQRT(2.0*(1.0+SQRT(1.0-G*G)))
CT=SQRT(1.0-ST*ST)
! WRITE(6,107) ST,CT
!107 FORMAT(10X,'ST*CT=',2F13.5)
DO 110 I=1,N1
G=A(I,IP)*CT-A(I,IQ)*ST
A(I,IQ)=A(I,IP)*ST+A(I,IQ)*CT
A(I,IP)=G
G=SQ(I,IP)*CT-SQ(I,IQ)*ST
SQ(I,IQ)=SQ(I,IP)*ST+SQ(I,IQ)*CT
SQ(I,IP)=G
110 CONTINUE
DO 120 I=1,N1
A(IP,I)=A(I,IP)
A(IQ,I)=A(I,IQ)
120 CONTINUE
G=2.0*V2*ST*CT
A(IP,IP)=V1*CT*CT+V3*ST*ST-G
A(IQ,IQ)=V1*ST*ST+V3*CT*CT+G
A(IP,IQ)=(V1-V3)*ST*CT+V2*(CT*CT-ST*ST)
A(IQ,IP)=A(IP,IQ)
130 CONTINUE
IF(L-1) 150,140,150
140 L=0
GOTO 60
150 WRITE(6,145)((A(I,J),I=1,N1),J=1,N1)
WRITE(6,142)((SQ(I,J),I=1,N1),J=1,N1)
142 FORMAT(20X,'SQ(I,J)='/(5X,5F13.5))
145 FORMAT(20X,'A(I,J)='/(5X,5F13.5))
IF(S3.GT.S2) GOTO 50
RETURN
END
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -