      PROGRAM rank_histograms_bootstrap
!
!     For estimating the sampling distribution of the Mean Square Deviation
!     (MSD) statistics for quantile bin rank histogram frequencies.  
!     These distributions can be used to answer the following question:
!
!     "If we have LENGTH_IN_YEARS years of model data and its rank histogram        
!      against observations has a given MSD value, what is the probability
!      of getting such a large MSD just as a result of internal variability"?
!
!     The sampling distribution is formed using a bootstrap:        
!
!     Each boostrap realization calculates the rank histograms by selecting a total
!     of LENGTH_IN_YEARS years of observed data randomly divided in chunks. Their
!     length is defined as follows:       
!
!     1) The number of chunks is at least MIN_CHUNK_NUMBER
!     2) If not restricted by (1) there are CHUNKS_PER_YEAR chunks for each year
!     3) The length is rounded to the nearest full number of days, so that the        
!         total length is LENGTH_IN_YEARS years (which may be non-integer)
!               
!     For each realization, the Mean Squared Difference (MSD) of the resulting rank
!     histogram relative to the theoretically expected flat histogram is calculated.
!
!     Jouni Räisänen, July 2023        
!
!--------------------------------------------------------------------------------
! Input files (text format, retrieved from ODB with the 'odb sql select' command)
!--------------------------------------------------------------------------------
!
!     INFILE: 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  
!
!--------------------------------------------------------------------------------
! Output files 
!--------------------------------------------------------------------------------
!
!     OUTFILE: 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  
!         
!     OUTFILE_GRADS: MSD distribution of quantile frequencies in a GrADS binary file (if grads_out=.true.)
!
!-------------------------------------------------------------------------------------------
! Namelist parameters
!-------------------------------------------------------------------------------------------        
!
!  infile : file for observation time series (see above)
!  quantile_file : file for pre-computed quantile values (see above)
!  outfile : output file for bootstrap MSD statistics in ODB compatible text format
!  outfile_grads : output file in GrADS binary format
!  grads_out: if .true., outfile_grads is also written        
!  l_code_in_char: if .true., 3-character station codes assumed (else integer)        
!  lorder: if .true., the output files are ordered from smallest to largest MSD values
!           
!  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 = first year used (if data available)
!  year2 = last year used (if data available)
!        
!   miss = missing value code. All input data f with abs(f) >= abs(miss) is treated as missing
!
!   length_in_years = length of bootstrap samples in years (does not need to integer)        
!
!   min_chunk_number = minimum number of separate data "chunks" for one bootstrap realization
!   chunks_per_year = length of bootstrap "chunks", if not limited by min_chunk_number        
!   nreal = number of bootstrap realizations
!   l_all_hours_required : if .true., only those days are used for which data for all the required         
!                          UTC hours is available, even in forming the single-UTC-hour bootstrap
!                          samples. This should be set to .false. for those data sets (e.g., soundings)
!                          for which data is frequently missing for some UTC hours        

        !     (in QUANTILE_FILE) are needed:
!                
!     INFILE: text file of the simulated or observed time series at the station location.
!             1st line for each UTC hour is a header
!             The other lines include station code, longitude and latitude,
!             year, month, day, hour and the data value
!
!     QUANTILE_FILE: quantile values, separately for each day of the year           
!              1st line is a header
!              The other lines include station code, longitude and latitude,
!              month, day and hour, and the 99 quantiles for each day+hoyr of the year
!        
!     Only data for the years YEAR1-YEAR2 are taken into account, even if other years      
!     are present in INFILE.        
!
!     The output is written in OUTFILE.
!            1st line is the header.
!            The other lines includes the station code, station coordinates,
!            LENGTH_in_YEARS, realization/rank number and the corresponding MSD values
!            for each UTC hour + their combination.
!
!     If (GRADS_OUT), output is also written in a GrADS binary file for easier plotting.
!
!---------------------------------------------------------------------------------------
!        
!     LIMITATIONS of the boostrap method:
!        
!       1) An in-sample boostrap will likely produce a narrower sampling distribution of
!          quantile bin frequencies, and therefore lower MSD:s, than would be obtained        
!          if observations from a period not used for calculating the quantiles were used.
        
