dirsubrout.f

优化问题中的直接搜索法

C| Rescale the variable x.                                               |
C+-----------------------------------------------------------------------+
      do 30 i=1,n
        x(i)=x(i)/c1(i)-c2(i)
 30   continue
      return

      end

C+-----------------------------------------------------------------------+
C| Subroutines to output the iteration history (with boxes) to a file.   |
C+-----------------------------------------------------------------------+
      SUBROUTINE DIRWriteHistBox(point,f,thirds,c,anchor,actdeep,file,
     +               l,u,file2,maxfunc,maxdeep,n,maxor,length)
      IMPLICIT None
      Integer maxfunc,maxdeep,actdeep,file,file2,n,maxor
      Integer length(maxfunc,maxor)
      Double Precision f(maxfunc,2),thirds(maxfunc)
      Double Precision c(maxfunc,n),l(n),u(n)
      Integer anchor(-1:maxdeep),i,point(maxfunc)
      Double Precision ufact(128),help
      Integer j

      do 40,i=1,n
        ufact(i) = (u(i) - l(i))
40    continue
      OPEN(12,FILE="matlab/DIRECT_histbox.dat",STATUS='UNKNOWN')
      DO 10,i = 1,maxfunc
         help = 0.D0
         Do 50, j=1,n
            help = max(help,c(i,j))
50       CONTINUE
         IF (help .GT. 0) THEN
          write(12,1000) f(i,1), f(i,2), (c(i,j)*ufact(j)+l(j),j=1,n), 
     +         (thirds(length(i,j)+1)*ufact(j),j=1,n)
        END IF
10    CONTINUE
      CLOSE(12)
1000  FORMAT(40E18.10)
      END



      SUBROUTINE DIRheader(logfile,version,x,n,eps,maxf,maxT,l,u,
     +               algmethod, maxfunc, maxdeep,    
     +               fglobal, fglper, Ierror,epsfix, iepschange,
     +               volper, sigmaper, 
     +               iidata, iisize, ddata, idsize, cdata, icsize)
      IMPLICIT None
      Integer logfile, version,n, maxf, maxT
      Integer algmethod, Ierror, i, maxfunc, maxdeep
      Double Precision x(n), l(n), u(n), eps    
      Double Precision fglobal, fglper, volper, sigmaper
      Integer iepschange
      Double Precision epsfix
C+-----------------------------------------------------------------------+
C| Variables to pass user defined data to the function to be optimized.  |
C+-----------------------------------------------------------------------+
      INTEGER iisize, idsize, icsize
      INTEGER iidata(iisize)
      Double Precision ddata(idsize)
      Character*40 cdata(icsize)
      
      Integer Imainver, Isubver, Isubsubver, Ihelp, numerrors

      Write(logfile,900)
      numerrors = 0
      IError = 0
      Imainver = INT(version/100)
      Ihelp = version - Imainver*100
      Isubver = INT(Ihelp /10)
      Ihelp = Ihelp - Isubver*10
      Isubsubver = Ihelp
C+-----------------------------------------------------------------------+
C| JG 01/13/01 Added check for epsilon. If epsilon is smaller 0, we use  |
C|             the update formula from Jones. We then set the flag       |
C|             iepschange to 1, and store the absolute value of eps in   |
C|             epsfix. epsilon is then changed after each iteration.     |
C+-----------------------------------------------------------------------+
      If (eps .lt. 0.D0) then
        iepschange = 1
        epsfix =  -eps
        eps = -eps
      else
        iepschange = 0
        epsfix = 1.D100
      endif
      
      write(logfile,100) Imainver, Isubver, Isubsubver
      write(*,100) Imainver, Isubver, Isubsubver
C+-----------------------------------------------------------------------+
C| JG 07/16/01 Removed printout of contents in cdata(1).                 |
C+-----------------------------------------------------------------------+
C      write(*,*) cdata(1)
      write(*,200) n
      write(*,201) eps
      if (iepschange .eq. 1) then
         write(*,206)
      else
         write(*,207)
      end if
      write(*,202) maxf
      write(*,203) maxT
      write(*,204) fglobal
      write(*,205) fglper
      write(*,208) volper
      write(*,209) sigmaper
      
C+-----------------------------------------------------------------------+
C| JG 07/16/01 Removed printout of contents in cdata(1).                 |
C+-----------------------------------------------------------------------+
C      write(logfile,*) cdata(1)
      write(logfile,200) n
      write(logfile,201) eps
      write(logfile,202) maxf
      write(logfile,203) maxT
      write(logfile,204) fglobal
      write(logfile,205) fglper
      write(logfile,208) volper
      write(logfile,209) sigmaper
      if (iepschange .eq. 1) then
         write(logfile,206)
      else
         write(logfile,207)
      end if
      if (algmethod .eq. 0) then
         write(*,*) 'Jones original DIRECT algorithm is used.'
         write(logfile,*) 'Jones original DIRECT algorithm is used.'
      else
         write(*,*) 'Our modification of the DIRECT algorithm is used.'
         write(logfile,*) 'Our modification of the DIRECT algorithm',
     +                    ' is used.'
      end if
      do 1010, i = 1,n
         IF (u(i) .le. l(i)) then
            Ierror = -1
            write(*,153) i,l(i), u(i)
            write(logfile,153) i,l(i), u(i)
            numerrors = numerrors + 1
         else
            write(*,152) i,l(i), u(i)
            write(logfile,152) i,l(i), u(i)
         end if
