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