86 lines
2.4 KiB
Fortran
86 lines
2.4 KiB
Fortran
|
|
module wavmetrics
|
|
|
|
! new: Thu Jan 4 00:08:04 UTC 2024
|
|
|
|
use mathstuff2
|
|
implicit none
|
|
|
|
type wavmetric
|
|
integer :: nbre ! number of slices/samples
|
|
real :: freql, freqr ! zero-crossing estimation
|
|
integer :: maxl, maxr ! maximum of abs values
|
|
real :: meanl, meanr
|
|
end type
|
|
|
|
type intsample
|
|
integer :: left, right
|
|
end type
|
|
|
|
contains
|
|
!-------------------------------------------------------------
|
|
!-
|
|
! main computation routine, still full buggy
|
|
!-
|
|
subroutine compute_wavmetric(samples, size, metrics)
|
|
type(intsample), intent(in) :: samples(:)
|
|
integer, intent(in) :: size
|
|
type(wavmetric), intent(out) :: metrics
|
|
|
|
integer :: Lmax, Rmax
|
|
integer :: Lval, Rval
|
|
integer :: idx
|
|
integer :: Lfreq, Rfreq
|
|
|
|
real :: Lsum, Rsum
|
|
|
|
Lmax = 0 ; Rmax = 0
|
|
Lfreq = 1 ; Rfreq = 1
|
|
Lsum = 0.0 ; Rsum = 0.0
|
|
|
|
do idx=1, size
|
|
Lval = samples(idx)%left
|
|
Rval = samples(idx)%right
|
|
|
|
! print *, Rval, Lval
|
|
if (abs(Lval) .GT. Lmax) Lmax = abs(Lval)
|
|
if (abs(Rval) .GT. Rmax) Rmax = abs(Rval)
|
|
|
|
if (idx .GT. 1) then
|
|
if (diff_sign(samples(idx-1)%left, Lval)) Lfreq = Lfreq + 1
|
|
if (diff_sign(samples(idx-1)%right, Rval)) Rfreq = Rfreq + 1
|
|
endif
|
|
|
|
Lsum = Lsum + Lval
|
|
Rsum = Rsum + Rval
|
|
|
|
enddo
|
|
|
|
metrics%nbre = size
|
|
metrics%maxl = Lmax ; metrics%maxr = Rmax
|
|
metrics%freql = 1.0 / (Lfreq / real(size))
|
|
metrics%freqr = 1.0 / (Rfreq / real(size))
|
|
metrics%meanl = Lsum / real(size)
|
|
metrics%meanr = Rsum / real(size)
|
|
|
|
end subroutine
|
|
|
|
!-------------------------------------------------------------
|
|
|
|
subroutine display_wavmetrics(metrics)
|
|
type(wavmetric), intent(in) :: metrics
|
|
|
|
! print '(1X, "metrics are :")'
|
|
|
|
print '(1X, " | nbre ", I0)', metrics%nbre
|
|
print '(1X, " | freq ", 2F12.2)', metrics%freql, metrics%freqr
|
|
print '(1X, " | mean ", 2F12.2)', metrics%meanl, metrics%meanr
|
|
print '(1X, " | maxi ", 2I8)', metrics%maxl, metrics%maxr
|
|
|
|
end subroutine
|
|
|
|
!-------------------------------------------------------------
|
|
!-------------------------------------------------------------
|
|
|
|
end module
|