This problem has been resolved, but I'm not sure how to close the question ...
The solution as it turns out was not as complex as I had expected:
EdgeCount[theModel]
VertexCount[theModel]
ConnectedGraphQ[theModel]
1507
1052
True
edgeCleanG = Fold[EdgeDelete[#1, #2[[1]]]&,theModel,
Select[Transpose[{EdgeList[theModel],
PropertyValue[theModel, EdgeWeight]}], #[[2]] == 0&]];
vertCleanG = VertexDelete[edgeCleanG,
Map[#[[1]]&, Drop[ConnectedComponents[edgeCleanG], 1]]];
EdgeCount[vertCleanG]
VertexCount[vertCleanG]
ConnectedGraphQ[vertCleanG]
1109
782
True