Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Jump to bottom

refactor(misc): bringing in changes made on transport branch #409

Merged
merged 1 commit into from
Apr 20, 2020
Merged

refactor(misc): bringing in changes made on transport branch #409

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
2 changes: 1 addition & 1 deletion doc/Common/obstypetable.tex
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -66,7 +66,7 @@

\hline
\hline
\textbf{Model} & \textbf{Observation types} & \textbf{ID} & \textbf{ID2} & \textbf{Description} \\
\textbf{Stress Package} & \textbf{Observation types} & \textbf{ID} & \textbf{ID2} & \textbf{Description} \\
\hline
\endhead

Expand Down
10 changes: 9 additions & 1 deletion msvs/mf6core.vfproj
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -134,7 +134,15 @@
<File RelativePath="..\src\Utilities\BudgetObject.f90"/>
<File RelativePath="..\src\Utilities\BudgetTerm.f90"/>
<File RelativePath="..\src\Utilities\comarg.f90"/>
<File RelativePath="..\src\Utilities\compilerversion.fpp"/>
<File RelativePath="..\src\Utilities\compilerversion.fpp">
<FileConfiguration Name="Debug|Win32">
<Tool Name="VFFortranCompilerTool" Preprocess="preprocessYes"/></FileConfiguration>
<FileConfiguration Name="Release|x64">
<Tool Name="VFFortranCompilerTool" Preprocess="preprocessYes"/></FileConfiguration>
<FileConfiguration Name="Debug|x64">
<Tool Name="VFFortranCompilerTool" Preprocess="preprocessYes"/></FileConfiguration>
<FileConfiguration Name="Release|Win32">
<Tool Name="VFFortranCompilerTool" Preprocess="preprocessYes"/></FileConfiguration></File>
<File RelativePath="..\src\Utilities\Constants.f90"/>
<File RelativePath="..\src\Utilities\genericutils.f90"/>
<File RelativePath="..\src\Utilities\HashTable.f90"/>
Expand Down
113 changes: 106 additions & 7 deletions src/Model/GroundWaterFlow/gwf3mvr8.f90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -100,7 +100,8 @@ module GwfMvrModule
use KindModule, only: DP, I4B
use ConstantsModule, only: LENORIGIN, LENPACKAGENAME, LENMODELNAME, &
LENBUDTXT, LENAUXNAME, LENPAKLOC, &
DZERO, DNODATA, MAXCHARLEN
DZERO, DNODATA, MAXCHARLEN, TABCENTER, &
LINELENGTH
use MvrModule, only: MvrType
use BudgetModule, only: BudgetType, budget_cr
use BudgetObjectModule, only: BudgetObjectType, budgetobject_cr
Expand All @@ -109,6 +110,7 @@ module GwfMvrModule
use PackageMoverModule, only: PackageMoverType
use BaseDisModule, only: DisBaseType
use InputOutputModule, only: urword
use TableModule, only: TableType, table_cr

implicit none
private
Expand All @@ -133,6 +135,9 @@ module GwfMvrModule
type(BudgetObjectType), pointer :: budobj => null() !new budget container (used to write binary file)
type(PackageMoverType), &
dimension(:), pointer, contiguous :: pakmovers => null() !pointer to package mover objects
!
! -- table objects
type(TableType), pointer :: outputtab => null()
contains
procedure :: mvr_ar
procedure :: mvr_rp
Expand All @@ -152,6 +157,8 @@ module GwfMvrModule
procedure :: allocate_arrays
procedure, private :: mvr_setup_budobj
procedure, private :: mvr_fill_budobj
procedure, private :: mvr_setup_outputtab
procedure, private :: mvr_print_outputtab
end type GwfMvrType

contains
Expand Down Expand Up @@ -507,12 +514,10 @@ subroutine mvr_bd(this, icbcfl, ibudfl, isuppress_output)
"(1X,/1X,A,' PERIOD ',I0,' STEP ',I0)"
! ------------------------------------------------------------------------------
!
if(ibudfl /= 0 .and. this%iprflow == 1 .and. isuppress_output == 0) then
write(this%iout, fmttkk) ' MVR SUMMARY', kper, kstp
do i = 1, this%nmvr
call this%mvr(i)%writeflow(this%iout)
enddo
endif
! -- Write the flow table
if (ibudfl /= 0 .and. this%iprflow /= 0 .and. isuppress_output == 0) then
call this%mvr_print_outputtab()
end if
!
! -- fill the budget object
call this%mvr_fill_budobj()
Expand Down Expand Up @@ -628,6 +633,13 @@ subroutine mvr_da(this)
call this%budobj%budgetobject_da()
deallocate(this%budobj)
nullify(this%budobj)
!
! -- output table object
if (associated(this%outputtab)) then
call this%outputtab%table_da()
deallocate(this%outputtab)
nullify(this%outputtab)
end if
endif
!
! -- Scalars
Expand Down Expand Up @@ -1071,6 +1083,9 @@ subroutine allocate_arrays(this)
! -- allocate the object and assign values to object variables
call mem_allocate(this%ientries, this%maxcomb, 'IENTRIES', this%origin)
!
! -- setup the output table
call this%mvr_setup_outputtab()
!
! -- Return
return
end subroutine allocate_arrays
Expand Down Expand Up @@ -1241,4 +1256,88 @@ subroutine mvr_fill_budobj(this)
return
end subroutine mvr_fill_budobj

subroutine mvr_setup_outputtab(this)
! ******************************************************************************
! mvr_setup_outputtab -- set up output table
! ******************************************************************************
!
! SPECIFICATIONS:
! ------------------------------------------------------------------------------
! -- dummy
class(GwfMvrType),intent(inout) :: this
! -- local
character(len=LINELENGTH) :: title
character(len=LINELENGTH) :: text
integer(I4B) :: ntabcol
integer(I4B) :: ilen
! ------------------------------------------------------------------------------
!
! -- allocate and initialize the output table
if (this%iprflow /= 0) then
!
! -- dimension table
ntabcol = 7
!
! -- initialize the output table object
title = 'WATER MOVER PACKAGE (' // trim(this%name) // &
') FLOW RATES'
call table_cr(this%outputtab, this%name, title)
call this%outputtab%table_df(this%maxmvr, ntabcol, this%iout, &
transient=.TRUE.)
text = 'NUMBER'
call this%outputtab%initialize_column(text, 10, alignment=TABCENTER)
text = 'PROVIDER LOCATION'
ilen = LENMODELNAME+LENPACKAGENAME+1
call this%outputtab%initialize_column(text, ilen)
text = 'PROVIDER ID'
call this%outputtab%initialize_column(text, 10)
text = 'AVAILABLE RATE'
call this%outputtab%initialize_column(text, 10)
text = 'PROVIDED RATE'
call this%outputtab%initialize_column(text, 10)
text = 'RECEIVER LOCATION'
ilen = LENMODELNAME+LENPACKAGENAME+1
call this%outputtab%initialize_column(text, ilen)
text = 'RECEIVER ID'
call this%outputtab%initialize_column(text, 10)

end if
!
! -- return
return
end subroutine mvr_setup_outputtab

subroutine mvr_print_outputtab(this)
! ******************************************************************************
! mvr_setup_outputtab -- set up output table
! ******************************************************************************
!
! SPECIFICATIONS:
! ------------------------------------------------------------------------------
! -- dummy
class(GwfMvrType),intent(inout) :: this
! -- local
character (len=LINELENGTH) :: title
integer(I4B) :: i
! ------------------------------------------------------------------------------
!
! -- Add terms and print the table
title = 'WATER MOVER PACKAGE (' // trim(this%name) // &
') FLOW RATES'
call this%outputtab%set_title(title)
call this%outputtab%set_maxbound(this%nmvr)
do i = 1, this%nmvr
call this%outputtab%add_term(i)
call this%outputtab%add_term(this%mvr(i)%pname1)
call this%outputtab%add_term(this%mvr(i)%irch1)
call this%outputtab%add_term(this%mvr(i)%qanew)
call this%outputtab%add_term(this%mvr(i)%qpactual)
call this%outputtab%add_term(this%mvr(i)%pname2)
call this%outputtab%add_term(this%mvr(i)%irch2)
end do
!
! -- return
return
end subroutine mvr_print_outputtab

end module
85 changes: 59 additions & 26 deletions src/Model/GroundWaterFlow/gwf3obs8.f90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -41,10 +41,10 @@ subroutine gwf_obs_cr(obs, inobs)
!
! SPECIFICATIONS:
! ------------------------------------------------------------------------------
implicit none
! -- dummy
type(GwfObsType), pointer, intent(out) :: obs
integer(I4B), pointer, intent(in) :: inobs
! ------------------------------------------------------------------------------
!
allocate(obs)
call obs%allocate_scalars()
Expand All @@ -56,11 +56,18 @@ subroutine gwf_obs_cr(obs, inobs)
end subroutine gwf_obs_cr

subroutine gwf_obs_ar(this, ic, x, flowja)
! ******************************************************************************
! gwf_obs_ar -- allocate and read
! ******************************************************************************
!
! SPECIFICATIONS:
! ------------------------------------------------------------------------------
! -- dummy
class(GwfObsType), intent(inout) :: this
type(GwfIcType), pointer, intent(in) :: ic
real(DP), dimension(:), pointer, contiguous, intent(in) :: x
real(DP), dimension(:), pointer, contiguous, intent(in) :: flowja
! ------------------------------------------------------------------------------
!
! Call ar method of parent class
call this%obs_ar()
Expand All @@ -72,14 +79,12 @@ subroutine gwf_obs_ar(this, ic, x, flowja)
end subroutine gwf_obs_ar

subroutine gwf_obs_df(this, iout, pkgname, filtyp, dis)
! **************************************************************************
! gwf_obs_df
! -- Store observation types supported by GwfModelType
! **************************************************************************
!
! SPECIFICATIONS:
! --------------------------------------------------------------------------
implicit none
! ******************************************************************************
! gwt_obs_df -- define
! ******************************************************************************
!
! SPECIFICATIONS:
! ------------------------------------------------------------------------------
! -- dummy
class(GwfObsType), intent(inout) :: this
integer(I4B), intent(in) :: iout
Expand All @@ -88,7 +93,7 @@ subroutine gwf_obs_df(this, iout, pkgname, filtyp, dis)
class(DisBaseType), pointer :: dis
! -- local
integer(I4B) :: indx
! --------------------------------------------------------------------------
! ------------------------------------------------------------------------------
!
! Call overridden method of parent class
call this%ObsType%obs_df(iout, pkgname, filtyp, dis)
Expand All @@ -112,22 +117,20 @@ subroutine gwf_obs_df(this, iout, pkgname, filtyp, dis)
end subroutine gwf_obs_df

subroutine gwf_obs_bd(this)
! **************************************************************************
! gwf_obs_bd
! -- Save simulated values for GwfModelType observations.
! **************************************************************************
!
! SPECIFICATIONS:
! --------------------------------------------------------------------------
implicit none
! ******************************************************************************
! gwf_obs_bd -- save obs
! ******************************************************************************
!
! SPECIFICATIONS:
! ------------------------------------------------------------------------------
! -- dummy
class(GwfObsType), intent(inout) :: this
! -- local
integer(I4B) :: i, jaindex, nodenumber
real(DP) :: v
character(len=100) :: msg
class(ObserveType), pointer :: obsrv => null()
!---------------------------------------------------------------------------
! ------------------------------------------------------------------------------
!
call this%obs_bd_clear()
!
Expand Down Expand Up @@ -158,16 +161,29 @@ subroutine gwf_obs_bd(this)
end subroutine gwf_obs_bd

