      PROGRAM fourierquantiles
!
!     Estimate the quantiles of the probability distribution of a variable
!     at a single location as a continuous Fourier series function of the time
!     of the year.
!
!      The input file (INFILE) contains the time series of observations
!      The output file (OUTFILE) contains the quantiles from 1% to 99%,
!      for each output UTC hour separately.        
!         
!-------------------------------------------------------
!     Jouni Räisänen, University of Helsinki, July 2023         
!-------------------------------------------------------
!
!     INPUT AND OUTPUT FILES
!-------------------------------------------------------
!                
!     INFILE (input): text file of input data, converted from .odb format
!             using an 'odb sql select' command. 
!
!       The first line is a header. The other lines are assumed
!       to include the time separated to four parts, and the
!       Actual data value of one parameter, i.e.:       
!
!       1) year
!       2) month
!       3) day
!       4) hour 
!       5  value        
!        
!     OUTFILE: (output): text file giving quantiles for each calendar
!     day and hour. This can be converted to .odb using
!     and 'odb import' command.
!
!      The first line is a header. The other lines include
!      (all items separated by a space):  
!
!      1) station code
!      2-3) station longitude and latitude
!      4-5) month and day
!      6-104) quantiles from 1% to 99%
!
!    OUTFILE_GRADS (output, optional) = GrADS output file (for easier plotting)
!        
!    Notes on files:
        
