Skip to content

Commit a4cffec

Browse files
rsreganrsregan
committed
fixed bugs in summary modules identified by Colin Penn
1 parent 3069e2d commit a4cffec

File tree

5 files changed

+109
-97
lines changed

5 files changed

+109
-97
lines changed

‎GSFLOW/src/prms/basin_sum.f90

+5-5
Original file line numberDiff line numberDiff line change
@@ -7,7 +7,7 @@ MODULE PRMS_BASINSUM
77
! Local Variables
88
character(len=*), parameter :: MODDESC = 'Output Summary'
99
character(len=9), parameter :: MODNAME = 'basin_sum'
10-
character(len=*), parameter :: Version_basin_sum = '2024-04-30'
10+
character(len=*), parameter :: Version_basin_sum = '2024-09-01'
1111

1212
INTEGER, SAVE :: BALUNT, Totdays
1313
INTEGER, SAVE :: Header_prt, Endjday
@@ -504,13 +504,12 @@ INTEGER FUNCTION sumbrun()
504504
INTRINSIC :: ABS, DBLE
505505
EXTERNAL :: header_print
506506
! Local variables
507-
INTEGER :: i, j, wyday, endrun, monthdays
508-
DOUBLE PRECISION :: wat_bal, obsrunoff, yrdays_dble
507+
INTEGER :: i, j, wyday, endrun
508+
DOUBLE PRECISION :: wat_bal, obsrunoff, yrdays_dble, monthdays
509509
!***********************************************************************
510510
sumbrun = 0
511511

512512
wyday = Julwater
513-
yrdays_dble = DBLE( Yrdays )
514513

515514
IF ( Nowyear==End_year .AND. Jday==Endjday ) THEN
516515
endrun = 1
@@ -634,7 +633,7 @@ INTEGER FUNCTION sumbrun()
634633
Basin_lakeevap_mo = Basin_lakeevap_mo + Basin_lakeevap
635634

636635
IF ( Nowday==Modays(Nowmonth) ) THEN
637-
monthdays = Modays(Nowmonth)
636+
monthdays = DBLE( Modays(Nowmonth) )
638637
Basin_swrad_mo = Basin_swrad_mo/monthdays
639638
Basin_max_temp_mo = Basin_max_temp_mo/monthdays
640639
Basin_min_temp_mo = Basin_min_temp_mo/monthdays
@@ -700,6 +699,7 @@ INTEGER FUNCTION sumbrun()
700699
ENDDO
701700

702701
IF ( wyday==Yrdays ) THEN
702+
yrdays_dble = DBLE( Yrdays )
703703
IF ( Print_type==0 ) THEN
704704

705705
Obs_runoff_yr = Obs_runoff_yr/yrdays_dble

‎GSFLOW/src/prms/basin_summary.f90

