aovspec.f90 Source File


Contents

Source Code


Source Code

Module aovspec
!! Routines for handling frequency spectra.
!! This file is part of AOV package of routines for computation and evaluation
!! of periodograms.
!! (C) A. Schwarzenberg-Czerny 1998-2018, alex@camk.edu.pl
!! Its distribution is free, except that distribution of modifications is
!! prohibited.
!
      Use aovconst
      Use mprms, Only: verbose, fsampl, mxfrq
      Use aovsub
!
!
      Implicit None
!
      Private
      Public fgrid, peak, peakrm, cre_spec, clr_spec
!
Contains
!
      Function cre_spec (nfr, fr0, frs)
!! create structure for spectrum frequency grid
         Type (SPEC_T) :: cre_spec !! new spec structure
         Integer, Intent (In) :: nfr !! number of frequencies
         Real (TIME), Intent (In) :: fr0 !! initial frequency
         Real (TIME), Intent (In) :: frs !! frequency step
!
         cre_spec = SPEC_T (nfr, fr0, frs, NULL())
         Allocate (cre_spec%th(nfr))
         If ( .Not. allocated(cre_spec%th)) Then
            Print *, "cre_spec: Failed memory allocation: th"
            Stop
         End If
      End Function cre_spec
!
      Subroutine clr_spec (spec)
!! clear structure for spectrum frequency grid
         Type (SPEC_T) :: spec !! spec structure to destroy
         Deallocate (spec%th)
      End Subroutine clr_spec
!
      Function fgrid (t, npar, fr0in, fruin, frsin)
!! Purpose:
!! Robust routine for evaluation of the time sampling pattern
!! and guessing a suitable frequency grid. The spec structure containing
!! grid parameters is returned as function value.
!
!
!! (C) A. Schwarzenberg-Czerny 1998-2018, alex@camk.edu.pl
!! Distribution of FGRID is free, except that distribution of modifications is
!! prohibited.
!
         Type (SPEC_T) :: fgrid !! new spec structure
!! spec.NFR, spec.FR0 and spec.FRS
!! where NFR is calculated as (FRU-FR0)/FRS+1
         Integer, Intent (In) :: npar !! number of model parameters (to refine frequency grid)
         Real (TIME), Intent (In) :: t (:)!! times
         Real (TIME), Intent (In) :: fr0in !! low frequency
         Real (TIME), Intent (In) :: frsin !! if positive set input grid values, though fru>=frs is forced;
!!           otherwise they are calculated within routine.
         Real (TIME), Intent (In) :: fruin !! high frequency
!
         Integer :: ind (size(t)), no, nf
         Real (SP) :: d (size(t)-1)
         Real (TIME) :: t0, fru, fr0, frs
!
         no = size (t)
         fru = fruin
         frs = frsin
         fr0 = fr0in
         fru = Max (fru, frs)
         If (frs <= 0._TIME) Then
            t0 = (t(no)+t(1)) * 0.5_TIME
            Call sortx (real(t-t0, SP), ind)
            frs = t (ind(1+Nint(0.93*(no-1)))) - t &
           & (ind(1+Nint(0.07*(no-1))))
            frs = 1._TIME / (frs*npar*fsampl)
            If (fru <= 0._TIME) Then
               d = real (t(ind(2:))-t(ind(:no-1)), SP)
               Call sortx (d, ind(:no-1))
               fru = 1._TIME / d (ind(1+Nint(0.33*(no-2))))
            End If
         End If
         fru = Max (fru, fr0)
         nf = Nint ((fru-fr0)/frs) + 1
         If (nf > mxfrq) Then
            nf = mxfrq
            frs = (fru-fr0) / (nf-1)
            Print '(A)', &
 'FGRID: *** DANGER *** Data spacing too fine or span too long for good', &
 'sampling of periodogramme. Brute solution to increase MXFRQ costs extra', &
 'execution time. You may choose to preset shorter or coarser frequency', &
 'grid by first loading shorter span data to choose a narrower frequency', &
 'range of interest and next load the big data. You may also choose to', &
 'modify the data: if high frequencies do not matter, data could be binned', &
 'into coarser time grid. Alternatively, you may split data into shorter', &
 'intervals and take average of several periodograms, thus keeping the', &
 'frequency range while degrading resolution. This kind of problems are', &
 'fundamental in time-frequency analysis independed of algorithm.', &
 'Violation of the uncertainity principle Dt*Df<1, where either', &
 'Dt-time span and Df-frequency resolution or Dt-resolution and Df-span', &
 'yields respectively undersampling or clipping of (effective) Nyquist', &
 'interval.'
         End If
         fgrid = cre_spec (nf, fr0, frs)
      End Function fgrid
