2014-03-05 13:20:40 -05:00
|
|
|
subroutine flat1(savg,iz,nsmo,syellow)
|
2013-01-22 14:19:00 -05:00
|
|
|
|
2014-03-05 13:20:40 -05:00
|
|
|
real savg(iz)
|
|
|
|
|
real syellow(iz)
|
|
|
|
|
real x(8192)
|
2013-01-22 14:19:00 -05:00
|
|
|
|
|
|
|
|
ia=nsmo/2 + 1
|
2014-03-05 13:20:40 -05:00
|
|
|
ib=iz - nsmo/2 - 1
|
|
|
|
|
nstep=20
|
|
|
|
|
nh=nstep/2
|
|
|
|
|
do i=ia,ib,nstep
|
|
|
|
|
call pctile(savg(i-nsmo/2),nsmo,50,x(i))
|
|
|
|
|
x(i-nh:i+nh-1)=x(i)
|
2013-01-22 14:19:00 -05:00
|
|
|
enddo
|
|
|
|
|
do i=1,ia-1
|
|
|
|
|
x(i)=x(ia)
|
|
|
|
|
enddo
|
2014-03-05 13:20:40 -05:00
|
|
|
do i=ib+1,iz
|
2013-01-22 14:19:00 -05:00
|
|
|
x(i)=x(ib)
|
|
|
|
|
enddo
|
|
|
|
|
|
2014-03-05 13:20:40 -05:00
|
|
|
x0=0.001*maxval(x(1:iz))
|
|
|
|
|
syellow(1:iz)=savg(1:iz)/(x(1:iz)+x0)
|
2013-01-22 14:19:00 -05:00
|
|
|
|
|
|
|
|
return
|
|
|
|
|
end subroutine flat1
|
|
|
|
|
|