+29-16
Original file line numberDiff line numberDiff line change
@@ -7,12 +7,11 @@ MODULE PRMS_BASIN_SUMMARY
77
! Module Variables
88
character(len=*), parameter :: MODDESC = 'Output Summary'
99
character(len=*), parameter :: MODNAME = 'basin_summary'
10-
character(len=*), parameter :: Version_basin_summary = '2021-08-13'
10+
character(len=*), parameter :: Version_basin_summary = '2024-09-01'
1111
INTEGER, SAVE :: Begin_results, Begyr, Lastyear, Dailyunit, Monthlyunit, Yearlyunit, Basin_var_type
1212
INTEGER, SAVE, ALLOCATABLE :: Nc_vars(:)
13-
CHARACTER(LEN=48), SAVE :: Output_fmt, Output_fmt2, Output_fmt3
14-
INTEGER, SAVE :: Daily_flag, Yeardays, Monthly_flag
15-
DOUBLE PRECISION, SAVE :: Monthdays
13+
CHARACTER(LEN=48), SAVE :: Output_fmt, Output_fmt2 !, Output_fmt3
14+
INTEGER, SAVE :: Daily_flag, Yeardays, Monthly_flag, Monthdays, save_year, save_month, save_day
1615
DOUBLE PRECISION, SAVE, ALLOCATABLE :: Basin_var_daily(:), Basin_var_monthly(:), Basin_var_yearly(:)
1716
! Parameters
1817
INTEGER, SAVE, ALLOCATABLE :: Nhm_id(:)
@@ -95,7 +94,7 @@ END SUBROUTINE basin_summarydecl
9594
!***********************************************************************
9695
SUBROUTINE basin_summaryinit()
9796
USE PRMS_CONSTANTS, ONLY: MAXFILE_LENGTH, ACTIVE, OFF, DAILY_MONTHLY, MEAN_MONTHLY, MEAN_YEARLY, DAILY, MONTHLY, &
98-
& DBLE_TYPE, ERROR_open_out
97+
& DBLE_TYPE, ERROR_open_out, YEARLY
9998
use PRMS_MMFAPI, only: getvarsize, getvartype
10099
use PRMS_READ_PARAM_FILE, only: getparam_int
101100
USE PRMS_MODULE, ONLY: Start_year, Prms_warmup, BasinOutON_OFF, Nhru, Inputerror_flag
@@ -143,10 +142,10 @@ SUBROUTINE basin_summaryinit()
143142
Yeardays = 0
144143
ALLOCATE ( Basin_var_yearly(BasinOutVars) )
145144
Basin_var_yearly = 0.0D0
146-
WRITE ( Output_fmt3, 9003 ) BasinOutVars
145+
!WRITE ( Output_fmt3, 9003 ) BasinOutVars
147146
ENDIF
148147
IF ( Monthly_flag==ACTIVE ) THEN
149-
Monthdays = 0.0D0
148+
Monthdays = 0
150149
ALLOCATE ( Basin_var_monthly(BasinOutVars) )
151150
Basin_var_monthly = 0.0D0
152151
ENDIF
@@ -175,7 +174,7 @@ SUBROUTINE basin_summaryinit()
175174
IF ( ios/=0 ) CALL error_stop('in basin_summary, mean yearly', ERROR_open_out)
176175
IF ( BasinOutON_OFF==2 ) WRITE ( Yearlyunit, '(A, 1X, I0)') 'nhm_id:', Nhm_id(1)
177176
WRITE ( Yearlyunit, Output_fmt2 ) (BasinOutVar_names(jj)(:Nc_vars(jj)), jj=1, BasinOutVars)
178-
ELSEIF ( BasinOut_freq==MEAN_YEARLY ) THEN
177+
ELSEIF ( BasinOut_freq==YEARLY ) THEN
179178
fileName = BasinOutBaseFileName(:numchars(BasinOutBaseFileName))//'_yearly.csv'
180179
CALL PRMS_open_output_file(Yearlyunit, fileName, 'basin_summary, yearly', 0, ios)
181180
IF ( ios/=0 ) CALL error_stop('in basin_summary, yearly', ERROR_open_out)
@@ -203,14 +202,15 @@ END SUBROUTINE basin_summaryinit
203202
! Output set of declared variables in CSV format
204203
!***********************************************************************
205204
SUBROUTINE basin_summaryrun()
206-
USE PRMS_CONSTANTS, ONLY: ACTIVE, OFF, MEAN_MONTHLY, YEARLY
205+
USE PRMS_CONSTANTS, ONLY: ACTIVE, OFF, MEAN_MONTHLY, MEAN_YEARLY
207206
use PRMS_MMFAPI, only: getvar_dble
208207
USE PRMS_MODULE, ONLY: Start_month, Start_day, End_year, End_month, End_day, Nowyear, Nowmonth, Nowday
209208
USE PRMS_BASIN_SUMMARY
210209
USE PRMS_SET_TIME, ONLY: Modays
211210
IMPLICIT NONE
212211
! Local Variables
213212
INTEGER :: jj, write_month, last_day
213+
DOUBLE PRECISION :: yeardays_dble, monthdays_dble
214214
!***********************************************************************
215215
IF ( Begin_results==OFF ) THEN
216216
IF ( Nowyear==Begyr .AND. Nowmonth==Start_month .AND. Nowday==Start_day ) THEN
@@ -232,16 +232,28 @@ SUBROUTINE basin_summaryrun()
232232
IF ( Nowyear==End_year .AND. Nowmonth==End_month .AND. Nowday==End_day ) last_day = ACTIVE
233233
IF ( Lastyear/=Nowyear .OR. last_day==ACTIVE ) THEN
234234
IF ( (Nowmonth==Start_month .AND. Nowday==Start_day) .OR. last_day==ACTIVE ) THEN
235-
DO jj = 1, BasinOutVars
236-
IF ( BasinOut_freq==YEARLY ) Basin_var_yearly(jj) = Basin_var_yearly(jj)/Yeardays
237-
ENDDO
238-
WRITE ( Yearlyunit, Output_fmt3) Lastyear, (Basin_var_yearly(jj), jj=1, BasinOutVars)
235+
yeardays_dble = DBLE( Yeardays )
236+
IF ( BasinOut_freq==MEAN_YEARLY ) THEN
237+
DO jj = 1, BasinOutVars
238+
Basin_var_yearly(jj) = Basin_var_yearly(jj)/yeardays_dble
239+
ENDDO
240+
ENDIF
241+
IF ( last_day==ACTIVE ) THEN
242+
save_year = Nowyear
243+
save_month = Nowmonth
244+
save_day = Nowday
245+
ENDIF
246+
!WRITE ( Yearlyunit, Output_fmt3) Lastyear, (Basin_var_yearly(jj), jj=1, BasinOutVars)
247+
WRITE ( Yearlyunit, Output_fmt) save_year, save_month, save_day, (Basin_var_yearly(jj), jj=1, BasinOutVars)
239248
Basin_var_yearly = 0.0D0
240249
Yeardays = 0
241250
Lastyear = Nowyear
242251
ENDIF
243252
ENDIF
244253
Yeardays = Yeardays + 1
254+
save_year = Nowyear
255+
save_month = Nowmonth
256+
save_day = Nowday
245257
ELSEIF ( Monthly_flag==ACTIVE ) THEN
246258
! check for last day of month and simulation
247259
IF ( Nowday==Modays(Nowmonth) ) THEN
@@ -251,7 +263,7 @@ SUBROUTINE basin_summaryrun()
251263
IF ( Nowday==End_day ) write_month = ACTIVE
252264
ENDIF
253265
ENDIF
254-
Monthdays = Monthdays + 1.0D0
266+
Monthdays = Monthdays + 1
255267
ENDIF
256268

