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

wavmetrics: add a small test

Browse Source
This commit is contained in:
tTh 2024-02-08 04:07:42 +01:00
parent f039df4fe2
commit 09a4cb7cff
4 changed files with 37 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
Modules/.gitignore vendored
View File

@ -3,6 +3,8 @@ chkpixels
twavm twavm
trnd trnd
datas/
*.pgm *.pgm
*.pnm *.pnm
*.png *.png

2
Modules/Makefile
View File

@ -6,7 +6,7 @@
GFOPT = -Wall -Wextra -g -I. GFOPT = -Wall -Wextra -g -I.
all: chkpixels trnd all: chkpixels trnd twavm
# --------------------------------------------------------- # ---------------------------------------------------------

34
Modules/twavm.f90
View File

@ -1,4 +1,4 @@
program essai program twavm
! new: Wed Feb 7 01:27:48 UTC 2024 ! new: Wed Feb 7 01:27:48 UTC 2024
@ -6,9 +6,9 @@ program essai
use wavmetrics use wavmetrics
implicit none implicit none
write(0, *) "----------------- essai -------------------" write(0, *) "----------------- twavm -------------------"
call run_first_test(44100/30) call run_second_test(44100/30)
contains contains
!----------------------------------------------------------------------- !-----------------------------------------------------------------------
@ -35,5 +35,33 @@ subroutine run_first_test(nbs)
end subroutine end subroutine
!----------------------------------------------------------------------- !-----------------------------------------------------------------------
!-----------------------------------------------------------------------
!-
!- we read the datas from stdin
!-
subroutine run_second_test(nbs)
integer, intent(in) :: nbs ! nombre d'echantillons
type(intsample), allocatable :: samples(:)
type(wavmetric) :: metrics
integer :: foo, bar
integer :: vl, vr
write(0, '(1X, "second test on ", I0, " samples.")') nbs
! create the buffer, and fill it with stdin
allocate(samples(nbs))
do foo=1, nbs
read(5, *) vl, vr
! print '(1X, 2I16)', vl, vr
samples(foo)%left = vl
samples(foo)%right = vr
enddo
! compute and display the metrics (gi-go)
call compute_wavmetric(samples, nbs, metrics)
call display_wavmetrics(metrics)
end subroutine
!-----------------------------------------------------------------------
end program end program

6
Modules/wavmetrics.f90
View File

@ -48,7 +48,7 @@ subroutine compute_wavmetric(samples, size, metrics)
if (idx .GT. 1) then if (idx .GT. 1) then
if (diff_sign(samples(idx-1)%left, Lval)) Lfreq = Lfreq + 1 if (diff_sign(samples(idx-1)%left, Lval)) Lfreq = Lfreq + 1
if (diff_sign(samples(idx-1)%right, Lval)) Rfreq = Rfreq + 1 if (diff_sign(samples(idx-1)%right, Rval)) Rfreq = Rfreq + 1
endif endif
Lsum = Lsum + Lval Lsum = Lsum + Lval
@ -56,7 +56,7 @@ subroutine compute_wavmetric(samples, size, metrics)
enddo enddo
metrics%num = size metrics%nbre = size
metrics%maxl = Lmax ; metrics%maxr = Rmax metrics%maxl = Lmax ; metrics%maxr = Rmax
metrics%freql = 1.0 / (Lfreq / real(size)) metrics%freql = 1.0 / (Lfreq / real(size))
metrics%freqr = 1.0 / (Rfreq / real(size)) metrics%freqr = 1.0 / (Rfreq / real(size))
@ -72,7 +72,7 @@ subroutine display_wavmetrics(metrics)
! print '(1X, "metrics are :")' ! print '(1X, "metrics are :")'
print '(1X, " | num ", I0)', metrics%num print '(1X, " | nbre ", I0)', metrics%nbre
print '(1X, " | freq ", 2F12.2)', metrics%freql, metrics%freqr print '(1X, " | freq ", 2F12.2)', metrics%freql, metrics%freqr
print '(1X, " | mean ", 2F12.2)', metrics%meanl, metrics%meanr print '(1X, " | mean ", 2F12.2)', metrics%meanl, metrics%meanr
print '(1X, " | maxi ", 2I8)', metrics%maxl, metrics%maxr print '(1X, " | maxi ", 2I8)', metrics%maxl, metrics%maxr