1010  continue
C+-----------------------------------------------------------------------+
C| If there are to many function evaluations or to many iteration, note  |
C| this and set the error flag accordingly. Note: If more than one error |
C| occurred, we give out an extra message.                               |
C+-----------------------------------------------------------------------+
      IF ((maxf+20) .GT. maxfunc) THEN
         Write(*,10001) maxf, maxfunc
         Write(logfile,10001) maxf, maxfunc
         numerrors = numerrors + 1
         IError = -2
      END IF
      if (IError .lt. 0) then
         write(logfile,120)
         write(*,120)
         if (numerrors .eq. 1) then
            write(*,105)
            write(logfile,105)
         else
            write(*,110) numerrors
            write(logfile,110) numerrors
         end if
      end if
      write(logfile,120)
      write(*,120)
      if (IError .ge. 0) then
         write(logfile,*) 'Iteration   # of f-eval.   fmin'
      end if

10001 FORMAT("WARNING : The maximum number of function evaluations (",
     +       I6,") is higher then the constant maxfunc (",I6,
     +       "). Increase maxfunc in subroutine DIRECT or ",
     + "decrease the maximum number of function evaluations.")
10005 FORMAT("WARNING : The maximum number of iterations (",I5,
     +        ") is higher then the constant maxdeep (",I5,
     +  "). Increase maxdeep or decrease the number of iterations. ")
      
100   FORMAT('DIRECT Version ',I1,'.',I1,'.',I1)
105   FORMAT('WARNING : There was one error in the input!')
110   FORMAT('WARNING : There were ',I2,' errors in the input!')
900   FORMAT('--------------------------------- Log file -------------'
     +       ,'-------------------')
120   FORMAT('--------------------------------------------------------'
     +       ,'-------------------')
152   format('Bounds on variable x',i2,'    : ', F12.5,
     + ' <= xi <= ', F12.5)
153   format('WARNING : Bounds on variable x',i2,'    : ', F12.5,
     + ' <= xi <= ', F12.5)
200   format(' Problem Dimension n                    : ',I6) 
201   format(' Eps value                              : ',E12.4)
202   format(' Maximum number of f-evaluations (maxf) : ',I6)
203   format(' Maximum number of iterations (MaxT)    : ',I6)
204   format(' Value of f_global                      : ',E12.4)
205   format(' Global percentage wanted               : ',E12.4)
206   format(' Epsilon is changed using the Jones formula.')
207   format(' Epsilon is constant.')
208   format(' Volume percentage wanted               : ',E12.4)
209   format(' Measure percentage wanted              : ',E12.4)

      END

      SUBROUTINE DIRsummary(logfile,x,l,u,n,fmin,
     +               fglobal, numfunc, Ierror)
      IMPLICIT None
      Integer logfile, n
      Integer Ierror, numfunc, i
      Double Precision x(n), l(n), u(n)
      Double Precision fglobal , fmin

      Write(logfile,900)
      Write(logfile,1000) fmin
      Write(logfile,1010) numfunc
      if (fglobal .gt. -1.D99) then
         write(logfile,1001) 100*(fmin-fglobal)/max(1.D0,abs(fglobal))
      end if
      Write(logfile,1002) 
      do 100, i = 1,n
         write(logfile,1003) i, x(i), x(i)-l(i), u(i) - x(i)
100   continue
      write(logfile,1200)
      
900   FORMAT('--------------------------------- Summary -------------'
     +       ,'-------------------')
1000  FORMAT('Final function value           : ',F12.7) 
1010  FORMAT('Number of function evaluations : ',I12) 
1001  FORMAT('Final function value is within ',F10.5, 
     +        ' percent of global optimum.')
1002  FORMAT('Index  Final solution   x(i) - l(i)   ',
     +       'u(i) - x(i) ') 
1003  FORMAT(i5,' ',F12.7,'    ',F12.7,'   ',F12.7)
1200  FORMAT('--------------------------------------------------------'
     +       ,'-------------------')

      END
      
      SUBROUTINE DIRMaxf_to_high1(maxf,maxfunc,dwrit,logfile)
      IMPLICIT None
      INTEGER maxf,maxfunc,dwrit,logfile

      Write(*,10001) maxf
      Write(*,10002) maxfunc
      Write(*,10003)
      Write(*,10004)
      IF (dwrit .EQ. 2) THEN
         Write(logfile,10001) maxf
         Write(logfile,10002) maxfunc
         Write(logfile,10003)
         Write(logfile,10004)
      END IF

10001 FORMAT("The maximum number of function evaluations (",
     +       I6,") is ")
10002 FORMAT("higher then the constant maxfunc (",I6,
     +       "). Increase ")
10003 FORMAT("maxfunc in the SUBROUTINE DIRECT or decrease ")
10004 FORMAT("the maximum number of function evaluations.")
      END

      SUBROUTINE DIRMaxT_to_high1(maxT,maxdeep,dwrit,logfile)
      IMPLICIT None
      INTEGER maxT,maxdeep,dwrit,logfile

      Write(*,10001) maxT
      Write(*,10002) maxdeep
      Write(*,10003)
      IF (dwrit .EQ. 2) THEN
         Write(logfile,10001) maxT
         Write(logfile,10002) maxdeep
         Write(logfile,10003)
      END IF

10001 FORMAT("The maximum number of iterations (",I5,
     +        ") is higher ")
10002 FORMAT("then the constant maxdeep (",I5,
     +       "). Increase maxdeep ")
10003 FORMAT("or decrease the number of iterations. ")
      END


      INTEGER Function Isinbox(x,a,b,n,Lmaxdim)
      IMPLICIT None

      Integer n, Lmaxdim
      Double Precision a(Lmaxdim),b(Lmaxdim),x(Lmaxdim)
      
      Integer i,outofbox
      
      outofbox = 1
      DO 1000, i = 1,n
        IF ((a(i) .gt. x(i)) .or. (b(i) .lt. x(i))) then
          outofbox = 0
          goto 1010
        end if
1000  continue
1010  Isinbox = outofbox
      end