257269
IF ( BasinOut_freq>MEAN_MONTHLY ) THEN
@@ -262,18 +274,19 @@ SUBROUTINE basin_summaryrun()
262274
ENDIF
263275

264276
IF ( Monthly_flag==ACTIVE ) THEN
277+
monthdays_dble = DBLE( Monthdays )
265278
DO jj = 1, BasinOutVars
266279
Basin_var_monthly(jj) = Basin_var_monthly(jj) + Basin_var_daily(jj)
267280
IF ( write_month==ACTIVE ) THEN
268-
IF ( BasinOut_freq==MEAN_MONTHLY ) Basin_var_monthly(jj) = Basin_var_monthly(jj)/Monthdays
281+
IF ( BasinOut_freq==MEAN_MONTHLY ) Basin_var_monthly(jj) = Basin_var_monthly(jj)/monthdays_dble
269282
ENDIF
270283
ENDDO
271284
ENDIF
272285

273286
IF ( Daily_flag==ACTIVE ) WRITE ( Dailyunit, Output_fmt) Nowyear, Nowmonth, Nowday, (Basin_var_daily(jj), jj=1,BasinOutVars)
274287
IF ( write_month==ACTIVE ) THEN
275288
WRITE ( Monthlyunit, Output_fmt) Nowyear, Nowmonth, Nowday, (Basin_var_monthly(jj), jj=1,BasinOutVars)
276-
Monthdays = 0.0D0
289+
Monthdays = 0
277290
Basin_var_monthly = 0.0D0
278291
ENDIF
279292

‎GSFLOW/src/prms/nhru_summary.f90

+5
Original file line numberDiff line numberDiff line change
@@ -466,6 +466,11 @@ SUBROUTINE nhru_summaryrun()
466466
ENDDO
467467
ENDIF
468468
ENDIF
469+
IF ( last_day==ACTIVE ) THEN
470+
save_year = Nowyear
471+
save_month = Nowmonth
472+
save_day = Nowday
473+
ENDIF
469474
CALL write_CBH_values(jj, Yearlyunit(jj), Nhru_var_type(jj), 3)
470475
ENDDO
471476
Nhru_var_yearly = 0.0D0

