      program rank_histograms_one_station
!
!     Produce the rank histogram (i.e., the frequencies at which the simulated or
!     observed data at one station fall between different quantiles of a pre-computed         
!     quantile distribution (below 1%, within 1-2%, ... above 99%)   
!
!     Jouni Räisänen, July 2015   
!
!----------------------------------------------------------------------
! Input files (text format)
!----------------------------------------------------------------------
!                        
!     INFILE: simulated or observed time series at the station location.        
!             The first line is a header. The other lines include:
!
!             1) year
!             2) month        
!             3) day        
!             4) hour
!             5) data value
!        
!     QUANTILE_FILE: quantile values, separately for each day of the year!        
!             The first line is a header. The other lines include:
!
!             1) station code        
!             2) longitude
!             3) latitude
!             4) month
!             5) day        
!             6) hour
!             7-105) The 99 quantiles from 1 % to 99 %
!
!             if (l_code_in_char) is .true., the station code is assumed to be a 3-char string.
!             Otherwise, it is assumed to be an integer  
!
!     MSD_BOOTSTRAP_FILE: MSD (mean squared deviation) distribution of quantile frequencies
!             from bootstrap tests.           
!
!             The first 1st line is a header. The other lines include
!
!             1) station code        
!             2) longitude
!             3) latitude
!             4) number of realization
!             5 to N-1) MSD values for HOUR1, HOUR1 + HOUR_STEP ... HOUR2
!             N) MSD calculated from frequencies averaged over all the UTC hours within
!                HOUR1, HOUR1 + HOUR_STEP ... HOUR2        
!        
!             if (l_code_in_char) is .true., the station code is assumed to be a 3-char string.
!             Otherwise, it is assumed to be an integer  
!
!----------------------------------------------------------------------
! Output files:
!----------------------------------------------------------------------
!               
!     OUTFILE: frequencies of quantiles.
!              The first 1st line is a header. The other lines include
!
!             1) station code        
!             2) longitude
!             3) latitude
!             4) hour
!             5) number of obervations for this (UTC) hour
!             6) MSD for the quantile frequencies
!             7) p-value of MSD (=fraction of bootstrap realizations with larger or equal MSD)
!             8-107) quantile frequencies (on scale 0-1) from 0-1 % ... 99-100%        
!
!             if (l_code_in_char) is .true., the station code is assumed to be a 3-char string.
!             Otherwise, it is assumed to be an integer.  
!
!             UTC hours included: HOUR1, HOUR1 + HOUR_STEP ... HOUR2 + all-UTC-statistics coded with HOUR=24        
!
!     OUTFILE_GRADS: frequencies of quantiles in GrADS binary output (if grads_out=.true.)
!        
!             The resulting GraDS binary file includes 7 variables (1 level for 1-6, 100 levels for 7):
!
!             1) longitude
!             2) latitude
!             3) hour
!             4) number of obervations for this (UTC) hour
!             5) MSD for the quantile frequencies
!             6) p-value of MSD (=fraction of bootstrap realizations with larger or equal MSD)
!             7) quantile frequencies (on scale 0-1) from 0-1 % ... 99-100%        
!
!---------------------------------------------------------------        
! Namelist parameters
!---------------------------------------------------------------
!      
!      NAMELIST/param/infile,outfile,quantile_file,msd_bootstrap_file,&
!           hour1,hour2,hour_step,year1,year2,month1,month2,grads_out,outfile_grads,&
!           l_code_in_char,l_round_hour,miss
!
!     infile : file name for simulated or observed time series (see above)
!     quantile_file : file name for pre-computed quantiles (see above)
!     msd_bootstrap_file : file name for pre-computed bootstrap statistics (see above)        
!     outfile : name of output file (see above)
!     outfile_grads : output file in GrADS binary format (see above)
!     grads_out : if .true., outfile_grads is written        
!     l_code_in_char: if .true., 3-character station codes assumed (else integer)
!
!     hour1 = first UTC hour analysed
!     hour2 = last UTC hour analysed        
!     hour_step = step of analyzed UTC hours
!     l_round_hour : if .true., hours are rounded to the nearest analysis hour.        
!                    if .false., data for non-matching hours is ignored
!        
!     year1,month1 = beginning of the analysis period
!     year2,month2 = end of the analysis period
!        
!     miss = missing value code. All input data f with abs(f) >= abs(miss) is treated as missing
!
!---------------------------------------------------------------
!        
     IMPLICIT NONE
      INTEGER :: I,J,K,Q
      INTEGER,PARAMETER :: NMON=12, NDAY=31, NHOUR=24, NQUANT=99
      REAL :: quantiles(nquant,nmon,nday,nhour) ! array for quantile values
      REAL :: q1(nquant) ! quantiles for one day + hour
      REAL :: frequency(nquant+1,nhour+1) ! frequency of quantiles. NHOUR+1 for the all-UTC frequencies
      REAL :: expected_freq ! expected frequency of quantiles (1/100)
      REAL :: MSD(nhour+1) ! MSD statistics per UTC hour
      REAL :: p_value(nhour+1) ! p values per UTC hour
      REAL :: msd_bootstrap(nhour+1) ! msd values for one bootstrap realization
      INTEGER :: n_bootstrap ! total number of bootstrap realizations
      INTEGER :: realization ! number of bootstrap realization read from msd_boostrap_file
      REAL :: value1 ! individual data values read from the input file
      INTEGER :: ntimes_hour(nhour) ! total number of times with data for an UTC hour
      INTEGER :: ntimes_hour_tot ! total number of times with data for all UTC hours
      CHARACTER*160 :: infile,outfile,quantile_file,msd_bootstrap_file 
      CHARACTER*160 :: outfile_grads
      INTEGER,PARAMETER :: L_dataline=1700 ! maximum length of lines in text files
      character*1700 :: dataline,headerline,emptyline ! character strings for writing of output files
      character*2 :: number_of_bin ! two-digit code for quantiles for outfile header
      character*16 :: frequency_value  ! frequency written in F16.6 format
