52 lines
1.6 KiB
FortranFixed
52 lines
1.6 KiB
FortranFixed
subroutine funkmin_stom(ndim,beta,fvalue)
|
|
implicit none
|
|
|
|
include '../testarea/stomoptim.h'
|
|
|
|
integer ndim
|
|
double precision beta(ndim+1),fvalue
|
|
!(in) ndim: the dimension of the parameter vector
|
|
!(in) beta: the parameters
|
|
!(out) fvalue: the value of the cost function at beta
|
|
!
|
|
integer i,j
|
|
double precision stomintercept,stomslope,gswmod,rayDzero
|
|
|
|
!----------- End of variables declaration ---------------------------------
|
|
!
|
|
! check to see if parameters are out of bounds
|
|
do i=1,ndim
|
|
if(beta(i).lt.bmin(i).or.beta(i).gt.bmax(i))then
|
|
! parameter out of bound
|
|
fvalue=1.0d+100
|
|
return
|
|
endif
|
|
enddo
|
|
stomintercept=beta(1)
|
|
stomslope=beta(2)
|
|
if(istommodel.eq.2.or.istommodel.eq.4)rayDzero=beta(3)
|
|
fvalue=0.0d0
|
|
do j=1,nobs
|
|
call StomatalConductance(pco2s(j),rehulfsurf(j),
|
|
& gammas(j),pvapordef_s(j),rayDzero,assim_net(j),
|
|
& istommodel,stomintercept,stomslope,gswmod)
|
|
fvalue=fvalue+(gswmeas(j)-gswmod)**2.0d0
|
|
enddo
|
|
return
|
|
end subroutine funkmin_stom
|
|
!$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
|
|
double precision function f1dim_stom(x)
|
|
INTEGER NMAX
|
|
double precision x
|
|
PARAMETER (NMAX=1000)
|
|
CU USES funkmin_stom
|
|
INTEGER j,ncom
|
|
double precision pcom(NMAX),xicom(NMAX),xt(NMAX)
|
|
COMMON /f1com/ pcom,xicom,ncom
|
|
do 11 j=1,ncom
|
|
xt(j)=pcom(j)+x*xicom(j)
|
|
11 continue
|
|
call funkmin_stom(ncom,xt,f1dim_stom)
|
|
return
|
|
END
|