var_data.f90

Go to the documentation of this file.

!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!!! Time-stamp: <2016-10-18 14:56:12 pbrowne>
!!!
!!!    module to store data for variational methods
!!!    Copyright (C) 2015  Philip A. Browne
!!!
!!!    This program is free software: you can redistribute it and/or modify
!!!    it under the terms of the GNU General Public License as published by
!!!    the Free Software Foundation, either version 3 of the License, or
!!!    (at your option) any later version.
!!!
!!!    This program is distributed in the hope that it will be useful,
!!!    but WITHOUT ANY WARRANTY; without even the implied warranty of
!!!    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
!!!    GNU General Public License for more details.
!!!
!!!    You should have received a copy of the GNU General Public License
!!!    along with this program.  If not, see <http://www.gnu.org/licenses/>.
!!!
!!!    Email: p.browne @ reading.ac.uk
!!!    Mail:  School of Mathematical and Physical Sciences,
!!!           University of Reading,
!!!       Reading, UK
!!!       RG6 6BB
!!!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

module var_data

  implicit none
  type, public :: var_control_type
     character(6) :: opt_method
     integer :: cg_method
     real(kind=kind(1.0d0)) :: cg_eps

     real(kind=kind(1.0d0)) :: lbfgs_factr

     

     real(kind=kind(1.0d0)) :: lbfgs_pgtol
     

     real(kind=kind(1.0d0)), dimension(:), allocatable :: l,u,x0
     integer, dimension(:), allocatable :: nbd

     integer :: n
     integer :: total_timesteps

     integer, allocatable, dimension(:) :: ny

  end type var_control_type
  type(var_control_type), save :: vardata