!
      INTEGER :: yyear,mmonth,dday,hhour ! time as read from the input file
      INTEGER :: year,month,day,hour ! time after eventual rounding of hours
      
      INTEGER :: year1,year2,month1,month2 ! period used in calculations (see above)
      INTEGER :: hour1,hour2,hour_step ! hours used in calculations (see above)
      LOGICAL :: HOUR_USED(nhour) ! true if the UTC hour is used
      INTEGER :: nhour_used      ! number of UTC hours used
      INTEGER :: station_int ! station code integer (for synop stations amd RHARM soundings)
      CHARACTER*3 :: station_char ! station with characters (for GRUAN soundings)
      LOGICAL :: l_code_in_char ! .true. for station code in characters
      REAL :: longitude,latitude ! station longitude and latitude
      
      LOGICAL :: GRADS_OUT  ! Output also as GrADS binaries, just for testing
      INTEGER :: IREC ! record number for GrADS output

      LOGICAL :: L_ROUND_HOUR ! if .true., hour rounded to the nearest output hour      
!
      REAL :: MISS ! missing value code
!
!-----------------------------------------------------------------------       
!      
      NAMELIST/param/infile,outfile,quantile_file,msd_bootstrap_file,&
           hour1,hour2,hour_step,year1,year2,month1,month2,grads_out,outfile_grads,&
           l_code_in_char,l_round_hour,miss

      MISS=-9.99e6
      READ(*,NML=PARAM)
!
!     Which UTC hours are used and what is their total number?
!      
      hour_used=.false.
      nhour_used=0.
      do i=hour1,hour2,hour_step
         hour_used(i+1)=.true.
         nhour_used=nhour_used+1
      enddo      
!
!     Empty data line 
!
      do i=1,L_dataline
         emptyline(i:i)=' '
      enddo
