Merge remote-tracking branch 'origin/release-v4.6.1'
[WRF.git] / hydro / Routing / Reservoirs / module_reservoir_read_timeslice_data.F90
blob3b10f6a66956e5fe3d94e0310f33b7c649cffb56
1 ! This module reads USGS (U.S. Geological Survey) or USACE
2 ! (U.S. Army Corps of Engineers) timeslice files to get gage discharge
3 ! values that will be used by reservoirs. An observation lookback
4 ! period is passed in to determine how far back in time from the
5 ! current model time the module will look for timeslice files.
6 ! The observation resolution determines the time increments the
7 ! module will look back. For instance, a standard lookback period
8 ! would be 18 hours with an observation resolution of 15 minutes,
9 ! where a model current time of 8:00 PM would search for timeslice
10 ! files at every 15 minute increment between 2:00 AM and 8:00 PM
11 ! that day. The module will first search for the most recent
12 ! timeslice files and grab the discharge for a particular
13 ! lake/reservoir if the gage quality standard is met at that time.
14 ! If a gage discharge is missing or if the gage quality standard
15 ! is not met for any particular lake/reservoir in the given
16 ! timeslice file, the module will continue to look back at every
17 ! observation resolution increment until either all
18 ! lakes/reservoirs have a good quality discharge or the end of
19 ! the lookback period is reached. The total lookback seconds
20 ! from current model time that the discharge is read will also
21 ! be returned.
23 module module_reservoir_read_timeslice_data
24     use module_reservoir_utilities, only: get_timeslice_array_dimension, &
25                                           read_timeslice_gage_ids, &
26                                           read_timeslice_netcdf_real_1D_variables, &
27                                           read_persistence_netcdf_gage_ids_all, &
28                                           geth_newdate, &
29                                           handle_err
30     use netcdf
31     implicit none
33     ! The timeslice_data is a singleton in that the object is instantiated only once per
34     ! processor by the first reservoir on that processor that needs it. The object is then used
35     ! by every other reservoir on that processor that needs it.
36     type :: timeslice_data_type
38         character(len=19)                             :: start_date
39         character(len=19)                             :: current_date
40         character(len=256)                            :: timeslice_path
41         character(len=15)                             :: data_source
42         integer                                       :: number_of_reservoir_gages
43         integer                                       :: observation_lookback_hours
44         integer                                       :: current_lookback_seconds
45         integer                                       :: last_update_time_seconds
46         integer,            allocatable, dimension(:) :: gage_lookback_seconds
47         character(len=15),  allocatable, dimension(:) :: reservoir_gage_ids
48         real,               allocatable, dimension(:) :: reservoir_gage_discharges
49         character(len=256), allocatable, dimension(:) :: timeslice_file_names
50         character(len=15),  allocatable, dimension(:) :: gage_id
51         real,               allocatable, dimension(:) :: gage_discharge
52         real,               allocatable, dimension(:) :: gage_quality
53         logical                                       :: initialized = .FALSE.
55     contains
57         procedure :: init => timeslice_data_init
58         procedure :: destroy => timeslice_data_destroy
59         procedure :: setup_read_timeslice => setup_read_timeslice
60         procedure :: read_timeslice_file => read_timeslice_file
62     end type timeslice_data_type
64     type (timeslice_data_type), target :: usgs_timeslice_data, usace_timeslice_data
66     integer, parameter :: observation_resolution_minutes = 15
67     real,    parameter :: gage_quality_threshold = 0.9
69 contains
71     ! Timeslice Data Type Constructor
72     subroutine timeslice_data_init(this, start_date, timeslice_path, &
73         reservoir_parameter_file, data_source, observation_lookback_hours)
74         implicit none
75         class(timeslice_data_type), intent(inout) :: this ! object being initialized
76         character(len=19),  intent(in)                   :: start_date
77         character(len=256), intent(in)                   :: timeslice_path
78         character(len=*),   intent(in)                   :: reservoir_parameter_file
79         character(len=*),   intent(in)                   :: data_source
80         integer,            intent(in)                   :: observation_lookback_hours
81         integer                                          :: ncid, var_id
82         integer                                          :: status  ! status of reading NetCDF
83         integer                                          :: timeslice_gage_index
84         character(len=15), allocatable, dimension(:)     :: gage_ids_string_array
85         character(len=15)                                :: gage_id_string, gage_id_string_trimmed
86         integer                                          :: gage_id_integer
87         integer                                          :: char_index, number_counter, temp_val
88         character(len=1)                                 :: temp_char
90         ! Return from subroutine if this singleton is already initialized
91         if (this%initialized) return
92         this%initialized = .true.
94         this%data_source = ADJUSTL(trim(data_source))
96         status = nf90_open(path = reservoir_parameter_file, mode = nf90_nowrite, ncid = ncid)
97         if (status /= nf90_noerr) call handle_err(status, "Could not open reservoir parameter file " &
98         // trim(ADJUSTL(reservoir_parameter_file)) // ".")
100         call read_persistence_netcdf_gage_ids_all(ncid, ADJUSTL(trim(this%data_source)) // "_gage_id", &
101         reservoir_parameter_file, var_id, this%number_of_reservoir_gages)
103         allocate (this%reservoir_gage_ids(this%number_of_reservoir_gages))
104         allocate (gage_ids_string_array(this%number_of_reservoir_gages))
106         status = nf90_get_var(ncid, var_id, gage_ids_string_array)
107         if (status /= nf90_noerr) call handle_err(status, "Error reading " // ADJUSTL(trim(this%data_source)) &
108          // "_gage_id from " // trim(ADJUSTL(reservoir_parameter_file)) // ".")
110         status = nf90_close(ncid)
111         if (status /= nf90_noerr) call handle_err(status, "Could not close reservoir parameter file " &
112         // trim(ADJUSTL(reservoir_parameter_file)) // ".")
114         ! Convert gage ids to integers
115         do timeslice_gage_index = 1, this%number_of_reservoir_gages
116             gage_id_string = gage_ids_string_array(timeslice_gage_index)
118             do char_index = 1, 15
119                 temp_val = ichar(gage_id_string(char_index:char_index))
121                 ! Check if null character, then pad with a space
122                 if (temp_val == 0) then
123                     gage_id_string(char_index:char_index) = ' '
124                 end if
125             end do
127             gage_id_string_trimmed = ADJUSTL(trim(gage_id_string))
129             this%reservoir_gage_ids(timeslice_gage_index) = gage_id_string_trimmed
131         end do
133         if(allocated(gage_ids_string_array)) deallocate(gage_ids_string_array)
135         this%start_date = start_date
136         this%current_date = start_date
137         this%timeslice_path = timeslice_path
138         this%observation_lookback_hours = observation_lookback_hours
140         this%last_update_time_seconds = -999
142         ! Allocate lookback, dishcharge, and timeslice name arrays
143         allocate (this%gage_lookback_seconds(this%number_of_reservoir_gages))
144         allocate (this%reservoir_gage_discharges(this%number_of_reservoir_gages))
145         allocate(this%timeslice_file_names(this%number_of_reservoir_gages))
147     end subroutine timeslice_data_init
150     ! Timeslice Data Type Destructor
151     subroutine timeslice_data_destroy(this)
153         implicit none
154         class(timeslice_data_type), intent(inout) :: this ! object being destroyed
156     end subroutine timeslice_data_destroy
159     ! Set up list of timeslice files to read
160     ! The timeslices are read only once on each processor at each timeslice update time
161     subroutine setup_read_timeslice(this, update_interval_seconds, current_reservoir_time_seconds, &
162         reservoir_gage_id, gage_lookback_seconds, reservoir_gage_discharge, reservoir_timeslice_file_name)
163         implicit none
165         class(timeslice_data_type), intent(inout) :: this
166         integer, intent(in)  :: update_interval_seconds
167         integer, intent(in)  :: current_reservoir_time_seconds
168         character(len=*), intent(in)  :: reservoir_gage_id
169         integer, intent(out) :: gage_lookback_seconds
170         real, intent(out)    :: reservoir_gage_discharge
171         character(len=256), intent(out)   :: reservoir_timeslice_file_name
172         character(len=256)   :: timeslice_file_name
173         character(len=256)   :: timeslice_file_name_full
174         character(len=19)    :: old_date, new_date
175         character(len=2)     :: observation_resolution_string
176         integer :: total_timeslice_time_periods, timeslice_file_index, reservoir_subset_index, lake_index
177         integer :: observation_minute, observation_resolution_seconds
178         logical :: file_exists
180         ! This check ensures that the timeslice is read only once for each processor at each timeslice update time
181         if (current_reservoir_time_seconds .ne. this%last_update_time_seconds) then
183             ! Checks if not the first timestep, then update date.
184             if (this%last_update_time_seconds .ne. -999) then
185                 call geth_newdate(this%current_date, this%current_date, update_interval_seconds)
186             end if
188             this%last_update_time_seconds = current_reservoir_time_seconds
190             ! Set gage discharges of subset lakes to default -1.0
191             this%reservoir_gage_discharges = -1.0
193             this%gage_lookback_seconds = 0
194             this%current_lookback_seconds = 0
196             ! Set timeslice file names to empty strings by default
197             this%timeslice_file_names = ""
199             total_timeslice_time_periods = this%observation_lookback_hours * (60 / observation_resolution_minutes)
201             old_date = this%current_date
203             read (old_date(15:16), *) observation_minute
205             ! Match minutes to proper observation resolution interval
206             observation_minute = observation_minute / observation_resolution_minutes * observation_resolution_minutes
208             ! Formatting for writing minutes
209             if (observation_minute < 10) then
210                 old_date(15:16) = "00"
211             else
212                 write(old_date(15:16), "(I2)") observation_minute
213             end if
215             ! Zero out seconds
216             old_date(18:19) = "00"
218             write(observation_resolution_string, "(I2)") observation_resolution_minutes
220             ! Negative for going back in time
221             observation_resolution_seconds = observation_resolution_minutes * 60 * (-1)
223             ! Loop through the total timeslice periods to look for and read timeslice files
224             do timeslice_file_index = 1, total_timeslice_time_periods
226                 ! Use below for timeslice files with colons in the time
227                 old_date = old_date(:13) // ':' // old_date(15:16) // ':' // old_date(18:)
229                 ! If any gages that still have discharges equal to -1.0, read the previous
230                 ! time timeslice file available.
231                 if ( any(this%reservoir_gage_discharges == -1.0)) then
233                     ! Construct timeslice filename
234                     timeslice_file_name = old_date // "." // &
235                             observation_resolution_string // 'min.' // ADJUSTL(trim(this%data_source)) // 'TimeSlice.ncdf'
237                     ! Add path to timeslice filename
238                     timeslice_file_name_full = trim(this%timeslice_path) // "/" // ADJUSTL(trim(timeslice_file_name))
240                     ! Check if file exists
241                     inquire(FILE = timeslice_file_name_full, EXIST = file_exists)
242                     if (file_exists) then
243                         ! Call subroutine to read a particular timeslice file
244                         call this%read_timeslice_file(timeslice_file_name_full, timeslice_file_name)
245                     end if
247                     ! Call subroutine to get the date from one observation resolution back in time
248                     call geth_newdate(new_date, old_date, observation_resolution_seconds)
249                     old_date = new_date
251                     ! Lookback seconds to account for how long back a timeslice file was read
252                     this%current_lookback_seconds = this%current_lookback_seconds - observation_resolution_seconds
254                 else
255                     exit
256                 end if
257             end do
259         end if
261         ! Loop through gages to return gage lookback seconds and gage discharge for a given reservoir
262         do reservoir_subset_index = 1, this%number_of_reservoir_gages
263             if (this%reservoir_gage_ids(reservoir_subset_index) .eq. reservoir_gage_id) then
264                 gage_lookback_seconds = this%gage_lookback_seconds(reservoir_subset_index)
265                 reservoir_gage_discharge = this%reservoir_gage_discharges(reservoir_subset_index)
266                 reservoir_timeslice_file_name = this%timeslice_file_names(reservoir_subset_index)
267             end if
268         end do
270     end subroutine setup_read_timeslice
273     ! Read given timeslice file to get gage discharges
274     subroutine read_timeslice_file(this, timeslice_file_full, timeslice_file)
275         implicit none
276         class(timeslice_data_type), intent(inout) :: this
277         character(len=256), intent(in) :: timeslice_file_full
278         character(len=256), intent(in) :: timeslice_file
279         integer :: reservoir_gage_index, timeslice_gage_index, number_of_gages
280         integer :: ncid, status
282         ! Open Timeslice NetCDF file
283         status = nf90_open(path = trim(timeslice_file_full), mode = nf90_nowrite, ncid = ncid)
284         if (status /= nf90_noerr) call handle_err(status, "Could not open timeslice file " &
285         // trim(ADJUSTL(timeslice_file_full)) // ".")
287         ! Get dimension of gage arrays
288         call get_timeslice_array_dimension(ncid, 'discharge', timeslice_file_full, number_of_gages)
290         ! Allocate gage info arrays
291         allocate(this%gage_id(number_of_gages))
292         allocate(this%gage_discharge(number_of_gages))
293         allocate(this%gage_quality(number_of_gages))
295         ! Get gage ids
296         call read_timeslice_gage_ids(ncid, 'stationId', timeslice_file_full, this%gage_id)
298         ! Get gage discharges
299         call read_timeslice_netcdf_real_1D_variables(ncid, 'discharge', timeslice_file_full, this%gage_discharge)
301         ! Get gage qualities
302         call read_timeslice_netcdf_real_1D_variables(ncid, 'discharge_quality', timeslice_file_full, this%gage_quality)
304         ! Normalize gage qualities to 1
305         this%gage_quality = this%gage_quality/100
307         ! First, quality check on the quality flag
308         where(this%gage_quality .lt. 0 .or. this%gage_quality .gt. 1) this%gage_quality=0
310         ! Currently using line below that would set quality to 0 if there is a negative
311         ! discharge but there may actually be a deficit in flow, i.e. no flow available
312         ! at all that the transducer has given us a negative pressure. We do not account
313         ! for that case here but may need to consider this later.
314         where(this%gage_discharge .lt. 0.000) this%gage_quality=0
316         ! Currently not using line below instead of above line that sets quality to 0 for negative discharge
317         !where(this%gage_discharge .le. 0.000) this%gage_discharge = 0.0
319         !! peak flow on MS river *2
320         !! http://nwis.waterdata.usgs.gov/nwis/peak?site_no=07374000&agency_cd=USGS&format=html
321         !! baton rouge 1945: 1,473,000cfs=41,711cms, multiply it roughly by 2
322         where(this%gage_discharge .ge. 90000.0) this%gage_quality=0
324         ! Loop through reservoir gage array to look for gages that still have discharges set to -1.0.
325         ! Match gage ids from the timeslice file gage id arrays to gage ids in the reservoir gage subset
326         ! array. If the matched gage is good quality, then set that reservoir gage subset discharge to
327         ! the discharge read from the timeslice file along with the total lookback seconds from current
328         ! model time that the gage discharge is read from a timeslice file.
329         do reservoir_gage_index = 1, this%number_of_reservoir_gages
330             if (this%reservoir_gage_discharges(reservoir_gage_index) == -1.0) then
331                 do timeslice_gage_index = 1, number_of_gages
332                     if (ADJUSTL(trim(this%gage_id(timeslice_gage_index))) &
333                     .eq. ADJUSTL(trim(this%reservoir_gage_ids(reservoir_gage_index)))) then
334                         if (this%gage_quality(timeslice_gage_index) .gt. gage_quality_threshold) then
335                             this%reservoir_gage_discharges(reservoir_gage_index) = this%gage_discharge(timeslice_gage_index)
336                             this%gage_lookback_seconds(reservoir_gage_index) = this%current_lookback_seconds
337                             this%timeslice_file_names(reservoir_gage_index) = ADJUSTL(trim(timeslice_file))
338                         end if
339                         exit
340                     end if
341                 end do
342             end if
343         end do
345     ! Close timeslice NetCDF file
346     status = nf90_close(ncid)
347     if (status /= nf90_noerr) call handle_err(status, "Could not close timeslice file " // trim(ADJUSTL(timeslice_file_full)) // ".")
349     ! Deallocate gage arrays
350     if(allocated(this%gage_id)) deallocate(this%gage_id)
351     if(allocated(this%gage_discharge)) deallocate(this%gage_discharge)
352     if(allocated(this%gage_quality)) deallocate(this%gage_quality)
354     end subroutine read_timeslice_file
356 end module module_reservoir_read_timeslice_data