weather_data_tabular.F90

Go to the documentation of this file.

module weather_data_tabular
 
  use iso_c_binding, only              : c_short, c_int, c_float, c_double, c_bool
  use constants_and_conversions, only  : true, false, m_per_foot, in_to_mm
  use fstring_list, only               : fstring_list_t, create_list, na_float
  use fstring, only                    : ascharacter, squote, operator(.contains.)
  use parameters, only                 : params
  use simulation_datetime, only        : sim_dt
  use datetime, only                   : datetime_t, operator(<), operator(>)
  use logfiles, only                   : logs, log_all
  use exceptions, only                 : assert, warn, die
 
  implicit none
 
  real (c_float), allocatable    :: tmin(:)
  real (c_float), allocatable    :: tmax(:)
  real (c_float), allocatable    :: precip(:)
  type (datetime_t), allocatable :: weather_date(:)
 
  integer (c_int), save  :: date_indx = 1
 
  private date_indx
 
contains
 
  subroutine weather_data_tabular_initialize()
 
    type (FSTRING_LIST_T)              :: slList
    integer (kind=c_int)               :: indx
    integer (kind=c_int)               :: iStat
    character (len=:), allocatable     :: date_str
    type (DATETIME_T)                  :: tempdate
    type (DATETIME_T)                  :: firstdate
    type (DATETIME_T)                  :: lastdate
    integer (c_int)                    :: error_count
    integer (c_int)                    :: first_indx
 
 
    call params%get_parameters(skey="PRCP", fvalues=precip)
    call params%get_parameters(skey="TMIN", fvalues=tmin)
    call params%get_parameters(skey="TMAX", fvalues=tmax)
 
    !> read in dates as a string list
    call params%get_parameters( skey="Date", slvalues=sllist)
 
    allocate(weather_date(sllist%count), stat=istat)
    call assert( istat==0, "Failed to allocate memory for WEATHER_DATE array", &
      __file__, __line__ )
 
    call logs%write("  Date       | PRCP          | TMIN         | TMAX")  
    call logs%write("-------------|---------------|--------------|--------------")
 
    call weather_date(1)%setDateFormat(sdateformat="YYYY-MM-DD")
 
    print *, "Scanning weather data file for anomalies... There are "//ascharacter(sllist%count)//" entries."
 
 
    error_count = 0
 
    do indx=1, sllist%count
      
      date_str = sllist%get(indx)
      call weather_date(indx)%parsedate( date_str, __file__, __line__ )
      
      if (indx == 1)  tempdate = weather_date(1)
 
      do
        if ( ( tempdate < sim_dt%start ) .or. ( tempdate > sim_dt%end ) ) then
 
          error_count = 0
          ! NOP
          exit
   
        elseif ( (weather_date(indx) == tempdate) .and. (error_count == 0)) then
 
          if (precip(indx) <= na_float)  call warn("Missing PRCP value for "//weather_date(indx)%prettydate(), lfatal=true) 
          if (tmax(indx) <= na_float)    call warn("Missing TMAX value for "//weather_date(indx)%prettydate(), lfatal=true) 
          if (tmin(indx) <= na_float)    call warn("Missing TMIN value for "//weather_date(indx)%prettydate(), lfatal=true) 
    
          call logs%write(weather_date(indx)%prettydate()//"  |  "//ascharacter(precip(indx))//"  |  "  &
                                                  //ascharacter(tmin(indx))//"  |  "                    &
                                                  //ascharacter(tmax(indx)))                                        
    
          exit
 
        elseif ((weather_date(indx) == tempdate) .and. (error_count > 0)) then
 
          call warn("Missing or out of order date sequence "//ascharacter(error_count)//" value(s) in"  &
           //" single-station weather data file. Problem date(s) span "//firstdate%prettydate()//" to "  &
           //lastdate%prettydate()//".", lfatal=true)
          error_count = 0
          exit
        elseif (error_count == 0) then
 
          firstdate = tempdate
          error_count = error_count + 1
          lastdate = weather_date(indx) - 1
          call tempdate%addDay()
          cycle
        else
 
          error_count = error_count + 1
          call tempdate%addDay()
          cycle
          
        endif    
 
      enddo
 
      call tempdate%addDay()
 
    enddo
 
    ! can we really have set up the code to use a GLOBAL value for the default
    ! date format?? That needs to change.
    call weather_date(1)%setDateFormat(sdateformat="MM-DD-YYYY")
 
  end subroutine weather_data_tabular_initialize
 
!-----------------------------------------------------------------------------------
 
  subroutine weather_data_find_date_indx(dt)
 
    type (DATETIME_T), intent(in) :: dt
 
    integer (c_int)   :: indx
    logical (c_bool)  :: date_found
 
    date_found = false
 
    do indx=date_indx, size(weather_date%iJulianDay,1)
 
      if (weather_date(indx) == dt) then
        date_found = true
        date_indx = indx
        exit
      endif  
 
    enddo
 
    call assert(date_found, "Failed to find a matching date value in the daily weather data table.", &
      __file__, __line__)
 
  end subroutine weather_data_find_date_indx
 
!-----------------------------------------------------------------------------------
 
  subroutine weather_data_tabular_get_precip( dt, precip_value )
 
    type (DATETIME_T), intent(in)    :: dt
    real (kind=c_float), intent(out) :: precip_value
 
    call weather_data_find_date_indx(dt)
 
    precip_value = precip(date_indx)
 
  end subroutine weather_data_tabular_get_precip
 
!-----------------------------------------------------------------------------------
 
  subroutine weather_data_tabular_get_tmax( dt, tmax_value )
 
    type (DATETIME_T), intent(in)    :: dt
    real (kind=c_float), intent(out) :: tmax_value
 
    call weather_data_find_date_indx(dt)
    tmax_value = tmax(date_indx)
 
  end subroutine weather_data_tabular_get_tmax
 
!-----------------------------------------------------------------------------------
 
  subroutine weather_data_tabular_get_tmin( dt, tmin_value )
 
    type (DATETIME_T), intent(in)    :: dt
    real (kind=c_float), intent(out) :: tmin_value
 
    call weather_data_find_date_indx(dt)
    tmin_value = tmin(date_indx)
 
  end subroutine weather_data_tabular_get_tmin
 
 
end module weather_data_tabular