!----------------------------------------------------------------------
!      
!     Read the contents of the quantile_file to array 'quantiles'
!
      quantiles=miss
      open(unit=1,form='formatted',status='old',file=quantile_file)

      do while(.true.)
         if(l_code_in_char)then
   !     The err=1 specifier ensures that header lines are skipped         
1         read(1,*,err=1,end=3)&     
              station_char,longitude,latitude,month,day,hour,(q1(i),i=1,nquant)
        else
2         read(1,*,err=2,end=3)&     
              station_int,longitude,latitude,month,day,hour,(q1(i),i=1,nquant)
        endif            
        do i=1,nquant
             quantiles(i,month,day,hour+1)=q1(i)
        enddo
! copy quantiles from 28 February to 29 February         
         if(month.eq.2.and.day.eq.28)then
            do i=1,nquant
               quantiles(i,month,day+1,hour+1)=q1(i)
            enddo   
         endif         
      enddo
3     continue
      close(1)            
!
!----------------------------------------------------------------------
!
!     Read the station observations and count the absolute quantile bin frequencies
!     
      frequency=0
      ntimes_hour=0
      ntimes_hour_tot=0
      
      open(unit=1,form='formatted',status='old',file=infile)
      
      do while(.true.)
11       read(1,*,err=11,end=12) yyear,mmonth,dday,hhour,value1
!
!     Rounding of hours? 
!         
         if(l_round_hour)then
            call round_hour(yyear,mmonth,dday,hhour,year,month,day,hour,&
                 hour1,hour2,hour_step)            
         else
            year=yyear
            month=mmonth
            day=dday
            hour=hhour
         endif
!
!     If the hour is used and the date is within th analyzed period,
!     update the quantile bin frequencies 

      if(hour_used(hour+1))then     
         if((year.gt.year1.or.(year.eq.year1.and.month.ge.month1)).and. &
           (year.lt.year2.or.(year.eq.year2.and.month.le.month2)).and. &
            abs(value1).lt.abs(miss))then
             ntimes_hour(hour+1)=ntimes_hour(hour+1)+1
             ntimes_hour_tot=ntimes_hour_tot+1
            call update_frequencies &
            (frequency(1,hour+1),value1,quantiles(1,month,day,hour+1),nquant,miss) 
         endif
      endif
      
      enddo
12    continue
      close(1)      
!
!----------------------------------------------------------------------
!
!     Convert absolute frequencies to relative frequencies      
!      
      do hour=hour1,hour2,hour_step
         do i=1,nquant+1
            if(ntimes_hour(hour+1).gt.0)then
               frequency(i,hour+1)=frequency(i,hour+1)/ntimes_hour(hour+1)
            else
               frequency(i,hour+1)=miss
            endif   
         enddo
      enddo
!
!--------------------------------------------------------------------------------   
!      
!  Calculation of MSD. Because it can be assumed that model data are always available,
!  all UTC hours get the same weight in the calculation of the all-UTC MSD.      
!      
        expected_freq=1./(nquant+1.)      
        do j=hour1,hour2,hour_step
           if(frequency(1,j+1).eq.miss)then
              msd(j+1)=miss
           else              
           do i=1,nquant+1
              msd(j+1)=msd(j+1)+((frequency(i,j+1)/expected_freq-1.)**2.)/(nquant+1.)
           enddo
           endif
        enddo        
        do i=1,nquant+1
           do j=hour1,hour2,hour_step              
              frequency(i,nhour+1)=&
              frequency(i,nhour+1)+frequency(i,j+1)/nhour_used
           enddo           
           msd(nhour+1)=msd(nhour+1)+((frequency(i,nhour+1)/expected_freq-1.)**2.)/(nquant+1.)
        enddo
        do j=hour1,hour2,hour_step
           if(frequency(1,j+1).eq.miss)then
              do i=1,nquant+1
                 frequency(i,nhour+1)=miss                 
              enddo              
              msd(nhour+1)=miss
           endif
        enddo        