!       2) Autocorrelation on time scales exceeding 1/CHUNKS_PER_YEARS years is neglected
!          This is also expected to reduce the sampling variability in quantile bin frequencies,
!          resulting a low bias in the MSD:s (particularly over sea areas for temperature?)          
!
!          For both reasons, there will be too many "false positives" when comparing
!          a model simulation with observations.
!        
!----------------------------------------------------------------------------------------
        
      IMPLICIT NONE
      INTEGER :: I,J,K,Q,R   
      INTEGER,PARAMETER :: NMON=12, NDAY=31, NHOUR=24, NQUANT=99
      REAL :: quantiles(nquant,nmon,nday,nhour) ! quantiles for each month, day and UTC hour      
      REAL :: q1(nquant) ! quantiles for one day + hour
      REAL :: value1 ! individual data values read from the input file
      INTEGER :: ntimes_hour(nhour) ! total number of times with data for an UTC hour
      CHARACTER*160 :: infile,outfile,quantile_file ! file names (see above)
      CHARACTER*160 :: outfile_grads ! grads output for testing?
      INTEGER :: loutfile_grads ! length of outfile_grads name, to circumvent a memory leak!? (6.5.2013)
      CHARACTER*2 :: hh ! hour code for ODB header
      INTEGER,PARAMETER ::  L_dataline=500 ! maximum length of data lines in output
      character*500 dataline,headerline,emptyline ! for writing lines in output text files
      character*16 msd_value  ! frequency written in F16.6 format
      !
      INTEGER :: yyear,mmonth,dday,hhour !year, month, day and hour from file
      INTEGER :: year,month,day,hour ! year, month, day and hour after eventual rounding of hours            
      INTEGER :: day1  ! running number for the first day in a bootstrap chunk
      INTEGER :: year1,year2 ! years of data used in forming the bootstrap samples
      INTEGER :: hour1,hour2,hour_step ! list of hours analysed
      LOGICAL :: L_ROUND_HOUR ! if .true., hour rounded to the nearest output hour      
      LOGICAL :: HOUR_USED(nhour) ! .true. for those UTC hours that are used
      INTEGER :: nhour_used  ! number of UTC hours used
      INTEGER :: station_int ! station code read from quantile file, as integer (for synop stations)
      CHARACTER*3 :: station_char ! ------------------------------ as characters (for soundings?)
      LOGICAL :: l_code_in_char ! .true. for station code in characters      
      REAL :: longitude,latitude ! statio longitude and latitude from the quantile file
      
      LOGICAL :: GRADS_OUT  ! Output also as GrADS binaries, just for testing
      INTEGER :: IREC ! record number for GrADS output
      LOGICAL :: LORDER ! if .true., MSD output in ascending order

      INTEGER,PARAMETER :: nmaxdays=100000,nmaxyears=250
      INTEGER :: rank1(nmaxyears,nmon,nday,nhour) ! quantile ranks (1-100) of the observed values      
      INTEGER :: rank(nmaxdays,nhour)  ! quantile ranks (1-100) of the observed values in chronological order
      INTEGER :: rank_all_UTC(nmaxdays,nhour) ! same for days in which data is available for all UTC hours
      INTEGER :: NDAYS(nhour+1) ! number of days in the observed time series. "nhour+1" represents the "all-UTC" value.
      LOGICAL :: L_all_hours_required ! if .true., all those days are omitted when data is missing for
      ! at least one of the output UTC hours. Otherwise, all valid observations are included for each UTC hour separately,
      ! but the all-UTC-hour statistics only uses data for all UTC hours available.
      LOGICAL:: day_OK(nhour+1) ! will the day be included in bootstrap?               
      
      REAL :: length_in_years ! total length of bootstrap samples in years (see above)
      INTEGER :: min_chunk_number ! minimum number of chunks per one bootstrap sample
      INTEGER :: chunks_per_year ! number of chunks per years
      INTEGER :: number_of_chunks ! number of chinks per bootstrap sample
                                  ! This is replaced by min_chunk_number if it is larger.
      INTEGER :: chunk_length_UTC(nhour+1) ! chunk length separately for each UTC hour  
      INTEGER :: number_of_chunks_UTC(nhour+1) ! number of chunks separately for each UTC hour  
      INTEGER :: nreal ! number of bootstrap realizations
      REAL :: rnd ! for random numbers
 
      INTEGER,PARAMETER :: NMAX_REAL=10000 ! maximum number of realizations
      REAL :: MSD(nmax_real,nhour+1)       ! nhour+1 to accommodate the all-UTC statistics
      REAL :: MSD1(nmax_real) ! MSD realizations for one UTC hour (to facilitate easy ordering)
      REAL :: frequency(nquant+1,nhour+1) ! quantile bin frequencies 
      REAL :: frequency_all_UTC(nquant+1,nhour+1) ! quantile bin frequencies for the days in the "all-UTC" sample
      REAL :: expected_freq ! expected quantile bin frequency (1/100)
      
      REAL :: MISS ! missing value code
