Commit f45746c1 authored by Stephan Thober's avatar Stephan Thober
Browse files

**Various**

- use nelminrange instead of nelmin
- started to modularize program
- further modularization needed before parallelization can be implemented
parent 74a15fa7
......@@ -30,8 +30,9 @@ program ED_Kriging
use mainVar , only: yStart, yEnd, jStart, jEnd, & ! interpolation time periods
grid, gridMeteo, & ! grid properties of input and output grid
nCell ! number of cells
use mo_setVario , only: setVario
use kriging
implicit none
integer(i4) :: icell ! loop varaible for cells
......@@ -58,7 +59,6 @@ program ED_Kriging
print*, 'finished reading of meteorological data'
! estimate variogram
call setVario(param)
stop 'TESTING OPTIMIZATION'
! write variogram
if (flagVario) call WriteDataMeteo(0,0,2)
!
......@@ -92,21 +92,10 @@ program ED_Kriging
end if
! write output
select case (trim(adjustl(outputformat)))
case('bin')
call WriteDataMeteo(year,doy,1)
case('nc')
allocate(tmp_array(gridMeteo%nrows, gridMeteo%ncols)); tmp_array=real(grid%nodata_value, dp)
tmp_array = real(reshape(cell(:)%z,(/gridMeteo%nrows, gridMeteo%ncols/)), dp)
call WriteFluxState((jday-jStart+1), netcdfid, transpose(tmp_array))
deallocate(tmp_array)
case DEFAULT
print*, '***ERROR: Output format not known: ', trim(adjustl(outputformat))
stop
end select
allocate(tmp_array(gridMeteo%nrows, gridMeteo%ncols)); tmp_array=real(grid%nodata_value, dp)
tmp_array = real(reshape(cell(:)%z,(/gridMeteo%nrows, gridMeteo%ncols/)), dp)
call WriteFluxState((jday-jStart+1), netcdfid, transpose(tmp_array))
deallocate(tmp_array)
end do timeloop
......@@ -114,7 +103,7 @@ program ED_Kriging
if (outputformat=='nc') call CloseFluxState_file(netcdfid)
end if
! deallocate memory !
! deallocate memory
call clean
! Timer
call Timer
......
......@@ -12,6 +12,15 @@
! Last update 19.02.2004
!
!**************************************************************************
module mo_EmpVar
implicit none
private
public :: EmpVar
contains
subroutine EmpVar(jd, flagMax)
use mainVar
use mo_kind , only : i4, dp
......@@ -75,7 +84,7 @@ subroutine EmpVar(jd, flagMax)
end if
end if
!
k=ceiling(dS(i)%S(j)/dh)
k=max(1, ceiling(dS(i)%S(j)/dh))
Nh(k)=Nh(k)+1
gamma(k,2)=gamma(k,2) + dz2S(i)%S(j)
end if
......@@ -153,3 +162,4 @@ subroutine EmpVar(jd, flagMax)
end subroutine EmpVar
end module mo_EmpVar
......@@ -44,8 +44,8 @@ subroutine ReadDataMain
! *************************************
if (flagVario .AND. flagEDK) then
print*, 'Both flags flagVario and flagEDK should not be activated at the same time!'
stop
print*, '***Warning: Both flags flagVario and flagEDK should not be activated at the same time!'
! stop
end if
ios = 0
......
......@@ -15,7 +15,7 @@ subroutine OPTI(pmin)
use VarFit
use mo_kind, only: i4, dp
use mo_obj_func, only: obj_func
use mo_nelmin, only: nelmin
use mo_nelmin, only: nelmin, nelminrange
! parameters for Nelder-Mead algorithm
real(dp) :: pstart(3) ! Starting point for the iteration.
......@@ -47,19 +47,19 @@ subroutine OPTI(pmin)
! DATA BIG/1.D31/
! Initialization of Nelder-Mead
pstart = (/0.05, 10., 0.5/) ! Starting point for the iteration.
pstart = (/0.0, 1., 0.5/) ! Starting point for the iteration.
prange(:, 1) = (/0., 0., 0./) ! Range of parameters (lower bound).
prange(:, 2) = (/2., 10., 2./) ! Range of parameters (upper bound).
prange(:, 2) = (/0.3, 5., 2./) ! Range of parameters (upper bound).
varmin = 0.001 ! the terminating limit for the variance of the function values. varmin>0 is required
step = (/0.001, 1., 0.01/) ! determines the size and shape of the initial simplex. The relative magnitudes of its elements should reflect the units of the variables. size(step)=size(start)
step = (/0.15, 2.5, 1./) ! determines the size and shape of the initial simplex. The relative magnitudes of its elements should reflect the units of the variables. size(step)=size(start)
konvge = 100 ! the convergence check is carried out every konvge iterations
maxeval = 2000 ! the maximum number of function evaluations. default: 1000
! Call Nelder-Mead optimizer to reduce GCOMP
pmin = nelmin(obj_func, pstart, varmin, step, konvge, maxeval, &
funcmin, neval, numrestart, ierror, history)
! pmin = nelminrange(obj_func, pstart, prange, varmin, step, konvge, maxeval, &
! funcmin, neval, numrestart, ierror)
! pmin = nelmin(obj_func, pstart, varmin, step, konvge, maxeval, &
! funcmin, neval, numrestart, ierror, history)
pmin = nelminrange(obj_func, pstart, prange, varmin, step, konvge, maxeval, &
funcmin, neval, numrestart, ierror)
! scale up distance h
where (gamma(:,1) > 0._dp) gamma(:,1) = gamma(:,1) * gmax(1)
......@@ -75,7 +75,7 @@ subroutine OPTI(pmin)
print *, "p_obj: ", pmin
print *, 'error: ', ierror
print *, 'varmin: ', varmin
print *, 'history: ', history(1), history(size(history))
if (allocated(history)) print *, 'history: ', history(1), history(size(history))
print *, 'gmax: ', gmax(1)
......
......@@ -29,6 +29,19 @@ MODULE mo_write_fluxes_states
CONTAINS
subroutine initOutFile(ncid)
! use mo_netcdf, only:
implicit none
integer(i4), intent(out) :: ncid
stop 'testing initOutFile'
end subroutine initOutFile
! ------------------------------------------------------------------
! NAME
......
......@@ -10,10 +10,21 @@
! Created Sa 19.02.2004 main structure
! Last update 12.04.2006
!**********************************************************************************
module mo_setVario
implicit none
private
public :: setVario
contains
subroutine setVario(param)
use runControl
use VarFit
use mainVar
use mo_EmpVar, only: EmpVar
use mo_kind, only: i4, dp
implicit none
real(dp), intent(out) :: param(3)
......@@ -45,3 +56,5 @@ subroutine setVario(param)
end if
end subroutine setVario
end module mo_setVario
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment