Skip to content

Commit

Permalink
merged in PRMS6, including new model_mode PRMS6
Browse files Browse the repository at this point in the history
  • Loading branch information
@rsregan
rsregan committed May 1, 2024
1 parent 0e79e21 commit 718a54b
Show file tree
Hide file tree
Showing 38 changed files with 999 additions and 1,010 deletions.
39 changes: 19 additions & 20 deletions GSFLOW/src/prms/basin.f90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -6,7 +6,7 @@ MODULE PRMS_BASIN
! Local Variables
character(len=*), parameter :: MODDESC = 'Basin Definition'
character(len=*), parameter :: MODNAME = 'basin'
character(len=*), parameter :: Version_basin = '2024-01-22'
character(len=*), parameter :: Version_basin = '2024-04-04'
INTEGER, SAVE :: Numlake_hrus, Active_hrus, Active_gwrs, Numlakes_check
INTEGER, SAVE :: Hemisphere, Dprst_clos_flag, Dprst_open_flag, Imperv_flag
DOUBLE PRECISION, SAVE :: Land_area, Water_area, Ag_area_total
Expand All @@ -17,7 +17,8 @@ MODULE PRMS_BASIN
INTEGER, SAVE :: Weir_gate_flag, Puls_lin_flag
DOUBLE PRECISION, SAVE, ALLOCATABLE :: Hru_area_dble(:), Lake_area(:)
! Declared Variables
REAL, SAVE, ALLOCATABLE :: Hru_frac_perv(:), Hru_frac_imperv(:), Hru_frac_dprst(:), Ag_area(:)
REAL, SAVE, ALLOCATABLE :: Hru_frac_perv(:), Ag_area(:)
REAL, SAVE, ALLOCATABLE :: Hru_frac_imperv(:), Hru_frac_dprst(:)
REAL, SAVE, ALLOCATABLE :: Dprst_area_max(:)
REAL, SAVE, ALLOCATABLE :: Hru_perv(:), Hru_imperv(:)
REAL, SAVE, ALLOCATABLE :: Dprst_area_open_max(:), Dprst_area_clos_max(:)
Expand Down Expand Up @@ -64,7 +65,7 @@ END FUNCTION basin
INTEGER FUNCTION basdecl()
USE PRMS_CONSTANTS, ONLY: ACTIVE, OFF
USE PRMS_MODULE, ONLY: Nhru, Nlake, Dprst_flag, Lake_route_flag, &
& PRMS4_flag, Glacier_flag, AG_flag, gwflow_flag
& PRMS4_flag, gwflow_flag, Glacier_flag, AG_flag
use PRMS_MMFAPI, only: declvar_real, declvar_dble
use PRMS_READ_PARAM_FILE, only: declparam
USE PRMS_BASIN
Expand Down Expand Up @@ -286,14 +287,13 @@ END FUNCTION basdecl
! and compute reservoir areas
!**********************************************************************
INTEGER FUNCTION basinit()
USE PRMS_CONSTANTS, ONLY: DEBUG_less, ACTIVE, OFF, &
& INACTIVE, LAKE, FEET, ERROR_basin, DEBUG_minimum, &
& NORTHERN, SOUTHERN, FEET2METERS, DNEARZERO, CLOSEZERO, ERROR_param, CANOPY !, METERS2FEET, SWALE
USE PRMS_CONSTANTS, ONLY: DEBUG_less, ACTIVE, OFF, CLOSEZERO, &
& INACTIVE, LAKE, FEET, ERROR_basin, DEBUG_minimum, ERROR_param, &
& NORTHERN, SOUTHERN, FEET2METERS, DNEARZERO, CANOPY !, METERS2FEET, SWALE
use PRMS_READ_PARAM_FILE, only: getparam_int, getparam_real
USE PRMS_MODULE, ONLY: Nhru, Nlake, Print_debug, &
& Dprst_flag, Lake_route_flag, PRMS4_flag, PRMS_VERSION, &
& Hru_type, irrigation_apply_flag, gwflow_flag, AG_flag, Ag_package, &
& Starttime, Endtime, Parameter_check_flag !, Frozen_flag
USE PRMS_MODULE, ONLY: Nhru, Nlake, Print_debug, Hru_type, irrigation_apply_flag, &
& Dprst_flag, Lake_route_flag, PRMS4_flag, gwflow_flag, PRMS_VERSION, &
& Starttime, Endtime, Parameter_check_flag, AG_flag, Ag_package !, Frozen_flag
USE PRMS_BASIN
use prms_utils, only: checkdim_bounded_limits, error_stop, read_error, write_outfile
IMPLICIT NONE
Expand All @@ -311,14 +311,6 @@ INTEGER FUNCTION basinit()
IF ( getparam_real(MODNAME, 'hru_area', Nhru, Hru_area)/=0 ) CALL read_error(2, 'hru_area')
IF ( getparam_real(MODNAME, 'hru_elev', Nhru, Hru_elev)/=0 ) CALL read_error(2, 'hru_elev')
Hru_elev_ts = Hru_elev
IF ( Elev_units==FEET ) THEN
! Hru_elev_feet = Hru_elev_ts
Hru_elev_meters = Hru_elev_ts * FEET2METERS
ELSE
! Hru_elev_feet = Hru_elev_ts * METERS2FEET
Hru_elev_meters = Hru_elev_ts
ENDIF

IF ( getparam_real(MODNAME, 'hru_lat', Nhru, Hru_lat)/=0 ) CALL read_error(2, 'hru_lat')
IF ( getparam_int(MODNAME, 'cov_type', Nhru, Cov_type)/=0 ) CALL read_error(2, 'cov_type')
IF ( getparam_real(MODNAME, 'covden_sum', Nhru, Covden_sum)/=0 ) CALL read_error(2, 'covden_sum')
Expand Down Expand Up @@ -453,6 +445,13 @@ INTEGER FUNCTION basinit()
ENDIF

Basin_lat = Basin_lat + DBLE( Hru_lat(i)*harea )
IF ( Elev_units==FEET ) THEN
! Hru_elev_feet(i) = Hru_elev(i)
Hru_elev_meters(i) = Hru_elev(i)*FEET2METERS
ELSE
! Hru_elev_feet(i) = Hru_elev(i)*METERS2FEET
Hru_elev_meters(i) = Hru_elev(i)
ENDIF
j = j + 1
Hru_route_order(j) = i

Expand Down Expand Up @@ -626,7 +625,7 @@ INTEGER FUNCTION basinit()
IF ( Water_area>0.0D0 ) PRINT *, 'Fraction lakes = ', Water_area*Basin_area_inv
IF ( Dprst_flag==ACTIVE ) PRINT *, 'Fraction storage area = ', basin_dprst*Basin_area_inv
IF ( AG_flag==ACTIVE ) PRINT *, 'Fraction area = ', basin_ag_area
PRINT *, ' '
! PRINT *, ' '
ENDIF

! print out start and end times
Expand Down Expand Up @@ -654,7 +653,7 @@ INTEGER FUNCTION basinit()
WRITE (buffer, 9005) 'Agriculture area: ', basin_ag_area*Active_area, ' Fraction AG: ', basin_ag_area
CALL write_outfile(buffer)
ENDIF
CALL write_outfile(' ')
! CALL write_outfile(' ')
ENDIF

9002 FORMAT (A, I4.2, 2('/', I2.2), I3.2, 2(':', I2.2))
Expand Down
42 changes: 21 additions & 21 deletions GSFLOW/src/prms/basin_sum.f90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -7,7 +7,7 @@ MODULE PRMS_BASINSUM
! Local Variables
character(len=*), parameter :: MODDESC = 'Output Summary'
character(len=9), parameter :: MODNAME = 'basin_sum'
character(len=*), parameter :: Version_basin_sum = '2024-01-22'
character(len=*), parameter :: Version_basin_sum = '2024-04-`0'

INTEGER, SAVE :: BALUNT, Totdays
INTEGER, SAVE :: Header_prt, Endjday
Expand Down Expand Up @@ -458,8 +458,8 @@ INTEGER FUNCTION sumbinit()
CALL header_print(Print_type)
! Print span dashes and initial storage
IF ( Print_type==1 ) THEN
WRITE (Buffer48, "(' initial', 27X,F9.3)") Basin_storage
CALL write_outfile(Buffer48(:44))
WRITE (Buffer48, "(' initial', 27X,F10.3)") Basin_storage
CALL write_outfile(Buffer48(:45))

ELSEIF ( Print_type==2 ) THEN
WRITE (Buffer120, 9001) Basin_intcp_stor, &
Expand Down Expand Up @@ -574,10 +574,10 @@ INTEGER FUNCTION sumbrun()
CALL write_outfile(Buffer40)

ELSEIF ( Print_type==1 ) THEN
WRITE ( Buffer80, "(I7,2I5,7F9.3)" ) Nowyear, &
WRITE ( Buffer120, "(I7,2I5,2F9.3,F10.3,4F9.3)" ) Nowyear, &
& Nowmonth, Nowday, Basin_ppt, Basin_actet, Basin_storage, &
& Basin_stflow_out, Obsq_inches, wat_bal, Watbal_sum
CALL write_outfile(Buffer80)
CALL write_outfile(Buffer120(:81))

ELSEIF ( Print_type==2 ) THEN
WRITE ( Buffer151, 9001 ) Nowyear, Nowmonth, Nowday, Basin_swrad, &
Expand Down Expand Up @@ -651,12 +651,12 @@ INTEGER FUNCTION sumbrun()
IF ( Dprt ) CALL write_outfile(DASHS(:40))

ELSEIF ( Print_type==1 ) THEN
IF ( Dprt ) CALL write_outfile(DASHS(:62))
WRITE ( Buffer80, "(I7,I5,5X,5F9.3)" ) Nowyear, &
IF ( Dprt ) CALL write_outfile(DASHS(:63))
WRITE ( Buffer80, "(I7,I5,5X,2F9.3,F10.3,2F9.3)" ) Nowyear, &
& Nowmonth, Basin_ppt_mo, Basin_actet_mo, Basin_storage, &
& Basin_stflow_mo, Obsq_inches_mo
CALL write_outfile(Buffer80(:62))
IF ( Dprt ) CALL write_outfile(DASHS(:62))
CALL write_outfile(Buffer80(:63))
IF ( Dprt ) CALL write_outfile(DASHS(:63))

ELSEIF ( Print_type==2 ) THEN
IF ( Dprt ) CALL write_outfile(DASHS)
Expand Down Expand Up @@ -711,11 +711,11 @@ INTEGER FUNCTION sumbrun()

! ****annual summary here
ELSEIF ( Print_type==1 ) THEN
IF ( Mprt .OR. Dprt ) CALL write_outfile(EQULS(:62))
WRITE ( Buffer80, "(I7,10X,5F9.3)" ) Nowyear, Basin_ppt_yr, &
IF ( Mprt .OR. Dprt ) CALL write_outfile(EQULS(:63))
WRITE ( Buffer80, "(I7,10X,2F9.3,F10.3,2F9.3)" ) Nowyear, Basin_ppt_yr, &
& Basin_actet_yr, Basin_storage, Basin_stflow_yr, Obsq_inches_yr
CALL write_outfile(Buffer80(:62))
IF ( Mprt .OR. Dprt ) CALL write_outfile(EQULS(:62))
CALL write_outfile(Buffer80(:63))
IF ( Mprt .OR. Dprt ) CALL write_outfile(EQULS(:63))

ELSEIF ( Print_type==2 ) THEN
Basin_swrad_yr = Basin_swrad_yr/yrdays_dble
Expand Down Expand Up @@ -795,11 +795,11 @@ INTEGER FUNCTION sumbrun()
CALL write_outfile(STARS(:40))

ELSEIF ( Print_type==1 ) THEN
CALL write_outfile(STARS(:62))
CALL write_outfile(STARS(:63))
WRITE ( Buffer80, 9005 ) ' Total for run', Basin_ppt_tot, &
& Basin_actet_tot, Basin_storage, Basin_stflow_tot, Obsq_inches_tot
CALL write_outfile(Buffer80(:62))
CALL write_outfile(STARS(:62))
CALL write_outfile(Buffer80(:63))
CALL write_outfile(STARS(:63))

ELSEIF ( Print_type==2 ) THEN
Obs_runoff_tot = Obs_runoff_tot/Totdays
Expand All @@ -819,7 +819,7 @@ INTEGER FUNCTION sumbrun()

9001 FORMAT (I6, 2I3, F5.0, 2F5.1, 2F7.2, 2F6.2, 2F7.2, F6.2, F6.3, F7.3, 2F6.3, 3F7.2, F7.4, F9.1, F9.2, F7.2)
9004 FORMAT (A, 13X, 2F7.2, F12.1, 2F7.2, 2F6.2, F7.2, 2F6.2, 4F7.2, F9.1, F9.2, F7.2)
9005 FORMAT (A, 3X, 6F9.3)
9005 FORMAT (A, 3X, 2F9.3,F10.3,2F9.3)
9006 FORMAT (I6, I3, 3X, 3F5.1, 2F7.2, F12.1, 2F7.2, 2F6.2, F7.2, 2F6.2, 3F7.2, F9.1, F9.2, 2F7.2)
9007 FORMAT (I6, 6X, 3F5.1, 2F7.2, 2F6.2, 2F7.2, 2F6.2, F7.2, 2F6.2, 3F7.2, F9.2, F9.2, 2F7.2)

Expand All @@ -841,8 +841,8 @@ SUBROUTINE header_print(Print_type)
IF ( Header_prt==3 ) THEN
CALL write_outfile(' Year Month Day Precip ET Storage S-Runoff M-Runoff')
WRITE (Buffer80, 9002)
CALL write_outfile(Buffer80(:62))
CALL write_outfile(DASHS(:62))
CALL write_outfile(Buffer80(:63))
CALL write_outfile(DASHS(:63))

ELSEIF ( Print_type==0 ) THEN
IF ( Print_freq==1 ) THEN
Expand All @@ -855,7 +855,7 @@ SUBROUTINE header_print(Print_type)