‎GSFLOW/src/prms/nsegment_summary.f90

+20-14
Original file line numberDiff line numberDiff line change
@@ -7,14 +7,13 @@ MODULE PRMS_NSEGMENT_SUMMARY
77
! Module Variables
88
character(len=*), parameter :: MODDESC = 'Output Summary'
99
character(len=*), parameter :: MODNAME = 'nsegment_summary'
10-
character(len=*), parameter :: Version_nsegment_summary = '2023-11-01'
10+
character(len=*), parameter :: Version_nsegment_summary = '2024-09-01'
1111
INTEGER, SAVE :: Begin_results, Begyr, Lastyear
1212
INTEGER, SAVE, ALLOCATABLE :: Dailyunit(:), Nc_vars(:), Nsegment_var_type(:)
1313
REAL, SAVE, ALLOCATABLE :: Nsegment_var_daily(:, :)
1414
DOUBLE PRECISION, SAVE, ALLOCATABLE :: Nsegment_var_dble(:, :)
1515
CHARACTER(LEN=48), SAVE :: Output_fmt, Output_fmt2 !, Output_fmt3
16-
INTEGER, SAVE :: Daily_flag, Double_vars, Yeardays, Monthly_flag
17-
DOUBLE PRECISION, SAVE :: Monthdays
16+
INTEGER, SAVE :: Daily_flag, Double_vars, Yeardays, Monthly_flag, Monthdays
1817
INTEGER, SAVE, ALLOCATABLE :: Monthlyunit(:), Yearlyunit(:)
1918
DOUBLE PRECISION, SAVE, ALLOCATABLE :: Nsegment_var_monthly(:, :), Nsegment_var_yearly(:, :)
2019
! Parameters
@@ -193,7 +192,7 @@ SUBROUTINE nsegment_summaryinit()
193192
!ENDIF
194193
ENDIF
195194
IF ( Monthly_flag==ACTIVE ) THEN
196-
Monthdays = 0.0D0
195+
Monthdays = 0
197196
ALLOCATE ( Nsegment_var_monthly(Nsegment, NsegmentOutVars), Monthlyunit(NsegmentOutVars) )
198197
Nsegment_var_monthly = 0.0D0
199198
Monthlyunit = 0
@@ -290,6 +289,7 @@ SUBROUTINE nsegment_summaryrun()
290289
INTRINSIC :: SNGL, DBLE
291290
! Local Variables
292291
INTEGER :: j, i, jj, write_month, last_day, save_year, save_month, save_day
292+
DOUBLE PRECISION :: yeardays_dble, monthdays_dble
293293
!***********************************************************************
294294
IF ( Begin_results==OFF ) THEN
295295
IF ( Nowyear==Begyr .AND. Nowmonth==Start_month .AND. Nowday==Start_day ) THEN
@@ -304,14 +304,12 @@ SUBROUTINE nsegment_summaryrun()
304304
DO jj = 1, NsegmentOutVars
305305
IF ( Nsegment_var_type(jj)==REAL_TYPE ) THEN
306306
CALL getvar_real(MODNAME, NsegmentOutVar_names(jj)(:Nc_vars(jj)), Nsegment, Nsegment_var_daily(:, jj))
307+
Nsegment_var_dble(:, jj) = Nsegment_var_daily(:, jj)
307308
ELSEIF ( Nsegment_var_type(jj)==DBLE_TYPE ) THEN
308309
CALL getvar_dble(MODNAME, NsegmentOutVar_names(jj)(:Nc_vars(jj)), Nsegment, Nsegment_var_dble(:, jj))
309-
DO i = 1, Nsegment
310-
Nsegment_var_daily(i, jj) = SNGL( Nsegment_var_dble(i, jj) )
311-
ENDDO
312310
ENDIF
313311
IF ( Daily_flag==ACTIVE ) WRITE ( Dailyunit(jj), Output_fmt) Nowyear, Nowmonth, Nowday, &
314-
& (Nsegment_var_daily(j,jj), j=1,Nsegment)
312+
& (Nsegment_var_dble(j,jj), j=1,Nsegment)
315313
ENDDO
316314