!----------------------------------------------------------------------        
!        
!     Read the bootstrap MSD:s and calculate the fractions of them that exceed the actual value
!        
      n_bootstrap=0
      p_value=0.
      
      open(unit=1,form='formatted',status='old',file=msd_bootstrap_file)      
      do while(.true.)
         if(l_code_in_char)then       
21         read(1,*,err=21,end=23)station_char,longitude,latitude,realization,&
              (msd_bootstrap(j+1),j=hour1,hour2,hour_step),msd_bootstrap(nhour+1)
         else
22         read(1,*,err=22,end=23)station_int,longitude,latitude,realization,&
              (msd_bootstrap(j+1),j=hour1,hour2,hour_step),msd_bootstrap(nhour+1)
         endif  
!
!    Update the p-value counters         
!        
         n_bootstrap=n_bootstrap+1
         do hour=hour1,hour2,hour_step
            if(msd_bootstrap(hour+1).ge.msd(hour+1))then
               p_value(hour+1)=p_value(hour+1)+1.
            endif
         enddo    
         if(msd_bootstrap(nhour+1).ge.msd(nhour+1))then
           p_value(nhour+1)=p_value(nhour+1)+1.
        endif
     enddo     
23   continue
!      
!    Convert the p_values from absolute counts to relative frequencies    
!     
     do hour=hour1,hour2,hour_step
        p_value(hour+1)=p_value(hour+1)/n_bootstrap
     enddo
     p_value(nhour+1)=p_value(nhour+1)/n_bootstrap
!
!--------------------------------------------------------------------------
!
! Open the output file and write its header line in ODB compatible text format
!
    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 hour@hdr:integer'
    else
       headerline='station@hdr:integer longitude@hdr:real latitude@hdr:real hour@hdr:integer'       
    endif    
    headerline=trim(headerline)//' total_number@body:real'
    headerline=trim(headerline)//' msd@body:real'
    headerline=trim(headerline)//' p_value@body:real'
!
!   quantile bin frequency variable names: f00, f01 ... f99
!    
    do j=0,nquant
       write(number_of_bin,'(i2.2)')j
       headerline=trim(headerline)//' f'//number_of_bin//'@body:real'
    enddo
    write(2,*)trim(headerline)
!
! Write the data lines for each UTC hour used
! 
    do hour=hour1,hour2,hour_step
       j=hour+1
       if(l_code_in_char)then          
         write(dataline,'(A3,2F16.6,1X,I2,I7,2F16.6)')&
              station_char,longitude,latitude,hour,ntimes_hour(j),msd(j),p_value(j)
       else
         write(dataline,'(I6,2F16.6,1X,I2,I7,2F16.6)')&
              station_int,longitude,latitude,hour,ntimes_hour(j),msd(j),p_value(j)        
       endif
       
       do i=1,nquant+1
          write(frequency_value,'(F16.6)')frequency(i,j)
          dataline=trim(dataline)//frequency_value          
       enddo
       write(2,*)trim(dataline)
    enddo
!
! Write the data line for the all-UTC statistics
!
     if(l_code_in_char)then
       write(dataline,'(A3,2F16.6,1X,I2,I7,2F16.6)')&
         station_char,longitude,latitude,24,ntimes_hour_tot,msd(nhour+1),p_value(nhour+1)              
     else
       write(dataline,'(I6,2F16.6,1X,I2,I7,2F16.6)')&
         station_int,longitude,latitude,24,ntimes_hour_tot,msd(nhour+1),p_value(nhour+1)       
     endif    
     do i=1,nquant+1
       write(frequency_value,'(F16.6)')frequency(i,nhour+1)
       dataline=trim(dataline)//frequency_value          
     enddo
     write(2,*)trim(dataline)

     close(2)     
