498 lines
17 KiB
FortranFixed
498 lines
17 KiB
FortranFixed
subroutine phenofit(nphenocycl0,iphenodowhat0,phenocyclmark,
|
|
&ntotpoints,phenoy,phenox,y0,a1,b1,c1,x01,a2,b2,c2,x02,amin,amax,
|
|
&bmin,bmax,cmin,cmax,y0min,y0max,x01min,x01max,x02min,x02max,ndim,
|
|
&beta,phenoy0,abcx,predphenoy,predphenox,sumsquare)
|
|
implicit none
|
|
integer nphenocycl0,iphenodowhat0(nphenocycl0),ntotpoints
|
|
double precision phenocyclmark(nphenocycl0),phenoy(ntotpoints),
|
|
&phenox(ntotpoints),y0,a1,b1,c1,x01,a2,b2,c2,x02,amin,amax,bmin,
|
|
&bmax,cmin,cmax,y0min,y0max,x01min,x01max,x02min,x02max,phenoy0,
|
|
&abcx(nphenocycl0,8),predphenoy(ntotpoints),predphenox(ntotpoints),
|
|
&sumsquare
|
|
!nphenocycl: the number of individual cycle units
|
|
!iphenodowhat: an index specifying what mathematical function to use for each individual cycle unit
|
|
!iphenodowhat= 1 - 4: double function cycle (paired sigmoid functions)
|
|
! =1: all parameters, 8 params
|
|
! =2: c1 and c2 set 1, 6 params
|
|
! =3: c1=c2=1, a1=a2, 5 params
|
|
! =4: a1=a2, 7 params
|
|
!iphenodowhat= 5 - 6: single function cycle (a2, b2, c2 and x02 are not used)
|
|
! =5: a1, b1, c1, x01. 4 parameters
|
|
! =6: a1, b1, x01. 3 parameters (c1 is set to be 1)
|
|
!
|
|
!ntotpoints: the total number of points in all cycle units
|
|
!phenoy: the y variable
|
|
!phenox: the x variable
|
|
!y0,a1,b1,c1,x01,a2,b2,c2,x02,amin,amax,bmin,bmax,cmin,cmax,y0min,y0max,x01min,x01max,x02min,x02max:
|
|
! - initial guesses and their bounds
|
|
!ndim: the total number of parameters estimated
|
|
!phenoy0: the estimated y0
|
|
!abcx: The parameters estimated for each cycle unit. (-0.9999 indicating not used)
|
|
! abcx(i,1)=a1
|
|
! abcx(i,2)=b1
|
|
! abcx(i,3)=c1
|
|
! abcx(i,4)=x01
|
|
! abcx(i,5)=a2
|
|
! abcx(i,6)=b2
|
|
! abcx(i,7)=c2
|
|
! abcx(i,8)=x02
|
|
!predphenoy: the predicted y variable for each phenox
|
|
!predphenox: the predicted x variable in case orthorgonal regression is used.
|
|
integer iderivative,INFO,j,ndim
|
|
double precision beta(nphenocycl0*8+1),betamin(nphenocycl0*8+1),
|
|
&betamax(nphenocycl0*8+1),weitphenox(ntotpoints),
|
|
&phenoxmin(ntotpoints),phenoxmax(ntotpoints),weitphenoy(ntotpoints)
|
|
!((((((((((((((((((((((((((((((((((((((((((((((((((((
|
|
integer nphenocycl,iphenodowhat(100)
|
|
COMMON /phenocom/nphenocycl,iphenodowhat
|
|
save /phenocom/
|
|
!))))))))))))))))))))))))))))))))))))))))))))))))))))
|
|
nphenocycl=nphenocycl0
|
|
do j=1,nphenocycl
|
|
iphenodowhat(j)=iphenodowhat0(j)
|
|
enddo
|
|
call phenoparams_init(nphenocycl,iphenodowhat,phenocyclmark,
|
|
&y0,a1,b1,c1,x01,a2,b2,c2,x02,amin,amax,bmin,bmax,cmin,cmax,y0min,
|
|
&y0max,x01min,x01max,x02min,x02max,beta,betamin,betamax,ndim)
|
|
iderivative=1
|
|
INFO=0
|
|
!INFO =0, ordinary distance regression
|
|
!INFO =1, explicit orthogonal distance regression with shortest distance within iteration
|
|
!INFO =2, explicit orthogonal distance regression with x positions as parameters
|
|
do j=1,ntotpoints
|
|
weitphenox(j)=1.0d0
|
|
phenoxmin(j)=phenox(j)-20.0d0
|
|
phenoxmax(j)=phenox(j)+20.0d0
|
|
weitphenoy(j)=1.0d0
|
|
enddo
|
|
call GenericRegres(ntotpoints,1,phenoy,1,phenox,weitphenoy,
|
|
&weitphenox,ndim,beta,betamin,betamax,phenoxmin,phenoxmax,
|
|
&iderivative,INFO,predphenoy,predphenox,sumsquare)
|
|
phenoy0=beta(1)
|
|
call phenoparams_alloc(nphenocycl,iphenodowhat,beta,abcx)
|
|
return
|
|
end
|
|
!$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
|
|
subroutine surffunc(nyvars,yvars,nxvars,
|
|
& xvars,ndim,beta,dydxp,idowhat)
|
|
implicit none
|
|
!idowhat=0, value of the function only
|
|
! =1, derivative with respect to the independent variable x and value of the function
|
|
! =2, derivative with respect to the parameters and value of the function
|
|
integer nyvars,nxvars,ndim,idowhat
|
|
double precision yvars(nyvars),xvars(nxvars),
|
|
& beta(ndim),dydxp(nyvars,(nxvars+ndim))
|
|
!((((((((((((((((((((((((((((((((((((((((((((((((((((
|
|
integer nphenocycl,iphenodowhat(100)
|
|
COMMON /phenocom/nphenocycl,iphenodowhat
|
|
save /phenocom/
|
|
!))))))))))))))))))))))))))))))))))))))))))))))))))))
|
|
integer j,NParam,i
|
|
double precision y0,a1,b1,c1,x01,a2,b2,c2,x02,
|
|
&abcx(1:nphenocycl,1:8),twoexpfunc,sigmoidfunc,grad(10)
|
|
y0=beta(1)
|
|
call phenoparams_alloc(nphenocycl,iphenodowhat,beta,
|
|
&abcx(1:nphenocycl,1:8))
|
|
|
|
! write(*,*)y0,ndim
|
|
! do j=1,nphenocycl
|
|
! write(*,330)(abcx(j,i),i=1,8)
|
|
! enddo
|
|
!330 format(8(f15.6))
|
|
! pause
|
|
|
|
yvars(1)=y0
|
|
do j=1,nphenocycl
|
|
a1=abcx(j,1)
|
|
b1=abcx(j,2)
|
|
c1=abcx(j,3)
|
|
x01=abcx(j,4)
|
|
if(iphenodowhat(j).le.4)then
|
|
a2=abcx(j,5)
|
|
b2=abcx(j,6)
|
|
c2=abcx(j,7)
|
|
x02=abcx(j,8)
|
|
yvars(1)=yvars(1)+
|
|
&twoexpfunc(0.0d0,a1,b1,c1,x01,a2,b2,c2,x02,xvars(1))
|
|
else
|
|
yvars(1)=yvars(1)+sigmoidfunc(0.0d0,a1,b1,c1,x01,xvars(1))
|
|
endif
|
|
enddo
|
|
if(idowhat.eq.1)then
|
|
dydxp(1,1)=0.0d0
|
|
do j=1,nphenocycl
|
|
a1=abcx(j,1)
|
|
b1=abcx(j,2)
|
|
c1=abcx(j,3)
|
|
x01=abcx(j,4)
|
|
if(iphenodowhat(j).le.4)then
|
|
a2=abcx(j,5)
|
|
b2=abcx(j,6)
|
|
c2=abcx(j,7)
|
|
x02=abcx(j,8)
|
|
call gradtwoexp(0.0d0,a1,b1,c1,x01,
|
|
&a2,b2,c2,x02,xvars(1),grad)
|
|
else
|
|
call gradsigmoidfunc(0.0d0,a1,b1,c1,x01,xvars(1),grad)
|
|
endif
|
|
dydxp(1,1)=dydxp(1,1)+grad(6)
|
|
enddo
|
|
endif
|
|
if(idowhat.eq.2)then
|
|
NParam=1
|
|
dydxp(1,1)=1.0d0
|
|
do j=1,nphenocycl
|
|
a1=abcx(j,1)
|
|
b1=abcx(j,2)
|
|
c1=abcx(j,3)
|
|
x01=abcx(j,4)
|
|
if(iphenodowhat(j).le.4)then
|
|
a2=abcx(j,5)
|
|
b2=abcx(j,6)
|
|
c2=abcx(j,7)
|
|
x02=abcx(j,8)
|
|
call gradtwoexp(0.0d0,a1,b1,c1,x01,
|
|
&a2,b2,c2,x02,xvars(1),grad)
|
|
else
|
|
call gradsigmoidfunc(0.0d0,a1,b1,c1,x01,xvars(1),grad)
|
|
endif
|
|
! a1<->grad(1)
|
|
! b1<->grad(2)
|
|
! c1<->grad(3)
|
|
! x01<->grad(4)
|
|
! y0<->grad(5)
|
|
! x<->grad(6)
|
|
! a2<->grad(7)
|
|
! b2<->grad(8)
|
|
! c2<->grad(9)
|
|
! x02<->grad(10)
|
|
if(iphenodowhat(j).eq.1)then
|
|
! all parameters in the two exp functions
|
|
dydxp(1,NParam+1)=grad(1)
|
|
dydxp(1,NParam+2)=grad(2)
|
|
dydxp(1,NParam+3)=grad(3)
|
|
dydxp(1,NParam+4)=grad(4)
|
|
dydxp(1,NParam+5)=grad(7)
|
|
dydxp(1,NParam+6)=grad(8)
|
|
dydxp(1,NParam+7)=grad(9)
|
|
dydxp(1,NParam+8)=grad(10)
|
|
NParam=NParam+8
|
|
endif
|
|
if(iphenodowhat(j).eq.2)then
|
|
! c1=c2=1.0
|
|
dydxp(1,NParam+1)=grad(1)
|
|
dydxp(1,NParam+2)=grad(2)
|
|
dydxp(1,NParam+3)=grad(4)
|
|
dydxp(1,NParam+4)=grad(7)
|
|
dydxp(1,NParam+5)=grad(8)
|
|
dydxp(1,NParam+6)=grad(10)
|
|
NParam=NParam+6
|
|
endif
|
|
if(iphenodowhat(j).eq.3)then
|
|
! c1=c2=1.0
|
|
! a1=a2
|
|
dydxp(1,NParam+1)=grad(1)+grad(7)
|
|
dydxp(1,NParam+2)=grad(2)
|
|
dydxp(1,NParam+3)=grad(4)
|
|
dydxp(1,NParam+4)=grad(8)
|
|
dydxp(1,NParam+5)=grad(10)
|
|
NParam=NParam+5
|
|
endif
|
|
if(iphenodowhat(j).eq.4)then
|
|
! a1=a2
|
|
dydxp(1,NParam+1)=grad(1)+grad(7)
|
|
dydxp(1,NParam+2)=grad(2)
|
|
dydxp(1,NParam+3)=grad(3)
|
|
dydxp(1,NParam+4)=grad(4)
|
|
dydxp(1,NParam+5)=grad(8)
|
|
dydxp(1,NParam+6)=grad(9)
|
|
dydxp(1,NParam+7)=grad(10)
|
|
NParam=NParam+7
|
|
endif
|
|
if(iphenodowhat(j).eq.5)then
|
|
! single function, 4 parameters
|
|
dydxp(1,NParam+1)=grad(1)
|
|
dydxp(1,NParam+2)=grad(2)
|
|
dydxp(1,NParam+3)=grad(3)
|
|
dydxp(1,NParam+4)=grad(4)
|
|
NParam=NParam+4
|
|
endif
|
|
if(iphenodowhat(j).eq.6)then
|
|
! single function, 3 parameters, c=1
|
|
dydxp(1,NParam+1)=grad(1)
|
|
dydxp(1,NParam+2)=grad(2)
|
|
dydxp(1,NParam+3)=grad(4)
|
|
NParam=NParam+3
|
|
endif
|
|
enddo
|
|
endif
|
|
return
|
|
end
|
|
!$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
|
|
subroutine phenoparams_init(nphenocycl,iphenodowhat,phenocyclmark,
|
|
&y0,a1,b1,c1,x01,a2,b2,c2,x02,amin,amax,bmin,bmax,cmin,cmax,y0min,
|
|
&y0max,x01min,x01max,x02min,x02max,BETA,BETAmin,BETAmax,NParam)
|
|
implicit none
|
|
integer nphenocycl,iphenodowhat(nphenocycl),NParam,i
|
|
double precision y0,a1,b1,c1,x01,a2,b2,c2,x02,amin,amax,bmin,bmax,
|
|
&cmin,cmax,x01min,x01max,x02min,x02max,y0min,y0max,
|
|
&BETA(nphenocycl*8+1),BETAmin(nphenocycl*8+1),
|
|
&BETAmax(nphenocycl*8+1),phenocyclmark(nphenocycl)
|
|
!number of parameters for each phenocycl
|
|
!iphenodowhat= 1 - 4: double function cycle
|
|
! =1: all parameters, 8 params
|
|
! =2: c1 and c2 set 1, 6 params
|
|
! =3: c1=c2=1, a1=a2, 5 params
|
|
! =4: a1=a2, 7 params
|
|
!
|
|
!iphenodowhat= 5 - 6: single function cycle
|
|
! =5: a, b, c, x0. 4 parameters
|
|
! =6: a, b, x0. c is set to be 1
|
|
!
|
|
! abcx(i,1)=a1
|
|
! abcx(i,2)=b1
|
|
! abcx(i,3)=c1
|
|
! abcx(i,4)=x01
|
|
! abcx(i,5)=a2
|
|
! abcx(i,6)=b2
|
|
! abcx(i,7)=c2
|
|
! abcx(i,8)=x02
|
|
NParam=1
|
|
BETA(1)=y0
|
|
BETAmin(1)=y0min
|
|
BETAmax(1)=y0max
|
|
do i=1,nphenocycl
|
|
if(iphenodowhat(i).eq.1)then
|
|
! all parameters in the two exp functions
|
|
BETA(NParam+1)=a1
|
|
BETA(NParam+2)=b1
|
|
BETA(NParam+3)=c1
|
|
BETA(NParam+4)=phenocyclmark(i)+x01
|
|
BETA(NParam+5)=a2
|
|
BETA(NParam+6)=b2
|
|
BETA(NParam+7)=c2
|
|
BETA(NParam+8)=phenocyclmark(i)+x02
|
|
BETAmin(NParam+1)=amin
|
|
BETAmax(NParam+1)=amax
|
|
BETAmin(NParam+2)=bmin
|
|
BETAmax(NParam+2)=bmax
|
|
BETAmin(NParam+3)=cmin
|
|
BETAmax(NParam+3)=cmax
|
|
BETAmin(NParam+4)=phenocyclmark(i)+x01min
|
|
BETAmax(NParam+4)=phenocyclmark(i)+x01max
|
|
BETAmin(NParam+5)=BETAmin(NParam+1)
|
|
BETAmax(NParam+5)=BETAmax(NParam+1)
|
|
BETAmin(NParam+6)=BETAmin(NParam+2)
|
|
BETAmax(NParam+6)=BETAmax(NParam+2)
|
|
BETAmin(NParam+7)=BETAmin(NParam+3)
|
|
BETAmax(NParam+7)=BETAmax(NParam+3)
|
|
BETAmin(NParam+8)=phenocyclmark(i)+x02min
|
|
BETAmax(NParam+8)=phenocyclmark(i)+x02max
|
|
NParam=NParam+8
|
|
endif
|
|
if(iphenodowhat(i).eq.2)then
|
|
! c1=c2=1.0
|
|
BETA(NParam+1)=a1
|
|
BETA(NParam+2)=b1
|
|
BETA(NParam+3)=phenocyclmark(i)+x01
|
|
BETA(NParam+4)=a2
|
|
BETA(NParam+5)=b2
|
|
BETA(NParam+6)=phenocyclmark(i)+x02
|
|
BETAmin(NParam+1)=amin
|
|
BETAmax(NParam+1)=amax
|
|
BETAmin(NParam+2)=bmin
|
|
BETAmax(NParam+2)=bmax
|
|
BETAmin(NParam+3)=phenocyclmark(i)+x01min
|
|
BETAmax(NParam+3)=phenocyclmark(i)+x01max
|
|
BETAmin(NParam+4)=BETAmin(NParam+1)
|
|
BETAmax(NParam+4)=BETAmax(NParam+1)
|
|
BETAmin(NParam+5)=BETAmin(NParam+2)
|
|
BETAmax(NParam+5)=BETAmax(NParam+2)
|
|
BETAmin(NParam+6)=phenocyclmark(i)+x01min
|
|
BETAmax(NParam+6)=phenocyclmark(i)+x02max
|
|
NParam=NParam+6
|
|
endif
|
|
if(iphenodowhat(i).eq.3)then
|
|
! c1=c2=1.0
|
|
! a1=a2
|
|
BETA(NParam+1)=a1
|
|
BETA(NParam+2)=b1
|
|
BETA(NParam+3)=phenocyclmark(i)+x01
|
|
BETA(NParam+4)=b2
|
|
BETA(NParam+5)=phenocyclmark(i)+x02
|
|
BETAmin(NParam+1)=amin
|
|
BETAmax(NParam+1)=amax
|
|
BETAmin(NParam+2)=bmin
|
|
BETAmax(NParam+2)=bmax
|
|
BETAmin(NParam+3)=phenocyclmark(i)+x01min
|
|
BETAmax(NParam+3)=phenocyclmark(i)+x01max
|
|
BETAmin(NParam+4)=BETAmin(NParam+2)
|
|
BETAmax(NParam+4)=BETAmax(NParam+2)
|
|
BETAmin(NParam+5)=phenocyclmark(i)+x02min
|
|
BETAmax(NParam+5)=phenocyclmark(i)+x02max
|
|
NParam=NParam+5
|
|
endif
|
|
if(iphenodowhat(i).eq.4)then
|
|
! a1=a2
|
|
BETA(NParam+1)=a1
|
|
BETA(NParam+2)=b1
|
|
BETA(NParam+3)=c1
|
|
BETA(NParam+4)=phenocyclmark(i)+x01
|
|
BETA(NParam+5)=b2
|
|
BETA(NParam+6)=c2
|
|
BETA(NParam+7)=phenocyclmark(i)+x02
|
|
BETAmin(NParam+1)=amin
|
|
BETAmax(NParam+1)=amax
|
|
BETAmin(NParam+2)=bmin
|
|
BETAmax(NParam+2)=bmax
|
|
BETAmin(NParam+3)=cmin
|
|
BETAmax(NParam+3)=cmax
|
|
BETAmin(NParam+4)=phenocyclmark(i)+x01min
|
|
BETAmax(NParam+4)=phenocyclmark(i)+x01max
|
|
BETAmin(NParam+5)=BETAmin(NParam+2)
|
|
BETAmax(NParam+5)=BETAmax(NParam+2)
|
|
BETAmin(NParam+6)=BETAmin(NParam+3)
|
|
BETAmax(NParam+6)=BETAmax(NParam+3)
|
|
BETAmin(NParam+7)=phenocyclmark(i)+x02min
|
|
BETAmax(NParam+7)=phenocyclmark(i)+x02max
|
|
NParam=NParam+7
|
|
endif
|
|
if(iphenodowhat(i).eq.5)then
|
|
! single function, 4 parameters
|
|
BETA(NParam+1)=a1
|
|
BETA(NParam+2)=b1
|
|
BETA(NParam+3)=c1
|
|
BETA(NParam+4)=phenocyclmark(i)+x01
|
|
BETAmin(NParam+1)=amin
|
|
BETAmax(NParam+1)=amax
|
|
BETAmin(NParam+2)=bmin
|
|
BETAmax(NParam+2)=bmax
|
|
BETAmin(NParam+3)=cmin
|
|
BETAmax(NParam+3)=cmax
|
|
BETAmin(NParam+4)=phenocyclmark(i)+x01min
|
|
BETAmax(NParam+4)=phenocyclmark(i)+x01max
|
|
NParam=NParam+4
|
|
endif
|
|
if(iphenodowhat(i).eq.6)then
|
|
! single function, 3 parameters, c=1
|
|
BETA(NParam+1)=a1
|
|
BETA(NParam+2)=b1
|
|
BETA(NParam+3)=phenocyclmark(i)+x01
|
|
BETAmin(NParam+1)=amin
|
|
BETAmax(NParam+1)=amax
|
|
BETAmin(NParam+2)=bmin
|
|
BETAmax(NParam+2)=bmax
|
|
BETAmin(NParam+3)=phenocyclmark(i)+x01min
|
|
BETAmax(NParam+3)=phenocyclmark(i)+x01max
|
|
NParam=NParam+3
|
|
endif
|
|
enddo
|
|
return
|
|
end
|
|
!$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
|
|
subroutine phenoparams_alloc(nphenocycl,iphenodowhat,BETA,abcx)
|
|
implicit none
|
|
integer nphenocycl,iphenodowhat(nphenocycl)
|
|
double precision BETA(nphenocycl*8+1),abcx(nphenocycl,8)
|
|
integer NParam,i
|
|
|
|
!number of parameters for each phenocycl
|
|
!iphenodowhat= 1 - 4: double function cycle
|
|
! =1: all parameters, 8 params
|
|
! =2: c1 and c2 set 1, 6 params
|
|
! =3: c1=c2=1, a1=a2, 5 params
|
|
! =4: a1=a2, 7 params
|
|
!
|
|
!iphenodowhat= 5 - 6: single function cycle
|
|
! =5: a, b, c, x0. 4 parameters
|
|
! =6: a, b, x0. c is set to be 1
|
|
|
|
! abcx(i,1)=a1
|
|
! abcx(i,2)=b1
|
|
! abcx(i,3)=c1
|
|
! abcx(i,4)=x01
|
|
! abcx(i,5)=a2
|
|
! abcx(i,6)=b2
|
|
! abcx(i,7)=c2
|
|
! abcx(i,8)=x02
|
|
|
|
NParam=1
|
|
do i=1,nphenocycl
|
|
if(iphenodowhat(i).eq.1)then
|
|
! all parameters in the two exp functions
|
|
abcx(i,1)=BETA(NParam+1)
|
|
abcx(i,2)=BETA(NParam+2)
|
|
abcx(i,3)=BETA(NParam+3)
|
|
abcx(i,4)=BETA(NParam+4)
|
|
abcx(i,5)=BETA(NParam+5)
|
|
abcx(i,6)=BETA(NParam+6)
|
|
abcx(i,7)=BETA(NParam+7)
|
|
abcx(i,8)=BETA(NParam+8)
|
|
NParam=NParam+8
|
|
endif
|
|
if(iphenodowhat(i).eq.2)then
|
|
! c1=c2=1.0
|
|
abcx(i,1)=BETA(NParam+1)
|
|
abcx(i,2)=BETA(NParam+2)
|
|
abcx(i,3)=1.0d0
|
|
abcx(i,4)=BETA(NParam+3)
|
|
abcx(i,5)=BETA(NParam+4)
|
|
abcx(i,6)=BETA(NParam+5)
|
|
abcx(i,7)=1.0d0
|
|
abcx(i,8)=BETA(NParam+6)
|
|
NParam=NParam+6
|
|
endif
|
|
if(iphenodowhat(i).eq.3)then
|
|
! c1=c2=1.0
|
|
! a1=a2
|
|
abcx(i,1)=BETA(NParam+1)
|
|
abcx(i,2)=BETA(NParam+2)
|
|
abcx(i,3)=1.0d0
|
|
abcx(i,4)=BETA(NParam+3)
|
|
abcx(i,5)=abcx(i,1)
|
|
abcx(i,6)=BETA(NParam+4)
|
|
abcx(i,7)=1.0d0
|
|
abcx(i,8)=BETA(NParam+5)
|
|
NParam=NParam+5
|
|
endif
|
|
if(iphenodowhat(i).eq.4)then
|
|
! a1=a2
|
|
abcx(i,1)=BETA(NParam+1)
|
|
abcx(i,2)=BETA(NParam+2)
|
|
abcx(i,3)=BETA(NParam+3)
|
|
abcx(i,4)=BETA(NParam+4)
|
|
abcx(i,5)=abcx(i,1)
|
|
abcx(i,6)=BETA(NParam+5)
|
|
abcx(i,7)=BETA(NParam+6)
|
|
abcx(i,8)=BETA(NParam+7)
|
|
NParam=NParam+7
|
|
endif
|
|
if(iphenodowhat(i).eq.5)then
|
|
! single function, 4 parameters
|
|
abcx(i,1)=BETA(NParam+1)
|
|
abcx(i,2)=BETA(NParam+2)
|
|
abcx(i,3)=BETA(NParam+3)
|
|
abcx(i,4)=BETA(NParam+4)
|
|
abcx(i,5)=0.0d0
|
|
abcx(i,6)=-0.9999d0
|
|
abcx(i,7)=0.0d0
|
|
abcx(i,8)=-0.9999d0
|
|
NParam=NParam+4
|
|
endif
|
|
if(iphenodowhat(i).eq.6)then
|
|
! single function, 3 parameters
|
|
abcx(i,1)=BETA(NParam+1)
|
|
abcx(i,2)=BETA(NParam+2)
|
|
abcx(i,3)=1.0d0
|
|
abcx(i,4)=BETA(NParam+3)
|
|
abcx(i,5)=0.0d0
|
|
abcx(i,6)=-0.9999d0
|
|
abcx(i,7)=0.0d0
|
|
abcx(i,8)=-0.9999d0
|
|
NParam=NParam+3
|
|
endif
|
|
enddo
|
|
return
|
|
end
|
|
!$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$
|