minimize Subroutine

public subroutine minimize(n, m, x, lb, ub, cube, n_gauss, dim_v, dim_y, dim_x, lambda_amp, lambda_mu, lambda_sig, lambda_var_amp, lambda_var_mu, lambda_var_sig, maxiter, kernel, iprint, std_map, mean_amp, mean_mu, mean_sig)

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(:,:,:), allocatable:: cube
integer, intent(in) :: n_gauss
integer, intent(in) :: dim_v
integer, intent(in) :: dim_y
integer, intent(in) :: dim_x
real(kind=xp), intent(in) :: lambda_amp
real(kind=xp), intent(in) :: lambda_mu
real(kind=xp), intent(in) :: lambda_sig
real(kind=xp), intent(in) :: lambda_var_amp
real(kind=xp), intent(in) :: lambda_var_mu
real(kind=xp), intent(in) :: lambda_var_sig
integer, intent(in) :: maxiter
real(kind=xp), intent(in), dimension(:,:), allocatable:: kernel
integer, intent(in) :: iprint
real(kind=xp), intent(in), dimension(:,:), allocatable:: std_map
real(kind=xp), intent(in), dimension(:), allocatable:: mean_amp
real(kind=xp), intent(in), dimension(:), allocatable:: mean_mu
real(kind=xp), intent(in), dimension(:), allocatable:: mean_sig

Calls

proc~~minimize~~CallsGraph proc~minimize minimize proc~setulb setulb proc~minimize->proc~setulb proc~f_g_cube f_g_cube proc~minimize->proc~f_g_cube proc~myfunc_spec myfunc_spec proc~f_g_cube->proc~myfunc_spec proc~ravel_3d ravel_3D proc~f_g_cube->proc~ravel_3d proc~convolution_2d_mirror convolution_2D_mirror proc~f_g_cube->proc~convolution_2d_mirror proc~unravel_3d unravel_3D proc~f_g_cube->proc~unravel_3d

Called by

proc~~minimize~~CalledByGraph proc~minimize minimize proc~update update proc~update->proc~minimize

Contents

Source Code


Source Code

  subroutine minimize(n, m, x, lb, ub, cube, n_gauss, dim_v, dim_y, dim_x, lambda_amp, lambda_mu, lambda_sig, &
       lambda_var_amp, lambda_var_mu, lambda_var_sig, maxiter, kernel, iprint, std_map, mean_amp, mean_mu, mean_sig)
    implicit none      

    integer, intent(in) :: n
    integer, intent(in) :: m
    integer, intent(in) :: dim_v, dim_y, dim_x
    integer, intent(in) :: n_gauss, maxiter
    integer, intent(in) :: iprint
    
    real(xp), intent(in) :: lambda_amp, lambda_mu, lambda_sig
    real(xp), intent(in) :: lambda_var_amp, lambda_var_mu, lambda_var_sig
    real(xp), intent(in), dimension(:), allocatable :: lb, ub
    real(xp), intent(in), dimension(:,:,:), allocatable :: cube
    real(xp), intent(in), dimension(:,:), allocatable :: kernel
    real(xp), intent(in), dimension(:,:), allocatable :: std_map
    real(xp), intent(in), dimension(:), allocatable :: mean_amp, mean_mu, mean_sig    

    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, dim_y, dim_x))

    residual = 0._xp
    f = 0._xp
    g = 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 f_g_cube(f, g, cube, x, dim_v, dim_y, dim_x, n_gauss, kernel, lambda_amp, lambda_mu, lambda_sig, &
               lambda_var_amp, lambda_var_mu, lambda_var_sig, std_map, mean_amp, mean_mu, mean_sig)
          
       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