!
      Subroutine peak (n, fx, xm, fm, dx)
!! Scan periodogram for a peak and return its properties<br>
!! Method:<br>
!! For `f=log(fx)` fits a parabola `0.5(d2*x**2+d1*x)+f(2)`
!! where `d2=f(1)+f(3)-2f(2)`, `d1=f(3)-f(1)`
!! finds `dxl` & `dxp` such, that the linear and quadratic terms drop
!! by 0.7 in log, i.e. by a factor of 2 `(dx=HWHI)`.<br>
!! (C) Alex Schwarzenberg-Czerny, 1999-2005 alex@camk.edu.pl
!
         Integer, Intent (In) :: n !! periodogram length
         Real (SP), Intent (In) :: fx (n)!! periodogram values
         Real (TIME), Intent (Out) :: xm !! peak location (in index units, 1<xm<n)
         Real (SP), Intent (Out) :: fm !! peak value;
         Real (SP), Intent (Out) :: dx !! peak halfwidth HWHI,dx<0 no valid peak
!
         Integer :: nm, n0
         Real (SP) :: f (3), d2, d1
!
! valid maximum?
         nm = maxloc (fx, dim=1)
         fm = fx (nm)
         xm = real (nm, TIME)
         dx = - 1.
         If (fm < 0.) Return! linear case (peak at edge)
         n0 = Max (2, Min(n-1, nm))
         f = Log (Max(Abs(fx(n0-1:n0+1))/fm, epsilon(1._SP)))
         d1 = f (3) - f (1)
         dx = - Abs (d1) / 1.4
!
! parabolic case (not on edge)
         d2 = - (f(1)-f(2)-f(2)+f(3))
         If (d2 > 0.7*dx*dx) Then ! original 1.4
            fm = Exp (0.125*d1*d1/d2+f(2)) * fm
            xm = 0.5 * d1 / d2 + n0
            dx = Sqrt (0.7*d2)
         End If
         dx = 1. / dx
      End Subroutine peak
!
      Subroutine peakrm (dt, spec, freq, thm, dfm)
!! Finds a peak and flags it to search for subsequent ones.
!! Flags are negated weights, so they are not lost.
         Real (TIME), Intent (In) :: dt !! peak width
         Type (SPEC_T) :: spec !! spectrum structure (changed on output)
         Real (SP), Intent (Out) :: thm !! current peak value
         Real (SP), Intent (Out) :: dfm !! current peak width
         Real (TIME), Intent (Out) :: freq !! current peak frequency
!
         Integer :: iwdt, nfm, j
!
! find peak
         Call peak (spec%nfr, spec%th, freq, thm, dfm)
         dfm = dfm * real (spec%frs, SP)
         nfm = Nint (freq)
         freq = (freq-1) * spec%frs + spec%fr0
         iwdt = Int (1.7/Abs(dt*spec%frs)) + 1
! remove peak +-iwdt
         Forall (j=Max(1, nfm-iwdt) :Min(spec%nfr, nfm+iwdt)) &
            spec%th(j) = - Abs (spec%th(j))
      End Subroutine peakrm
!
End Module aovspec