contains
  subroutine set_var_controls
    use output_empire, only : emp_o

    write(emp_o,'(A)') 'Opening namelist file to read var_params'

    call parse_vardata

    write(emp_o,'(A)') 'var_params successfully read from nml file to control pf code.'

  end subroutine set_var_controls


  subroutine parse_vardata
    use output_empire, only : unit_vardata,emp_e
    implicit none
    character(*), parameter :: filename='vardata.nml'
    character(*), parameter :: filename2='empire.nml'
    integer :: ios

    character(6) :: opt_method='CG'
    integer :: cg_method=2
    real(kind=kind(1.0d0)) :: cg_eps=1.0d-5
    real(kind=kind(1.0d0)) :: lbfgs_factr=1.0d+7
    real(kind=kind(1.0d0)) :: lbfgs_pgtol=1.0d-5 
    integer :: n=-1
    integer :: total_timesteps = -1

    namelist/var_params/opt_method,&
         &cg_method,&
         &cg_eps,&
         &lbfgs_factr,&
         &lbfgs_pgtol,&
         &total_timesteps,&
         &n

    !set defaults:
    vardata%opt_method = opt_method
    vardata%cg_method = cg_method
    vardata%cg_eps = cg_eps
    vardata%lbfgs_factr = lbfgs_factr
    vardata%lbfgs_pgtol = lbfgs_pgtol
    vardata%n = n
    vardata%total_timesteps = total_timesteps



    open(unit_vardata,file=filename,iostat=ios,action='read',status='old')
    if(ios .ne. 0) then
       write(*,*) 'Cannot open ',filename
       
       open(unit_vardata,file=filename2,iostat=ios,action='read',status='old')
       
       if(ios .ne. 0) then
          write(emp_e,*) 'Cannot open ',filename2
          write(emp_e,*) 'var_data ERROR: no .nml file found. STOPPING.'
          stop '-65'
       end if
       
       read(unit_vardata,nml=var_params,iostat=ios) 
       if(ios .ne. 0) then
          write(emp_e,*) 'var_data ERROR: no var_params namelist found in &
               &',filename,' or ',filename2,'. STOPPING.'
          stop '-66'
       end if
       
    else
       read(unit_vardata,nml=var_params,iostat=ios)
       if(ios .ne. 0) then
          close(unit_vardata)
          open(unit_vardata,file=filename2,iostat=ios,action='read',status='old')
          if(ios .ne. 0) then
             write(emp_e,*) 'var_data ERROR: no var_params namelist found &
                  &in &              
               &',filename,' and could not open ',filename2,'. STOPPING.'
             stop '-67'
          end if

          read(unit_vardata,nml=var_params,iostat=ios)
          if(ios .ne. 0) then
             write(emp_e,*) 'var_data ERROR: no var_params namelist found in &
                  &',filename,' or ',filename2,'. STOPPING.'
             stop '-68'
          end if
       end if
    end if
    close(unit_vardata)

















    select case (opt_method)
    case('cg')
       write(*,*) 'VAR_DATA: Nonlinear Conjugate Gradient Method selected'
       vardata%opt_method = opt_method
    case('lbfgs')
       write(*,*) 'VAR_DATA: Unconstrained L-BFGS Method selected'
       vardata%opt_method = opt_method
    case('lbfgsb')
       write(*,*) 'VAR_DATA: Bound constrained L-BFGS Method selected'
       vardata%opt_method = opt_method
    case default
       write(emp_e,*) 'VAR_DATA ERROR: opt_method in ',filename,' incorrect&
            &ly given as ',opt_method
       write(emp_e,*) 'VAR_DATA ERROR: Correct inputs are:'
       write(emp_e,*) 'VAR_DATA ERROR: cg'
       write(emp_e,*) 'VAR_DATA ERROR: lbfgs'
       write(emp_e,*) 'VAR_DATA ERROR: lbfgsb'
       stop 3
    end select

    if(cg_method .lt. 1 .or. cg_method .gt. 3) then
       write(emp_e,*) 'VAR_DATA ERROR: cg_method in ',filename, ' incorrect&
            &ly given as ',cg_method
       write(emp_e,*) 'VAR_DATA ERROR: Correct inputs are:'
       write(emp_e,*) 'VAR_DATA ERROR: 1  FLETCHER-REEVES '
       write(emp_e,*) 'VAR_DATA ERROR: 2  POLAK-RIBIERE (DEFAULT)'
       write(emp_e,*) 'VAR_DATA ERROR: 3  POSITIVE POLAK-RIBIERE ( BETA=MAX{BETA,0} )'
       stop 4
    else
       vardata%cg_method = cg_method
       if(vardata%opt_method .eq. 'cg') then
          select case (vardata%cg_method)
          case(1) 
             write(*,*) 'CG METHOD 1:  FLETCHER-REEVES '
          case(2)
             write(*,*) 'CG METHOD 2:  POLAK-RIBIERE (DEFAULT)'
          case(3)
             write(*,*) 'CG METHOD 3:  POSITIVE POLAK-RIBIERE'
          case default
          end select
       end if
    end if


    if(cg_eps .ne. 1.0d-5) then
       if(cg_eps .lt. 0.0d0) then
          write(emp_e,*) 'VAR_DATA ERROR: cg_eps read as negative: ',cg_eps
          write(emp_e,*) 'VAR_DATA ERROR: Please make cg_eps positive (small).'
          stop 5
       elseif(cg_eps .ge. 0.5d0) then
          write(*,*) 'VAR_DATA WARNING: cg_eps read as "large": '&
               &,cg_eps
          write(*,*) 'VAR_DATA WARNING: cg_eps default is 1.0d-5'
       else
          write(*,*) 'VAR_DATA: CG tolerance read in as ',cg_eps
          vardata%cg_eps = cg_eps
       end if
    else
       vardata%cg_eps = 1.0d-5
    end if

    if(lbfgs_factr .ne. 1.0d+7) then
       write(*,*) 'VAR_DATA: LBFGS factr read in as ',lbfgs_factr
       vardata%lbfgs_factr = lbfgs_factr    
    end if


    if(lbfgs_pgtol .ne. 1.0d-5) then
       write(*,*) 'VAR_DATA: LBFGS pgtol read in as ',lbfgs_pgtol
       vardata%lbfgs_pgtol = lbfgs_pgtol
    end if


    !    if(n .lt. 1) then
    !       write(*,*) 'VAR_DATA ERROR: n < 1'
    !       stop 2
    !    else
    !       vardata%n = n
    !    end if
    !print*,'nens = ',nens
    !vardata%n = nens-1
    
    !vardata%n = -2
    

    if(total_timesteps .lt. 1) then
       write(emp_e,*) 'VAR_DATA ERROR: total_timesteps < 1'
       stop 6
    else
       vardata%total_timesteps = total_timesteps
    end if



  end subroutine parse_vardata


  subroutine allocate_vardata
    allocate(vardata%x0(vardata%n))

    allocate(vardata%ny(vardata%total_timesteps))


    if(vardata%opt_method == 'lbfgsb') then
       allocate(vardata%nbd(vardata%n))
       allocate(vardata%l(vardata%n))
       allocate(vardata%u(vardata%n))
    end if

  end subroutine allocate_vardata

  subroutine deallocate_vardata
    if(allocated(vardata%x0)) deallocate(vardata%x0)
    if(allocated(vardata%ny)) deallocate(vardata%ny)
    if(allocated(vardata%nbd)) deallocate(vardata%nbd)
    if(allocated(vardata%l)) deallocate(vardata%l)
    if(allocated(vardata%u)) deallocate(vardata%u)
  end subroutine deallocate_vardata


  subroutine read_lbfgsb_bounds
  end subroutine read_lbfgsb_bounds

  subroutine read_observation_numbers
    vardata%ny = 0
    vardata%ny(8) = 3
    vardata%ny(16) = 3
    vardata%ny(24) = 3
    print*,'vardata%ny = ',vardata%ny
  end subroutine read_observation_numbers


end module var_data