弹流润滑数值计算程序迭代失败 ！！求助！！

小戈

如题，程序出自《弹性流体动压润滑方法与程序》，运行失败，程序如下。求助出错原因

[Fortran] 纯文本查看 复制代码

        PROGRAM LINEEHL
                COMMON /COM1/ENDA,A1,A2,A3,Z,HM0,DH/COM2/EDA0/COM4/X0,XE/COM3/E1,PH,B,R
                DATA PAI,Z,P0/3.14159265,0.68,1.96E8/
                DATA N,X0,XE,W,E1,EDA0,R,Us/130,-4.0,1.5,1.0E5,2.2E11,0.05,0.05,1.5/
                OPEN(8,FILE='OUT.DAT',STATUS='UNKNOWN')
                W1=W/(E1*R)
                PH=E1*SQRT(0.5*W1/PAI)
                A1=(ALOG(EDA0)+9.67)
                A2=PH/P0
                A3=0.59/(PH*1.E-9)
                B=4.*R*PH/E1
                ALFA=Z*A1/P0
                G=ALFA*E1
                U=EDA0*US/(2.*E1*R)
                CC1=SQRT(2.*U)
                AM=2.*PAI*(PH/E1)**2/CC1
                ENDA=3.*(PAI/AM)**2/8.
                HM0=1.6*(R/B)**2*G**0.6*U**0.7*W1**(-0.13) 
                WRITE(*,*)N,X0,XE,W,E1,EDA0,R,US
                CALL SUBAK(N)
                CALL EHL(N)
                STOP
                END
                SUBROUTINE EHL(N)
                DIMENSION X(1100),P(1100),H(1100),RO(1100),POLD(1100),EPS(1100),EDA(1100),V(1100)
                COMMON /COM1/ENDA,A1,A2,A3,Z,HM0,DH/COM4/X0,XE
                COMMON /COM3/E1,PH,B,RR
                MK=1
                DX=(XE-X0)/(N-1.0)
                DO 10 I=1,N
                X(I)=X0+(I-1)*DX
                IF(ABS(X(I)).GE.1.0)P(I)=0.0
                IF(ABS(X(I)).LT.1.0)P(I)=SQRT(1.-X(I)*X(I))
10      CONTINUE
                CALL HREE(N,DX,X,P,H,RO,EPS,EDA,V)
                CALL FZ(N,P,POLD)
14                KK=19
                CALL ITER(N,KK,DX,X,P,H,RO,EPS,EDA,V)
                MK=MK+1
                CALL ERROP(N,P,POLD,ERP)
                WRITE(*,*)'ERP=',ERP
                IF(ERP.GT.1.E-5.AND.DH.GT.1.E-7)THEN
                IF(MK.GE.50)THEN
                MK=1
                DH=0.5*DH
                ENDIF
                GOTO 14
                ENDIF
                IF(DH.LE.1.E-7)WRITE(*,*)'Pressures are not convergent!!!'
                 H2=1.E3
                P2=0.0
                DO 106 I=1,N
                IF(H(I).LT.H2)H2=H(I)
                IF(P(I).GT.P2)P2=P(I)
106     CONTINUE
                H3=H2*B*B/RR
                P3=P2*PH
110                FORMAT(6(1X,E12.6))
120                CONTINUE
                WRITE(*,*)'P2,H2,P3,H3=',P2,H2,P3,H3
                CALL OUTHP(N,X,P,H)
                RETURN
                END
                SUBROUTINE OUTHP(N,X,P,H)
                DIMENSION X(N),P(N),H(N)
                DO 10 I=1,N
                WRITE(8,20)X(I),P(I),H(I)
10      CONTINUE
20      FORMAT(1X,6(E12.6,1X))
                RETURN
                END
                SUBROUTINE HREE(N,DX,X,P,H,RO,EPS,EDA,V)
                DIMENSION X(N),P(N),H(N),RO(N),EPS(N),EDA(N),V(N)
                COMMON /COM1/ENDA,A1,A2,A3,Z,HM0,DH/COM2/EDA0/COMAK/AK(0:1100)
                DATA KK,PAI1,G0/0,0.318309886,1.570796325/
                IF(KK.NE.0)GOTO 3
                H00=0.0
