看看这个程序错在哪里？

风花雪月

1.         REAL LAD
   
2.         DIMENSION 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)
   
3.         COMMON TH/PAL/PS,PSAI,LAD/FU/XB,YB,FAI,THETA
   
4.         COMMON/MXY/XM,YM/CR/RAB,RBC,RCD,RAD
   
5.         COMMON/CRM/RBM,OMEGA
   
6.         X(15)=0
   
7.         X(16)=0
   
8.         OPEN (6,FILE='PRINTER:')
   
9.         WRITE(*,1)
   
10. 1        FORMAT(2X,'N1=?')
    
11.         READ(*,5) N1
    
12. 5        FORMAT(I3)
    
13.         WRITE(*,4)
    
14. 4        FORMAT(3X,'HH=?')
    
15.         WRITE(*,2) HH
    
16. 2        FORMAT(F13.5)
    
17.         EP1=1.0E-10
    
18.         WRITE(6,6) HH,EP1,N1
    
19. 6        FORMAT(5X,'H(I)=',E10.3,2X,'EP1=',E10.3,5X,'N1=',I3/)
    
20.         ITMAX=5000
    
21.         DO 11 I=1,16
    
22.         X(I)=0.0
    
23. 11        H(I)=HH
    
24.         M=-2
    
25.         IF(N1.EQ.1) GOTO 22
    
26. 
    
27. 22        WRITE(*,23)
    
28. 23        FORMAT(2X,'N=?')
    
29.         READ(*,9) N
    
30.         WRITE(6,25) N
    
31. 25        FORMAT(20X,'N=?',I3)
    
32.         WRITE(6,26)
    
33. 26      FORMAT(///,25X,'SYNTHESIS FOR PATH'/18X,33('*')//18X,16('-')/20X,'I',9X,'XM',13X,'YM',/18X,16('-'))
    
34.         NN=2*N
    
35.         READ(*,20)(XM(I),I=1,N+1)
    
36. 20        FORMAT(F10.4)
    
37.         READ(*,24)(YM(I),I=1,N+1)
    
38. 24        FORMAT(F10.4)
    
39. 27        WRITE(6,28) I,XM(I),YM(I)
    
40. 28        FORMAT(19X,I2,3X,2(F10.5,4X))
    
41.         WRITE(6,17)
    
42.         WRITE(*,1111)
    
43.         READ(*,31) (X(I),I=1,NN)
    
44.         WRITE(6,36) (X(I),I=1,NN)
    
45.         J=1
    
46.         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)
    
47.         WRITE(6,21)
    
48. 21        FORMAT(//5X,30('**')//)
    
49.         WRITE(6,45) KENN,MAX,S
    
50.         WRITE(6,37)
    
51. 37        FORMAT(18X,36('-')/20X,'I',9X,'X(I)',13X,'(Y)'/18X,36('-'))
    
52.         DO 38 I=1,NN
    
53. 38        WRITE(6,39) I,X(I),Y(I)
    
54. 39        FORMAT(19X,I2,4X,F12.5,5X,E10.4)
    
55.         WRITE(6,71)
    
56.         CALL CRK(X(15),X(16),X(1),X(2),X(3),X(4),X(13),X(14),M,KK,N1,KN)
    
57. 54        BX=X(1)
    
58.         BY=X(2)
    
59.         AX=X(15)
    
60.         AY=X(16)
    
61.         GOTO 95
    
62. 95        CALL CRK(N,X,BX,BY,AX,AY,N1)
    
63.         IF(KK.EQ.2.OR.KK.EQ.4) GOTO 1004
    
64.         RR=RAB
    
65.         RAB=RCD
    
66.         RCD=RR
    
67.         WRITE(6,1002)
    
68. 1002    FORMAT(10X,'***** THE BAR CD IS THE CRANK *****')
    
69. 1001    CALL PRE(40.0)
    
70.         STOP
    
71. 1004    WRITE(6,1005)
    
72. 1005    FORMAT(10X,'***** THE SHORTEST BAR IS NOT A CRANK *****')
    
73. 
    
74.         SUBROUTINE FUNCT1(X,Y,N1)
    
75.         DIMENSION X(16),Y(16),XM(10),YM(10)
    
76.         COMMON /MXY/XM,YM
    
77.         N1=1
    
78.         N=6
    
79.         GOTO (8,7,6),N
    
80. 8        X(13)=X(12)
    
81.         X(14)=X(13)
    
82.         X(15)=X(14)
    
83.         GOTO 10
    
84. 7        X(13)=X(14)
    
85.         X(14)=X(12)
    
86.         GOTO 10
    
87. 6        X(13)=X(10)
    
88. 10        DO 20 I=1,N1=1
    
89.           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)
    
90.           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))
    
91.         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))
    
92.         Y4=(XM(1)**2+YM(1)**2+XM(I+1)**2+YM(I+1)**2)/2.0
    
93. 20      Y(I)=Y(1)+Y(2)+Y(3)+Y(4)
    
94.         DO 30 I=N1,2*(N1-1)
    
95.         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)
    
96.         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))
    
97.         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))
    
98. 30      Y(I)=Y(1)+Y(2)+Y()3+Y(4)
    
99.         WRITE(*,40)Y
    
100. 40      FORMAT(16(2X,E30.7/))
     
101.         RETURN
     
102.         END
     
103.         
     
104.         SUBROUTINE DAMPMS(N,M,X,F,1HDER,S,EP1,EP2,ITMAX,P,XATA,2KENN,FP,G,DX,OLDX,DFDX,AA,3KN,JJ)
     
