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