forrtl: severe (29): file not found, unit 1, file 问题

我是处手 · 发表于 2014-4-29 20:39:37

[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:19

[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:54

生成exe执行件,从7001开始不能操作,求帮忙找找原因,谢谢各位

楚香饭 · 发表于 2014-4-29 22:20:32

我听不懂你的意思。什么叫从 7001 开始不能操作？

我是处手 · 发表于 2014-4-29 23:06:02

7001 format(3x,'data file name=****.***')
从这里开始打不开open以后

我是处手 · 发表于 2014-4-30 00:22:09

我QQ:736223939,愿意帮助我的,加我好友,重谢

pasuka · 发表于 2014-4-30 08:11:42

我是处手发表于 2014-4-30 00:22
我QQ:736223939,愿意帮助我的,加我好友,重谢

lz这么长又无任何注释的代码，就别指望有热心人会无偿替你帮忙了
建议去水木社区的数值计算版面，发帖有偿征人调试吧，那里牛人更多些

楚香饭 · 发表于 2014-4-30 08:30:46

请详细描述你遇到的问题，错误提示，现象。否则没人可以帮助你。

我是处手 · 发表于 2014-4-30 09:53:32

这是约束非线性离散变量组合型优化设计方法,我下面代有优化数学模型,执行生成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:21

我使用的是compaq visual fortran6.5编辑器,程序好像是八几年的,我导师给我的,需要我做分离机械结构参数优化,但是调不好

[文件读写] forrtl: severe (29): file not found, unit 1, file 问题

评分

新人勋章

爱心勋章

水王勋章

元老勋章

热心勋章