!
!-----------------------------------------------------------------------------------------------------
!      
      NAMELIST/param/infile,outfile,quantile_file,&
           hour1,hour2,hour_step,year1,year2,grads_out,outfile_grads,lorder,&
           length_in_years,min_chunk_number,chunks_per_year,nreal,&
           l_code_in_char,l_round_hour,l_all_hours_required,miss

      expected_freq=1./(nquant+1) ! frequencies in a flat rank histogram
      lorder=.true.  ! by default, ascending order of MSDs in the output
      min_chunk_number=2 ! default for minimum number of chunks
      chunks_per_year=4 ! default. Decrease of this will reduce the autocorrelation
                        ! problem but it will also reduce the independence
                        ! (thus the variation) between the bootstrap samples
      nreal=1000        ! default number of bootstrap realizations
      miss=-9.99e6
      READ(*,NML=PARAM)
!
!     Length of the GrADS output file name. This should not really be needed.      
!      
      loutfile_grads=len(trim(outfile_grads))
!
!     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 for ODB-compatible output
!
      do i=1,L_dataline
         emptyline(i:i)=' '
      enddo
!      write(*,*)'Check 1',len(trim(outfile_grads)),loutfile_grads,outfile_grads              
!----------------------------------------------------------------------
!      
!     Read the contents of the quantile_file to array 'quantiles'
      !
      quantiles=miss
      open(unit=1,form='formatted',status='old',file=quantile_file)
      write(*,*)'Opened 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
!     The err=2 specifier ensures that header lines are skipped                        
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
!      (in case the latter is not in the quantile file as it should)         
         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
      write(*,*)'Quantile file read'
      close(1)
!
!----------------------------------------------------------------------
!      
! Open the input data file (i.e. the station observations for the variable of interest).
! The data must be in chronological order.
      
      open(unit=1,form='formatted',status='old',file=infile)
      
!  Read the data from the input file and find their ranks in the quantile distribution. 

      rank1=miss      
      do while(.true.)
11       read(1,*,err=11,end=12)yyear,mmonth,dday,hhour,value1
   !         write(*,*)year,month,day,hour,value1
 
         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(year.ge.year1.and.year.le.year2.and.hour_used(hour+1).and.abs(value1).le.abs(miss))then
            call find_rank(value1,quantiles(1,month,day,hour+1),nquant,&
                 rank1(year-year1+1,month,day,hour+1),miss)
         endif
      enddo
12    continue
      close(1)
!---------------------------------------------------------------------------------------------------
! Rewrite the ranks for easier implementation of the bootstrap (= omit missing values)
!---------------------------------------------------------------------------------------------------
      ndays=0            
      do year=year1,year2
        do month=1,nmon
           do day=1,nday
            day_OK=.true.  
            do hour=hour1,hour2,hour_step                  
               if(rank1(year-year1+1,month,day,hour+1).eq.miss)then
                  day_OK(hour+1)=.false.
                  day_OK(nhour+1)=.false. ! all-UTC: day excluded if any data is missing
               endif
            enddo
            ! all data excluded if some of the UTC hours is missing and all hours are required.
            if(l_all_hours_required.and..not.day_OK(nhour+1))then
               day_OK=.false.
            endif
!
!     Form the list of valid days and calculate its length separately for each UTC hour:
!      
      do hour=hour1,hour2,hour_step
         if(day_OK(hour+1))then
           ndays(hour+1)=ndays(hour+1)+1
           rank(ndays(hour+1),hour+1)=rank1(year-year1+1,month,day,hour+1)
         endif
      enddo      
 !     
 !    All-UTC list of days and ranks. Only days with valid data for all UTC hours are included.
 !     
      if(day_OK(nhour+1))then
         ndays(nhour+1)=ndays(nhour+1)+1
         do hour=hour1,hour2,hour_step
           rank_all_UTC(ndays(nhour+1),hour+1)=rank1(year-year1+1,month,day,hour+1) 
         enddo
      endif

           enddo  ! end of year-loop
         enddo ! end of month-loop
      enddo ! end of day-loop
                       
      write(*,*)'ndays',(ndays(hour+1),hour=hour1,hour2,hour_step),ndays(nhour+1)
      