317315
write_month = OFF
@@ -320,12 +318,19 @@ SUBROUTINE nsegment_summaryrun()
320318
IF ( Nowyear==End_year .AND. Nowmonth==End_month .AND. Nowday==End_day ) last_day = ACTIVE
321319
IF ( Lastyear/=Nowyear .OR. last_day==ACTIVE ) THEN
322320
IF ( (Nowmonth==Start_month .AND. Nowday==Start_day) .OR. last_day==ACTIVE ) THEN
321+
yeardays_dble = DBLE( Yeardays )
323322
DO jj = 1, NsegmentOutVars
324323
IF ( NsegmentOut_freq==MEAN_YEARLY ) THEN
325324
DO i = 1, Nsegment
326-
Nsegment_var_yearly(i, jj) = Nsegment_var_yearly(i, jj)/Yeardays
325+
Nsegment_var_yearly(i, jj) = Nsegment_var_yearly(i, jj)/yeardays_dble
327326
ENDDO
328327
ENDIF
328+
IF ( last_day==ACTIVE ) THEN
329+
save_year = Nowyear
330+
save_month = Nowmonth
331+
save_day = Nowday
332+
ENDIF
333+
!WRITE ( Yearlyunit(jj), Output_fmt3) last_year, (Nsegment_var_yearly(j,jj), j=1,Nsegment)
329334
WRITE ( Yearlyunit(jj), Output_fmt) save_year, save_month, save_day, (Nsegment_var_yearly(j,jj), j=1,Nsegment)
330335
ENDDO
331336
Nsegment_var_yearly = 0.0D0
@@ -346,24 +351,25 @@ SUBROUTINE nsegment_summaryrun()
346351
IF ( Nowday==End_day ) write_month = ACTIVE
347352
ENDIF
348353
ENDIF
349-
Monthdays = Monthdays + 1.0D0
354+
Monthdays = Monthdays + 1
350355
ENDIF
351356

352357
IF ( NsegmentOut_freq>MEAN_MONTHLY ) THEN
353358
DO jj = 1, NsegmentOutVars
354359
DO i = 1, Nsegment
355-
Nsegment_var_yearly(i, jj) = Nsegment_var_yearly(i, jj) + DBLE( Nsegment_var_daily(i, jj) )
360+
Nsegment_var_yearly(i, jj) = Nsegment_var_yearly(i, jj) + Nsegment_var_dble(i, jj)
356361
ENDDO
357362
ENDDO
358363
RETURN
359364
ENDIF
360365

361366
IF ( Monthly_flag==ACTIVE ) THEN
367+
monthdays_dble = DBLE( Monthdays )
362368
DO jj = 1, NsegmentOutVars
363369
DO i = 1, Nsegment
364-
Nsegment_var_monthly(i, jj) = Nsegment_var_monthly(i, jj) + DBLE( Nsegment_var_daily(i, jj) )
370+
Nsegment_var_monthly(i, jj) = Nsegment_var_monthly(i, jj) + Nsegment_var_dble(i, jj)
365371
IF ( write_month==ACTIVE ) THEN
366-
IF ( NsegmentOut_freq==MEAN_MONTHLY ) Nsegment_var_monthly(i, jj) = Nsegment_var_monthly(i, jj)/Monthdays
372+
IF ( NsegmentOut_freq==MEAN_MONTHLY ) Nsegment_var_monthly(i, jj) = Nsegment_var_monthly(i, jj)/monthdays_dble
367373
ENDIF
368374
ENDDO
369375
ENDDO
@@ -374,7 +380,7 @@ SUBROUTINE nsegment_summaryrun()
374380
WRITE ( Monthlyunit(jj), Output_fmt) Nowyear, Nowmonth, Nowday, &
375381
& (Nsegment_var_monthly(j,jj), j=1,Nsegment)
376382
ENDDO
377-
Monthdays = 0.0D0
383+
Monthdays = 0
378384
Nsegment_var_monthly = 0.0D0
379385
ENDIF
380386

0 commit comments

Comments
 (0)