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