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