!      
!---------------------------------------------------------------------------------
!   
! Open the file for GrADS output and write its contents, for visualisation in GrADS?
! 
     if(grads_out)then
        open(unit=11,form='unformatted',file=outfile_grads,access='DIRECT',&
                 recl=4,status='unknown')
!
! Again, first each UTC hour separately
! 
     do hour=hour1,hour2,hour_step
        j=(hour-hour1)/hour_step
        write(11,rec=1+j*(nquant+6))longitude
        write(11,rec=2+j*(nquant+6))latitude
        write(11,rec=3+j*(nquant+6))real(ntimes_hour(hour+1))    
        write(11,rec=4+j*(nquant+6))msd(hour+1)
        write(11,rec=5+j*(nquant+6))p_value(hour+1)        
        do i=1,nquant+1
           write(11,rec=5+j*(nquant+6)+i)frequency(i,hour+1)
        enddo
     enddo
 !
 !   The all-UTC statistics
 !
      write(11,rec=1+(j+1)*(nquant+6))longitude
      write(11,rec=2+(j+1)*(nquant+6))latitude
      write(11,rec=3+(j+1)*(nquant+6))real(ntimes_hour_tot) 
      write(11,rec=4+(j+1)*(nquant+6))msd(nhour+1)
      write(11,rec=5+(j+1)*(nquant+6))p_value(nhour+1)        
      do i=1,nquant+1
         write(11,rec=5+(j+1)*(nquant+6)+i)frequency(i,nhour+1)
      enddo

      close(11)
      
      endif ! if (grads_out)      
         
      END program rank_histograms_one_station
!
!----------------------------------------------------------------
!
      subroutine update_frequencies &
           (frequency,f,quantiles,nquant,miss)
!
!    Find the location of the data value (f) within the         
!    quantile value table (quantiles, ascending order)
!    and update the table of absolute quantile bin
!    frequencies (frequency)         
!
!    frequency (in/out) = quantile bin frequencies        
!    f (in) = individual data value
!    quantiles (in) = quantile values
!    nquant (in) = number of quantiles        
!    miss (in) = missing value code
        
        implicit none
        integer :: nquant
        real :: quantiles(nquant)
        real :: frequency(nquant+1)
        real :: f
        integer :: i1,i2,i,ind
        real :: miss
!
!   Quantiles should never be missing, but if they are,
!   this should concern all quantiles simultaneously.
!   Therefore, check just the 1st quantile        
        
       if(abs(quantiles(1)).ge.abs(miss))then
          write(*,*)'Quantiles missing!?'
          stop
       endif
!
!    Find the position of f (ind) in the quantile table
!       
        if(f.lt.quantiles(1))then
           ind=1
        else
           if(f.ge.quantiles(nquant))then
              ind=nquant+1
           else
              i1=1
              i2=nquant
              do while (i2.gt.i1+1)
                 i=(i1+i2)/2
                 if(f.ge.quantiles(i))then
                    i1=(i1+i2)/2
                 else
                    i2=(i1+i2)/2
                 endif
              enddo
              ind=i1+1
           endif
        endif
!
!     Update the frequency table        
!
      frequency(ind)=frequency(ind)+1.

      return
      end subroutine update_frequencies

!----------------------------------------------------------------------
      
subroutine round_hour(yyear,mmonth,dday,hhour,year,month,day,hour,&
     hour1,hour2,hour_step)
! 
! Rounding the hour to the nearest hour within (hour1, hour1 + hour_step, ... hour2)
!  
implicit none
integer :: yyear,mmonth,dday,hhour  ! year, month, day and hour before rounding (IN)
integer :: year,month,day,hour      ! year, month, day and hour after rounding (OUT)
integer :: hour1,hour2,hour_step    ! target hours: hour1, hour1 + hour_step ... hour2
integer :: ndays_month(12)          ! number of days per month
integer :: hour_index
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((hhour-hour1+0.)/hour_step)
hour=hour1+hour_step*hour_index
   if(hour.ge.24)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

        
      