!--------------------------------------------------------------------------------------
!     Bootstrap parameters (nreal realizations, each consisting of 'number_of_chunks' 'chunk_length'-day periods).
!      
!     These parameters must be defined for each UTC hour separately,
!     because the length of the time series may be different      
!      
!     The length of a "chunk" is not allowed to exceed half of the length of the period of data
!      
      number_of_chunks=nint(length_in_years*chunks_per_year)  ! default number of chunks per realization
      number_of_chunks=max(number_of_chunks,min_chunk_number) ! reset to minimum if needed
!
!     Recalculate chunk lengths and numbers of chunks for each UTC hour, based on the real number of
!     days that are available and the requirement that the chunk length must not exceed half of
!     the total data sample.
      
      do hour=hour1,hour2,hour_step       
         chunk_length_UTC(hour+1)=min(nint((365.25*length_in_years)/number_of_chunks),ndays(hour+1)/2)
         number_of_chunks_UTC(hour+1)=nint((365.25*length_in_years)/chunk_length_UTC(hour+1))
      enddo
      chunk_length_UTC(nhour+1)=min(nint((365.25*length_in_years)/number_of_chunks),ndays(nhour+1)/2)
      number_of_chunks_UTC(nhour+1)=nint((365.25*length_in_years)/chunk_length_UTC(nhour+1))
      
      write(*,*)'number_of_chunks_UTC',(number_of_chunks_UTC(hour+1),hour=hour1,hour2,hour_step),number_of_chunks_UTC(nhour+1)
      write(*,*)'chunk_length_UTC',(chunk_length_UTC(hour+1),hour=hour1,hour2,hour_step),chunk_length_UTC(nhour+1)                  
!**************************************************************************************
!     Bootstrap begins      
!**************************************************************************************
      msd=0.      
      do r=1,nreal
         frequency=0
         
         
!    Selection of chunks and calculation of rank frequencies (each UTC hour sperately)
         
         do j=hour1,hour2,hour_step

            if(ndays(j+1).gt.1)then
            
           do k=1,number_of_chunks_UTC(j+1)
             call random_number(rnd)
             day1=1+(ndays(j+1)-chunk_length_UTC(j+1)+1)*rnd
             do i=day1,day1+chunk_length_UTC(j+1)-1
               frequency(rank(i,j+1),j+1)=&
               frequency(rank(i,j+1),j+1)+1./(number_of_chunks_UTC(j+1)*chunk_length_UTC(j+1))
             enddo
          enddo

          endif
          
        enddo        
!
!       Calculation of the MSD for each UTC hour separately.
!        
        do j=hour1,hour2,hour_step
           if(ndays(j+1).gt.1)then
             do i=1,nquant+1
                msd(r,j+1)=msd(r,j+1)+((frequency(i,j+1)/expected_freq-1.)**2.)/(nquant+1.)
             enddo
           else
             msd(r,j+1)=miss
           endif
        enddo
!
!    Selection of chunks and calculation of rank frequencies (all-UTC-hour case,
!    only including data for the days for which all UTC hours are available)       
!
        frequency_all_UTC=0.
        if(ndays(nhour+1).gt.1)then
           do k=1,number_of_chunks_UTC(nhour+1)
             call random_number(rnd)
             day1=1+(ndays(nhour+1)-chunk_length_UTC(nhour+1)+1)*rnd
             do i=day1,day1+chunk_length_UTC(nhour+1)-1
               do j=hour1,hour2,hour_step 
                  frequency_all_UTC(rank_all_UTC(i,j+1),j+1)=&
                  frequency_all_UTC(rank_all_UTC(i,j+1),j+1)+1./(number_of_chunks_UTC(nhour+1)*chunk_length_UTC(nhour+1))
               enddo
             enddo
          enddo
       endif       