105.         LOGICAL DER
     
106.         REAL LAD
     
107.         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)
     
108.         COMMON TH/PAL/PS,PSAI,LAD/FU/XB,YB,FAI,1THETA/MXY/XM,YM
     
109.         NN=1+N/2
     
110.         KENN=0
     
111.         IT=0
     
112.         PP=P
     
113.         ISB=1
     
114.         GO TO 1000
     
115. 1111    IF(IT.EQ.0) GOTO 112
     
116. 112     WRITE(6,48) SB
     
117.         FORMAT(20X,'S0=',E10.3)
     
118.         SA=SB
     
119.         IF(DER) GOTO 30
     
120.         DO 45 I=1,N
     
121.         HF=H(I)
     
122.         HZ=X(I)
     
123.         GOTO(1,2,3),JJ
     
124. 1       CALL FUNCT(X,FP,KN)
     
125.         GOTO 4
     
126. 2       CALL FUNCT1(X,FP,N1)
     
127.         GOTO 4
     
128. 3       CALL FUNCT2(X,FP)
     
129. 4       X(I)=HZ-HF
     
130.         GOTO (7,8,9),JJ
     
131. 7       CALL FUNCT(X,FM,KN)  
     
132.         GOTO 5
     
133. 8       CALL FUNCT1(X,FM,N1)
     
134.         GOTO 5
     
135. 9       CALL FUNCT2(X,FM)
     
136. 5       X(I)=HZ
     
137.         HZ=0.5/HF
     
138.         DO 45 K=1,M
     
139. 45      DFDX (K,I)=(FP(K)-FM(K))*HZ
     
140.         GO TO 40
     
141. 30      CALL DERIVE(X,DFDX)
     
142. 40      IF(M,EQ,N)GO TO 50
     
143.         DO 60 I=1,N
     
144.         HF=0.0
     
145.         DO 70 K=1,M
     
146. 70      HF=HF+DFDX(K,I)*F(K)
     
147.         G(I)=HF
     
148.         DX(I)=HF
     
149.         DO 80 K=1,N
     
150.         HF=0.0
     
151.         DO 90 J=1,M
     
152. 90      HF=HF+DFDX(J,I)*DFDX(J,K)
     
153.         AA(I,K)=HF
     
154. 80      AA(K,I)=HF
     
155. 60      AA(I,I)=AA(I,I)+PP
     
156.         CALL GS(N,AA,DX,1.0E-10,ISW)
     
157.         GOTO 65
     
158. 50      DO 110 I=1,N
     
159. 110     DX(I)=F(I)
     
160.         CALL GS(N,DFDX,DX,1.0E-10,ISW)
     
161. 65      IF(ISW.EQ.1) GO TO 100
     
162.         KENN=-2
     
163.         GOTO 10000
     
164. 100     DO 120 I=1,N
     
165.         OLDX(I)=X(I)
     
166. 120     X(I)=X(I)-DX(I)
     
167.         ISB=2
     
168.         GOTO 10000
     
169. 2222    IF(SB.GE.SA) GO TO 130
     
170.         C=1.0
     
171. 140     IT=IT+1
     
172.         HF=0.0
     
173.         HZ=0.0
     
174.         DO 230 I=1,N
     
175.         HF=HF+ABS(C*DX(I))
     
176. 230     HZ=HZ+ABS(X(I))
     
177.         IF(HF.LT.EP2*HZ.OR.SA-SB.LT.EP1*SA)
     
178.         GOTO 10000
     
179.         IF(IT.LT.ITMAX) GO TO 145
     
180.         KENN=1
     
181.         GOTO 10000
     
182. 145     PP=PP*XATA
     
183.         GOTO 1111
     
184. 130     IF(M.EQ.N) GO TO 150
     
185.         GDX=0.0
     
186.         DO 160 I=1,N
     
187. 160     GDX=GDX+G(I)*DX(I)
     
188.         GOTO 170
     
189. 150     GDX=SA
     
190. 170     C=GDX/(SB-SA+2.0*GDX)
     
191.         L=0
     
192. 180     DO 190 I=1,N
     
193. 190     X(I)=OLDX(I)-C*DX(I)
     
194.         ISB=3
     
195.         GOTO 10000
     
196. 3333    IF(SB.LT.SA)GO TO 140
     
197.         IF(L.EQ.7)GO TO 210
     
198.         L=L+1
     
199.         C=0.5*C
     
200.         GOTO 180
     
201. 210     KENN=-1
     
202.         DO 220 I=1,N
     
203. 220     X(I)=OLDX(I)
     
204.         ISB=4
     
205. 10000   GOTO (11,22,33),JJ
     
206. 11      CALL FUNCT(X,F,KN)
     
207.         GOTO 44
     
208. 22      CALL FUNCT1(X,F,N1)
     
209.         GOTO 44
     
210. 33      CALL FUNCT2(X,F)
     
211. 44      SB=0.0
     
212.         DO 250 I=1,M
     
213. 250     SB=SB+F(I)**2
     
214.         GOTO(1111,2222,3333,10000),ISB
     
215. 10000   ITMAX=IT
     
216.         S=SB
     
217.         RETURN
     
218.         STOP
     
219.         END

复制代码

fruit_zj

还没有仔细看。但是主程序最后似乎少了END.

dgl0611

'' WRITE(*,1)'' 中的*，改成6