New changes from l2g

w
2022-09-12 16:40:28 +00:00
parent 78eb7147d0
commit d713d4f61a
110 changed files with 87672 additions and 1098 deletions
@@ -0,0 +1,74 @@
+      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