subroutine gwf_obs_rp(this)
implicit none
! ******************************************************************************
! gwf_obs_rp
! ******************************************************************************
!
! SPECIFICATIONS:
! ------------------------------------------------------------------------------
class(GwfObsType), intent(inout) :: this
! ------------------------------------------------------------------------------
!
! Do GWF observations need any checking? If so, add checks here
return
end subroutine gwf_obs_rp

subroutine gwf_obs_da(this)
! ******************************************************************************
! gwf_obs_da
! ******************************************************************************
!
! SPECIFICATIONS:
! ------------------------------------------------------------------------------
! -- dummy
class(GwfObsType), intent(inout) :: this
class(GwfObsType), intent(inout) :: this
! ------------------------------------------------------------------------------
!
nullify(this%ic)
nullify(this%x)
Expand All @@ -178,9 +194,15 @@ subroutine gwf_obs_da(this)
end subroutine gwf_obs_da

subroutine set_pointers(this, ic, x, flowja)
! ******************************************************************************
! set_pointers
! ******************************************************************************
!
! SPECIFICATIONS:
! ------------------------------------------------------------------------------
! -- dummy
class(GwfObsType), intent(inout) :: this
type(GwfIcType), pointer, intent(in) :: ic
class(GwfObsType), intent(inout) :: this
type(GwfIcType), pointer, intent(in) :: ic
real(DP), dimension(:), pointer, contiguous, intent(in) :: x
real(DP), dimension(:), pointer, contiguous, intent(in) :: flowja
!
Expand All @@ -194,7 +216,12 @@ end subroutine set_pointers
! -- Procedures related to GWF observations (NOT type-bound)

subroutine gwf_process_head_drawdown_obs_id(obsrv, dis, inunitobs, iout)
implicit none
! ******************************************************************************
! gwf_process_head_drawdown_obs_id
! ******************************************************************************
!
! SPECIFICATIONS:
! ------------------------------------------------------------------------------
! -- dummy
type(ObserveType), intent(inout) :: obsrv
class(DisBaseType), intent(in) :: dis
Expand All @@ -204,7 +231,7 @@ subroutine gwf_process_head_drawdown_obs_id(obsrv, dis, inunitobs, iout)
integer(I4B) :: nn1
integer(I4B) :: icol, istart, istop
character(len=LINELENGTH) :: ermsg, strng
! formats
! ------------------------------------------------------------------------------
!
! -- Initialize variables
strng = obsrv%IDstring
Expand All @@ -228,7 +255,12 @@ subroutine gwf_process_head_drawdown_obs_id(obsrv, dis, inunitobs, iout)
end subroutine gwf_process_head_drawdown_obs_id

subroutine gwf_process_intercell_obs_id(obsrv, dis, inunitobs, iout)
implicit none
! ******************************************************************************
! gwf_process_intercell_obs_id
! ******************************************************************************
!
! SPECIFICATIONS:
! ------------------------------------------------------------------------------
! -- dummy
type(ObserveType), intent(inout) :: obsrv
class(DisBaseType), intent(in) :: dis
Expand All @@ -240,6 +272,7 @@ subroutine gwf_process_intercell_obs_id(obsrv, dis, inunitobs, iout)
character(len=LINELENGTH) :: ermsg, strng
! formats
70 format('Error: No connection exists between cells identified in text: ',a)
! ------------------------------------------------------------------------------
!
! -- Initialize variables
strng = obsrv%IDstring
Expand Down
2 changes: 1 addition & 1 deletion src/Utilities/Budget.f90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -93,7 +93,7 @@ subroutine budget_df(this, maxsize, bdtype, bddim, labeltitle, bdzone)
! -- Allocate arrays
call this%allocate_arrays()
!
! -- Set the budget name
! -- Set the budget type
if(present(bdtype)) then
this%bdtype = bdtype
else
Expand Down
Loading