minimize_spec Subroutine

public subroutine minimize_spec(n, m, x, lb, ub, line, dim_v, n_gauss, maxiter, iprint)

Minimize algorithn for a specturm

Arguments

Type IntentOptional AttributesName
integer, intent(in) :: n
integer, intent(in) :: m
real(kind=xp), intent(in), dimension(:), allocatable:: x
real(kind=xp), intent(in), dimension(:), allocatable:: lb
real(kind=xp), intent(in), dimension(:), allocatable:: ub
real(kind=xp), intent(in), dimension(dim_v):: line
integer, intent(in) :: dim_v
integer, intent(in) :: n_gauss
integer, intent(in) :: maxiter
integer, intent(in) :: iprint

Calls

proc~~minimize_spec~~CallsGraph proc~minimize_spec minimize_spec proc~myfunc_spec myfunc_spec proc~minimize_spec->proc~myfunc_spec proc~setulb setulb proc~minimize_spec->proc~setulb proc~myresidual myresidual proc~minimize_spec->proc~myresidual proc~mygrad_spec mygrad_spec proc~minimize_spec->proc~mygrad_spec proc~gaussian gaussian proc~myresidual->proc~gaussian

Called by

proc~~minimize_spec~~CalledByGraph proc~minimize_spec minimize_spec proc~upgrade upgrade proc~upgrade->proc~minimize_spec proc~init_spectrum init_spectrum proc~init_spectrum->proc~minimize_spec

Contents

Source Code


Source Code

  subroutine minimize_spec(n, m, x, lb, ub, line, dim_v, n_gauss, maxiter, iprint)
    !! Minimize algorithn for a specturm
    implicit none      

    integer, intent(in) :: n
    integer, intent(in) :: m
    integer, intent(in) :: dim_v
    integer, intent(in) :: n_gauss, maxiter
    integer, intent(in) :: iprint

    real(xp), intent(in), dimension(:), allocatable :: lb, ub
    real(xp), intent(in), dimension(dim_v) :: line

    real(xp), intent(in), dimension(:), allocatable :: x
    
    real(xp), parameter    :: factr  = 1.0d+7, pgtol  = 1.0d-5
    
    character(len=60)      :: task, csave
    logical                :: lsave(4)
    integer                :: isave(44)
    real(xp)               :: f
    real(xp)               :: dsave(29)
    integer,  dimension(:), allocatable  :: nbd, iwa
    real(xp), dimension(:), allocatable  :: g, wa

    real(xp), dimension(:), allocatable  :: residual
    
    !     Allocate dynamic arrays
    allocate(nbd(n), g(n))
    allocate(iwa(3*n))
    allocate(wa(2*m*n + 5*n + 11*m*m + 8*m))

    allocate(residual(dim_v))
    residual = 0._xp

    ! Init nbd
    nbd = 2
    
    !     We now define the starting point.
    !     We start the iteration by initializing task.
    task = 'START'
    
    !     The beginning of the loop
    do while(task(1:2).eq.'FG'.or. task.eq.'NEW_X' .or. task.eq.'START') 
       
       !     This is the call to the L-BFGS-B code.
       call setulb (n, m, x, lb, ub, nbd, f, g, factr, pgtol, wa, iwa, task, iprint, csave, lsave, isave, dsave)
       
       if (task(1:2) .eq. 'FG') then          
          !     Compute function f and gradient g for the sample problem.
          call myresidual(x, line, residual, n_gauss, dim_v)
          f = myfunc_spec(residual)          
          call mygrad_spec(n_gauss, g, residual, x, dim_v)
          
       elseif (task(1:5) .eq. 'NEW_X') then
          !        1) Terminate if the total number of f and g evaluations
          !             exceeds maxiter.
          if (isave(34) .ge. maxiter) &
               task='STOP: TOTAL NO. of f AND g EVALUATIONS EXCEEDS LIMIT'
          
          !        2) Terminate if  |proj g|/(1+|f|) < 1.0d-10.            
          if (dsave(13) .le. 1.d-10*(1.0d0 + abs(f))) &
               task='STOP: THE PROJECTED GRADIENT IS SUFFICIENTLY SMALL'
       endif
    !     end of loop do while       
    end do
  end subroutine minimize_spec