!          1) Station code, longitude and latitude are given as
!             namelist parameters. They are not included in INFILE 
!          2) Year is not written in quantile output because the
!             quantiles are assumed to be independent of year  
!             (true in a stationary climate).
!          3) OUTFILE_GRADS is not needed if python is used for plotting     
!
!-------------------------------------------------------------                
!     NAMELIST PARAMETERS:
!-------------------------------------------------------------        
!
!    NWAVES = Number of Fourier waves in fitting the annual cycle. This
!           is an important choice, because there is a tradeoff between
!           sampling errors (too large NWAVES) and systematic errors
!           (too small NWAVES). NWAVES = 4 is a first suggestion
!           for 2m temperature but the optimum will depend on length
!           of data record, variable etc.
!
!    INFILE = input file with station time series (see above)
!    OUTFILE = output file with quantiles (see above)
!    OUTFILE_GRADS = output file in GrADS binary format (see above)
!    GRADS_OUT : If .true., output is also written in a GrADS binary file
!              for easier plotting.
!      
!    YEAR1 = first year taken into account in calculation of quantiles
!    YEAR2 = first year taken into account in calculation of quantiles
!        
!    Observations outside [YEAR1,YEAR2] are ignored
!
!    HOUR1 = first UTC hour in output
!    HOUR2 = last UTC hour in output
!    HOUR_STEP = interval of UTC hours in output        
!    L_ROUND_HOUR : if .true., hour rounded to the nearest output hour
!                   (otherwise, data for non-matching hours are ignored)
!      
!    L_CODE_IN_CHAR: if .true., the station code is assumed to be 
!                    a 3-character string (as for GRUAN soundings).
!                   Otherwise, station code as integer is assumed.
!    STATION_INT = station code in integer
!    STATION_CHAR = station code as a 3-character string (GRUAN SOUNDINGS)
!    LONGITUDE = station longitude
!    LATITUDE = station latitude
!
!    In practice, the station code and coordinates need to be found
!    beforehand from a .odb file.
!
!    MIN_N_OBS = minimum total number of valid observations required    
!                for calculation of quantiles (separataly for each UTC hour)
!                Default: 100
!
!    MISS = missing value code (in input and output). Default: -9.99e6.      
!           all observations with abs(f) >= abs(miss) are treated as missing.
!
!    RRMAX = maximum number of iterations in solving fourier component amplitudes        
!            (default: 10000)
!---------------------------------------------------------------        
      IMPLICIT NONE
      INTEGER :: I,J,K,Q,R,D ! loop variables
      INTEGER :: IMIN ! index with minimum penalty function in iteration
      INTEGER :: RRMAX ! maximum number of iterations
      INTEGER :: NDAYS ! number of days from beginning of YEAR1 to end of YEAR2
      INTEGER :: NWAVES ! number of Fourier components
      INTEGER :: KK ! 2 x NWAWES + 1 = number of amplitudes to be solved
      INTEGER,PARAMETER :: KMAX=50 ! maximum number of Fourier components  
      INTEGER,PARAMETER :: NDMAX=20000 ! maximum number of days in timeseries
      INTEGER,PARAMETER :: NDIV=4 ! this is used in the iteration procedure
      REAL,PARAMETER :: YRLEN=365.25 ! length of year in days
      DOUBLE PRECISION :: A(2*KMAX+1),AA(2*KMAX+1) ! Fourier amplitudes
      DOUBLE PRECISION :: PII ! 3.14159265..       
      DOUBLE PRECISION :: FOUR(NDMAX,2*KMAX+1) ! daily values of Fourier components
      DOUBLE PRECISION :: SFDER(2*KMAX+1) ! penalty function derivative     
      DOUBLE PRECISION :: F(NDMAX) ! daily values of variable for one UTC hour
      DOUBLE PRECISION :: FF(NDMAX) ! a copy of the previous
      REAL :: F_min,F_max ! minimum and maximum of F
      INTEGER,PARAMETER :: NHOUR=24 ! Number of hours in days
      REAL :: VALUES(NDMAX,nhour) ! Daily values of variable for all 24 UTC hours
      INTEGER :: n_obs(nhour) ! number of observations available for each 24 UTC hours
      INTEGER :: min_n_obs ! minimum number of observations required for calculating the quantiles
      REAL :: F1 ! a single data value read from INFILE
      DOUBLE PRECISION :: STEP0,STEP,MINSTEP,NORM ! iteration-related stuff
      DOUBLE PRECISION :: SF,SF2,SFMIN,SFMINPREV ! iteration-related stuff
      REAL :: MISS ! missing value code
      CHARACTER*160 :: INFILE,OUTFILE ! input and output file
      CHARACTER*160 :: OUTFILE_GRADS ! grads output just for testing
      INTEGER, PARAMETER :: L_dataline=1700 ! max length of input or output text line
      character*1700 :: dataline,headerline,emptyline ! strings for output
      character*2 :: number_of_quantile ! from 01 to 99
      character*16 :: quantile_value ! for adding a quantile value to dataline
      INTEGER, PARAMETER :: NQUANT=99 ! number of quantiles (from 1% to 99%)
      REAL :: FR(365) ! daily values of a quantile
      REAL :: GR(365) ! copy of the previou
      REAL :: FFR(NQUANT,365) ! all quantiles collected to one variable      
      REAL :: QUANT(NQUANT) ! quantiles to be calculated (0.01 ... 0.99)
      INTEGER :: yyear,mmonth,dday,hhour !year, month, day and hour as read from file
      INTEGER :: year,month,day,hour ! year, month, day and hour after
!                                      eventual rounding of hours      
      INTEGER :: year1,year2 ! first and last year in analysis
      INTEGER :: day_number ! day number since beginning of year 1
      INTEGER :: station_int ! station code integer (for synop stations and RHARM soundings)
      CHARACTER*3 :: station_char ! station with characters (for GRUAN soundings)
      LOGICAL :: l_code_in_char ! .true. for station code in characters (GRUAN soundings)
      REAL ::longitude,latitude ! station coordinates
      LOGICAL ::GRADS_OUT  ! Output also as GrADS binaries
      INTEGER :: IREC ! record number in GrADS output

      INTEGER :: HOUR1,HOUR2,HOUR_STEP ! Hours included in output
      INTEGER :: N_OUTPUT_HOURS ! Number of hours included in output
      INTEGER :: HOUR_INDEX ! counter for output hours (only needed for GrADS)
      LOGICAL :: L_ROUND_HOUR ! if .true., hour rounded to the nearest output hour
      
!-------------------------------------------------------------------------------      

      NAMELIST/param/NWAVES,INFILE,OUTFILE,&
           MISS,YEAR1,YEAR2,&
           STATION_INT,STATION_CHAR,LONGITUDE,LATITUDE,GRADS_OUT,OUTFILE_GRADS,&
           L_CODE_IN_CHAR,HOUR1,HOUR2,HOUR_STEP,L_ROUND_HOUR,&
           MIN_N_OBS,RRMAX
  
      PII=4.*ATAN(1.)
      MISS=-9.99e6
      RRMAX=10000
      min_n_obs=100
      READ(*,NML=PARAM)
      
      KK = 2*NWAVES+1
      ndays=day_number(year2,12,31,year1)
!
!     DAILY VALUES OF EACH COSINE AND SINE FOURIER COMPONENT 
!
      DO D=1,NDAYS
        FOUR(D,1)=1.  ! this is the constant component
        DO K=1,KMAX  
          FOUR(D,2*K)=SIN(2.*PII/YRLEN*K*D)
          FOUR(D,2*K+1)=COS(2.*PII/YRLEN*K*D)
        ENDDO 
      ENDDO       
!
!     Quantiles from 1% to 99% 
!      
      do i=1,nquant
         quant(i)=i/(nquant+1.)            
      enddo             
!
!     Empty data line 
!
      do i=1,L_dataline
         emptyline(i:i)=' '
      enddo
!-------------------------------------------------------
!     Read the contents of the input file to array F
!------------------------------------------------------
      values=miss
      open(unit=1,form='formatted',status='old',file=infile)
      read(1,*) ! This is the header line
      do while(.true.)
         read(1,*,err=1,end=1)yyear,mmonth,dday,hhour,f1                  
         ! find the number of day since 31 Dec Year1-1
         if(l_round_hour)then
            call round_hour(yyear,mmonth,dday,hhour,year,month,day,hour,&
                 hour1,hour2,hour_step,nhour)            
         else
            year=yyear
            month=mmonth
            day=dday
            hour=hhour
         endif         
         
         d=day_number(year,month,day,year1)
         ! insert the read data value to its place in table 'values'
         values(d,hour+1)=f1         
      enddo
1     continue
      
!     Calculate the number of non-missing observations for each UTC hour
!
      n_obs=0      
      do hour=hour1,hour2,hour_step
        do d=1,ndays
           if(abs(values(d,hour+1)).lt.abs(miss))n_obs(hour+1)=n_obs(hour+1)+1
        enddo
      enddo
!     
!--------------------------------------------------------------------
!      
! Open the output file and write its first line.
!
 open(unit=2,form='formatted',status='unknown',file=outfile)      

 headerline=emptyline
 if(l_code_in_char)then
 headerline='station@hdr:string longitude@hdr:real latitude@hdr:real month@hdr:integer day@hdr:integer hour@hdr:integer'
 else   
    headerline='station@hdr:integer longitude@hdr:real latitude@hdr:real month@hdr:integer day@hdr:integer hour@hdr:integer'
 endif
 
 do j=1,nquant
    write(number_of_quantile,'(i2.2)')j
    headerline=trim(headerline)//' q'//number_of_quantile//'@body:real'
 enddo 
 write(2,*)trim(headerline)
!
! Output file for GrADS data, for visualization only? 
! 
 if(grads_out)then
    open(unit=11,form='unformatted',file=outfile_grads,access='DIRECT',&
    recl=4,status='unknown')
 endif
 
!*****************************************************************************
!     Main loop: calculate the quantiles separately for each UTC hour      
!
      do hour=hour1,hour2,hour_step

        if(n_obs(hour+1).ge.min_n_obs)then ! enough of data to calculate the quantiles
!----------------------------------------------------------------------         
            
        do d=1,ndays
           f(d)=values(d,hour+1)
        enddo
!
!       Find the minimum and maximum of f(d) to determine
!       the initial step in iteration 

        f_min=abs(miss)
        f_max=-abs(miss)
        do d=1,ndays
           if(f(d).gt.f_max.and.abs(f(d)).lt.abs(miss))f_max=f(d)
           if(f(d).lt.f_min.and.abs(f(d)).lt.abs(miss))f_min=f(d)
        enddo
        step0=(f_max-f_min)/50. ! initial step in iteration (arbitrary choice)
        minstep=step0/2000.     ! minimum step in iteration
        
!--------------------------------------------------------------------------------     
!     LOOP OVER QUANTILES BEGINS     
!
      DO Q=1,NQUANT
         step=step0
!
!     Initial guesses for the Fourier component amplitudes
!
      A(1)=(f_min+f_max)/2.   
      DO K=2,KK
        A(K)=0.
      ENDDO        
!      
      SFMINPREV=9.99e8 ! previous minimum of the penalty function 
      SFMIN=SFMINPREV/2. ! arbitrary large value but smaller than SFMINPREV
!
!---------------------------------------------------------------------
!
!     Iterative solution of Fourier component amplitudes      
!      
      R=0
!
!     Continue iteration as far as the penalty function decreases,
!     but no more than RRMAX rounds      
!      
      do while (R.lt.RRMAX.and.SFMIN.le.SFMINPREV) 
      R=R+1
!
!     Find out the penalty function and the direction of iteration      
!            
      CALL PENALTY(F,FF,FOUR,KK,A,NDAYS,NDMAX,SF,SFDER,MISS,QUANT(Q),.true.)
!
!     Amplitude of the penalty function derivative
! 
      NORM=0.
      DO K=1,KK
        NORM=NORM+SFDER(K)**2.
      ENDDO
      NORM=SQRT(NORM)
!
!     Iteration. To find out a suitable down-gradient distance,
!     search with intervals STEP/NDIV up to the distance STEP
      
      SFMIN=SF
      IMIN=0
      DO I=1,NDIV
        DO K=1,KK
          AA(K)=A(K)-STEP*(SFDER(K)/NORM)*REAL(I)/NDIV
        ENDDO 
        CALL PENALTY(F,FF,FOUR,KK,AA,NDAYS,NDMAX,SF2,SFDER,MISS,QUANT(Q),.false.)
        IF(SF2.LE.SFMIN)THEN
          SFMIN=SF2
          IMIN=I
        ENDIF
      ENDDO
!
!    Update the iteration step  
!      
      IF(IMIN.EQ.0)THEN
        STEP=STEP/(2.*NDIV)
      ELSE
        STEP=(IMIN*STEP)/(1.*NDIV)
      ENDIF
      if(step.lt.minstep)step=minstep
!
!    Update Fourier component amplitudes
!      
      DO K=1,KK
        A(K)=A(K)-STEP*(SFDER(K)/NORM)
      ENDDO 
      
!      WRITE(*,*)'R,SFMIN,STEP',R,SFMIN,STEP

      IF(SFMIN.LT.SFMINPREV)then
         SFMINPREV=SFMIN
      ENDIF

      ENDDO ! END of the iteration loop
!--------------------------------------------------------------------------
!     Iteration ready. Calculate the quantile estimate for each day
!     of the year from the last amplitudes (a(k)) of the Fourier components.
!      
      do d=1,365
        ffr(q,d)=0.
        do k=1,kk       
          ffr(q,d)=ffr(q,d)+a(k)*four(d,k)
        enddo
      enddo

      ENDDO ! End of quantile loop (Q)     
!---------------------------------------------------------------------------
!      
!     In rare cases (some tens of a per cent), the calculated quantile
!     values are not in ascending order. This is an artefact of the
!     Fourier fitting. To avoid this, the quantiles are forcibly
!     arranged to ascending order even if they were not.

      do d=1,365
         do q=1,nquant
           fr(q)=ffr(q,d) 
         enddo
         call order(fr,gr,nquant)
         do q=1,nquant
           ffr(q,d)=gr(q) 
         enddo
      enddo
!
!---------------------------------------------------------------------
!      
     else ! quantiles not calculated because there was too little data
        ffr=miss
     endif
!
!----------------------------------------------------------------------     
!      
!    Write the quantiles to file. 
! 
      do d=1,365
        dataline=emptyline 
        call month_and_day_from_day_number(d,month,day)
        if(l_code_in_char)then
           write(dataline,'(A3,2F16.6,1X,I2,1X,I2,1X,I2)')station_char,longitude,latitude,month,day,hour
        else
           write(dataline,'(I7,2F16.6,1X,I2,1X,I2,1X,I2)')station_int,longitude,latitude,month,day,hour
        endif        
           
        do q=1,nquant
          write(quantile_value,'(F16.6)')ffr(q,d)
          dataline=trim(dataline)//quantile_value          
        enddo           
        write(2,*)trim(dataline)
        if(month.eq.2.and.day.eq.28)then ! copy Feb 28 values for Feb 29
           dataline=emptyline
           if(l_code_in_char)then
              write(dataline,'(A3,2F16.6,1X,I2,1X,I2,1X,I2)')station_char,longitude,latitude,month,day,hour
           else
              write(dataline,'(I7,2F16.6,1X,I2,1X,I2,1X,I2)')station_int,longitude,latitude,month,day,hour
           endif        
          do q=1,nquant
            write(quantile_value,'(F16.6)')ffr(q,d)
            dataline=trim(dataline)//quantile_value          
          enddo           
          write(2,*)trim(dataline)        
        endif
        if(grads_out)then  ! February 29 skipped in GrADS output, although included in the text file
                           ! that will be converted to ODB.  
           n_output_hours=(hour2-hour1)/hour_step+1
           do q=1,nquant
              hour_index=(hour-hour1)/hour_step
            irec=1+hour_index+n_output_hours*(q-1)+(d-1)*n_output_hours*nquant
            write(11,rec=irec)ffr(q,d)
          enddo  
        endif      
      enddo ! end of day lopp
                        
     ENDDO ! end of hour loop

!-----------------------------------------------------------------     
     
      close(2)
      if(grads_out)close(11)
      
      END program fourierquantiles
!
!-----------------------------------------------------------------
!      
      SUBROUTINE PENALTY &
         (F,FF,FOUR,NFOUR,A,NDAYS,NDMAX,SF,SFDER,MISS,QUANT,LDER)
!
!     Calculation of the penalty function and its derivatives
!     wrt of the amplitude of each Fourier component      
!
!     The penalty function is defined as the sum of daily penalties
!
!     If the value from the fourier series (FF) exceeds the actual data value (F),
!     the daily penalty is         
!
!        (1-QUANT)*(FF-F)
!
!     where QUANT is the quantile estimated (scale 0-1). In the opposite case (F > FF)
!     the daily penalty is        
!        
!        QUANT*(F-FF)
        
      IMPLICIT NONE

      integer :: nfour ! IN: number of fourier components used (cosine + sine)
      integer :: ndays,ndmax ! IN: actual and maximum number of days in time series
      real :: miss ! IN: missing value code
      double precision :: f(ndays) ! IN: values of input for each day
      double precision :: ff(ndays)! OUT: values calculated from fourier series
      double precision :: four(ndmax,nfour)! IN: values of fourier components in each day
      double precision :: sf,sfder(nfour) ! OUT: penalty function and its derivatives wrt. fourier amplitudes
      double precision :: A(nfour) ! IN: previous amplitudes of fourier components
      real :: quant ! IN: quantile to be estimated (scale 0-1)
      logical :: lder ! If .true., the derivative of the penalty function is also calculate
      integer :: i,k
!
!     Initialize the penalty function and its derivatives to zero      
!     
      sf=0.
      if(lder)sfder=0.
! 
!     Sum the penalty function and its derivatives over all days in time series
!      
      do i=1,ndays 
        if(abs(f(i)).lt.abs(miss))then

!     Calculate the Fourier series estimate from the previous amplitudes
           
        ff(i)=0.
        do k=1,nfour       
          ff(i)=ff(i)+a(k)*four(i,k)
        enddo
!
!     Add the daily contribution to the penalty function and its derivatives           
!       
        if(f(i).lt.ff(i))then     
           sf=sf+(1.-quant)*(ff(i)-f(i))
          if(lder)then 
            do k=1,nfour
              sfder(k)=sfder(k)+(1.-quant)*four(i,k)
            enddo
          endif     
        endif  
        if(f(i).gt.ff(i))then
           sf=sf+quant*(f(i)-ff(i))
          if(lder)then
            do k=1,nfour
              sfder(k)=sfder(k)-quant*four(i,k)
            enddo
          endif      
        endif  
       
        endif ! abs(f(i).lt.abs(miss))
      enddo     

      RETURN
      END subroutine penalty
!
!---------------------------------------------------------------------------------
!      
      INTEGER FUNCTION DAY_NUMBER(year,month,day,year1)
!
!     Day number of "year,month,day", where "year1,1,1" = 1. 
!        
        implicit none
        integer :: year,month,day,year1
        integer,parameter :: nmon=12
        integer :: days_before(nmon) ! this is for normal years. Leap days added separately
        integer :: dnumber,n_leap_days,yr,yr_end
        data days_before / 0,31,59,90,120,151,181,212,243,273,304,334 /
        dnumber=365*(year-year1)+days_before(month)+day
!
!       Calculate and add the number of leap days since beginning of year1 
!
        n_leap_days=0
        yr_end=year
        if(month.le.2)yr_end=year-1
        do yr=year1,yr_end
           if(mod(yr,4).eq.0.and.((mod(yr,400).eq.0).or.(mod(yr,100).gt.0)))then
              n_leap_days=n_leap_days+1
           endif
        enddo        
        day_number=dnumber+n_leap_days           
        return
        end function DAY_NUMBER
!
!-------------------------------------------------------------------------        
!        
        subroutine month_and_day_from_day_number(day_number,month,day)
!
!       Convert day_number from beginning of the year (IN) to month and day (OUT)            
!       assuming a normal (non-leap) year
!          
        implicit none
        integer :: day_number,month,day
        integer,parameter :: nmon=12
        integer :: days_before(nmon+1) ! this is for normal years only
        integer m
        data days_before /0,31,59,90,120,151,181,212,243,273,304,334,365/
        do m=1,12
           if(day_number.gt.days_before(m)&
              .and.day_number.le.(days_before(m+1)))then
             month=m
             day=day_number-days_before(m)
             exit
           endif
        enddo
        return
        end subroutine month_and_day_from_day_number
!
!----------------------------------------------------------------------        
!        
       subroutine order(f,g,n)
!
!       Ordering the values of f(1...n) in ascending order. Result in g
!       Simple exachange ordering (inefficient for large n!)
!          
        implicit none
        integer :: i,j,n
        real :: f(n),g(n),g1
        g=f
        do i=1,n-1
           do j=i+1,n
              if(g(j).lt.g(i))then
                 g1=g(i)
                 g(i)=g(j)
                 g(j)=g1
              endif
           enddo
        enddo

        return
        end subroutine order
!
!-------------------------------------------------------------------!
!        
subroutine round_hour(yyear,mmonth,dday,hhour,year,month,day,hour,&
     hour1,hour2,hour_step,nhour)
!
! Rounding of time to the nearest hour in (hour1,hour1+hour_step,...,hour2)
!  
! time in input: yyear,mmonth,dday,hhour
! time in output: year,month,day,hour
  
implicit none
integer :: year,month,day,hour
integer :: yyear,mmonth,dday,hhour
integer :: hour1,hour2,hour_step
integer :: ndays_month(12)
integer :: hour_index
integer :: nhour
ndays_month=31
ndays_month(4)=30
ndays_month(6)=30
ndays_month(9)=30
ndays_month(11)=30
ndays_month(2)=28
if((mod(yyear,4).eq.0.and.mod(yyear,100).gt.0).or.(mod(yyear,400).eq.0))then
  ndays_month(2)=29
endif
year=yyear
month=mmonth
day=dday
!
! Round the hour to the nearest output hour
!
hour_index=nint(real(hhour-hour1)/hour_step)
hour=hour1+hour_step*hour_index
   if(hour.ge.nhour)then ! hhour was rounded forward to next day
      hour=hour1
      day=dday+1
      if(day.gt.ndays_month(month))then
         day=1
         month=month+1
         if(month.gt.12)then
            month=1
            year=yyear+1
         endif
      endif
   endif
   if(hour.lt.0)then ! hhour was rounded backward to previous day
   hour=hour2
   day=dday-1
     if(day.eq.0)then
        month=month-1
        if(month.eq.0)then
           month=12
           year=yyear-1
        endif                  
        day=ndays_month(month)
     endif
  endif
   
return
end subroutine round_hour

        