3                W1=0.0
                DO 4 I=1,N
4       W1=W1+P(I)
                C3=(DX*W1)/G0
                DW=1.-C3
                CALL VI(N,DX,P,V)
                HMIN=1.E3
                DO 30 I=1,N
                H0=0.5*X(I)*X(I)+V(I)
                IF(H0.LT.HMIN)HMIN=H0
                H(I)=H0
30                CONTINUE
                IF(KK.NE.0)GOTO 32
                KK=1
                DH=0.005*HM0
                H00=-HMIN+HM0
32                IF(DW.LT.0.0)H00=H00+DH
                IF(DW.GT.0.0)H00=H00-DH
                DO 60 I=1,N
                H(I)=H00+H(I)
                EDA(I)=EXP(A1*(-1.+(1.+A2*P(I))**Z))
                RO(I)=(A3+1.35*P(I))/(A3+P(I))
                EPS(I)=RO(I)*H(I)**3/(ENDA*EDA(I))
60                CONTINUE
                RETURN
                END
                SUBROUTINE ITER(N,KK,DX,X,P,H,RO,EPS,EDA,V)
                DIMENSION X(N),P(N),H(N),RO(N),EPS(N),EDA(N),V(N)
                COMMON /COMAK/AK(0:1100)
                DATA PAI1/0.318309886/
                DO 100 K=1,KK
                D2=0.5*(EPS(1)+EPS(2))
                D3=0.5*(EPS(2)+EPS(3))
                DO 70 I=2,N-1
                D1=D2
                D2=D3
                IF(I.NE.N-1)D3=0.5*(EPS(I+1)+EPS(I+2))
                D8=RO(I)*AK(0)*PAI1
                D9=RO(I-1)*AK(1)*PAI1
                D10=1.0/(D1+D2+(D9-D8)*DX)
                D11=D1*P(I-1)+D2*P(I+1)
                D12=(RO(I)*H(I)-RO(I-1)*H(I-1)+(D8-D9)*P(I))*DX
                P(I)=(D11-D12)*D10
                IF(P(I).LT.0.0)P(I)=0.0
70      CONTINUE
                CALL HREE(N,DX,X,P,H,RO,EPS,EDA,V)
100     CONTINUE
                RETURN
                END
                SUBROUTINE VI(N,DX,P,V)
                DIMENSION P(N),V(N)
                COMMON /COMAK/AK(0:1100)
                PAI1=0.318309886
                C=ALOG(DX)
                DO 10 I=1,N
                V(I)=0.0
                DO 10 J=1,N
                IJ=IABS(I-J)
10                V(I)=V(I)+(AK(IJ)+C)*DX*P(J)
                DO I=1,N
                V(I)=-PAI1*V(I)
                ENDDO
                RETURN
                END

                SUBROUTINE SUBAK(MM)
                COMMON /COMAK/AK(0:1100)
                DO 10 I=0,MM
10      AK(I)=(I+0.5)*(ALOG(ABS(I+0.5))-1.)-(I-0.5)*(ALOG(ABS(I-0.5))-1.)
                RETURN
                END

                SUBROUTINE FZ(N,P,POLD)
                DIMENSION P(N),POLD(N)
                DO 10 I=1,N
10      POLD(I)=P(I)
                RETURN
                END

                SUBROUTINE ERROP(N,P,POLD,ERP)
                DIMENSION P(N),POLD(N)
                SD=0.0
                SUM=0.0
                DO 10 I=1,N
                SD=SD+ABS(P(I)-POLD(I))
                POLD(I)=P(I)
10      SUM=SUM+P(I)
                ERP=SD/SUM
                RETURN
                END

li913

给出错误提示。

L25

你好，请问解决了吗