75 lines
2.0 KiB
FortranFixed
75 lines
2.0 KiB
FortranFixed
program main
|
|
implicit none
|
|
double precision lamta(100),fmeas(100),sigma(100),chisq,
|
|
&u(100,10),v(10,10),w(10),beta(10),fmod(100)
|
|
integer i,ma,mp,np,ndata,nsifparams
|
|
double precision solar(100)
|
|
Common /irradiance/solar,nsifparams
|
|
external getsifbasisfunc
|
|
!u(mp,np),v(np,np),w(np),x(ndata),y(ndata),TOL
|
|
|
|
lamta(1)=730.0d0
|
|
ndata=90
|
|
do i= 2,ndata
|
|
lamta(i)=lamta(i-1)+1.0d0
|
|
enddo
|
|
do i=1,ndata
|
|
solar(i)=100.0d0*dabs(dsin(dble(i)*6.28d0/5.0d0))
|
|
sigma(i)=1.0d0
|
|
enddo
|
|
beta(1)=3.20d0
|
|
beta(2)=-10.23d0
|
|
beta(3)=-99.9d0
|
|
beta(4)=25.0d0
|
|
beta(5)=-200.0d0
|
|
beta(6)=157.0d0
|
|
ma=6
|
|
nsifparams=3
|
|
c mp>=ndata, np>=ma. ma is the number of coefficients
|
|
mp=ndata
|
|
np=ma
|
|
|
|
do i=1,ndata
|
|
call SIFforwardmodel(lamta(i),i,fmeas(i),beta,ma)
|
|
enddo
|
|
call svdfit(lamta,fmeas,sigma,ndata,beta,ma,u(1:mp,1:np),
|
|
*v(1:np,1:np),w,mp,np,chisq,getsifbasisfunc)
|
|
do i=1,ma
|
|
write(*,*)beta(i),w(i)
|
|
enddo
|
|
do i=1,ndata
|
|
call SIFforwardmodel(lamta(i),i,fmod(i),beta,ma)
|
|
write(*,*)lamta(i),fmeas(i),fmod(i)
|
|
enddo
|
|
end
|
|
|
|
subroutine SIFforwardmodel(lamta,ipos,irradmeas,beta,ma)
|
|
implicit none
|
|
integer ma,ipos,i
|
|
double precision lamta,irradmeas,beta(ma),basisfunc(ma)
|
|
call getsifbasisfunc(lamta,basisfunc,ma,ipos)
|
|
irradmeas=0.0d0
|
|
do i=1,ma
|
|
irradmeas=irradmeas+beta(i)*basisfunc(i)
|
|
enddo
|
|
return
|
|
end
|
|
|
|
subroutine getsifbasisfunc(x,basisfunc,ma,ipos)
|
|
implicit none
|
|
double precision x,basisfunc(ma)
|
|
integer ma,ipos,i
|
|
integer nsifparams
|
|
double precision solar(100)
|
|
Common /irradiance/solar,nsifparams
|
|
basisfunc(1)=1.0d0
|
|
do i=2,nsifparams
|
|
basisfunc(i)=basisfunc(i-1)*x
|
|
enddo
|
|
basisfunc(nsifparams+1)=solar(ipos)
|
|
do i=nsifparams+2,ma
|
|
basisfunc(i)=basisfunc(i-1)*x
|
|
enddo
|
|
return
|
|
end
|