aovobs.f90 Source File


Contents

Source Code


Source Code

Module aovobs
!!   Routines for pre-processing of observations.
!!   This is part of the AOV package of routines for computation and
!!   evaluation of AOV periodograms.
!!   This package is subject to copyrights by its author,
!!   (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: epoch, verbose
      Use aovsub
!
!
      Implicit None
!
      Private
      Public get_obs, test_obs, clr_obs
!
Contains
!
      Function cre_obs (no, weights)
!! create structure for observations
         Type (OBS_T) :: cre_obs !! new obs structure
         Integer, Intent (In) :: no !! number of observations
         Logical, Intent (In) :: weights !! weights present?
         cre_obs%no = no
         Allocate (cre_obs%t(no), cre_obs%v(no))
         If (weights) allocate (cre_obs%w(no))
      End Function cre_obs
!
      Subroutine clr_obs (obs)
!! clear structure for observations
         Type (OBS_T) :: obs !! obs structure to destroy
         If (allocated(obs%w)) deallocate (obs%w)
         If (allocated(obs%v)) deallocate (obs%v)
         If (allocated(obs%t)) deallocate (obs%t)
      End Subroutine clr_obs
!
      Function get_obs (fname)
!! Purpose:
!! Reads 2 or 3 ascii columns of observations from file fname.
!! Returns structure obs storing them. Number of columns is set
!! basing on first line containing 2 or 3 float numbers. Lines
!! inconsistent with the first one are skipped.
         Character (Len=*), Intent (In) :: fname !! Input file name
         Type (OBS_T) :: get_obs !! result obs structure
!
         Type NODE_T
            Real (TIME) :: t
            Real (SP) :: v, w
            Type (NODE_T), Pointer :: next => NULL ()
         End Type NODE_T
         Type (NODE_T), Pointer :: cur, sav, first
         Integer :: io, num, cnt, cols, skip
         Character (Len=80) :: buffer
!
         get_obs%no = 0
!
         cnt = 0
         cols = 0
         skip = 0
         Open (1, File=trim(fname), Status='old', IoStat=io)! get file
         If (io /= 0) Then
            Print *, "***get_obs: Failed to open " // trim (fname)
            Return
         End If
!
         Allocate (cur)
         first => cur
!
         Do ! read one line and add to list
            Read (1, '(A)', IoStat=io) buffer
            If (io /= 0) Exit
            num = 3
            Read (buffer,*, IoStat=io) cur%t, cur%v, cur%w
            If (io /= 0) Then
               num = 2
               Read (buffer,*, IoStat=io) cur%t, cur%v
               cur%w = 1._SP
               If (io /= 0) num = 0
            End If
            If (num > 0) Then
               If (cnt == 0 .And. num >= 2 .And. num <= 3) cols = num
               If (num == cols) Then
                  cnt = cnt + 1
                  Allocate (sav)
                  cur%next => sav
                  cur => sav
               Else
                  skip = skip + 1
               End If
            Else
               skip = skip + 1
            End If
         End Do
         Close (1)
         If (verbose) Print *, "Accepted ", cnt, ", Skipped ", skip
   ! copy observations from list into arrays
         get_obs = cre_obs (cnt, .True.)
         If (get_obs%no <= 0) Return
         get_obs%weights = (cols == 3)
         cur => first
         cnt = 1
         Do
            If ( .Not. associated(cur%next)) Exit
            get_obs%t (cnt) = cur%t
            get_obs%v (cnt) = cur%v
            get_obs%w (cnt) = cur%w
            cnt = cnt + 1
            sav => cur
            cur => cur%next
            Deallocate (sav)
         End Do
         Deallocate (cur)
! normalize times and weights
! For numerical reasons subtract epoch from times
         Call norm_times (epoch, get_obs)
         Where (get_obs%w /= 0._SP) get_obs%w = 1._SP / &
            (Abs(get_obs%w)*get_obs%w)
      End Function get_obs
!
      Subroutine norm_times (epstr, obs)
!! Purpose: <br>
!! Normalize times prior period analysis. Depending on EPSTR and
!! presence of weights calculates EPOCH and subtracts it from
!! all times. This should be done for numerical reasons so that
!! times span zero. Since user may wish a fixed epoch, e.g. to
!! use consistent phase bins, this is not performed inside
!! periodogram routines.
         Character (Len=*), Intent (In) :: epstr !! epoch string
!! permitted: 'MIN','AVE','MED' or real number string
         Type (OBS_T) :: obs !! times modified by subtraction of EPOCH
!
         Integer :: ind (obs%no)
         Real (TIME) :: epval
!
         Call sortx (obs%t, ind)
         obs%tmin = obs%t(ind(1))
         obs%tmax = obs%t(ind(obs%no))
         Read (epstr,*, IoStat=io) epval
         If (io /= 0) Then
            Select Case (trim(epstr))
            Case ('MIN')
               epval = obs%tmin
            Case ('AVE')
               epval = sum (obs%t*obs%w, mask=obs%w > 0._SP) / sum &
              & (obs%w, mask=obs%w > 0._SP)
            Case ('MED')
               epval = obs%t (ind((obs%no+1)/2))
            Case Default
               If (verbose) Print *, "norm_times: warning: wrong EPOCH string"
               epval = obs%tmin
            End Select
         ElseIf ((epval-obs%tmin)*(epval-obs%tmax) > 0._TIME.And.verbose) Then
            Print *, "norm_times: warning: EPOCH out of times range"
         End If
         If (verbose) Print *, "EPOCH= ", obs%epoch
         obs%epoch = epval
         obs%t = obs%t - epval
         If (any(obs%t(2:)-obs%t(:obs%no-1) < 0._TIME) .And. verbose) &
            Print *, "norm_times: warning: times not sorted"
      End Subroutine norm_times
!
      Function test_obs (no)
!! Returns simulated light curve for test purposes.
         Type (OBS_T) :: test_obs !! result structure containing observations
         Integer, Intent (In) :: no !! number of observations to simulate
!
         Integer, Allocatable :: ind (:)
         Integer :: k, k1
         Real (SP) :: s2n, span, omt
         Real (TIME) :: fr, dph
!
         test_obs = cre_obs (no, .True.)
!   simulate data
         s2n = 100._SP
         span = 40._SP
         fr = 1._TIME / 0.3617869_TIME
         Print *, 'Simulated data, FR0=', fr
         Do k = 1, no
            k1 = k - 1
            test_obs%w (k) = 0.5_SP
            test_obs%t (k) = span * Sin (k1*1._TIME) ** 2.
            test_obs%t (1) = 0._TIME
            test_obs%t (no) = span
            dph = fr * test_obs%t(k)
            omt = real (PI2*(dph-floor(dph)), SP)
            test_obs%v (k) = 11.90_SP + 0.434_SP * Cos (omt+4.72_SP) + &
               0.237_SP * Cos (2._SP*omt+0.741_SP) + Sin (k1*1.7_SP) / s2n
         End Do
         test_obs%weights = .True.
!
         Open (4, File='SIMUL1.dat', Status='unknown', IoStat=io)
         If (io /= 0) Then
            Write (*,*) 'Failed to write SIMUL1.dat'
            Stop
         End If
!
         Allocate (ind(no))
         Call sortx (real(test_obs%t-test_obs%t(1), kind=SP), ind)
         Write (4, '(f12.6,f13.6,f11.6)') (test_obs%t(ind(k)), &
            test_obs%v(ind(k)), 1._SP/Sqrt(test_obs%w(ind(k))), k=1, no)
         Close (4)
         Deallocate (ind)
! For numerical reasons subtract epoch from times
         Call norm_times (epoch, test_obs)
!
      End Function test_obs
!
End Module aovobs