tTh/Fortraneries
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

wavmetrics in the wild !

Browse Source
This commit is contained in:
tTh
2024-02-07 02:36:08 +01:00
parent 49183e4153
commit cd715e902f
5 changed files with 106 additions and 11 deletions
Download Patch File Download Diff File Expand all files Collapse all files

63
Modules/wavmetrics.f90
View File

@@ -1,15 +1,16 @@
! new: Thu Jan 4 00:08:04 UTC 2024
module wavmetrics
! new: Thu Jan 4 00:08:04 UTC 2024
use mathstuff2
implicit none
type wavmetric
integer :: num
real :: freql, freqr
integer :: maxl, maxr
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
@@ -17,14 +18,51 @@ module wavmetrics
end type
contains
!-------------------------------------------------------------
subroutine compute_wavmetric(samples, start, size, metrics)
!-
! main computation routine, still full buggy
!-
subroutine compute_wavmetric(samples, size, metrics)
type(intsample), intent(in) :: samples(:)
integer, intent(in) :: start, size
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, Lval)) Rfreq = Rfreq + 1
endif
Lsum = Lsum + Lval
Rsum = Rsum + Rval
enddo
metrics%num = 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
!-------------------------------------------------------------
@@ -32,6 +70,13 @@ end subroutine
subroutine display_wavmetrics(metrics)
type(wavmetric), intent(in) :: metrics
! print '(1X, "metrics are :")'
print '(1X, " | num ", I0)', metrics%num
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
!-------------------------------------------------------------