forrtl: severe (29): file not found, unit 1, file 问题
c fortran language program oof mixed discret composite programminginteger en,p,eq,cycle,cst,fun,sch,qun
REAL X0(20),IX0(20),XL(20),IXL(20),XU(20),IXU(20),XB(20),IXB(20)
1,XT(20),IXT(20),DX(20),IDX(20),G(500),IV(20,41),Y(41),XV(500,20)
character*1 iyn
character*3 chr1,chr3
character*8 chr2
DIMENSION NP(20)
COMMON /C0/I1,I2,I3,I4,I5,I6/C1/N,M,EN,P,EQ,NV/C2/MI,CYCLE,CST,
1FUN,SCH,QUN/C3/G/C4/X0,IX0/C5/XB,IXB/C6/XT,IXT/C7/XL,IXL,XU,IXU
2/C8/DX,IDX/C9/IV,Y/C10/XV/C11/N1/C12/F1,F2,PF0,PF1
COMMON /CSUB/SUB/ci7/i7
WRITE(*,1300)
1300 FORMAT(/,10X,'***MDCP***',/,/,/)
write(*,5900)
5900 format(3x,'Options:',/,3x,'Checkout Adjacent Points?(Y/N)',\)
read(*,'(a)')iyn
if (iyn.eq.'y'.or.iyn.eq.'Y') then
i1=1
else
i1=0
endif
write(*,6001)
6001 format(3x,'Quadratic accelerating?(Y/N)',\)
read(*,'(a)')iyn
if (iyn.eq.'y'.or.iyn.eq.'Y') then
i2=1
else
i2=0
endif
write(*,6002)
6002 format(3x,'Change Search Direction?(Y/N)',\)
read(*,'(a)')iyn
if (iyn.eq.'y'.or.iyn.eq.'Y') then
i3=1
else
i3=0
endif
write(*,6003)
6003 format(3x,'Reconstruct Complex?(Y/N)',\)
read(*,'(a)') iyn
if (iyn.eq.'y'.or.iyn.eq.'Y') then
i4=1
else
i4=0
endif
write(*,6005)
6005 format(3x,'Search Along Bounds?(Y/N)',\)
read(*,'(a)') iyn
if (iyn.eq.'y'.or.iyn.eq.'Y') then
i5=1
else
i5=0
endif
write(*,6006)
6006 format(3x,'Show Computational Details?(Y/N)',\)
read(*,'(a)') iyn
if (iyn.eq.'y'.or.iyn.eq.'Y') then
i6=1
else
i6=0
endif
WRITE(*,1060)I1,I2,I3,I4,I5,I6
1060 FORMAT(8X,'I1',8X,'I2',8X,'I3',8X,'I4',8X,'I5',8X,'I6',/,6I10)
write(*,7001)
7001 format(3x,'data file name=****.***')
read(*,7003)chr2
7003 format(17x,a)
write(*,7005)
7005 format(3x,'a new file or an old one?(new/old)',\)
read(*,'(a3)')chr3
if(chr3.eq.'new'.or.chr3.eq.'NEW') then
open(1,file=chr2,status='new',access='direct',form='binary',
1recl=80)
else
open(1,file=chr2,access='direct',form='binary',recl=80)
read(1,rec=1)n,m,eq,p,en,nn,mi,nv
WRITE(*,1080)N,M,EQ,P,EN,NN,MI,NV
endif
close(1)
6009 write(*,6010)
6010 format(3x,'New Problem Parameters?(Y/N)',\)
read(*,'(a)')iyn
open(1,file=chr2,access='direct',form='binary',recl=80)
if(iyn.eq.'y'.or.iyn.eq.'Y') then
write(*,6020)
6020 format(3x,'N=**M=***EQ=**P=**EN=**NN=***MI=*******')
read(*,6022)n,m,eq,p,en,nn,mi
6022 format(4x,i2,4x,i3,5x,i2,4x,i2,5x,i2,5x,i3,5x,i7)
NV=2*N+1
WRITE(*,1080)N,M,EQ,P,EN,NN,MI,NV
1080 FORMAT(3X,'N=',I2,2X,'M=',I3,2X,'EQ=',I2,2X,'P=',I2,2X,'EN=',I2,
12X,'NN=',I3,2X,'MI=',I7,2X,'NV=',I2)
write(1,rec=1)n,m,eq,p,en,nn,mi,nv
elseif(iyn.ne.'n'.and.iyn.ne.'N') then
goto 6009
else
read(1,rec=1)n,m,eq,p,en,nn,mi,nv
endif
if(chr3.eq.'new'.or.chr3.eq.'NEW') goto 6023
read(1,rec=2)x0
close(1)
write(*,'(1x,6f13.6)')(x0(i),i=1,n)
6023 write(*,6024)
6024 format(3x,'New Initial Point?(Y/N)',\)
read(*,'(a)')iyn
open(1,file=chr2,access='direct',form='binary',recl=80)
if (iyn.eq.'y'.or.iyn.eq.'Y') then
chr1='X0('
call input(chr1,x0)
write(1,rec=2)x0
elseif(iyn.ne.'n'.and.iyn.ne.'N') then
goto 6023
else
read(1,rec=2)x0
endif
if(chr3.eq.'new'.or.chr3.eq.'NEW') goto 6025
read(1,rec=3)xu
close(1)
write(*,'(1x,6f13.6)')(xu(i),i=1,n)
6025 write(*,6026)
6026 format(3x,'New Upper Bounds?(Y/N)',\)
read(*,'(a)')iyn
open(1,file=chr2,access='direct',form='binary',recl=80)
if (iyn.eq.'y'.or.iyn.eq.'Y') then
chr1='XU('
call input(chr1,xu)
write(1,rec=3)xu
elseif(iyn.ne.'n'.and.iyn.ne.'N') then
goto 6025
else
read(1,rec=3)xu
endif
if(chr3.eq.'new'.or.chr3.eq.'NEW') goto 6027
read(1,rec=4)xl
close(1)
write(*,'(1x,6f13.6)')(xl(i),i=1,n)
6027 write(*,6028)
6028 format(3x,'New Lower Bounds?(Y/N)',\)
read(*,'(a)')iyn
open(1,file=chr2,access='direct',form='binary',recl=80)
if (iyn.eq.'y'.or.iyn.eq.'Y') then
chr1='XL('
call input(chr1,xl)
write(1,rec=4)xl
elseif(iyn.ne.'n'.and.iyn.ne.'N') then
goto 6027
else
read(1,rec=4)xl
endif
if(chr3.eq.'new'.or.chr3.eq.'NEW') goto 6029
read(1,rec=5)dx
close(1)
write(*,'(1x,6f13.6)')(dx(i),i=1,n)
6029 write(*,6030)
6030 format(3x,'New Variable Increaments?(Y/N)',\)
read(*,'(a)')iyn
open(1,file=chr2,access='direct',form='binary',recl=80)
if (iyn.eq.'y'.or.iyn.eq.'Y') then
chr1='DX('
call input(chr1,dx)
write(1,rec=5)dx
elseif(iyn.ne.'n'.and.iyn.ne.'N') then
goto 6029
else
read(1,rec=5)dx
endif
close(1)
IF(EQ.EQ.0) GOTO 510
6039 write(*,6040)
6040 format(3x,'New Design Space?(Y/N)',\)
read(*,'(a)')iyn
open(1,file=chr2,access='direct',form='binary',recl=80)
if(iyn.eq.'y'.or.iyn.eq.'Y') then
call inpnp(np)
call inpxv(np)
write(1,rec=6)np
do 917 j=1,nn
irc=6+j
write(1,rec=irc)(xv(j,i),i=1,eq)
917 continue
elseif(iyn.ne.'n'.and.iyn.ne.'N') then
goto 6039
else
read(1,rec=6)np
write(*,'(1x,10i8)')(np(i),i=1,eq)
do 919 j=1,nn
irc=6+j
read(1,rec=irc)(xv(j,i),i=1,eq)
919 continue
write(*,'(1x,6f13.6)')((xv(j,i),j=1,nn),i=1,eq)
endif
close(1)
510 CONTINUE
DO 512 I=1,N
IF(X0(I).LT.XL(I).OR.X0(I).GT.XU(I)) GOTO 515
512 CONTINUE
GOTO 520
515 WRITE(*,1180)
1180 FORMAT(5X,'THE INITIAL POINT VIOLATES THE BOUNDS FOR VARIABLES')
GOTO 599
520 CONTINUE
DO 522 I=1,N
IF(I-P) 524,524,526
524 IDX(I)=1
GOTO 522
526 IDX(I)=DX(I)
522 CONTINUE
DO 550 I=1,N
IF(I.GT.EQ) GOTO 530
IXL(I)=1
IXU(I)=NP(I)
JJ=NP(I)
W=10.E10
DO 532 J=1,JJ
IF(ABS(X0(I)-XV(J,I)).GE.W) GOTO 532
K=J
W=ABS(X0(I)-XV(J,I))
532 CONTINUE
IX0(I)=K
X0(I)=XV(K,I)
GOTO 550
530 CONTINUE
IF(I.GT.P) GOTO 540
W=XL(I)/DX(I)+.5
IXL(I)=AINT(W)
W=XU(I)/DX(I)
IXU(I)=AINT(W)
W=X0(I)/DX(I)+sign(1.,x0(i))*.5
IX0(I)=AINT(W)
X0(I)=IX0(I)*DX(I)
GOTO 550
540 IXL(I)=XL(I)
IXU(I)=XU(I)
IX0(I)=X0(I)
550 CONTINUE
CYCLE=0
FUN=0
CST=0
SCH=0
QUN=0
PF0=EF(X0)
WRITE(*,1215)(X0(I),I=1,N)
1215 FORMAT(5X,'X0(I)=',8F8.3)
WRITE(*,1190)(G(I),I=1,M)
1190 FORMAT(5X,'G=',/,5F15.7)
WRITE(*,1200)PF0
1200 FORMAT(5X,'PF0=',F15.7)
CALL COMPLE
IF(FUN-1) 560,562,562
560 WRITE(*,1210)
1210 FORMAT(10X,'NO FEASIBLE POINT')
GOTO 564
562 WRITE(*,1220)
1220 FORMAT(72('E'))
564 RAT=ABS((PF0-PF1)/PF0)
WRITE(*,1230)CYCLE,SCH,QUN,FUN,CST,RAT
1230 FORMAT(5X,'CYCLE=',I3,5X,'SCH=',I5,5X,'QUN=',I4,/,5X,'FUN=',I6,
15X,'CST=',I6,/,5X,'RAT=',F15.7)
write(*,8001)
8001 format(3x,'Show All Constraints?(Y/N)',\)
read(*,'(a)')iyn
if(iyn.eq.'y'.or.iyn.eq.'Y') then
DO 565 I=1,M
565 WRITE(*,1240)I,G(I)
1240 FORMAT(10X,'G(',I3,')=',F15.7)
endif
write(*,8003)
8003 format(3x,'Show Solution?(Y/N)',\)
read(*,'(a)')iyn
if(iyn.eq.'y'.or.iyn.eq.'Y') then
DO566 I=1,N
566 WRITE(*,1250)I,XT(I)
1250 FORMAT(20X,'X(',I2,')=',F15.7)
WRITE(*,1260)PF1
1260 FORMAT(20X,'F(X)=',F15.7,/,/)
endif
write(*,8005)
8005 format(3x,'Show All Verticies?(Y/N)',\)
read(*,'(a)')iyn
if(iyn.eq.'y'.or.iyn.eq.'Y') then
WRITE(*,1270)(Y(I),I=1,NV)
1270 FORMAT(5X,'Y=',/,5F15.7)
PF1=FUNC(XT,FUN)
DO 570 I=1,NV
DO 568 J=1,N
568 IXT(J)=IV(J,I)
CALL ROUND(XT,IXT)
WRITE(*,1280)I,(XT(J),J=1,N)
1280 FORMAT(5X,'XV=',I2,/,1X,'X=',/,8F15.7)
CALL CONST(XT,G,CST)
WRITE(*,1290)(G(J),J=1,M)
1290 FORMAT(1X,'G=',/,5F15.7)
570 CONTINUE
endif
599 CONTINUE
STOP
END
subroutine comple
integer cycle,en,p,eq,cst,fun,sch,qun
character*1 iyn
character*3 chr
CHARACTER*8 NAME
real x0(20),ix0(20),xl(20),ixl(20),xu(20),ixu(20),xb(20),
1ixb(20),xt(20),ixt(20),dx(20),idx(20),g(500),iv(20,41),y(41),
2xv(500,20)
common /c0/i1,i2,i3,i4,i5,i6/c1/n,m,en,p,eq,nv/c2/mi,cycle,cst,
1fun,sch,qun/c3/g/c4/x0,ix0/c5/xb,ixb/c6/xt,ixt/c7/xl,ixl,xu,ixu
2/c8/dx,idx/c9/iv,y/c11/n1/c12/f1,f2,pf0,pf1/c10/xv
common /csub/sub/ci7/i7/cff/ff(11,2),kk,knt/c15/fo(11),df(11,2),
1dfdx(11,4),cf(11,4)
WRITE(*,'(1x,A)')'Verticies Storage File Name=****.*** NSCH=***'
READ(*,'(28X,A8,6X,I3)')NAME,NSCH
919 write(*,'(1x,a,\)')'Input Verticies?(y/n)'
READ(*,'(A)')IYN
IF(IYN.EQ.'y'.or.IYN.EQ.'Y') then
goto 913
elseif(iyn.ne.'n'.and.iyn.ne.'N') then
goto 919
endif
do 300 i=1,n
300 iv(i,1)=ix0(i)
y(1)=pf0
430 continue
do 302 k=1,n
do 304 i=1,n
if (i.eq.k) go to 306
ii=k+1
iv(i,ii)=ix0(i)
ii=ii+n
iv(i,ii)=ix0(i)
go to 308
306 ii=k+1
iv(i,ii)=ixl(i)
ii=ii+n
iv(i,ii)=ixu(i)
308 continue
304 continue
302 continue
goto 440
913 OPEN(2,FILE=NAME,ACCESS='DIRECT',FORM='BINARY',RECL=160)
DO 921 I=1,NV
READ(2,REC=I)(IV(J,I),J=1,N)
921 CONTINUE
nv1=nv+1
read(2,rec=nv1)sch,fun,cst,cycle
CLOSE(2)
DO 923 I=1,N
923 IX0(I)=IV(I,1)
CALL ROUND(X0,IX0)
PF0=EF(X0)
Y(1)=PF0
write(*,'(1x,2hx0,6f13.6)')(x0(i),i=1,n)
write(*,'(1x,5hf(x0),3x,f13.6)')pf0
write(*,'(1x,4hsch=,i4,3x,4hfun=,i5,3x,4hcst=,i5,3x,6hcycle=,i2)
1')sch,fun,cst,cycle
440 continue
do 310 i=2,nv
do 312 j=1,n
312 ixt(j)=iv(j,i)
call round(xt,ixt)
310 y(i)=ef(xt)
450 call compar
if (i6.ne.1) go to 350
write(*,1000) (y(i),i=1,nV)
1000 format(1x,2hf=,/,5f15.7)
do 320 i=1,nv
do 315 j=1,n
315 ixt(j)=iv(j,i)
call round(xt,ixt)
write(*,1010) i,(xt(ii),ii=1,n)
1010 format(1x,2hx=,i5,/,(5f15.7))
320 continue
350 ir=0
do 352 i=1,n
dl=1.e10
du=-1.e10
do 354 j=1,nv
w=iv(i,j)
if (w.ge.du) du=w
if (w.le.dl) dl=w
354 continue
w=du-dl
if (w.le.idx(i)) ir=ir+1
352 continue if (ir.ge.en) go to 470
if (i2.ne.1) go to 360
w=sch/15
iw=int(w)
if (iw.le.qun) go to 360
call quadr
if (f1.ge.y(1)) go to 360
call round(xb,ixb)
write(*,1020) qun,f1,(xb(i),i=1,n)
1020 format(10x,7hsuccess,/,10x,4hqun=,i5,/,10x,2hf=,f15.7,/,
110x,2hx=,/,(5f15.7))
y(nv)=f1
do 356 i=1,n
356 iv(i,nv)=ixb(i)
go to 450
360 continue
IF(I7.EQ.1) THEN
isch=sch/50
if (isch*50.ne.sch) go to 351
ngl=0
do 337 i=1,n
ngt=0
nlt=0
do 331 j=2,nv
if (iv(i,j).gt.iv(i,1)) ngt=ngt+1
if (iv(i,j).lt.iv(i,1)) nlt=nlt+1
331 continue
if (ngt.gt.1.and.nlt.gt.1) ngl=ngl+1
337 continue
if (ngl.gt.1) go to 351
sub=1.
n1=nv
call search
if (f1.gE.y(n1)) go to 351
do 346 i=1,n
346 iv(i,nv)=ixb(i)
y(nv)=f1
KT=4
go to 450
351 continue
ENDIF
n1=nv
460 MSCH=SCH/NSCH
IF(MSCH*NSCH.EQ.SCH) THEN
OPEN(2,FILE=NAME,STATUS='NEW',ACCESS='DIRECT',FORM='BINARY',
1RECL=160)
DO 927 I=1,NV
WRITE(2,REC=I)(IV(J,I),J=1,N)
927 CONTINUE
nv1=nv+1
write(2,rec=nv1)sch,fun,cst,cycle
CLOSE(2)
ENDIF
call search
if (f1.ge.y(n1)) go to 366
do 362 i=1,n
362 iv(i,nv)=ixb(i)
y(nv)=f1
KT=5
go to 450
366 continue
if (i3.ne.1) go to 380
480 n1=n1-1
if (n1.le.1) go to 380
iw=0
ii=n1+1
do 370 i=1,n
if (iv(i,n1).eq.iv(i,ii)) go to 370
iw=1
go to 490
370 continue
490 continue
if (iw.eq.1) go to 460
go to 480
380 continue
do 382 i=2,nv
do 384 j=1,n
w=iv(j,1)+0.667*(iv(j,i)-iv(j,1))
if (j.gt.p) go to 384
w=w+0.5
w=int(w)
384 iv(j,i)=w
382 continue
go to 440
470 continue
if (i1.ne.1) go to 500
do 386 i=2,nv
w=1.0
do 388 j=1,n
ii=i-1
if (iv(j,ii).ne.iv(j,i)) w=0.
388 continue
if (w.eq.1.) go to 386
do 390 j=1,n
ixt(j)=2*iv(j,1)-iv(j,i)
if (ixt(j).gt.ixu(j)) ixt(j)=ixu(j)
if (ixt(j).lt.ixl(j)) ixt(j)=ixl(j)
390 continue
call round(xt,ixt)
w=ef(xt)
if (w.ge.y(1)) go to 386
y(i)=w
do 392 j=1,n
392 iv(j,i)=ixt(j)
go to 450
386 continue
500 cycle=cycle+1
do 394 i=1,n
394 ixt(i)=iv(i,1)
call round(xt,ixt)
pf1=y(1)
write(*,1030) cycle,sch,fun,cst,pf1
1030 format(5x,'cycle=',i5,5x,'sch=',i5,5x,'fun=',i5,5x,'cst=',i5,/,
110x,'pf1=',f15.7,/)
write(*,1301) (xt(i),i=1,n)
1301 format(1x,2hx=,5f15.7)
if (i4.ne.1) go to 400
do 408 i=1,n
if (abs(iv(i,1)-ix0(i)).le.1e-6) go to 408
do 402 j=1,n
402 ix0(j)=iv(j,1)
go to 430
408 continue
400 call const(xt,g,cst)
return
end
subroutine search
real xt(20),ixt(20),xb(20),ixb(20),dx(20),idx(20),y(41),
1iv(20,41),xu(20),ixu(20),xl(20),ixl(20),s(20),g(500),xv(500,20)
integer en,p,eq,cycle,cst,fun,qun,sch
common /c1/n,m,en,p,eq,nv/c2/mi,cycle,cst,fun,sch,qun
1/c5/xb,ixb/c6/xt,ixt/c7/xl,ixl,xu,ixu/c8/dx,idx/c9/iv,y
2/c11/n1/c0/i1,i2,i3,i4,i5,i6/c12/f1,f2,pf0,pf1/c3/g/c10/xv
common /csub/sub
do 40 i=1,n
40 ixb(i)=iv(i,n1)
f1=y(n1)
do 41 i=1,n
w=0.
if(sub.ne.1.) goto 777
w=iv(i,1)
goto 779
777 continue
do 42 j=1,nv
42 if(j.ne.n1) w=w+iv(i,j)
w=w/(nv-1)
779 continue
41 s(i)=w-ixb(i)
w=10.e10
him=10.e10
do 43 i=1,n
if(abs(s(i)).gt.10.e-8) w=abs(idx(i)/s(i)/2)
if(w.lt.him) him=w
43 continue
t=1.3
t0=1.3
r=1.
110 continue
if(t.lt.him) goto 120
do 44 i=1,n
w=iv(i,n1)+t0*s(i)
if(i.le.p) w=aint(w+.5)
ixt(i)=w
if(i5.ne.1) goto 46
if(ixt(i).gt.ixu(i)) ixt(i)=ixu(i)
if(ixt(i).lt.ixl(i)) ixt(i)=ixl(i)
goto 44
46 continue
if(ixt(i).le.ixu(i).and.ixt(i).ge.ixl(i)) goto 44
t=t/2
r=-1.
t0=t0-t
goto 110
44 continue
call round(xt,ixt)
f2=ef(xt)
if(f2.lt.f1) goto 50
t=t/2
r=-1.
t0=t0-t
goto 110
50 continue
do 51 i=1,n
xb(i)=xt(i)
51 ixb(i)=ixt(i)
f1=f2
if(r.eq.1.) t=t*2
if(r.ne.1.) t=t/2
t0=t0+t
goto 110
120 sch=sch+1
return
end
subroutine quadr
integer en,p,eq,cycle,cst,fun,sch,qun
real a(20),b(20),c(20),e(20),f(20),h(20),xb(20),ixb(20),
1iv(20,41),xt(20),ixt(20),xu(20),ixu(20),xl(20),ixl(20),dx(20),
2idx(20),y(41),g(500),xv(500,20)
common /c1/n,m,en,p,eq,nv/c2/mi,cycle,cst,fun,sch,qun/c5/xb,ixb
1/c6/xt,ixt/c7/xl,ixl,xu,ixu/c8/dx,idx/c9/iv,y/c12/f1,f2,pf0,pf1
2/c3/g/c10/xv
do 60 i=1,n
ixb(i)=iv(i,1)
60 c(i)=ixb(i)
f1=y(1)
do 62 i=2,nv
k=i
do 64 j=1,n
if(abs(iv(j,i)-c(j)).gt.10.e-4) goto 210
64 continue
62 continue
goto 250
210 continue
do 66 i=1,n
66 b(i)=iv(i,k)
kk=k+1
do 68 i=kk,nv
k=i
do 70 j=1,n
if(abs(iv(j,i)-b(j)).gt.10.e-4) goto 220
70 continue
68 continue
goto 250
220 continue
do 72 i=1,n
72 a(i)=iv(i,k)
ii=1
do 74 i=1,n
k=i
if(a(i).lt.b(i).and.b(i).lt.c(i)) goto 230
74 continue
ii=-1
do 76 i=1,n
k=i
if(a(i).gt.b(i).and.b(i).gt.c(i)) goto 230
76 continue
ii=0
230 continue
if(ii.eq.0) goto 250
do 78 i=1,n
e(i)=c(i)
f(i)=(b(i)-c(i))/(b(k)-c(k))
78 h(i)=((a(i)-c(i))/(a(k)-c(k))-f(i))/(a(k)-b(k))
d1=ii*2*idx(k)
d=d1
w=1.
240 continue
if(abs(d).lt.idx(k)/2) goto 250
do 80 i=1,n
ixt(i)=e(i)+f(i)*d1+h(i)*d1*(d1+c(k)-b(k))
wi=ixt(i)+.5
if(i.le.p) ixt(i)=aint(wi)
if(ixt(i).le.ixu(i).and.ixt(i).ge.ixl(i)) goto 82
w=-1
d=d/2
d1=d1-d
goto 240
82 continue
80 continue
call round(xt,ixt)
f2=ef(xt)
if(f2.lt.f1) goto 83
w=-1
d=d/2
d1=d1-d
goto 240
83 f1=f2
do 84 i=1,n
ixb(i)=ixt(i)
84 xb(i)=xt(i)
if(w.eq.1) d=d*2
if(w.ne.1) d=d/2
d1=d1+d
goto 240
250 qun=qun+1
return
end
subroutine input(chr1,x)
character*1 iyn
character*3 chr1
character*13 chr2
dimension x(20)
common /c1/n,m,en,p,eq,nv
chr2=')=*****.*****'
do 10 i=1,n
write(*,100)chr1,i,chr2
100 format(3x,a3,i2,a13)
read(*,200)x(i)
200 format(9x,f11.5)
write(*,200)x(i)
10 continue
14 write(*,300)
300 format(3x,'all right?(y/n)',\)
read(*,'(a)')iyn
if(iyn.eq.'n'.or.iyn.eq.'N') then
write(*,400)chr1,chr2
400 format(3x,'i=** ',3x,a3,'i',a13)
read(*,500)i,x(i)
500 format(4x,i2,6x,f11.5)
write(*,500)i,x(i)
goto 14
elseif(iyn.ne.'y'.and.iyn.ne.'Y') then
goto 14
endif
return
end
subroutine inpnp(np)
integer eq
character*1 iyn
character*3 chr1
character*6 chr2
dimension np(20)
common /c1/n,m,en,p,eq,nv
chr1='Np('
chr2=')=****'
do 10 i=1,eq
write(*,100)chr1,i,chr2
100 format(3x,a3,i2,a6)
read(*,200)np(i)
200 format(9x,i4)
write(*,200)np(i)
10 continue
14 write(*,300)
300 format(3x,'all right?(y/n)',\)
read(*,'(a)')iyn
if(iyn.eq.'n'.or.iyn.eq.'N') then
write(*,400)chr1,chr2
400 format(3x,'i=** ',3x,a3,'i',a13)
read(*,500)i,np(i)
500 format(4x,i2,6x,i4)
write(*,500)i,np(i)
goto 14
elseif(iyn.ne.'y'.and.iyn.ne.'Y') then
goto 14
endif
return
end
subroutine inpxv(np)
integer eq
character*1 iyn
character*3 chr1
character*13 chr2
dimension np(20),xv(500,20)
common /c1/n,m,en,p,eq,nv/c10/xv
chr1='XV('
chr2=')=*****.*****'
do 10 i=1,eq
do 10 j=1,np(i)
write(*,100)chr1,j,i,chr2
100 format(3x,a3,i3,',',i2,a13)
read(*,200)xv(j,i)
200 format(13x,f11.5)
write(*,200)xv(j,i)
10 continue
299 write(*,300)
300 format(3x,'all right?(y/n)',\)
read(*,'(a)')iyn
if(iyn.eq.'n'.or.iyn.eq.'N') then
write(*,400)chr1,chr2
400 format(3x,'j=***i=**',2x,a3,'j,i',a13)
read(*,500)j,i,xv(j,i)
500 format(4x,i3,4x,i2,9x,f11.5)
write(*,500)j,i,xv(j,i)
goto 299
elseif(iyn.ne.'y'.and.iyn.ne.'Y') then
goto 299
endif
return
end
subroutine compar
real y(41),iv(20,41)
common /c1/n,m,en,p,eq,nv/c9/iv,y
jj=nv-1
do 30 i=1,jj
j=i
ii=i+1
do 31 k=ii,nv
if(y(k).lt.y(j)) j=k
31 continue
w=y(i)
y(i)=y(j)
y(j)=w
do 32 k=1,n
w=iv(k,i)
iv(k,i)=iv(k,j)
32 iv(k,j)=w
30 continue
return
end
subroutine round(x,ix)
real x(20),ix(20),dx(20),xv(500,20),idx(20)
integer en,p,eq
common /c1/n,m,en,p,eq,nv/c8/dx,idx/c10/xv
do 20 i=1,n
w=ix(i)+0.5
ii=int(w)
if (i.le.eq) x(i)=xv(ii,i)
if (i.gt.eq.and.i.le.p) x(i)=dx(i)*ix(i)
if (i.gt.p) x(i)=ix(i)
20 continue
return
end
FUNCTION EF(X)
DIMENSION X(20),G(500)
INTEGER CST,FUN,SCH,QUN
COMMON /C1/N,M,EN,P,EQ,NV/C3/G/C2/MI,CYCLE,CST,FUN,SCH,QUN
CALL CONST(X,G,CST)
SUM=0.
DO 10 I=1,M
IF(G(I).GT.0) SUM=SUM+G(I)
10 CONTINUE
IF(SUM.EQ.0) GOTO 11
W=MI+SUM
GOTO 12
11 W=FUNC(X,FUN)
12 EF=W
RETURN
END
FUNCTION FUNC(X,FUN)
DIMENSION X(20)
INTEGER FUN
FUN=FUN+1
FUNC=X(1)+120*X(2)
RETURN
END
SUBROUTINE CONST(X,G,CST)
DIMENSION X(20),G(500)
INTEGER CST
G(1)=4-X(1)
G(2)=6.429+X(1)*X(2)
G(3)=6.429-X(1)*X(2)**3
G(4)=321.14-X(1)**2*X(2)
CST=CST+1
RETURN
END 生成exe执行件,从7001开始不能操作,求帮忙找找原因,谢谢各位 我听不懂你的意思。什么叫 从 7001 开始不能操作？ 7001format(3x,'data file name=****.***')
从这里开始打不开open以后 我QQ:736223939,愿意帮助我的,加我好友,重谢 我是处手 发表于 2014-4-30 00:22
我QQ:736223939,愿意帮助我的,加我好友,重谢
lz这么长又无任何注释的代码，就别指望有热心人会无偿替你帮忙了
建议去水木社区的数值计算版面，发帖有偿征人调试吧，那里牛人更多些 请详细描述你遇到的问题，错误提示，现象。否则没人可以帮助你。 这是约束非线性离散变量组合型优化设计方法,我下面代有优化数学模型,执行生成exe文件后,操作到7001 format(3x,'data file name=****.***')
read(*,7003)chr2
7003 format(17x,a)
write(*,7005)
7005 format(3x,'a new file or an old one?(new/old)',\)
read(*,'(a3)')chr3
if(chr3.eq.'new'.or.chr3.eq.'NEW') then
open(1,file=chr2,status='new',access='direct',form='binary',
1recl=80)
else
open(1,file=chr2,access='direct',form='binary',recl=80)
read(1,rec=1)n,m,eq,p,en,nn,mi,nv
WRITE(*,1080)N,M,EQ,P,EN,NN,MI,NV
endif
close(1)
在窗口会出现:
data file name=****.***
chr2
a new file or an old one?(new/old)new
forrtl: severe (29): file not found, unit 1, file
Image PC Routine Line Source
M.exe 004193F9Unknown UnknownUnknown
M.exe 0041922BUnknown UnknownUnknown
M.exe 00418434Unknown UnknownUnknown
M.exe 00418869Unknown UnknownUnknown
M.exe 00413314Unknown UnknownUnknown
M.exe 00401C7DUnknown UnknownUnknown
M.exe 00444A29Unknown UnknownUnknown
M.exe 00436E44Unknown UnknownUnknown
kernel32.dll 7C816037Unknown UnknownUnknown
Incrementally linked image--PC correlation disabled.
Press any key to continue
,就不能继续操作了,不知道怎么回事
我使用的是compaq visual fortran6.5编辑器,程序好像是八几年的,我导师给我的,需要我做分离机械结构参数优化,但是调不好