diff --git a/src/Model/TransportModel/tsp1fmi1.f90 b/src/Model/TransportModel/tsp1fmi1.f90 index 8f1b8412c65..c1ca1772272 100644 --- a/src/Model/TransportModel/tsp1fmi1.f90 +++ b/src/Model/TransportModel/tsp1fmi1.f90 @@ -192,60 +192,6 @@ subroutine fmi_ad(this, cnew) call this%set_active_status(cnew) end if ! - ! -- if flow cell is dry, then set gwt%ibound = 0 and conc to dry - do n = 1, this%dis%nodes - ! - ! -- Calculate the ibound-like array that has 0 if saturation - ! is zero and 1 otherwise - if (this%gwfsat(n) > DZERO) then - this%ibdgwfsat0(n) = 1 - else - this%ibdgwfsat0(n) = 0 - end if - ! - ! -- Check if active transport cell is inactive for flow - if (this%ibound(n) > 0) then - if (this%gwfhead(n) == DHDRY) then - ! -- transport cell should be made inactive - this%ibound(n) = 0 - cnew(n) = DHDRY - call this%dis%noder_to_string(n, nodestr) - write (this%iout, fmtdry) trim(nodestr), DHDRY - end if - end if - ! - ! -- Convert dry transport cell to active if flow has rewet - if (cnew(n) == DHDRY) then - if (this%gwfhead(n) /= DHDRY) then - ! - ! -- obtain weighted concentration - crewet = DZERO - tflow = DZERO - do ipos = this%dis%con%ia(n) + 1, this%dis%con%ia(n + 1) - 1 - m = this%dis%con%ja(ipos) - flownm = this%gwfflowja(ipos) - if (flownm > 0) then - if (this%ibound(m) /= 0) then - crewet = crewet + cnew(m) * flownm - tflow = tflow + this%gwfflowja(ipos) - end if - end if - end do - if (tflow > DZERO) then - crewet = crewet / tflow - else - crewet = DZERO - end if - ! - ! -- cell is now wet - this%ibound(n) = 1 - cnew(n) = crewet - call this%dis%noder_to_string(n, nodestr) - write (this%iout, fmtrewet) trim(nodestr), crewet - end if - end if - end do - ! ! -- Return return end subroutine fmi_ad @@ -264,6 +210,7 @@ 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 + real(DP) :: qcorr ! ! -- Calculate the flow imbalance error and make a correction for it if (this%iflowerr /= 0) then @@ -273,7 +220,9 @@ subroutine fmi_fc(this, nodes, cold, nja, matrix_sln, idxglo, rhs) do n = 1, nodes idiag = this%dis%con%ia(n) idiag_sln = idxglo(idiag) - call matrix_sln%add_value_pos(idiag_sln, -this%gwfflowja(idiag)) + !call matrix_sln%add_value_pos(idiag_sln, -this%gwfflowja(idiag)) + qcorr = -this%gwfflowja(idiag) * this%eqnsclfac + call matrix_sln%add_value_pos(idiag_sln, qcorr) end do end if !