1 ! 2 ! HDXDAT.B4S: Hardy-Cross Pipe Network Analysis Data 3 ! Management Program 4 ! 5 ! Installed as: ...HDD 6 ! 7 ! Include files 8 ! 9 ! TRUTH.B4S 10 .DEFINE .TRUE%=-1% 11 .DEFINE .FALSE%=0% 12 COMMON (FCSERR) err1%, err2% 13 ! 14 ! File channel definitions 15 ! 16 ! {HDDDEF.B4S} 17 ! 18 .DEFINE .pipe.chan% = 21% 19 .DEFINE .node.chan% = 22% 20 .DEFINE .loop.chan% = 23% 21 .DEFINE .tf.out.chan% = 24% 22 .DEFINE .log.chan% = 25% 23 ! 24 ! 25 ! Constant definitions 26 ! 27 .DEFINE .eof% = -10% 28 .DEFINE .max.args% = 21% 29 .DEFINE .tf.bufsiz% = 128% 30 .DEFINE .cmd.line.siz% = 128% 31 .DEFINE .node.buf.siz% = 52% 32 .DEFINE .pipe.buf.siz% = 30% 33 .DEFINE .loop.buf.siz% = 42% ! must be (2 * .max.nodes% + 2) 34 ! 35 .DEFINE .max.nodes% = 20% 36 ! 37 ! Buffer and Map definitions 38 ! 39 ! {HDDMAP} 40 ! 41 ! buffers/maps 42 ! 43 MAP (NODES) node$ = .node.buf.siz% 44 MAP (NODES) n%(4%), ! connected nodes & ! -ve denotes blocked off & ! zero means no node & nodeflow, ! drawoff from node - litres/sec & xnode, ynode,! node coords & elevation, ! reduced level at node (m - AHD)) & resid.head, ! head at the node (m) & procflag% ! bit set means branch "done" 45 ! 46 MAP (PIPES) pipe$ = .pipe.buf.siz% 47 MAP (PIPES) node1%, node2%, diam, length, pipeflow 48 ! 49 ! note - pipeflow is +ve in direction node1 -> node2 50 ! 51 MAP (LOOPS) loop$ = .loop.buf.siz% 52 MAP (LOOPS) loop%, l.node%(.max.nodes%) 53 ! 54 MAP (INBUF) inbuf$ = 128% 55 MAP (CMDBUF) command.buffer$ = .cmd.line.siz% 56 ! 57 COMMON (SETUP) in.put%, input%, pipe.coeff, & node.file.open%, pipe.file.open%, & loop.file.open%, & echo%, first%, ask%, help%, & node.inp%, pipe.inp%, loop.inp%, line.inp%, & heads%, flows%, lo.op%, co.eff%, & loopdata%, results%, spare1%, & debug%, debug1%, debug2%, & more.data%, not.finished% 58 ! 59 ! 60 DIM field$(.max.args%) 61 ! 62 workfile%, outfile%, flows%, heads%, lo.op%, loopdata%, co.eff%, debug% = .false% 63 pipe.coeff = 120 ! unless otherwise set 64 title$ = "NO TITLE ASSIGNED" 65 66 ! 67 ! *************** GCL parameter input ******************* 68 ! 69 ! 70 not.finished% = .true% 71 rwatitle$ = chr$(27%) + "[2J" + chr$(27%) + "[3;1H" + & " Richard Wittenoom and Associates Pty Ltd" + CR + LF + LF + & " HARDY CROSS PIPE NETWORK DATA MANAGEMENT" + CR + LF + LF + LF + LF 72 ! 73 frst% = .true% 74 ! 75 WHILE not.finished% 76 more.data% = .true% 77 help% = .false% 78 ! 79 WHILE more.data% 80 ! 81 IF frst% & THEN prompt$ = rwatitle$ + "HDD>" & \ frst% = .false% & ELSE prompt$ = LF + LF + CR + "HDD>" 82 ! 83 CALL GCL.(prompt$,LEN(prompt$), command.buffer$, .cmd.line.siz%, len.got%, EG%, EF%, ED%) 84 command$ = EDIT$(left$(command.buffer$, len.got%), 32%+128%) 85 ! 86 fields% = .max.args% 87 field$(i%) = "" for i% = 1% to (.max.args% -1%) ! zero the beast 88 ! 89 CALL READTF (command$, 2%, 0%, 0%, field$(), "", fields%) 90 ! 91 CALL HDDSET(field$(), command$, title$, workfile$, outfile$, err.msg$) 92 ! 93 GOTO 32000 IF (NOT (not.finished%)) ! bomb without the unwanted messages 94 ! 95 call HDDHLP("HELP", "") IF help% 96 help% = .false% 97 ! 98 NEXT 99 ! 100 ! log.file$ = workfile$ + ".LOG" 101 ! 102 ! CALL OPEN. (log.file$, "W", .log.chan%, 0%) IF debug% > 0% 103 ! 104 105 ! 106 ! ********* main tree processing routine ******* 107 ! 108 ! call close.(.node.chan%) \ node.file.open% = .false% 109 ! call close.(.pipe.chan%) \ pipe.file.open% = .false% 110 ! call close.(.loop.chan%) \ loop.file.open% = .false% 111 ! 112 ! open the data files - open for update unless created during data entry for this run 113 ! 114 IF NOT (node.file.open%) & THEN do% = fn.open.workfile%(".N", "U", .node.chan%, .node.buf.siz%) & \ node.file.open% = .true% 115 ! 116 IF NOT (pipe.file.open%) & THEN do% = fn.open.workfile%(".P", "U", .pipe.chan%, .pipe.buf.siz%) & \ pipe.file.open% = .true% 117 ! 118 IF NOT (loop.file.open%) & THEN do% = fn.open.workfile%(".L", "U", .loop.chan%, .loop.buf.siz%) & \ loop.file.open% = .true% 119 ! 120 CALL FCSNOR (.node.chan%, numrecs) 121 num.node.recs% = numrecs 122 CALL FCSNOR (.pipe.chan%, numrecs) 123 num.pipe.recs% = numrecs 124 CALL FCSNOR (.loop.chan%, numrecs) 125 num.loop.recs% = numrecs 126 ! print "nodes, pipes, loops: "; num.node.recs%, num.pipe.recs%, num.loop.recs% 127 ! 128 ! write a first zero into non-valid loop records (i.e. loops that have not been written by the GCL input routine) 129 ! 130 FOR r% = 1% to num.loop.recs% 131 CALL GET.(.loop.chan%, loop$, r%) 132 ! print "err1%: "; err1% IF err1% 133 ! 134 ! print "loop rec check" 135 ! print "r, loop, first"; r%, loop%, l.node%(0) 136 IF r% <> loop% & THEN loop% = 0% & \ CALL PUT.(.loop.chan%, loop$, r%) & ELSE IF ((l.node%(0%) < 1%) OR (l.node%(0%) > num.node.recs%)) & THEN loop% = 0% & \ CALL PUT.(.loop.chan%, loop$, r%) 137 ! print "loop after the ITE : "; loop% 138 ! 139 NEXT r% 140 ! 141 ! zero the processing flag for each node to permit tree processing 142 ! 143 do% = fn.clear.procflag% IF heads% OR nodes% 144 ! print "zero procflag d1,2,3: "; debug1%, debug2%, debug3% 145 ! 146 CALL HDDHLP("NODES", title$, num.node.recs%) IF debug1% ! dump the nodes file 147 CALL HDDHLP("PIPES", title$, num.pipe.recs%) IF debug2% ! dump the pipes file 148 CALL HDDHLP("LOOPS", title$, num.loop.recs%) IF debug3% ! dump the loops file 149 ! 150 ! carry out tree processing if heads% OR flows% 151 ! 152 ! print "starting the tree" 153 IF heads% & THEN IF flows% & THEN heads% = .false% ! turn off head processing for the present & \ do% = fn.process.tree% ! process flows & \ flows% = .false% ! flows off & \ heads% = .true% & \ do% = fn.clear.procflag% ! so we can go down the tree again & \ do% = fn.process.tree% ! process heads & \ heads% = .false% & ELSE do% = fn.process.tree% & \ heads% = .false% & ELSE IF flows% & THEN do% = fn.process.tree% & \ flows% = .false% 154 ! print "exiting the tree" 155 ! 156 heads%, flows% = .false% ! don't go through the tree again unless explicitly instructed 157 ! 158 ! 159 ! print "loopdata%, infildata%; "; loopdata%, infildata% 160 CALL HDDOUT("LOOPS", title$, outfile$, num.node.recs%, num.pipe.recs%, num.loop.recs%) IF loopdata% 161 CALL HDDOUT("RESULTS", title$, outfile$, num.node.recs%, num.pipe.recs%, num.loop.recs%) IF results% 162 ! 163 ! print "leaving the loop ZZZZ" 164 NEXT ! re-enter the loop while (not.finished%) 165 ! 166 GOTO 32000 ! in case we haven't picked this up elsewhere 167 168 ! 169 ! ********************** FUNCTIONS ************************* 170 ! 171 ! ******************* fn.clear.procflag% ******************* 172 ! 173 ! zero the processing flag for each node to permit tree processing 174 ! 175 DEF fn.clear.procflag% 176 ! 177 IF heads% OR nodes% & THEN FOR j% = 1% to num.node.recs% & \ CALL GET.(.node.chan%, node$, j%) & \ procflag% = .false% ! i.e. zero all bits & \ CALL PUT.(.node.chan%, node$, j%) & \ NEXT j% 178 ! 179 FNEND 180 ! 181 ! ************* fn.process.tree%() ************* 182 ! start at the topmost node - this will be node 1. 183 ! 184 DEF fn.process.tree% 185 ! 186 fir.st% = .true% 187 this.adr% = 1% 188 CALL GET.(.node.chan%, node$, this.adr%) 189 ! 190 WHILE ((this.adr% > 1%) OR fir.st%) ! i.e. stop after the fn.up% which arrives back at adr% = 1 191 ! 192 fir.st% = .false% 193 down.adr% = fn.find.down%(this.adr%) 194 ! 195 IF down.adr% > 0% & THEN this.adr% = fn.down%(down.adr%, this.adr%) & ELSE this.adr% = fn.up%(this.adr%) ! fn.up returns the new address 196 ! 197 NEXT 198 ! 199 FNEND 200 ! 201 ! ************** fn.down% ********************* 202 ! 203 DEF fn.down%(this%, prev%) 204 ! 205 ! - here with the previous record still in the node buffer. 206 ! - first store the head information at the previous node. 207 ! 208 prev.node.elevation = elevation 209 prev.node.head = resid.head 210 ! 211 CALL GET.(.node.chan%, node$, this%) 212 ! 213 ! first make sure where we have just come down from is first in the connected node array 214 ! 215 IF n%(0%) <> prev% & THEN FOR i% = 1% to 3% & \ IF n%(i%) = prev% & THEN tmp% = n%(0%) & \ n%(0%) = n%(i%) & \ n%(i%) = tmp% & ELSE dont% = sw.ap% & \ NEXT i% & ! 216 ! print "FN.DOWN: node0, prev "; n%(0%), prev% 217 ! print "ERROR - FN.DOWN: previous node "; prev%; " not pointed to by next node"; this% IF prev% <> n%(0%) 218 ! 219 ! if heads% is set true, calculate heads on the way down 220 ! 221 fn.down% = this% 222 ! 223 FNEXIT IF NOT (heads%) 224 ! 225 pipe% = fn.get.pipe% (prev%, this%) ! note that the pipe record is now in the pipe buffer 226 ! 227 IF node1% = prev% & THEN sense% = +1% ! sense% is +ve if the +ve & ELSE sense% = -1% ! direction is DOWNSTREAM 228 ! 229 ! print "pipe, sense, node1, prev, this: "; pipe%; sense%; node1%; prev%; this% IF debug% => 8% 230 ! 231 ! head at downstream node will be: 232 ! 233 ! prev.node.elevation + prev.node.head - pipe.loss - elevation 234 ! 235 downstr.q = pipeflow * sense% / 1000 ! convert to c.m./sec 236 q.sign = sgn(downstr.q) 237 qval = abs(downstr.q) ! setup to avoid -ve arg in, exp expr'n 238 ! 239 K = ((1/(PI * (diam^2)/4.0E6)) / (0.849 * pipe.coeff * ((diam/4.0E3)^0.63)))^1.85 240 pipe.loss = K * q.sign * (qval^1.85) * length 241 ! 242 ! now find and store the head in the current node record 243 ! 244 resid.head = prev.node.elevation + prev.node.head - pipe.loss - elevation 245 ! 246 ! print "dsq, hloss, res.h, pr.n.head, pn.elev, elev: " if debug% > 5% 247 ! print " "; downstr.q; pipe.loss; resid.head; prev.node.head; prev.node.elevation; elevation if debug% > 5% 248 ! 249 ! store the record 250 ! 251 CALL PUT.(.node.chan%, node$, this%) 252 CALL PUT.(.pipe.chan%, pipe$, pipe%) 253 ! 254 FNEND 255 ! 256 ! *********************** fn.get.pipe%() ******************* 257 ! 258 DEF fn.get.pipe%(nod1%, nod2%) ! get the required pipe record into the pipe buffer 259 ! 260 pipe.found% = .false% 261 i1% = 0% 262 WHILE ((i1% < num.pipe.recs%) AND (NOT(pipe.found%))) 263 i1% = i1% + 1% 264 CALL GET.(.pipe.chan%, pipe$, i1%) 265 IF ((nod1% = node1%) AND (nod2% = node2%)) OR ((nod1% = node2%) AND (nod2% = node1%)) & THEN pipe.found% = .true% 266 ! 267 NEXT 268 ! 269 fn.get.pipe% = i1% 270 ! 271 FNEND 272 ! 273 ! ************* fn.find.down% ************************ 274 ! 275 DEF fn.find.down%(this%) ! return address of next down path or -1% if none 276 ! 277 ! at this point we know that the downstream nodes are n%(1%) -> 278 ! and that a zero node number denotes a nonexistent branch 279 ! 280 ! processing flag bit settings: 281 ! bit 0 set: no significance (procflag% = 1%) 282 ! bit 1 set: branch 1 processing flagged (procflag% = 2%) 283 ! etc. 284 ! 285 ! 286 ! 287 ! 288 IF (n%(1%) > 0%) AND ((procflag% AND 2%) < 1%) & THEN addr% = n%(1%) & \ procflag% = procflag% + 2% & ELSE IF (n%(2%) > 0%) AND ((procflag% AND 4%) < 1%) & THEN addr% = n%(2%) & \ procflag% = procflag% + 4% & ELSE IF (n%(3%) > 0%) AND ((procflag% AND 8%) < 1%) & THEN addr% = n%(3%) & \ procflag% = procflag% + 8% & ELSE addr% = -1% 289 ! 290 ! print "fn.find.down: addr%: "; addr% IF debug% > 9% 291 fn.find.down% = addr% 292 ! 293 CALL PUT.(.node.chan%, node$, this%) 294 ! 295 FNEND 296 ! 297 ! ********************** fn.up%() *********************** 298 ! 299 DEF fn.up%(this%) 300 ! 301 ! we are currently at a node for which all branches have been satisfied (or a terminal node). 302 ! note that the current node record is already in the node buffer 303 ! 304 ! if flows are required, invoke fn.get.flow and store these in the upstream pipe record. 305 ! 306 do% = fn.accumulate.flows(this%) IF flows% ! get the flows and write into the upstream pipe record 307 ! 308 fn.up% = n%(0%) ! store the upstream node for return 309 CALL GET.(.node.chan%, node$, n%(0%)) ! get the upstr record into the node buffer before returning 310 ! 311 FNEND 312 ! 313 ! ************** fn.accumulate.flows() ******************** 314 ! 315 ! (here with the current node in the buffer) 316 ! 317 DEF fn.accumulate.flows(th.is%) ! th.is% is the node in the buffer 318 ! 319 uspipeflow = nodeflow ! first store the node draw-off 320 ! 321 FOR i% = 1% to 3% 322 ! 323 IF n%(i%) > 0% ! i.e. the node exists and the line is not CLOSED & THEN do% = fn.get.pipe%(th.is%, n%(i%)) ! returns with the pipe in the pipe buffer & \ IF node1% = th.is% & THEN sense% = +1% ! sense% is +ve if the +ve & ELSE sense% = -1% ! direction is DOWNSTREAM 324 ! 325 ! print "fn.get.flow: th.is, n%(i%), node1%, node2%, sense%: "; th.is%; n1%(i%), node1%; node2%, sense% IF debug% => 7% 326 ! 327 downstr.q = pipeflow * sense% 328 ! 329 uspipeflow = uspipeflow + downstr.q IF n%(i%) > 0% ! add it in only if the branch exists 330 ! 331 NEXT i% 332 ! 333 upstr.pipe.adr% = fn.get.pipe%(n%(0%), th.is%) 334 ! 335 IF node1% = n%(0%) & THEN sense% = +1% ! (sense% is +ve if the +ve) & ELSE sense% = -1% ! (direction is DOWNSTREAM ) 336 ! 337 ! print "upstream pipe: n%(0), th.is%, node1%, sense%: ", pipe.adr%, n%(0%); th.is%, node1%, sense% 338 ! 339 CALL GET.(.pipe.chan%, pipe$, upstr.pipe.adr%) ! write out the pipe record including the flow 340 pipeflow = uspipeflow * sense% ! store the flow in the buffer in the correct sense for the pipe 341 CALL PUT.(.pipe.chan%, pipe$, upstr.pipe.adr%) ! write out the pipe record including the flow 342 ! 343 ! print 344 ! print "******* pipe, uspipeflow, sense%: "; upstr.pipe.adr%, uspipeflow, sense% 345 ! print 346 ! 347 FNEND 348 ! 349 ! ************* fn.open.workfile%() ************* 350 ! 351 DEF fn.open.workfile%(ext$, mode$, chan%, reclen%) 352 ! 353 IF workfile$ = "" & THEN workfile$ = "HDXDAT" 354 ! 355 CALL OPEN.(workfile$ + ext$, mode$, chan%, reclen%) 356 ! 357 FNEND 358 ! 359 ! {BL:[101,5]FNSAW.B4S} 360 ! FNANSCHK.B4S 361 ! 362 DEF fn.ans$ (text$) = edit$ (left$ (text$, 1%), 32%) 363 DEF fn.upper.case$ (text$) = edit$ (text$, 32%) 364 ! 365 DEF fn.ans% (text$) 366 IF ((edit$ (left$ (text$, 1%), 32%) = "Y") OR (text$ = "1")) & THEN fn.ans% = -1% & ELSE fn.ans% = 0% 367 FNEND 368 ! 32000 CALL CLOSE. (.tf.out.chan%) 32001 CALL CLOSE. (.node.chan%) 32002 CALL CLOSE. (.pipe.chan%) 32003 CALL CLOSE. (.loop.chan%) 32004 CALL CLOSE. (.log.chan%) 32005 ! 32767 END