! This writes the water balance table header.
ELSEIF ( Print_type==1 ) THEN
CALL write_outfile(' Year Month Day Precip ET Storage S-Runoff M-Runoff Watbal WBalSum')
CALL write_outfile(' Year Month Day Precip ET Storage S-Runoff M-Runoff Watbal WBalSum')
WRITE (Buffer80, 9001)
CALL write_outfile(Buffer80)
CALL write_outfile(DASHS(:80))
Expand All @@ -871,7 +871,7 @@ SUBROUTINE header_print(Print_type)
ENDIF

9001 FORMAT (17X, 7(' (inches)'))
9002 FORMAT (17X, 5(' (inches)'))
9002 FORMAT (17X, 2(' (inches)'), 1(' (inches)'), 2(' (inches)'))

END SUBROUTINE header_print

Expand Down
8 changes: 4 additions & 4 deletions GSFLOW/src/prms/basin_summary.f90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -4,19 +4,19 @@
MODULE PRMS_BASIN_SUMMARY
USE PRMS_CONSTANTS, ONLY: MAXFILE_LENGTH
IMPLICIT NONE
! Module Variables
! Module Variables
character(len=*), parameter :: MODDESC = 'Output Summary'
character(len=*), parameter :: MODNAME = 'basin_summary'
character(len=*), parameter :: Version_basin_summary = '2023-11-01'
character(len=*), parameter :: Version_basin_summary = '2021-11-19'
INTEGER, SAVE :: Begin_results, Begyr, Lastyear, Dailyunit, Monthlyunit, Yearlyunit, Basin_var_type
INTEGER, SAVE, ALLOCATABLE :: Nc_vars(:)
CHARACTER(LEN=48), SAVE :: Output_fmt, Output_fmt2, Output_fmt3
INTEGER, SAVE :: Daily_flag, Yeardays, Monthly_flag
DOUBLE PRECISION, SAVE :: Monthdays
DOUBLE PRECISION, SAVE, ALLOCATABLE :: Basin_var_daily(:), Basin_var_monthly(:), Basin_var_yearly(:)
! Parameters
! Parameters
INTEGER, SAVE, ALLOCATABLE :: Nhm_id(:)
! Control Parameters
! Control Parameters
INTEGER, SAVE :: BasinOutVars, BasinOut_freq
CHARACTER(LEN=36), SAVE, ALLOCATABLE :: BasinOutVar_names(:)
CHARACTER(LEN=MAXFILE_LENGTH), SAVE :: BasinOutBaseFileName
Expand Down
2 changes: 1 addition & 1 deletion GSFLOW/src/prms/cascade.f90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -265,7 +265,7 @@ INTEGER FUNCTION cascinit()
ENDDO
ENDIF
IF ( Cascadegw_flag>CASCADEGW_OFF ) THEN
WRITE ( MSGUNT, 9002 )
WRITE ( MSGUNT, 9002 )
k = 0
DO ii = 1, Active_gwrs
i = Gwr_route_order(ii)
Expand Down
10 changes: 2 additions & 8 deletions GSFLOW/src/prms/ccsolrad.f90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -13,7 +13,7 @@ MODULE PRMS_CCSOLRAD
! Local Variables
character(len=*), parameter :: MODDESC = 'Solar Radiation Distribution'
character(len=*), parameter :: MODNAME = 'ccsolrad'
character(len=*), parameter :: Version_ccsolrad = '2024-02-08'
character(len=*), parameter :: Version_ccsolrad = '2024-04-04'
INTEGER, SAVE :: Observed_flag
! Declared Variables
DOUBLE PRECISION, SAVE :: Basin_radadj, Basin_cloud_cover
Expand Down Expand Up @@ -104,13 +104,7 @@ INTEGER FUNCTION ccsolrad()
ENDIF
ENDIF
ENDIF
! in Alaska, there are HRUs on certain days when the sun never rises, so this equation doesn't work
! when soltab_potsw or hru_cossl are 0.0
if ( Soltab_potsw(jday, j) > 0.0D0 .and. Hru_cossl(j) > 0.0D0 ) then
Swrad(j) = SNGL( Soltab_potsw(Jday, j)*DBLE( Cloud_radadj(j))/Hru_cossl(j) )
else
Swrad(j) = 0.0
endif
Swrad(j) = SNGL( Soltab_potsw(Jday, j)*DBLE( Cloud_radadj(j))/Hru_cossl(j) )
Basin_swrad = Basin_swrad + DBLE( Swrad(j)*Hru_area(j) )
ENDDO
Basin_orad = Basin_orad*Basin_area_inv
Expand Down
Loading

0 comments on commit 718a54b

Please sign in to comment.