看看这个程序错在哪里？
REAL LADDIMENSION X(16),Y(16),H(16),XM(10),YM(10),TH(6),PS(4),FAI(5),PSAI(5),XB(10),YB(10),THETA(7),FP(16),FM(16),G(16),DX(16),FAI2(5),DLDX(16),DFDX(16,16),AA(16,16),XM1(16),YM1(16),XM2(16),YM2(16)
COMMON TH/PAL/PS,PSAI,LAD/FU/XB,YB,FAI,THETA
COMMON/MXY/XM,YM/CR/RAB,RBC,RCD,RAD
COMMON/CRM/RBM,OMEGA
X(15)=0
X(16)=0
OPEN (6,FILE='PRINTER:')
WRITE(*,1)
1 FORMAT(2X,'N1=?')
READ(*,5) N1
5 FORMAT(I3)
WRITE(*,4)
4 FORMAT(3X,'HH=?')
WRITE(*,2) HH
2 FORMAT(F13.5)
EP1=1.0E-10
WRITE(6,6) HH,EP1,N1
6 FORMAT(5X,'H(I)=',E10.3,2X,'EP1=',E10.3,5X,'N1=',I3/)
ITMAX=5000
DO 11 I=1,16
X(I)=0.0
11 H(I)=HH
M=-2
IF(N1.EQ.1) GOTO 22
22 WRITE(*,23)
23 FORMAT(2X,'N=?')
READ(*,9) N
WRITE(6,25) N
25 FORMAT(20X,'N=?',I3)
WRITE(6,26)
26 FORMAT(///,25X,'SYNTHESIS FOR PATH'/18X,33('*')//18X,16('-')/20X,'I',9X,'XM',13X,'YM',/18X,16('-'))
NN=2*N
READ(*,20)(XM(I),I=1,N+1)
20 FORMAT(F10.4)
READ(*,24)(YM(I),I=1,N+1)
24 FORMAT(F10.4)
27 WRITE(6,28) I,XM(I),YM(I)
28 FORMAT(19X,I2,3X,2(F10.5,4X))
WRITE(6,17)
WRITE(*,1111)
READ(*,31) (X(I),I=1,NN)
WRITE(6,36) (X(I),I=1,NN)
J=1
CALL DAMPMS(NN,NN,X,Y,H,FALSE,S,EP1,EP1,ITMAX,5.0,0.7,KENN,FP,FM,G,DX,DLDX,DFDX,AA,KN,J)
WRITE(6,21)
21 FORMAT(//5X,30('**')//)
WRITE(6,45) KENN,MAX,S
WRITE(6,37)
37 FORMAT(18X,36('-')/20X,'I',9X,'X(I)',13X,'(Y)'/18X,36('-'))
DO 38 I=1,NN
38 WRITE(6,39) I,X(I),Y(I)
39 FORMAT(19X,I2,4X,F12.5,5X,E10.4)
WRITE(6,71)
CALL CRK(X(15),X(16),X(1),X(2),X(3),X(4),X(13),X(14),M,KK,N1,KN)
54 BX=X(1)
BY=X(2)
AX=X(15)
AY=X(16)
GOTO 95
95 CALL CRK(N,X,BX,BY,AX,AY,N1)
IF(KK.EQ.2.OR.KK.EQ.4) GOTO 1004
RR=RAB
RAB=RCD
RCD=RR
WRITE(6,1002)
1002 FORMAT(10X,'***** THE BAR CD IS THE CRANK *****')
1001 CALL PRE(40.0)
STOP
1004 WRITE(6,1005)
1005 FORMAT(10X,'***** THE SHORTEST BAR IS NOT A CRANK *****')
SUBROUTINE FUNCT1(X,Y,N1)
DIMENSION X(16),Y(16),XM(10),YM(10)
COMMON /MXY/XM,YM
N1=1
N=6
GOTO (8,7,6),N
8 X(13)=X(12)
X(14)=X(13)
X(15)=X(14)
GOTO 10
7 X(13)=X(14)
X(14)=X(12)
GOTO 10
6 X(13)=X(10)
10 DO 20 I=1,N1=1
Y1=X(1)*X(15)+X(2)*X(16)-XM(I+1)*X(15)-YM(I+1)*X(16)-XM(1)*X(1)-YM(1)*X(2)
Y2=COS(X(I+4))*(-X(1)*X(15)-X(2)*X(16)+XM(1)*X(15)+YM(1)*X(16)-XM1(1)*XM(I+1)-YM(1)YM(I+1)+YM(I+1)*X(1)+YM(I+1)*X(2))
Y3=SIN(X(I+4))*(X(15)*X(2)-X(16)*X(1)+XM(1)*X(16)-YM(1)*X(15)+XM(I+1)*YM(1)-YM(I+1)*XM(1)+YM(I+1)*X(1)-XM(I+1)*X(2))
Y4=(XM(1)**2+YM(1)**2+XM(I+1)**2+YM(I+1)**2)/2.0
20 Y(I)=Y(1)+Y(2)+Y(3)+Y(4)
DO 30 I=N1,2*(N1-1)
Y1=X(3)*X(13)+X(4)*X(14)-XM(I-N1+2)*X(13)-\YM(I-N1+2)*X(14)-XM(1)*X(3)-YM(1)*X(4)
Y2=COS(X(I-N1+5))*(-X(3)*X(13)-X(4)*X(14)+XM(1)*X(13)+YM(1)*X(14)-XM(1)*XM(I-N1+2)-YM(1)*YM(I-N1+2)+XM(I-N1+2)*X(3)+YM(I-N1+2)*X(4))
Y3=SIN(X(I-N1+5))*(X(13)X(4)-X(14)*X(3)+XM(1)*X(14)-YM(1)*X(13)+YM(I-N1+2)*YM(1)-YM(I-N1+2)*XM(1)+YM(I-N1+2)*X(3)-XM(I-N1+2)*X(4))
30 Y(I)=Y(1)+Y(2)+Y()3+Y(4)
WRITE(*,40)Y
40 FORMAT(16(2X,E30.7/))
RETURN
END
SUBROUTINE DAMPMS(N,M,X,F,1HDER,S,EP1,EP2,ITMAX,P,XATA,2KENN,FP,G,DX,OLDX,DFDX,AA,3KN,JJ)
LOGICAL DER
REAL LAD
DIMENSION X(16),F(16),H(16),FP(16),FM(16),1G(16),DX(16),OLDX(16),DFDX(16,16),2AA(16,16),XB(10),YB(10),XM(10),YM(10),3PS(4),TH(6),THETA(5),FAI(5),PSAI(5)
COMMON TH/PAL/PS,PSAI,LAD/FU/XB,YB,FAI,1THETA/MXY/XM,YM
NN=1+N/2
KENN=0
IT=0
PP=P
ISB=1
GO TO 1000
1111 IF(IT.EQ.0) GOTO 112
112 WRITE(6,48) SB
FORMAT(20X,'S0=',E10.3)
SA=SB
IF(DER) GOTO 30
DO 45 I=1,N
HF=H(I)
HZ=X(I)
GOTO(1,2,3),JJ
1 CALL FUNCT(X,FP,KN)
GOTO 4
2 CALL FUNCT1(X,FP,N1)
GOTO 4
3 CALL FUNCT2(X,FP)
4 X(I)=HZ-HF
GOTO (7,8,9),JJ
7 CALL FUNCT(X,FM,KN)
GOTO 5
8 CALL FUNCT1(X,FM,N1)
GOTO 5
9 CALL FUNCT2(X,FM)
5 X(I)=HZ
HZ=0.5/HF
DO 45 K=1,M
45 DFDX (K,I)=(FP(K)-FM(K))*HZ
GO TO 40
30 CALL DERIVE(X,DFDX)
40 IF(M,EQ,N)GO TO 50
DO 60 I=1,N
HF=0.0
DO 70 K=1,M
70 HF=HF+DFDX(K,I)*F(K)
G(I)=HF
DX(I)=HF
DO 80 K=1,N
HF=0.0
DO 90 J=1,M
90 HF=HF+DFDX(J,I)*DFDX(J,K)
AA(I,K)=HF
80 AA(K,I)=HF
60 AA(I,I)=AA(I,I)+PP
CALL GS(N,AA,DX,1.0E-10,ISW)
GOTO 65
50 DO 110 I=1,N
110 DX(I)=F(I)
CALL GS(N,DFDX,DX,1.0E-10,ISW)
65 IF(ISW.EQ.1) GO TO 100
KENN=-2
GOTO 10000
100 DO 120 I=1,N
OLDX(I)=X(I)
120 X(I)=X(I)-DX(I)
ISB=2
GOTO 10000
2222 IF(SB.GE.SA) GO TO 130
C=1.0
140 IT=IT+1
HF=0.0
HZ=0.0
DO 230 I=1,N
HF=HF+ABS(C*DX(I))
230 HZ=HZ+ABS(X(I))
IF(HF.LT.EP2*HZ.OR.SA-SB.LT.EP1*SA)
GOTO 10000
IF(IT.LT.ITMAX) GO TO 145
KENN=1
GOTO 10000
145 PP=PP*XATA
GOTO 1111
130 IF(M.EQ.N) GO TO 150
GDX=0.0
DO 160 I=1,N
160 GDX=GDX+G(I)*DX(I)
GOTO 170
150 GDX=SA
170 C=GDX/(SB-SA+2.0*GDX)
L=0
180 DO 190 I=1,N
190 X(I)=OLDX(I)-C*DX(I)
ISB=3
GOTO 10000
3333 IF(SB.LT.SA)GO TO 140
IF(L.EQ.7)GO TO 210
L=L+1
C=0.5*C
GOTO 180
210 KENN=-1
DO 220 I=1,N
220 X(I)=OLDX(I)
ISB=4
10000 GOTO (11,22,33),JJ
11 CALL FUNCT(X,F,KN)
GOTO 44
22 CALL FUNCT1(X,F,N1)
GOTO 44
33 CALL FUNCT2(X,F)
44 SB=0.0
DO 250 I=1,M
250 SB=SB+F(I)**2
GOTO(1111,2222,3333,10000),ISB
10000 ITMAX=IT
S=SB
RETURN
STOP
END 还没有仔细看。但是主程序最后似乎少了END. '' WRITE(*,1)'' 中的*，改成6
页:
[1]