!
!       Calculation of the all-UTC MSD
!
       if(ndays(nhour+1).gt.1)then       
           do i=1,nquant+1
                do j=hour1,hour2,hour_step              
                  frequency_all_UTC(i,nhour+1)=&
                  frequency_all_UTC(i,nhour+1)+frequency_all_UTC(i,j+1)/nhour_used
                enddo               
                msd(r,nhour+1)=msd(r,nhour+1)+((frequency_all_UTC(i,nhour+1)/expected_freq-1.)**2.)/(nquant+1.)
             enddo             
       else
          msd(r,nhour+1)=miss
       endif             

!*********************************************************************           
        enddo ! end of the bootstrap (r) loop
!*********************************************************************        
      
!--------------------------------------------------------------------------------------------------
!
!    Ordering of the MSD:s in ascending order?       
!    Again, first the individual UTC hours and then the all-UTC MSD:s
      
     if(lorder)then
        do j=hour1,hour2,hour_step
           do r=1,nreal
              msd1(r)=msd(r,j+1)
           enddo           
           call order(msd1,msd(1,j+1),nreal)
        enddo
        do r=1,nreal
          msd1(r)=msd(r,nhour+1)
        enddo           
        call order(msd1,msd(1,nhour+1),nreal)       
     endif
!------------------------------------------------------------------------------------------------
!     
! 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 realization@hdr:integer'        
     else          
        headerline='station@hdr:integer longitude@hdr:real latitude@hdr:real realization@hdr:integer'
     endif     
     do j=hour1,hour2,hour_step
       write(hh,'(i2.2)')j
       headerline=trim(headerline)//' msd'//hh//'@body:real'
     enddo
     headerline=trim(headerline)//' msd24'//'@body:real'
     write(2,*)trim(headerline)
 !
 ! Write the MSD values to the output file: first for each   
 ! individual UTC hour, then the overall statistics
 !   
     do r=1,nreal
        dataline=emptyline
        if(l_code_in_char)then
           write(dataline,'(A3,2F16.6,I6)')station_char,longitude,latitude,r
        else
           write(dataline,'(I6,2F16.6,I6)')station_int,longitude,latitude,r           
        endif        
       do j=hour1,hour2,hour_step
          write(msd_value,'(F16.6)')msd(r,j+1)
          dataline=trim(dataline)//msd_value
       enddo
       write(msd_value,'(F16.6)')msd(r,nhour+1)
       dataline=trim(dataline)//msd_value
       write(2,*)trim(dataline)
       if(r.eq.1.or.r.eq.500.or.r.eq.1000)write(*,*)r,trim(dataline)
     enddo
   
     close(2)
! -----------------------------------------------------------------   
!
! Output also as GrADS binaries, for visualisation in GrADS? 
! 
     if(grads_out)then
        open(unit=11,form='unformatted',file=outfile_grads(1:loutfile_grads),access='DIRECT',&
            recl=4,status='unknown')
        do hour=hour1,hour2,hour_step
          j=1+(hour-hour1)/hour_step
          do i=1,nreal
             write(11,rec=(j-1)*nreal+i)msd(i,hour+1)
          enddo    
        enddo
        do i=1,nreal
           write(11,rec=j*nreal+i)msd(i,nhour+1)
        enddo
        close(11)
      endif
 
      END program rank_histograms_bootstrap
!
!--------------------------------------------------------------------------------------------
!      
      subroutine find_rank &
           (f,quantiles,nquant,rank1,miss)
!
!     Find the rank of a data value within the quantile table (quantiles). 
!
!     f = individual data value (IN)
!     quantiles = quantile values (IN)
!     nquant = number of quantile values (IN)        
!     rank1 = rank of the data value (OUT)
!     miss = missing value code (IN/OUT)        
        
        implicit none
        integer :: nquant
        real :: quantiles(nquant)
        integer :: rank1
        real :: f
        integer :: i1,i2,i,ind
        real :: miss
        if(abs(quantiles(1)).ge.abs(miss))then
           write(*,*)'Quantiles missing!?' ! This should never happen.
           rank1=miss
        else        
           if(f.lt.quantiles(1))then
              rank1=1
           else
              if(f.ge.quantiles(nquant))then
                 rank1=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
              rank1=i1+1
              endif              
           endif
        endif
        
      return
      end subroutine find_rank
!
!--------------------------------------------------------------------------------------------
!            
      subroutine order(f,g,n)
!
!       Ordering the values of f(1...n) in ascending order. Result in g
!       Simple exchange 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)
! 
! 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

        
      
       
