diff --git a/src/Model/GroundWaterTransport/gwt1fmi1.f90 b/src/Model/GroundWaterTransport/gwt1fmi1.f90 index cd1f5ef6bac..779b9a86d63 100644 --- a/src/Model/GroundWaterTransport/gwt1fmi1.f90 +++ b/src/Model/GroundWaterTransport/gwt1fmi1.f90 @@ -59,8 +59,8 @@ module GwtFmiModule procedure :: initialize_gwfterms_from_bfr procedure :: initialize_gwfterms_from_gwfbndlist procedure :: read_options => gwtfmi_read_options - procedure :: read_packagedata => gwtfmi_read_packagedata procedure :: set_aptbudobj_pointer + procedure :: read_packagedata => gwtfmi_read_packagedata end type GwtFmiType @@ -231,15 +231,8 @@ subroutine fmi_ad(this, cnew) return end subroutine fmi_ad + !> @brief Calculate coefficients and fill matrix and rhs subroutine fmi_fc(this, nodes, cold, nja, matrix_sln, idxglo, rhs) -! ****************************************************************************** -! fmi_fc -- Calculate coefficients and fill matrix and rhs -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- modules - !use BndModule, only: BndType, GetBndFromList ! -- dummy class(GwtFmiType) :: this integer, intent(in) :: nodes @@ -250,7 +243,6 @@ subroutine fmi_fc(this, nodes, cold, nja, matrix_sln, idxglo, rhs) real(DP), intent(inout), dimension(nodes) :: rhs ! -- local integer(I4B) :: n, idiag, idiag_sln -! ------------------------------------------------------------------------------ ! ! -- Calculate the flow imbalance error and make a correction for it if (this%iflowerr /= 0) then @@ -268,14 +260,8 @@ subroutine fmi_fc(this, nodes, cold, nja, matrix_sln, idxglo, rhs) return end subroutine fmi_fc + !> @brief Calculate flow correction subroutine fmi_cq(this, cnew, flowja) -! ****************************************************************************** -! fmi_cq -- Calculate flow correction -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- modules ! -- dummy class(GwtFmiType) :: this real(DP), intent(in), dimension(:) :: cnew @@ -284,7 +270,6 @@ subroutine fmi_cq(this, cnew, flowja) integer(I4B) :: n integer(I4B) :: idiag real(DP) :: rate -! ------------------------------------------------------------------------------ ! ! -- If not adding flow error correction, return if (this%iflowerr /= 0) then @@ -305,13 +290,8 @@ subroutine fmi_cq(this, cnew, flowja) return end subroutine fmi_cq + !> @brief Calculate budget terms subroutine fmi_bd(this, isuppress_output, model_budget) -! ****************************************************************************** -! mst_bd -- Calculate budget terms -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use TdisModule, only: delt use BudgetModule, only: BudgetType, rate_accumulator @@ -322,7 +302,6 @@ subroutine fmi_bd(this, isuppress_output, model_budget) ! -- local real(DP) :: rin real(DP) :: rout -! ------------------------------------------------------------------------------ ! ! -- flow correction if (this%iflowerr /= 0) then @@ -334,13 +313,8 @@ subroutine fmi_bd(this, isuppress_output, model_budget) return end subroutine fmi_bd + !> @brief Save budget terms subroutine fmi_ot_flow(this, icbcfl, icbcun) -! ****************************************************************************** -! fmi_ot_flow -- Save budget terms -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- dummy class(GwtFmiType) :: this integer(I4B), intent(in) :: icbcfl @@ -350,7 +324,6 @@ subroutine fmi_ot_flow(this, icbcfl, icbcun) integer(I4B) :: iprint, nvaluesp, nwidthp character(len=1) :: cdatafmp = ' ', editdesc = ' ' real(DP) :: dinact -! ------------------------------------------------------------------------------ ! ! -- Set unit number for binary output if (this%ipakcb < 0) then @@ -380,18 +353,12 @@ subroutine fmi_ot_flow(this, icbcfl, icbcun) return end subroutine fmi_ot_flow + !> @brief Deallocate variables subroutine gwtfmi_da(this) -! ****************************************************************************** -! fmi_da -- Deallocate variables -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ ! -- modules use MemoryManagerModule, only: mem_deallocate ! -- dummy class(GwtFmiType) :: this -! ------------------------------------------------------------------------------ ! -- todo: finalize hfr and bfr either here or in a finalize routine ! ! -- deallocate any memory stored with gwfpackages @@ -446,34 +413,18 @@ subroutine gwtfmi_allocate_scalars(this) class(GwtFmiType) :: this ! -- local ! - ! -- allocate scalars in NumericalPackageType - call this%NumericalPackageType%allocate_scalars() + ! -- allocate scalars in parent + call this%FlowModelInterfaceType%allocate_scalars() ! ! -- Allocate - call mem_allocate(this%flows_from_file, 'FLOWS_FROM_FILE', this%memoryPath) - call mem_allocate(this%iflowsupdated, 'IFLOWSUPDATED', this%memoryPath) call mem_allocate(this%iflowerr, 'IFLOWERR', this%memoryPath) - call mem_allocate(this%igwfstrgss, 'IGWFSTRGSS', this%memoryPath) - call mem_allocate(this%igwfstrgsy, 'IGWFSTRGSY', this%memoryPath) - call mem_allocate(this%iubud, 'IUBUD', this%memoryPath) - call mem_allocate(this%iuhds, 'IUHDS', this%memoryPath) - call mem_allocate(this%iumvr, 'IUMVR', this%memoryPath) - call mem_allocate(this%nflowpack, 'NFLOWPACK', this%memoryPath) ! ! -- Although not a scalar, allocate the advanced package transport ! budget object to zero so that it can be dynamically resized later allocate (this%aptbudobj(0)) ! ! -- Initialize - this%flows_from_file = .true. - this%iflowsupdated = 1 this%iflowerr = 0 - this%igwfstrgss = 0 - this%igwfstrgsy = 0 - this%iubud = 0 - this%iuhds = 0 - this%iumvr = 0 - this%nflowpack = 0 ! ! -- Return return @@ -490,6 +441,9 @@ subroutine gwtfmi_allocate_arrays(this, nodes) ! -- local integer(I4B) :: n ! + ! -- allocate parent arrays + call this%FlowModelInterfaceType%allocate_arrays(nodes) + ! ! -- Allocate variables needed for all cases if (this%iflowerr == 0) then call mem_allocate(this%flowcorrect, 1, 'FLOWCORRECT', this%memoryPath) @@ -500,66 +454,12 @@ subroutine gwtfmi_allocate_arrays(this, nodes) this%flowcorrect(n) = DZERO end do ! - ! -- Allocate ibdgwfsat0, which is an indicator array marking cells with - ! saturation greater than 0.0 with a value of 1 - call mem_allocate(this%ibdgwfsat0, nodes, 'IBDGWFSAT0', this%memoryPath) - do n = 1, nodes - this%ibdgwfsat0(n) = 1 - end do - ! - ! -- Allocate differently depending on whether or not flows are - ! being read from a file. - if (this%flows_from_file) then - call mem_allocate(this%gwfflowja, this%dis%con%nja, 'GWFFLOWJA', & - this%memoryPath) - call mem_allocate(this%gwfsat, nodes, 'GWFSAT', this%memoryPath) - call mem_allocate(this%gwfhead, nodes, 'GWFHEAD', this%memoryPath) - call mem_allocate(this%gwfspdis, 3, nodes, 'GWFSPDIS', this%memoryPath) - do n = 1, nodes - this%gwfsat(n) = DONE - this%gwfhead(n) = DZERO - this%gwfspdis(:, n) = DZERO - end do - do n = 1, size(this%gwfflowja) - this%gwfflowja(n) = DZERO - end do - ! - ! -- allocate and initialize storage arrays - if (this%igwfstrgss == 0) then - call mem_allocate(this%gwfstrgss, 1, 'GWFSTRGSS', this%memoryPath) - else - call mem_allocate(this%gwfstrgss, nodes, 'GWFSTRGSS', this%memoryPath) - end if - if (this%igwfstrgsy == 0) then - call mem_allocate(this%gwfstrgsy, 1, 'GWFSTRGSY', this%memoryPath) - else - call mem_allocate(this%gwfstrgsy, nodes, 'GWFSTRGSY', this%memoryPath) - end if - do n = 1, size(this%gwfstrgss) - this%gwfstrgss(n) = DZERO - end do - do n = 1, size(this%gwfstrgsy) - this%gwfstrgsy(n) = DZERO - end do - ! - ! -- If there is no fmi package, then there are no flows at all or a - ! connected GWF model, so allocate gwfpackages to zero - if (this%inunit == 0) call this%allocate_gwfpackages(this%nflowpack) - end if - ! - ! -- Return + ! -- return return end subroutine gwtfmi_allocate_arrays + !> @brief Calculate groundwater cell head saturation for end of last time step function gwfsatold(this, n, delt) result(satold) -! ****************************************************************************** -! gwfsatold -- calculate the groundwater cell head saturation for the end of -! the last time step -! ****************************************************************************** -! -! SPECIFICATIONS: -! ------------------------------------------------------------------------------ - ! -- modules ! -- dummy class(GwtFmiType) :: this integer(I4B), intent(in) :: n @@ -570,7 +470,6 @@ function gwfsatold(this, n, delt) result(satold) real(DP) :: vcell real(DP) :: vnew real(DP) :: vold -! ------------------------------------------------------------------------------ ! ! -- calculate the value vcell = this%dis%area(n) * (this%dis%top(n) - this%dis%bot(n)) @@ -765,12 +664,12 @@ subroutine gwtfmi_read_packagedata(this) end subroutine gwtfmi_read_packagedata !> @brief Set the pointer to a budget object - !! - !! An advanced transport can pass in a name and a - !! pointer budget object, and this routine will look through the budget - !! objects managed by FMI and point to the one with the same name, such as - !! LAK-1, SFR-1, etc. - !! + ! + ! An advanced transport can pass in a name and a + ! pointer budget object, and this routine will look through the budget + ! objects managed by FMI and point to the one with the same name, such as + ! LAK-1, SFR-1, etc. + ! !< subroutine set_aptbudobj_pointer(this, name, budobjptr) ! -- modules @@ -851,7 +750,8 @@ subroutine initialize_gwfterms_from_bfr(this) call this%gwfpackages(ip)%set_name(this%bfr%dstpackagenamearray(i), & this%bfr%budtxtarray(i)) naux = this%bfr%nauxarray(i) - call this%gwfpackages(ip)%set_auxname(naux, this%bfr%auxtxtarray(1:naux, i)) + call this%gwfpackages(ip)%set_auxname(naux, & + this%bfr%auxtxtarray(1:naux, i)) ip = ip + 1 end do ! @@ -960,10 +860,10 @@ subroutine initialize_gwfterms_from_gwfbndlist(this) end subroutine initialize_gwfterms_from_gwfbndlist !> @brief Allocate GWF packages - !! - !! This routine allocates gwfpackages (an array of PackageBudget - !! objects) to the proper size and initializes member variables. - !! + ! + ! This routine allocates gwfpackages (an array of PackageBudget + ! objects) to the proper size and initializes member variables. + ! !< subroutine gwtfmi_allocate_gwfpackages(this, ngwfterms) ! -- modules diff --git a/src/Model/ModelUtilities/FlowModelInterface.f90 b/src/Model/ModelUtilities/FlowModelInterface.f90 index d5c4fd8d0af..e7a794f062e 100644 --- a/src/Model/ModelUtilities/FlowModelInterface.f90 +++ b/src/Model/ModelUtilities/FlowModelInterface.f90 @@ -435,10 +435,10 @@ subroutine initialize_bfr(this) end subroutine initialize_bfr !> @brief Advance the budget file reader - !! - !! Advance the budget file reader by reading the next chunk - !! of information for the current time step and stress period. - !! + ! + ! Advance the budget file reader by reading the next chunk + ! of information for the current time step and stress period. + ! !< subroutine advance_bfr(this) ! -- modules @@ -504,9 +504,9 @@ subroutine advance_bfr(this) if (kper /= this%bfr%kper) then write (errmsg, '(4x,a)') 'PERIOD NUMBER IN BUDGET FILE & &DOES NOT MATCH PERIOD NUMBER IN TRANSPORT MODEL. IF THERE & - &IS MORE THAN ONE TIME STEP IN THE BUDGET FILE FOR A GIVEN STRESS & - &PERIOD, BUDGET FILE TIME STEPS MUST MATCH GWT MODEL TIME STEPS & - &ONE-FOR-ONE IN THAT STRESS PERIOD.' + &IS MORE THAN ONE TIME STEP IN THE BUDGET FILE FOR A GIVEN & + &STRESS PERIOD, BUDGET FILE TIME STEPS MUST MATCH GWT MODEL & + &TIME STEPS ONE-FOR-ONE IN THAT STRESS PERIOD.' call store_error(errmsg) call store_error_unit(this%iubud) end if @@ -515,7 +515,7 @@ subroutine advance_bfr(this) if (this%bfr%kstp > 1 .and. (kstp /= this%bfr%kstp)) then write (errmsg, '(4x,a)') 'TIME STEP NUMBER IN BUDGET FILE & &DOES NOT MATCH TIME STEP NUMBER IN TRANSPORT MODEL. IF THERE & - &IS MORE THAN ONE TIME STEP IN THE BUDGET FILE FOR A GIVEN STRESS & + &IS MORE THAN ONE TIME STEP IN THE BUDGET FILE FOR A GIVEN STRESS & &PERIOD, BUDGET FILE TIME STEPS MUST MATCH GWT MODEL TIME STEPS & &ONE-FOR-ONE IN THAT STRESS PERIOD.' call store_error(errmsg) @@ -712,10 +712,10 @@ subroutine finalize_hfr(this) end subroutine finalize_hfr !> @brief Initialize gwf terms from budget file - !! - !! initalize terms and figure out how many - !! different terms and packages are contained within the file - !! + ! + ! initalize terms and figure out how many + ! different terms and packages are contained within the file + ! !< subroutine initialize_gwfterms_from_bfr(this) ! -- modules @@ -879,11 +879,11 @@ subroutine initialize_gwfterms_from_gwfbndlist(this) end subroutine initialize_gwfterms_from_gwfbndlist !> @brief Allocate budget packages - !! - !! gwfpackages is an array of PackageBudget objects. - !! This routine allocates gwfpackages to the proper size and initializes some - !! member variables. - !! + ! + ! gwfpackages is an array of PackageBudget objects. + ! This routine allocates gwfpackages to the proper size and initializes some + ! member variables. + ! !< subroutine allocate_gwfpackages(this, ngwfterms) ! -- modules