85 lines
2.8 KiB
FortranFixed
85 lines
2.8 KiB
FortranFixed
!This subroutine fills gaps in the y variable based on neural network regression
|
|
subroutine blockgapfilling(nx,nobs,xsamp,ysamp,nmax)
|
|
implicit none
|
|
!Gaps must be represented by -9999
|
|
!It is ok to have missing values in xsamp. If any dimension in xsamp is missing, that dimension
|
|
!is not used as the independent variable for the gap in y. For different gaps in y, the dimensions used
|
|
!in x may be different.
|
|
integer nx,nobs,nmax
|
|
double precision xsamp(1:nobs,1:nx),ysamp(1:nobs)
|
|
!Locals
|
|
integer i,j,k,n,idowhat,nh,nxfit,nobsfit,ixuse(nx),
|
|
&iposdif,itakethis,iposfit(nobs),iuseit
|
|
|
|
parameter(nh=3)
|
|
double precision w(1:nx,1:nh),bph(nh),q(nh),bend,c(nh),xnew(nx),
|
|
&calvalue(nobs),fn9999,tiny,xfit(nobs,nx),yfit(nobs),rsq
|
|
parameter(fn9999=-9999.0d0,tiny=1.0d-6)
|
|
!
|
|
do i=1,nobs
|
|
if(dabs(ysamp(i)-fn9999).gt.tiny)goto 1000
|
|
!a gap
|
|
nxfit=0
|
|
do j=1,nx
|
|
if(dabs(xsamp(i,j)-fn9999).lt.tiny)then
|
|
!this x dimension is not used
|
|
ixuse(j)=0
|
|
else
|
|
!this x dimension is used
|
|
nxfit=nxfit+1
|
|
xnew(nxfit)=xsamp(i,j)
|
|
ixuse(j)=1
|
|
endif
|
|
enddo
|
|
if(nxfit.eq.0)goto 1000
|
|
!Fill this gap by choosing the nmax valid points that are closest to i for the fitting
|
|
nobsfit=0
|
|
10 iposdif=10000000
|
|
do n=1,nobs
|
|
if(n.ne.i.and.dabs(ysamp(n)-fn9999).gt.tiny)then
|
|
iuseit=1
|
|
!make sure it is not one that has been already selected
|
|
do k=1,nobsfit
|
|
if(n.eq.iposfit(k))iuseit=0
|
|
enddo
|
|
if(iuseit.eq.1)then
|
|
!make sure it has the x dimensions needed
|
|
do j=1,nx
|
|
if(ixuse(j).eq.1)then
|
|
if(dabs(xsamp(n,j)-fn9999).lt.tiny)iuseit=0
|
|
endif
|
|
enddo
|
|
endif
|
|
if(iuseit.eq.1)then
|
|
!make sure the distance is smaller than the current miminum
|
|
if(iabs(n-i).lt.iposdif)then
|
|
iposdif=iabs(n-i)
|
|
itakethis=n
|
|
endif
|
|
endif
|
|
endif
|
|
enddo
|
|
nobsfit=nobsfit+1
|
|
iposfit(nobsfit)=itakethis
|
|
yfit(nobsfit)=ysamp(itakethis)
|
|
n=0
|
|
do j=1,nx
|
|
if(ixuse(j).eq.1)then
|
|
n=n+1
|
|
xfit(nobsfit,n)=xsamp(itakethis,j)
|
|
endif
|
|
enddo
|
|
if(nobsfit.lt.nmax)goto 10
|
|
idowhat=1
|
|
call NeuralNetRegres(idowhat,nxfit,nobsfit,nh,
|
|
&xfit(1:nobsfit,1:nxfit),yfit,calvalue,rsq,
|
|
&w(1:nxfit,1:nh),bph,q,bend,c,xnew,ysamp(i))
|
|
idowhat=2
|
|
call NeuralNetRegres(idowhat,nxfit,1,nh,
|
|
&xfit(1:1,1:nxfit),yfit,calvalue,rsq,
|
|
&w(1:nxfit,1:nh),bph,q,bend,c,xnew,ysamp(i))
|
|
1000 continue
|
|
enddo
|
|
return
|
|
end subroutine blockgapfilling
|