DIMENSION IJKE(3),EVD(4)
DIMENSION NEFLZ(15)
COMMON/MPG4/ IBC(540,3)
COMMON/KNO/ IJK(960)
COMMON/VEL/ EVDEV(4)
COMMON/SHA/ A(3),B(3),C(3),AREA,X1C,X2C
COMMON/HAR/ EHARD(7,7),ELOAD(7)
COMMON/FOR/ GHARD(1200,40),GLOAD(1200)
COMMON/SEL/ V1(540),V2(540),SIGMA(480)
COMMON/INT1/ X1(540),X2(540)
PI=3.1415926536
OPEN(1,STATUS=’UNKNOWN’,FILE=’INF2.DAT’)
READ(1,2001) NZ,IVY0,IVY1,IVYE,IVYH,ITER
READ(1,2003) V0,FMU0,DENS,DAV
READ(1,2001) (NEFLZ(L),L=1,NZ)
READ(1,2001) NFL,NEFL,NK,NE,N11,NQ,NU,MWB
nefll=nefl+1
REWIND 1
OPEN(2,STATUS=’UNKNOWN’,FILE=’IJK.DAT’)
READ(2,2002) (IJK(L),L=1,NE)
READ(2,2001) ((IBC(L,M),M=1,3),L=1,NK)
CLOSE (2)
OPEN(3,STATUS=’UNKNOWN’,FILE=’CRD.DAT’)
READ(3,2001) N11,NEFLL
READ(3,2003) (X1(L),L=1,NK)
READ(3,2003) (X2(L),L=1,NK)
CLOSE (3)
OPEN(7,STATUS=’UNKNOWN’,FILE=’INF3.DAT’)
READ(7,2001) LIMP0
REWIND 7
2001 FORMAT(19I4)
2002 FORMAT(6I12)
2003 FORMAT(6E13.7)
20033 FORMAT(8E10.3)
C ********* BBO„ ?CXO„HO‰ ?H”OPMA–?? ********
NX1=NFL+1
LIMP=LIMP0+ITER
C **************************************************
IF(ITER.GT.0) THEN
OPEN(15,STATUS=’UNKNOWN’,FILE=’PRES.DAT’)
READ(15,2001) NFL,NEFL
READ(15,2003) ((SIGMA(L),L=I,NQ,NEFL),I=1,NEFL)
REWIND 15
GOTO 4
END IF
ITER=0
4 ITER=ITER+1
WRITE(*,100) ITER
100 FORMAT(23X,’?TEPA–?? N’,I3)
21 CONTINUE
C ** ”OPM?POBAH?E MATP?–› C?CTEM› “PABHEH?‰ ? ˜PABO‰ —ACT? **
DO 13 L1=1,NU
GLOAD(L1)=0.
DO 13 L2=1,MWB
GHARD(L1,L2)=0.
13 CONTINUE
PI=3.14159265
IF(IVYE.EQ.0) THEN
DO L=1,NX1
V2(L)=-V0*SQRT((L-1.)/NFL)
END DO
END IF
N1=NK/NX1
IF(IVYH.EQ.0) THEN
DO L1=1,N1
V2(L1*NX1)=-V0
END DO
END IF
DO L5=1,NFL
I=IBC(L5,2)
J=IBC(L5+1,2)
EF=DAV*(X1(L5+1)-X1(L5))/2.
IF(I.GT.0) GLOAD(I)=GLOAD(I)-EF
IF(J.GT.0) GLOAD(J)=GLOAD(J)-EF
END DO
402 DO 11 L1=1,NFL
NN=NEFL*(L1-1)
DO 11 L2=1,2
NFLC2=2*(L1-1)+L2
DO 20 L3=1,NEFL
NEC=NEFL*(NFLC2-1)+L3
NQC=NN+L3
CALL NODES(I,J,K,NEC)
IJKE(1)=I
IJKE(2)=J
IJKE(3)=K
CALL SHAPE1(X1(I),X1(J),X1(K),X2(I),X2(J),X2(K))
IF(ITER.EQ.1) THEN
CALL HARDA2(FMU0,DENS,0.,0.,0.,0.,0.,0.)
ELSE
CALL HARDA2(FMU0,DENS,V1(I),V1(J),V1(K),V2(I),V2(J),V2(K))
END IF
CALL FORM1(L2,NQC,IJKE,MWB)
20 CONTINUE
11 CONTINUE
C ******* PE?EH?E C?CTEM› “PABHEH?‰ ***********
CALL MID1(NU,MWB)
C ******* O˜PA˜OTKA PE‡“‹?TATOB *************
CALL SELECT(NK,NFL,NEFL,DV1,DV2)
C****************************************************************
IF(ITER.GE.LIMP) THEN
WRITE(*,*)
WRITE(*,*) ‘˜˜?‚…„…H?’,LIMP,’ ?’…˜?–?‰. ˜˜?„?‹†?’? ˜?‘—…’ ?’
WRITE(*,*) ‘„A – ccY¤?aY c?a«® ¤®?®«?aY«iea ?aYa ae?©, HET – ¦
*¬?aY ENTER ‘
READ(*,2001) NDOP
IF(NDOP.EQ.0) GO TO 12
LIMP=LIMP+NDOP
END IF
GO TO 4
C ********* B›BO„ PE‡“‹?TATOB ***************
12 CONTINUE
DO 24 L=1,NK
V2(L)=-V2(L)
24 X2(L)=-X2(L)
WRITE(1,2001) NZ,IVY0,IVY1,IVYE,IVYH,ITER
WRITE(1,2003) V0,FMU0,DENS,DAV
WRITE(1,2001) (NEFLZ(L),L=1,NZ)
WRITE(1,2001) NFL,NEFL,NK,NE,N11,NQ,NU,MWB
CLOSE (1)
WRITE(7,2001) LIMP0
CLOSE (7)
OPEN(14,STATUS=’UNKNOWN’,FILE=’VEL.DAT’)
WRITE(14,2001) N11,NEFLL
WRITE(14,2003) (V1(L),L=1,NK)
WRITE(14,2003) (V2(L),L=1,NK)
CLOSE (14)
OPEN(15,STATUS=’UNKNOWN’,FILE=’PRES.DAT’)
WRITE(15,2001) NFL,NEFL
WRITE(15,2003) ((SIGMA(L),L=I,NQ,NEFL),I=1,NEFL)
CLOSE (15)
OPEN(15,STATUS=’UNKNOWN’,FILE=’PRESSURE.DAT’)
DO I=1,NEFL
DO L=I,NQ,NEFL
WRITE(15,2009) SIGMA(L)
END DO
END DO
CLOSE (15)
OPEN(14,STATUS=’UNKNOWN’,FILE=’COORD_X.DAT’)
DO L=1,NK
WRITE(14,2005) X2(L)
END DO
CLOSE (14)
OPEN(14,STATUS=’UNKNOWN’,FILE=’VELOS_X.DAT’)
DO L=1,NK
WRITE(14,2005) V2(L)
END DO
CLOSE (14)
OPEN(14,STATUS=’UNKNOWN’,FILE=’COORD_Y.DAT’)
DO L=1,NK
WRITE(14,2005) X1(L)
END DO
CLOSE (14)
OPEN(14,STATUS=’UNKNOWN’,FILE=’VELOS_Y.DAT’)
DO L=1,NK
WRITE(14,2005) V1(L)
END DO
CLOSE (14)
OPEN(2,STATUS=’UNKNOWN’,FILE=’RESULT.DAT’)
WRITE(2,3110)
WRITE(2,3100)
WRITE(2,3110)
3100 FORMAT(21(‘*’),’ ?CXO„H›E „AHH›E ‘,21(‘*’))
3110 FORMAT(1X,78(‘*’))
WRITE(2,3115)
3115 FORMAT(//7X,15(‘*’),’˜APAMETP› CETK?’,15(‘*’))
WRITE(2,3130) NZ,NFL,NEFL,NK,NE
3130 FORMAT(//5X,’—?C‹O ‡OH’,26(‘.’),
1I2/5X,’—?C‹O ?˜ ˜? ‚›‘?’………………..’,
2I2/5X,’—?C‹O K˜ ˜? „‹?H…………………’,
3I2/5X,’—?C‹O “‡‹OB…………………..’,
4I3/5X,’—?C‹O ˜‹EMEHTOB……………….’,I3)
3311 FORMAT(5X,’CKOPOCT? ‘,21X,F13.4,’ ¬/aY?’/
*5X,’B?‡KOCT? ‘,21X,F13.4,’ ˜ *aY? ‘/
*5X,’˜‹?’H?‘’?’,21X,F13.4,’ ?F/¬3’//)
WRITE(2,290)
WRITE(2,2081) (X1(L),L=1,NK)
WRITE(2,291)
WRITE(2,2081) (X2(L),L=1,NK)
2080 FORMAT(11(1X,F6.3))
2082 FORMAT(11F7.2)
2081 FORMAT(11(1X,F6.1))
121 FORMAT(///29X,’***˜O‹E CKOPOCTE‰ VY***’/)
1210 FORMAT(///29X,’***˜O‹E CKOPOCTE‰ VX***’/)
1211 FORMAT(//29X,’***„AB‹EH?E ***’/)
290 FORMAT(//29X,’***KOOP„?HAT› Y “‡‹OB***’/)
291 FORMAT(//29X,’***KOOP„?HAT› X “‡‹OB***’/)
WRITE(2,121)
WRITE(2,2080) (V1(L),L=1,NK)
WRITE(2,1210)
WRITE(2,2082) (V2(L),L=1,NK)
WRITE(2,1211)
WRITE(2,2009) ((SIGMA(L),L=I,NQ,NEFL),I=1,NEFL)
2005 FORMAT(F10.4)
2009 FORMAT(5F15.12)
113 STOP
END
C *************************************************
SUBROUTINE HARDA2(FEP,DENS,VX1,VX2,VX3,VY1,VY2,VY3)
COMMON/SHA/ A(3),B(3),C(3),AREA,RC,ZC
COMMON/HAR/ EHARD(7,7),ELOAD(7)
A2=FEP/AREA/2.
DO 2 L1=1,3
M=L1*2
DO 2 L2=L1,3
N=L2*2
EHARD(M-1,N-1)=(B(L1)*B(L2)+0.5*C(L1)*C(L2))*A2
EHARD(M-1,N)=0.5*C(L1)*B(L2)*A2
EHARD(M,N-1)=0.5*B(L1)*C(L2)*A2
2 EHARD(M,N)=(C(L1)*C(L2)+0.5*B(L1)*B(L2))*A2
DO 3 L1=1,3
M=L1*2
EHARD(M-1,7)=B(L1)/2.
3 EHARD(M,7)=C(L1)/2.
EHARD(7,7)=0.
DO 4 L1=1,7
4 ELOAD(L1)=0.
VXX=B(1)*VX1+B(2)*VX2+B(3)*VX3
VYX=B(1)*VY1+B(2)*VY2+B(3)*VY3
VXY=C(1)*VX1+C(2)*VX2+C(3)*VX3
VYY=C(1)*VY1+C(2)*VY2+C(3)*VY3
VVX1=VX1*VXX+VY1*VXY
VVX2=VX2*VXX+VY2*VXY
VVX3=VX3*VXX+VY3*VXY
VVY1=VX1*VYX+VY1*VYY
VVY2=VX2*VYX+VY2*VYY
VVY3=VX3*VYX+VY3*VYY
ELOAD(1)=-DENS/24*(2.*VVX1+VVX2+VVX3)
ELOAD(2)=-DENS/24*(2.*VVY1+VVY2+VVY3)
ELOAD(3)=-DENS/24*(VVX1+2.*VVX2+VVX3)
ELOAD(4)=-DENS/24*(VVY1+2.*VVY2+VVY3)
ELOAD(5)=-DENS/24*(VVX1+VVX2+2.*VVX3)
ELOAD(6)=-DENS/24*(VVY1+VVY2+2.*VVY3)
5 CONTINUE
RETURN
END
C ****************************************************************
SUBROUTINE FORM1(L2,NQ,IJKE,MWB)
COMMON/MPG4/ IBC(540,3)
COMMON/HAR/ EHARD(7,7),ELOAD(7)
COMMON/FOR/ GHARD(1200,40),GLOAD(1200)
COMMON/SEL/ V1(540),V2(540),P(480)
DIMENSION NGU(7),VU(7),IJKE(3)
DO 1 I=1,3
NV=IJKE(I)
NGU(2*I-1)=IBC(NV,1)
NGU(2*I)=IBC(NV,2)
VU(2*I-1)=V1(NV)
1 VU(2*I)=V2(NV)
K=IJKE(3)
IF(L2.EQ.2) K=IJKE(2)
NGU(7)=IBC(K,3)
VU(7)=P(NQ)
DO 3 I=1,7
NL1=NGU(I)
IF(NL1.GT.0) GLOAD(NL1)=GLOAD(NL1)+ELOAD(I)
IF(NL1.EQ.0) GO TO 3
DO 2 J=I,7
NL2=NGU(J)
IF(NL2.EQ.0) GO TO 2
IF(NL1) 5,6,6
6 IF(NL2) 7,8,8
7 GLOAD(NL1)=GLOAD(NL1)-EHARD(I,J)*VU(J)
GO TO 2
8 IF(NL1.GT.NL2) GO TO 9
NS=NL2
NR=MWB+NL1-NL2
GO TO 10
9 NS=NL1
NR=MWB+NL2-NL1
10 GHARD(NS,NR)=GHARD(NS,NR)+EHARD(I,J)
GO TO 2
5 IF(NL2.GT.0) GLOAD(NL2)=GLOAD(NL2)-EHARD(I,J)*VU(I)
2 CONTINUE
3 CONTINUE
RETURN
END
C ******************************************************************
SUBROUTINE SELECT(NK,NFL,NEFL,DV1,DV2)
COMMON/MPG4/ IBC(540,3)
COMMON/FOR/ GHARD(1200,40),GLOAD(1200)
COMMON/SEL/ V1(540),V2(540),SIGMA(480)
DV1=0.
DV2=0.
DO 1 L1=1,NK
IF(IBC(L1,1)) 3,3,2
2 AV=GLOAD(IBC(L1,1))
D=ABS(V1(L1)-AV)
IF(D.GT.DV1) DV1=D
V1(L1)=AV
3 IF(IBC(L1,2)) 1,1,4
4 AV=GLOAD(IBC(L1,2))
D=ABS(V2(L1)-AV)
IF(D.GT.DV2) DV2=D
V2(L1)=AV
1 CONTINUE
NX1=NFL+1
DO 5 L1=1,NFL
N=NEFL*(L1-1)
NKC=L1+1
DO 5 L2=1,NEFL
NQC=N+L2
NKC=NKC+NX1
5 SIGMA(NQC)=GLOAD(IBC(NKC,3))
RETURN
END
C ************************************************************
SUBROUTINE NODES(I,J,K,NEC)
COMMON/KNO/ IJK(960)
NOD=IJK(NEC)
I=NOD/1000000
J=NOD/1000-I*1000
K=NOD-I*1000000-J*1000
RETURN
END
C ***************************************************
SUBROUTINE MID1(N,ML)
COMMON/FOR/ A(1200,40),B(1200)
DOUBLE PRECISION X,AX,A1
A(1,ML)=1./A(1,ML)
ML1=ML-1
X=-A(2,ML1)*A(1,ML)
A(2,ML)=1./(A(2,ML)+A(2,ML1)*X)
A(2,ML1)=X
DO 9 I=3,ML1
II=I-1
MLI=ML-I
DO 3 J=2,II
JJ=J-1
MLJ=ML-J
J2=MLI+J
AX=0.
DO 10 K=1,JJ
A1=A(J,MLJ+K)
10 AX=AX+A1*A(I,MLI+K)
3 A(I,J2)=A(I,J2)+AX
AX=0.
DO 4 J=1,II
J2=MLI+J
X=-A(I,J2)*A(J,ML)
AX=AX+X*A(I,J2)
4 A(I,J2)=X
9 A(I,ML)=1./(A(I,ML)+AX)
DO 1 I=ML,N
MLI=I-ML
DO 2 J=2,ML1
J2=MLI+J
MLJ=ML-J
JJ=J-1
AX=0.
DO 11 K=1,JJ
A1=A(J2,MLJ+K)
11 AX=AX+A1*A(I,K)
2 A(I,J)=A(I,J)+AX
AX=0.
DO 5 J=1,ML1
X=-A(I,J)*A(MLI+J,ML)
AX=AX+X*A(I,J)
5 A(I,J)=X
1 A(I,ML)=1./(A(I,ML)+AX)
DO 15 I=2,ML1
II=I-1
MLI=ML-I
AX=0.
DO 12 J=1,II
A1=A(I,MLI+J)
12 AX=AX+A1*B(J)
15 B(I)=B(I)+AX
DO 6 I=ML,N
MLI=I-ML
AX=0.
DO 13 J=1,ML1
A1=B(MLI+J)
13 AX=AX+A(I,J)*A1
6 B(I)=B(I)+AX
B(N)=B(N)*A(N,ML)
ML2=ML-2
DO 7 I=1,ML2
II=N-I
B(II)=B(II)*A(II,ML)
AX=0.
DO 14 J=1,I
JJ=II+J
A1=A(JJ,ML-J)
14 AX=AX+A1*B(JJ)
7 B(II)=B(II)+AX
N1=N-1
DO 8 I=ML1,N1
II=N-I
B(II)=B(II)*A(II,ML)
MLI=ML+II
AX=0.
DO 16 J=1,ML1
JJ=MLI-J
A1=A(JJ,J)
16 AX=AX+A1*B(JJ)
8 B(II)=B(II)+AX
RETURN
END
C ***************************************************
SUBROUTINE SHAPE1(X1I,X1J,X1K,X2I,X2J,X2K)
COMMON/SHA/ A(3),B(3),C(3),AREA,X1C,X2C
A(1)=X1J*X2K-X1K*X2J
A(2)=X1K*X2I-X1I*X2K
A(3)=X1I*X2J-X1J*X2I
B(1)=X2J-X2K
B(2)=X2K-X2I
B(3)=X2I-X2J
C(1)=X1K-X1J
C(2)=X1I-X1K
C(3)=X1J-X1I
AREA=(X1I*B(1)+X1J*B(2)+X1K*B(3))/2.
AREA=ABS(AREA)
X1C=(X1I+X1J+X1K)/3.
X2C=(X2I+X2J+X2K)/3.
RETURN
END
C ***************************************************
Нашли опечатку? Выделите и нажмите CTRL+Enter
