Fortran Coder
标题: forrtl: severe (29): file not found, unit 1, file 问题 [打印本页]
作者: 我是处手 时间: 2014-4-29 20:39
标题: forrtl: severe (29): file not found, unit 1, file 问题
[Fortran] 纯文本查看 复制代码
c fortran language program oof mixed discret composite programming
integer 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,
1 FUN,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',
1 recl=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,
1 2X,'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,
1 5X,'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),
1 ixb(20),xt(20),ixt(20),dx(20),idx(20),g(500),iv(20,41),y(41),
2 xv(500,20)
common /c0/i1,i2,i3,i4,i5,i6/c1/n,m,en,p,eq,nv/c2/mi,cycle,cst,
1 fun,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),
1 dfdx(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
作者: 我是处手 时间: 2014-4-29 20:40
[Fortran] 纯文本查看 复制代码
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,/,
1 10x,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',
1 RECL=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,/,
1 10x,'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),
1 iv(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),
1 iv(20,41),xt(20),ixt(20),xu(20),ixu(20),xl(20),ixl(20),dx(20),
2 idx(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
作者: 我是处手 时间: 2014-4-29 20:43
生成exe执行件,从7001开始不能操作,求帮忙找找原因,谢谢各位
作者: 楚香饭 时间: 2014-4-29 22:20
我听不懂你的意思。什么叫 从 7001 开始不能操作？
作者: 我是处手 时间: 2014-4-29 23:06
7001 format(3x,'data file name=****.***')
从这里开始打不开open以后
作者: 我是处手 时间: 2014-4-30 00:22
我QQ:736223939,愿意帮助我的,加我好友,重谢
作者: pasuka 时间: 2014-4-30 08:11
lz这么长又无任何注释的代码，就别指望有热心人会无偿替你帮忙了
建议去水木社区的数值计算版面，发帖有偿征人调试吧，那里牛人更多些
作者: 楚香饭 时间: 2014-4-30 08:30
请详细描述你遇到的问题，错误提示，现象。否则没人可以帮助你。
作者: 我是处手 时间: 2014-4-30 09:53
这是约束非线性离散变量组合型优化设计方法,我下面代有优化数学模型,执行生成exe文件后,操作到[Fortran] 纯文本查看 复制代码
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',
1 recl=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 004193F9 Unknown Unknown Unknown
M.exe 0041922B Unknown Unknown Unknown
M.exe 00418434 Unknown Unknown Unknown
M.exe 00418869 Unknown Unknown Unknown
M.exe 00413314 Unknown Unknown Unknown
M.exe 00401C7D Unknown Unknown Unknown
M.exe 00444A29 Unknown Unknown Unknown
M.exe 00436E44 Unknown Unknown Unknown
kernel32.dll 7C816037 Unknown Unknown Unknown
Incrementally linked image--PC correlation disabled.
Press any key to continue
,就不能继续操作了,不知道怎么回事
作者: 我是处手 时间: 2014-4-30 09:56
我使用的是compaq visual fortran6.5编辑器,程序好像是八几年的,我导师给我的,需要我做分离机械结构参数优化,但是调不好
作者: pasuka 时间: 2014-4-30 10:00
本帖最后由 pasuka 于 2014-4-30 10:09 编辑
我的建议：
为发论文毕业的话，就别折腾这种F77的古董了，直接上matlab，使用现成工具箱的话，代码量不会超过300行
btw，这样的导师一来不负责任，二来长期脱离科研第一线，三则高估了现在学生的学习能力和学习欲望了
作者: 我是处手 时间: 2014-4-30 10:07
除了这样,没有办法了吗?
作者: pasuka 时间: 2014-4-30 10:23
本帖最后由 pasuka 于 2014-4-30 10:25 编辑
1、从lz的发帖来看，我感觉不到lz有任何主动学习的欲望和想法，只是被动完成老板交代的任务；
2、如果1成立，那么多快好省地完成任务，按时发论文毕业且找到满意的工作才是最符合lz利益的
综上所述，我的建议就是彻底和fortran说88，投入matlab的怀抱，上手快，可以吃现成饭，网上参考资料也多，甚至可以说是信手拈来，最合适不过的敲门砖
若1不成立，那么请问lz花费多少精力在学习fortran和优化算法上面了呢？彭国伦的书看过了吗？本站的相关文章阅读了多少？优化算法的书又看了多少？文献又阅读了多少？
一分耕耘一分收获，读研做项目可以取巧，但是不能饭来张口，衣来伸手
以上是一家之言，仅供lz参考，人各有志，不能强求
作者: fcode 时间: 2014-4-30 14:00
楼上说得对。
如果你打算静下来检查问题的错误，这里可能有一些线索。
[Fortran] 纯文本查看 复制代码
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(*,*)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',
1 recl=80)
几点建议：
1.除非万不得已，read 语句一律用 * ，而不要格式符控制。
2.你的错误在于找不到 1 号文件。
open(1,file=chr2 这里的 chr2 可能根本就没有值。因为 read 的格式是 7003 format(17x,a)
为什么要用 17x,a 来读取字符串呢？？不是很奇怪么？用 read(*,*) 就可以了
作者: aliouying 时间: 2014-5-2 21:45
确定文件名是"chr2" ?
作者: 我是处手 时间: 2014-5-3 21:59
对于楼上各位评论,我接受,我也很无语,这程序是八几年导师买来的,里面没有任何注释,我只知道是约束非线性混合离散变量组合型优化程序,里面是一维搜索方法,我就开始看这个优化方法的内容和程序,关于里面的字符含义百分之八十没有具体说明.非计算机专业,fortran我本人看书学习了一个月,语法懂些,没有自己设计过程序.关于这个帖子的问题,已经解决.
在执行件中,输入数据,有严格格式要求,当时没有注意.谢谢各位了.
目前又出现新问题了 Vertices Storage File Name=****.*** NSCH=***
0012.dat 001
Input Vertices?(y/n)y
forrtl: severe (36): attempt to access non-existent record, unit 2, file F:\M\00
12.dat
Image PC Routine Line Source
M.exe 00419409 Unknown Unknown Unknown
M.exe 0041923B Unknown Unknown Unknown
M.exe 00418444 Unknown Unknown Unknown
M.exe 00418879 Unknown Unknown Unknown
M.exe 00414F1A Unknown Unknown Unknown
M.exe 00414710 Unknown Unknown Unknown
M.exe 00405AE6 Unknown Unknown Unknown
M.exe 00404C87 Unknown Unknown Unknown
M.exe 00444A39 Unknown Unknown Unknown
M.exe 00436E54 Unknown Unknown Unknown
kernel32.dll 7C816037 Unknown Unknown Unknown
Incrementally linked image--PC correlation disabled.
Press any key to continue
真心不懂,如果有懂的,或者可以帮助调试整个程序的,可以私密我QQ736223939.有偿
作者: 我是处手 时间: 2014-5-3 22:20
data file name=****.***
读入时格式控制,输入正好对齐****.***
程序执行时是这样来的,你说的也行,这个程序是F77,这个程序是六五国家科技攻关项目
作者: 我是处手 时间: 2014-5-3 22:23
突然好失落啊,被鄙视了,确实,若是直接用matlab工具箱,带入个数学优化模型就搞定,那学位论文的题目又有何意义?
作者: fcode 时间: 2014-5-4 05:28
1.这里没有计算机专业的。据我所知，没有，大家都是非计算机专业。
2.你别介意，大家给你意见，是为让你提高。尽管有时候不太中听。
3.关于 attempt to access non-existent record, 的问题，请看本章常见错误：http://error.w.fcode.cn
作者: 我是处手 时间: 2014-5-4 23:37
[Fortran] 纯文本查看 复制代码
WRITE(*,'(1x,A)')'Vertices Storage File Name=****.*** NSCH=***'
READ(*,'(28X,A8,6X,I3)')NAME,NSCH
919 write(*,'(1x,a,\)')'Input Vertices?(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',
1 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,/,
1 10x,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',
1 RECL=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
管理员,我在窗口里按提示输入数据,中间到goto913那句就出现forrtl: severe (36): attempt to access non-existent record, unit 2,导师说以前就打不开,我应该怎么改写,纠结快一星期了,可以指导下吗?
作者: pasuka 时间: 2014-5-5 06:16
好吧，实在是恨铁不成钢。。。另外，lz导师也够厉害的，一个三无程序就这么随随便便丢给学生去捣鼓了，感觉更像建筑工地的包工头而不是大学教师
fortran和matlab都是工具，为啥换一个更趁手的工具，学位论文的题目就没有意义了呢？
作者: vvt 时间: 2014-5-5 06:22
常见错误里都有的。看看对二进制文件的读取，超过了文件已有的内容长度。
作者: 我是处手 时间: 2014-5-5 16:13
这个我改长度还是一样,读取不了,很肉疼啊
作者: vvt 时间: 2014-5-6 11:06
这个问题是一个综合的问题，这取决于你的数据是如何存储的？应该有多少记录？你的代码读取了多少记录？在你的想法中，每笔记录应该是多少字节？
不是说，把他总数凑成一样就可以。
这需要你对二进制数据文件有足够的了解，对数据的含义有足够的了解。
如果你对二进制读写不熟悉，可阅读 http://www.fcode.cn/guide-4-1.html
你给了一大堆代码，但依然不完整（我不能编译链接），也没有给出数据文件（甚至数据说明，而数据说明很重要），别人很难帮助你。
作者: li913 时间: 2014-5-10 19:46
提示的意思就是没找到文件。
作者: 艾艾奥里斯 时间: 2014-5-13 19:17
文件找不到啊。
你DEBUG到具体的出错行（估计是open语句），看一看路径是否正确。
作者: 我是处手 时间: 2014-5-14 21:10
[img][/img]
作者: 我是处手 时间: 2014-5-14 22:09
ntdll! 7c92120e()求解决办法
作者: fcode 时间: 2014-5-15 09:38
看不到你的图片哦，亲，请以附件形式上传图片
作者: 我是处手 时间: 2014-5-15 14:58
作者: 我是处手 时间: 2014-8-1 11:59
fcode, 帖子删了吧,前段时间没有顾上,帖子搁浅了,sorry.这个问题知道原因了,记录长度的问题,就是不知道这个RECL=长度要怎么确定,感谢大家的帮助了,谢谢
作者: fcode 时间: 2014-8-1 13:09
哎呀，解决了就解决了。为什么要删除帖子呢？
作者: xiaorenwu 时间: 2014-8-2 15:46
在哪里有？？？？
| 欢迎光临 Fortran Coder (http://bbs.fcode.cn/) |
Powered by Discuz! X3.2 |