Files
2022-09-12 16:40:28 +00:00

70 lines
2.2 KiB
FortranFixed

!&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
subroutine stomoptimization(npoints,ioption,pco2s0,rehulfsurf0,
&gammas0,yAnet0,gswmeas0,stomintercept,stomslope,pvapordef_s0,
&rayDzero)
implicit none
include '../testarea/stomoptim.h'
c
integer npoints,ioption
double precision pco2s0(npoints),rehulfsurf0(npoints),
&gammas0(npoints),yAnet0(npoints),gswmeas0(npoints),
&pvapordef_s0(npoints),stomintercept,stomslope,rayDzero
integer i,ndim
double precision beta(10),fatbeta,ftol,f1dim_stom
parameter(ftol=1.0d-7)
external funkmin_stom,f1dim_stom
istommodel=ioption
nobs = npoints
do i=1,npoints
pco2s(i)=pco2s0(i)
rehulfsurf(i)=rehulfsurf0(i)
gammas(i)=gammas0(i)
assim_net(i)=yAnet0(i)
gswmeas(i)=gswmeas0(i)
pvapordef_s(i)=pvapordef_s0(i)
enddo
ndim=2
beta(1)=stomintercept
bmin(1)=0.0d0
bmax(1)=1.0d+7
if(stomintercept.lt.bmin(1).or.stomintercept.gt.bmax(1))
&beta(1)=0.001d0
beta(2)=stomslope
bmin(2)=0.0d0
bmax(2)=1.0d+8
if(stomslope.lt.bmin(2).or.stomslope.gt.bmax(2))
&beta(2)=10.0d0
if(istommodel.eq.1.or.istommodel.eq.3)then
ndim=2
endif
if(istommodel.eq.2.or.istommodel.eq.4)then
ndim=3
beta(3)=rayDzero
bmin(3)=0.00001d0
bmax(3)=1.0d+8
if(rayDzero.lt.bmin(3).or.rayDzero.gt.bmax(3))
&beta(3)=2000.0d0
endif
!
! Initialize the cost function evaluation counter in the subroutine funkmin.
! The counter counts and memorizes points where the cost function is evaluated.
call funkmin_stom(ndim,beta,fatbeta)
call nongradopt(ndim,funkmin_stom,f1dim_stom,beta,
& bmin,bmax,ftol,fatbeta)
call RepeatCompassSearch(ndim,beta,fatbeta,bmin,
& bmax,funkmin_stom,f1dim_stom,ftol)
! Replace these parameters with their optimized values
stomintercept=beta(1)
stomslope=beta(2)
if(istommodel.eq.2.or.istommodel.eq.4)rayDzero=beta(3)
return
END subroutine stomoptimization
c
!$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$