SUB_WAVELET/Fortran/SUB_upsconv1.f90
2025-04-17 17:31:56 +08:00

43 lines
828 B
Fortran

SUBROUTINE upsconv1(nx,x,nf,f,s,y)
implicit none
integer :: nx,nf,s
real*8 :: x(nx),f(nf),y(s)
integer :: lx,lf,tempn,tempn2,i,first,last
real*8 :: d
real*8,allocatable :: tempy(:),tempy2(:)
y = 0
lx = 2*nx
lf = nf
tempn = lx-1
allocate(tempy(tempn))
tempy = 0
do i=1,tempn,2
tempy(i) = x(i/2+1)
end do
tempn2 = tempn+nf-1
allocate(tempy2(tempn2))
call conv(tempn,tempy,nf,f,tempy2(1:tempn2))
deallocate(tempy)
if(s<0.or.s>=tempn2) then
y(1:tempn2) = tempy2(1:tempn2)
goto 10
end if
d = (tempn2-s)/2.0
first = 1+int(floor(d))
last = tempn2-int(ceiling(d))
!ny = last-first+1
y(1:s) = tempy2(first:last)
deallocate(tempy2)
10 end subroutine