📄 程序.f90
字号:
B3=Y(K2)-Y(K1)
R(K3)=R(K3)-(B2/6.0+B1/3.0)*B3
R(K4)=R(K4)-(B2/6.0+B1/3.0)*B3*TA2
R(K5)=R(K5)-(B1/6.0+B2/3.0)*B3
R(K6)=R(K6)-(B1/6.0+B2/3.0)*B3*TA2
GOTO 150
146 E1=XA(2)-Y(K1)
E2=X(K1)-X(K2)
IF(K4.EQ.0) GOTO 148
R(K4)=R(K4)-0.5*E1*E2
148 IF(K6.EQ.0) GOTO 150
R(K6)=R(K6)-0.5*E1*E2
GOTO 150
160 IF(NB.EQ.3) GOTO 150
! IK=ME(1)
! JK=ME(2)
! MK=JR(1,IK)
! NK=JR(1,JK)
! LK=JR(2,IK)
! KK=JR(2,JK)
! IF(XA(1).GE.Y(IK)) GOTO 170
! IF(XA(1).LT.Y(IK).AND.XA(1).GT.Y(JK)) GOTO 180
! GOTO 150
! 170 D1=XA(1)-Y(IK)
! D2=Y(IK)-Y(JK)
! D3=XA(1)-Y(JK)
! R(MK)=R(MK)+(D1/3.0+D3/6.0)*D2
! R(LK)=R(LK)-(D1/3.0+D3/6.0)*D2*TA1
! R(NK)=R(NK)+(D1/6.0+D3/3.0)*D2
! R(KK)=R(KK)-(D1/6.0+D3/3.0)*D2*TA1
! GOTO 150
! 180 D4=XA(1)-Y(JK)
! D5=Y(IK)-Y(JK)
! D6=D4*D4*D4
! D7=D4*D4*D5
! R(MK)=R(MK)+D6/6.0/D5
! R(LK)=R(LK)-D6*TA1/6.0/D5
! R(NK)=R(NK)+(3.0*D7-D6)/6.0/D5
! R(KK)=R(KK)-(3.0*D7-D6)*TA1/6.0/D5
150 CONTINUE
120 RETURN
END
! ******************************************************************
SUBROUTINE OUTPUT
DIMENSION JR(2,800),R(1600)
COMMON/CA/NP,NE,NM,NR,NI,NL,NG,ND,NC/CC/N,NH,JR,R
DO 100 I=1,NP
L=JR(1,I)
IF(L) 10,20,30
30 S=R(L)
GOTO 10
20 S=0.0
10 L=JR(2,I)
IF(L) 40,50,60
60 SS=R(L)
GOTO 40
50 SS=0.0
40 WRITE(6,75) I,S,SS
75 FORMAT(8X,I4,5X,F20.8,5X,F20.8)
100 CONTINUE
RETURN
END
! *****************************************************************
SUBROUTINE DECOMP(SK,MA,KH,KN)
DIMENSION SK(KH),MA(KN)
COMMON/CC/N,NH,JR(2,800),R(1600)
DO 130 I=2,N
L=MA(I-1)+I-MA(I)+1
K=I-1
DO 280 J=L,K
IF(J-L) 20,280,20
20 JP=MA(I)-I+J
M=MA(J-1)+J-MA(J)+1
IF(L.GT.M) M=L
MP=J-1
DO 230 IP=M,MP
JJ=MA(I)-I+IP
JK=MA(J)-J+IP
SK(JP)=SK(JP)-SK(JJ)*SK(JK)
230 CONTINUE
280 CONTINUE
DO 400 IP=L,K
JI=MA(I)-I+IP
JL=MA(IP)
SK(JI)=SK(JI)/SK(JL)
JN=MA(I)
SK(JN)=SK(JN)-SK(JI)*SK(JI)*SK(JL)
400 CONTINUE
130 CONTINUE
RETURN
END
! *****************************************************************
SUBROUTINE FOBA(SK,MA,KH,KN)
DIMENSION SK(KH),MA(KN),JR(2,800),R(1600)
COMMON/CC/N,NH,JR,R/CA/NP,NE,NM,NR,NI,NL,NG,ND,NC
DO 210 I=2,N
JJ=MA(I)
JK=I-1
JL=MA(JK)+I-JJ+1
DO 210 J=JL,JK
JP=MA(I)-I+J
R(I)=R(I)-SK(JP)*R(J)
210 CONTINUE
DO 220 I=1,N
JJ=MA(I)
R(I)=R(I)/SK(JJ)
220 CONTINUE
DO 230 J4=2,N
I=2+N-J4
JJ=MA(I-1)+I-MA(I)+1
M=MA(I)-I
JP=I-1
DO 240 J=JJ,JP
JM=J+M
R(J)=R(J)-SK(JM)*R(I)
240 CONTINUE
230 CONTINUE
RETURN
END
! ******************************************************************
SUBROUTINE CES(AE,X,Y,MEO,KM,KP,KE)
DIMENSION AE(4,KM),X(KP),Y(KP),MEO(2,KE),R(1600),JR(2,800), &
ME(3),BI(3),CI(3),B(6),CC(3)
COMMON/CA/NP,NE,NM,NR,NI,NL,NG,ND,NC
COMMON/CC/N,NH,JR,R/CB/EO,VO,W,T,S,H11,H12,H21,H22,ME,BI,CI, &
ER,TA1,TA2,NB,L
COMMON/CD/EE(20),SS(20),A1(6),XA(20),YA(20),JA(20),SD(20), &
ED(20),SP(20),EP(20),A2(6,50),KL1,KL2,CH(4),KL
DO 6 I=1,6
A1(I)=0.0
6 CONTINUE
DO 10 IE=1,NE
CALL DIV (IE,AE,X,Y,MEO,NM,NP,NE)
V1=VO/(1.0-VO)
V2=EO/(1.0-VO*VO)
ET=V2/(1.0-V1*V1)/S/2.0
DO 55 I=1,3
J2=ME(I)
I2=JR(1,J2)
I3=JR(2,J2)
IF(I2) 50,60,70
70 B(2*I-1)=R(I2)
GOTO 50
60 B(2*I-1)=0.0
50 IF(I3) 55,65,75
75 B(2*I)=R(I3)
GOTO 55
65 B(2*I)=0.0
55 CONTINUE
H1=0.0
H2=0.0
H3=0.0
DO 100 I=1,3
H1=H1+BI(I)*B(2*I-1)
H2=H2+CI(I)*B(2*I)
H3=H3+BI(I)*B(2*I)+CI(I)*B(2*I-1)
100 CONTINUE
AA1=ET*(H1+V1*H2)
A4=ET*(H2+V1*H1)
A3=ET*(1.0-V1)*H3/2.0
H1=AA1+A4
H2=SQRT((AA1-A4)*(AA1-A4)+4.0*A3*A3)
B(4)=(H1+H2)/2.0
B(5)=(H1-H2)/2.0
IF(ABS(A3).GT.1E-4) GOTO 400
B(6)=90.0
GOTO 450
400 B(6)=ATAN((B(4)-AA1)/A3)*57.29578
450 B(1)=AA1
B(2)=A4
B(3)=A3
IF (IE.EQ.2)GOTO 1001
GOTO 1002
1001 KL=IE
DO 1000 I=1,6
A1(I)=B(I)
1000 CONTINUE
! IF(IE.GE.KL1.AND.IE.LE.KL2) GOTO 220
! IF(IE.GE.KL1) GOTO 220
! GOTO 445
! 220 IQ=IE-KL1+1
! DO 230 I=1,6
! A2(I,IQ)=B(I)
! 230 CONTINUE
1002 WRITE(6,555)IE,(B(I),I=1,6)
555 FORMAT(4X,I4,2X,F8.3,2X,F8.3,2X,F8.3,3X,F10.4,2X,F10.4,2X,F8.3)
! 445 CONTINUE
10 CONTINUE
WRITE(6,999)KL,(A1(I),I=1,6)
999 FORMAT(4X,'KL=',I4,2X,F8.3,2X,F8.3,2X,F8.3,3X,F10.4,2X,F10.4, &
2X,F8.3)
! IF (NI.LT.0) GOTO 411
! C1=(CH(4)-CH(2))*(CH(4)-CH(3))/(CH(1)-CH(2))/(CH(1)-CH(3))
! C2=(CH(4)-CH(1))*(CH(4)-CH(3))/(CH(2)-CH(1))/(CH(2)-CH(3))
! C3=(CH(4)-CH(1))*(CH(4)-CH(2))/(CH(3)-CH(1))/(CH(3)-CH(2))
! DO 150 I=1,3
! DO 160 J=KL1,KL2,2
! P=J-KL1+1
! P=J-1+1
! L=P+1
! M=(J-KL1)/2+1
! CC(M)=(A2(I,P)+A2(I,L))/2.0
!160 CONTINUE
! A1(I)=C1*CC(1)+C2*CC(2)+C3*CC(3)
!150 CONTINUE
! C4=(A1(1)+A1(2))/2.0
! C5=(A1(1)-A1(2))/2.0
! A1(4)=C4+SQRT(C5*C5+A1(3)*A1(3))
! A1(5)=C4-SQRT(C5*C5+A1(3)*A1(3))
! WRITE(6,610) A1
!610 FORMAT(5X,'A1(I)**=',6(2X,F8.3))
!411 IP=KL2-KL1+1
! WRITE(6,421) ((A2(I,J),I=1,6),J=1,IP)
! 421 FORMAT(2X,'A2(KL1---KL2 STRESSES)'/(5X,6F12.4))
RETURN
END
! *****************************************************************
SUBROUTINE ERFAC (AE,X,Y,MEO,KM,KP,KE)
DIMENSION NCI(20),NCE(4,20),ME(3),BI(3),R(1600),JR(2,800), &
AE(4,KM),X(KP),Y(KP),MEO(2,KE),CI(3)
COMMON /CA/NP,NE,NM,NR,NI,NL,NG,ND,NC,NA,NN1
COMMON /CC/N,NH,JR,R
COMMON/CB/EO,VO,W,T,S,H11,H12,H21,H22,ME,BI,CI
READ(5,*) (NCI(J),J=1,NC)
READ (5,*) ((NCE(I,J),I=1,4),J=1,NC)
WRITE(6,35)(NCI(J),J=1,NC)
WRITE(6,45)((NCE(I,J),I=1,4),J=1,NC)
35 FORMAT(//30X,'NODN-NAME***NCI='//(10X,10I6))
45 FORMAT(//30X,'ELEMENT-NAME***NCE='//(10X,12I5))
WRITE(6,999)
999 FORMAT(//30X,'NODAL REACTIONS'//15X,'NODE',13X'X-COMP', &
13X'Y-COMP')
DO 20 JJ=1,NC
FX=0.0
FY=0.0
L=NCI(JJ)
DO 80 M=1,4
IF(NCE(M,JJ)) 80,80,70
70 IE=NCE(M,JJ)
CALL DIV(IE,AE,X,Y,MEO,NM,NP,NE)
DO 100 IM=1,3
K=IM
IF(L-ME(IM)) 100,110,100
100 CONTINUE
WRITE(6,555) L
555 FORMAT(//20X,'ERROR OF ELEMENT MESSAGE******NODE NUMBER',I5)
110 DO 400 IP=1,3
CALL KRS(BI(K),BI(IP),CI(K),CI(IP))
NL=ME(IP)
JI=JR(1,NL)
JP=JR(2,NL)
IF(JI) 210,210,220
210 S=0.0
GOTO 200
220 S=R(JI)
200 IF(JP) 310,310,320
310 SS=0.0
GOTO 300
320 SS=R(JP)
300 FX=FX+H11*S+H12*SS
FY=FY+H21*S+H22*SS
400 CONTINUE
80 CONTINUE
WRITE(6,444) L,FX,FY
444 FORMAT(14X,I6,10X,F12.4,10X,F12.4)
20 CONTINUE
RETURN
END
! ****************************************************************
SUBROUTINE KRS(BR,BS,CR,CS)
COMMON/CB/EO,VO,W,T,S,H11,H12,H21,H22,ME(3),BI(3),CI(3)
ET=EO*T*(1.0-VO)/4.0/S/(1.0+VO)/(1.0-2.0*VO)
V1=VO/(1.0-VO)
V2=(1.0-2.0*VO)/2.0/(1.0-VO)
H11=ET*(BR*BS+V2*CR*CS)
H12=ET*(V1*BR*CS+V2*BS*CR)
H21=ET*(V1*CR*BS+V2*BR*CS)
H22=ET*(CR*CS+V2*BR*BS)
RETURN
END
! ****************************************************************
SUBROUTINE TREAT(SK,MA,KH,KN)
DIMENSION SK(KH),MA(KN),R(1600),NDI(10),DV(2,10),JR(2,800)
COMMON/CA/NP,NE,NM,NR,NI,NL,NG,ND,NC
COMMON/CC/N,NH,JR,R
READ(5,*)(NDI(J),J=1,ND)
READ(5,*)((DV(I,J),I=1,2),J=1,ND)
WRITE(6,35)(NDI(J),J=1,ND)
WRITE(6,45)((DV(I,J),I=1,2),J=1,ND)
35 FORMAT(//25X,'NODE-NAME**NDI='//(10X,10I6))
45 FORMAT(//20X,'DISPLACEMENT-VALUES**DV'//(10X,6F10.4))
DO 120 I=1,ND
DO 120 J=1,2
IF(DV(I,J)) 70,120,70
70 JJ=NDI(I)
L=JR(J,JJ)
IF(L.EQ.0) GOTO 120
JN=MA(L)
SK(JN)=1E15
R(L)=DV(I,J)*1E15
120 CONTINUE
RETURN
END
! **************************************************************
SUBROUTINE RIC(GY,AE,X,Y,MEO,MA,SK,KH,KN,KP,KE,KM,RD,R1,KV, &
A,SQ,AS)
DIMENSION FM(6,20),RD(KN,KV),FK(6),R1(KN), &
YA(20),GA(20),A(KV,KV),SQ(KV,KV),AS(KV,KV), &
XA(20),AE(4,KM),X(KP),Y(KP),MEO(2,KE),BI(3), &
CI(3),B(6,6),NN(6),SK(KH),MA(KN)
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
DO 3 I=1,N
DO 3 J=1,NV
RD(I,J)=0.0
3 CONTINUE
DO 10 IE=1,NE
DO 5 I=1,6
DO 5 J=1,NV
FM(I,J)=0.0
5 CONTINUE
CALL DIV(IE,AE,X,Y,MEO,NM,NP,NE)
LL=2*L+1
FM(2,LL)=-S*T/3.0
FM(4,LL)=FM(2,LL)
FM(6,LL)=FM(2,LL)
J1=ME(1)
J2=ME(2)
Y1=Y(J1)
Y2=Y(J2)
X1=X(J1)
X2=X(J2)
NQ=NB-2
IF (NQ) 11,12,13
11 IF (XA(1).GT.Y1) GOTO 15
IF (XA(1).EQ.Y1) GOTO 38
IF (XA(1).LT.Y1.AND.XA(1).GT.Y2) GOTO 20
! GOTO 40
GOTO 13
15 IF(Y1.EQ.Y2) GOTO 35
! FM(1,1)=(Y1-Y2)/2.0
! FM(3,1)=(Y1-Y2)/2.0
FM(1,1)=(Y1-Y2)/2.0
FM(3,1)=(Y1-Y2)/2.0
FM(2,3)=-S*T/3.0
FM(4,3)=FM(2,3)
FM(6,3)=FM(2,3)
GOTO 40
! 35 FM(2,1)=(X2-X1)*0.5
! FM(4,1)=FM(2,1)
35 FM(2,1)=(X2-X1)*0.5
FM(4,1)=FM(2,1)
FM(2,6)=-S*T/3.0
FM(4,6)=FM(2,6)
FM(6,6)=FM(2,6)
GOTO 40
! 38 FM(1,1)=(Y1-Y2)/6.0
! FM(3,1)=(Y1-Y2)/3.0
38 FM(1,1)=(Y1-Y2)/6.0
FM(3,1)=(Y1-Y2)/3.0
FM(2,3)=-S*T/3.0
FM(4,3)=FM(2,3)
FM(6,3)=FM(2,3)
GOTO 40
! 20 FM(1,1)=3.*(XA(1)-Y2)**2/6./(Y1-Y2)
! FM(3,1)=(6.*(XA(1)-Y2)*(Y1-Y2)-3.*(XA(1)-Y2)**2)/6./(Y1-Y2)
20 FM(1,1)=3.*(XA(1)-Y2)**2/6./(Y1-Y2)
FM(3,1)=(6.*(XA(1)-Y2)*(Y1-Y2)-3.*(XA(1)-Y2)**2)/6./(Y1-Y2)
FM(2,3)=-S*T/3.0
FM(4,3)=FM(2,3)
FM(6,3)=FM(2,3)
GOTO 40
12 IF (XA(2).GT.Y2) GOTO 22
IF (XA(2).EQ.Y2) GOTO 26
IF (XA(2).LT.Y2.AND.XA(2).GT.Y1) GOTO 24
! GOTO 40
GOTO 13
22 IF (Y1.EQ.Y2) GOTO 23
! FM(1,2)=-(Y2-Y1)/2.0
! FM(2,2)=FM(1,2)*TA2
! FM(3,2)=FM(1,2)
! FM(4,2)=FM(2,2)
FM(1,2)=-(Y2-Y1)/2.0
FM(2,2)=FM(1,2)*TA2
FM(3,2)=FM(1,2)
FM(4,2)=FM(2,2)
FM(2,3)=-S*T/3.0
FM(4,3)=FM(2,3)
FM(6,3)=FM(2,3)
GOTO 40
! 23 FM(2,2)=0.5*(X2-X1)
! FM(4,2)=FM(2,2)
23 FM(2,2)=0.5*(X2-X1)
FM(4,2)=FM(2,2)
FM(2,6)=-S*T/3.0
FM(4,6)=FM(2,6)
FM(6,6)=FM(2,6)
GOTO 40
! 26 FM(1,2)=-(Y2-Y1)/3.0
! FM(2,2)=FM(1,2)*TA2
! FM(3,2)=-(Y2-Y1)/6.0
! FM(4,2)=FM(3,2)*TA2
26 FM(1,2)=-(Y2-Y1)/3.0
FM(2,2)=FM(1,2)*TA2
FM(3,2)=-(Y2-Y1)/6.0
FM(4,2)=FM(3,2)*TA2
FM(2,3)=-S*T/3.0
FM(4,3)=FM(2,3)
FM(6,3)=FM(2,3)
GOTO 40
! 24 FM(1,2)=-(6.*(XA(2)-Y1)*(Y2-Y1)-3.*(XA(2)-Y1)**2)/6./(Y2-Y1)
! FM(2,2)=-(6.*(XA(2)-Y1)*(Y2-Y1)-3.*(XA(2)-Y1)**2)*TA2/6./(Y2-Y1)
! FM(3,2)=-3.*(XA(2)-Y1)**2/6./(Y2-Y1)
! FM(4,2)=-3.*(XA(2)-Y1)**2*TA2/6./(Y2-Y1)
24 FM(1,2)=-(6.*(XA(2)-Y1)*(Y2-Y1)-3.*(XA(2)-Y1)**2)/6./(Y2-Y1)
FM(2,2)=-(6.*(XA(2)-Y1)*(Y2-Y1)-3.*(XA(2)-Y1)**2)*TA2/6./(Y2-Y1)
FM(3,2)=-3.*(XA(2)-Y1)**2/6./(Y2-Y1)
FM(4,2)=-3.*(XA(2)-Y1)**2*TA2/6./(Y2-Y1)
FM(2,3)=-S*T/3.0
FM(4,3)=FM(2,3)
FM(6,3)=FM(2,3)
GOTO 40
13 FM(2,3)=-S*T/3.0
FM(4,3)=FM(2,3)
FM(6,3)=FM(2,3)
IF(NB.EQ.3) GOTO 40
! IF(XA(1).GT.Y1) GOTO 19
! IF(XA(1).EQ.Y1) GOTO 21
! IF(XA(1).LT.Y1.AND.XA(1).GT.Y2) GOTO 33
! GOTO 40
! 19 FM(1,1)=0.5*(Y1-Y2)
! FM(2,1)=-FM(1,1)*TA1
! FM(2,1)=-FM(1,1)
! FM(3,1)=FM(1,1)
! FM(4,1)=FM(2,1)
! GOTO 40
! 21 FM(1,1)=(Y1-Y2)/6.
! FM(2,1)=-FM(1,1)*TA1
! FM(2,1)=-FM(1,1)
! FM(3,1)=FM(1,1)*2.
! FM(4,1)=FM(2,1)*2.
! GOTO 40
! 33 D8=XA(1)-Y2
! D9=Y1-Y2
! FM(1,1)=D8*D8/D9/2.
! FM(2,1)=-FM(1,1)*TA1
! FM(3,1)=(6.*D9*D8-3.*D8*D8)/D9/6.
! FM(4,1)=-FM(3,1)*TA1
40 CONTINUE
! WRITE(6,16)((FM(I,J),J=1,NV),I=1,6)
! 16 FORMAT(25X,'FM ********=='//(10X,5F12.4))
DO 45 K=1,NV
DO 45 I=1,3
J2=ME(I)
DO 45 J3=1,2
K1=2*(I-1)+J3
J4=JR(J3,J2)
IF (J4.GT.0) RD(J4,K)=RD(J4,K)+FM(K1,K)
45 CONTINUE
! LL=2*(L+1)
LL=3*(L-1)+4
DO 50 I=1,3
DO 50 J=1,3
CALL KRS(BI(I),BI(J),CI(I),CI(J))
B(2*I-1,2*J-1)=H11/XA(LL)
B(2*I-1,2*J)=H12/XA(LL)
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -