SUBROUTINE NETWORK_CLEAR(net) #include "dyna.inc" #include "network.inc" RECORD /Road_Network/ net INTEGER i,j net.nnodes = 0 DO i = 1,NU_NO+1 CALL NODE_CLEAR(net.node(i)) ENDDO net.nlinks = 0 DO i = 1,NU_LI+1 CALL LINK_CLEAR(net.link(i)) ENDDO C FIX UP THE (N+1)TH LINK FOR A DUMMY CALCULATION IN THE **** C VECTOR PROCESSING OF ARC TRIP TIMES... IGNORE... **** net.link(net.nlinks+1).length = 0.001 net.link(net.nlinks+1).speed = 10000.0 net.link(net.nlinks+1).numdslinks = 2 net.nmoves = 0 DO i = 1,NU_MV CALL MOVE_CLEAR(net.movement(i)) ENDDO net.nstations = 0 net.rollpnt = 0 net.stationacc = 0.D0 DO i = 1,MAX_DETECTOR_STATIONS CALL STATION_CLEAR(net.station(i)) ENDDO net.numact = 0 ! not clearing actuations for now DO i = 1,MAX_NO net.nodenum(i) = 0 ENDDO ! not clearing fs for now ! not clearing sp data for now ! not clearing leqpd for now DO j = 1,MAX_LANE_TYPE net.lanesat(j) = 0.D0 DO i = 1,6 net.lanemove(i,j) = 0 ENDDO ENDDO net.npp = 0 net.ncp = 0 net.eqpathsteps = 0 ! not clearing eqpath for now ! not clearing cmspath for now net.numcms = 0 DO i = 1,MAX_CMS CALL CMS_CLEAR(net.cms(i)) ENDDO net.numph = 0 DO i = 1,NU_PH CALL PHASE_CLEAR(net.phase(i)) ENDDO net.ngen_tag = 0 net.nin_tag = 0 net.nout_tag = 0 net.nout_info = 0 net.info_time_tag = 0 net.noinfo_time_tag = 0 net.info_dly_tag = 0 net.noinfo_dly_tag = 0 net.info_dist_tag = 0 net.noinfo_dist_tag = 0 net.ngen_nontag = 0 net.nin_nontag = 0 net.nout_nontag = 0 DO i = 1,MAX_TRIP_LENGTH_BINS+1 net.info_trip_len_freq(i) = 0 net.noinfo_trip_len_freq(i) = 0 ENDDO net.icount_stop = 0 net.oldnumcars = 0 net.use_signals = 1 net.normalize_links = .FALSE. net.use_link_iden = .FALSE. RETURN END SUBROUTINE NETWORK_INIT(sim,net) #include "dyna.inc" #include "sim.inc" #include "network.inc" RECORD /Sim_Data/ sim RECORD /Road_Network/ net RECORD /Node_Data/ node RECORD /Link_Data/ link RECORD /Move_Data/ move INTEGER i,j,k INTEGER NODE_READ !function INTEGER LINK_READ !function C - Read all nodes from the node file REWIND(NODE_FILE) CALL READSTAT('nodes',NODE_FILE) DO WHILE( NODE_READ(NODE_FILE, node).EQ.0 ) CALL ADD_NODE(net,node) ENDDO C - Read all links from the link file REWIND(LINK_FILE) CALL READSTAT('links',LINK_FILE) DO WHILE( LINK_READ(LINK_FILE, link).EQ.0 ) CALL ADD_LINK(sim,net,link) ENDDO C --- ================================================================== C - SET THE FORWARD-STAR AND THE BACKWARD-STAR OF THE NETWORK C --- ================================================================== k=1 DO i = 1,net.nnodes net.fs.npoint(I)=k DO j = 1,net.nlinks IF (net.link(j).idnod.EQ.i) THEN net.fs.ifwdarc(k,1) = net.link(j).iunod net.fs.ifwdarc(k,2) = J net.link(j).backindex = k k=k+1 ENDIF ENDDO ENDDO net.fs.npoint(net.nnodes+1)=k DO i=1,net.nnodes+1 net.spd.bsd.backpointr(i)=net.fs.npoint(i) net.spd.fs.npoint(i) = net.fs.npoint(i) ENDDO DO i=1,net.nlinks net.spd.bsd.backstr1(i)=net.fs.ifwdarc(i,1) DO j = 1,2 net.spd.fs.ifwdarc(i,j) = net.fs.ifwdarc(i,j) ENDDO ENDDO net.spd.nd.noofnodes = net.nnodes net.spd.nd.noofarcs = net.nlinks net.spd.nd.nlinks = net.nlinks c - initialization for 1st bacstr DO i=1,net.spd.nd.noofnodes DO k=net.spd.bsd.backpointr(i),net.spd.bsd.backpointr(i+1)-1 DO j=1,net.spd.nd.nlinks IF (i.eq.net.link(j).idnod.AND. + net.spd.bsd.backstr1(k).eq.net.link(j).iunod) THEN net.spd.bsd.backstr2(k) = net.link(j).length / + net.link(j).speed net.link(j).backindex = k ENDIF ENDDO ENDDO ENDDO Cr - Initialize all movements to have infinite penalties DO i=1,NU_LI DO j=1,7 net.spd.pn.penalty(i,j) = INFINITY ENDDO ENDDO cr DO WHILE( MOVE_READ(MOVE_FILE, move).EQ.0 ) cr CALL ADD_MOVE(net,move) cr ENDDO CALL MOVE_INIT(sim,net) CALL LANE_INIT(net) CALL CONTROL_INIT(sim,net) CALL SURVEILLANCE_INIT(sim,net) RETURN END INTEGER FUNCTION ADD_NODE(net,node) #include "dyna.inc" #include "network.inc" RECORD /Road_Network/ net RECORD /Node_Data/ node INTEGER i,j INTEGER nnum nnum = net.nnodes + 1 IF (nnum.GT.NU_NO) THEN 692 FORMAT(/'ERROR: Number of nodes ['I4 + ,'] greater than array parameter NU_NO ['I4']') WRITE(ostr,692) nnum,NU_NO CALL DYNA_ERROR(ostr + ,DYNA_FATAL_ERROR + ,DYNA_OUT_OF_MEMORY + ,DYNA_TOO_MANY_NODES) ENDIF IF (node.number.GT.MAX_NO.OR.node.number.LE.0) THEN WRITE(ostr,'(A,I5,A)') 'Invalid node number for new node: ' + ,node.number,CHAR(0) CALL DYNA_ERROR(ostr + ,DYNA_FATAL_ERROR + ,DYNA_INPUT_ERROR + ,DYNA_INVALID_NODENUM) ENDIF C - Izone is handled in reconcile net.node(nnum) = node net.nodenum(node.number) = nnum net.nnodes = net.nnodes + 1 ADD_NODE = 0 RETURN END INTEGER FUNCTION ADD_LINK(sim,net,link) #include "dyna.inc" #include "sim.inc" #include "network.inc" RECORD /Sim_Data/ sim RECORD /Road_Network/ net RECORD /Link_Data/ link INTEGER lnum INTEGER nod INTEGER demfrom INTEGER i1 INTEGER j,izn lnum = net.nlinks + 1 link.number = lnum C - CHECK IF GEOMETRY EXCEEDS PROGRAM PARAMETERS IF (lnum.GT.NU_LI) THEN 693 FORMAT(/'ERROR: Number of links ['I4 + ,'] greater than array parameter NU_LI ['I4']'A) WRITE(ostr,693) lnum,NU_LI CALL DYNA_ERROR(ostr + ,DYNA_FATAL_ERROR + ,DYNA_OUT_OF_MEMORY + ,DYNA_TOO_MANY_LINKS) ENDIF nod = link.iunod link.iunod = 0 IF (nod.GT.0 + .OR.nod.LE.MAX_NO) THEN link.iunod = net.nodenum(nod) ENDIF IF (link.iunod.EQ.0) THEN WRITE(ostr,'(A,I5,A)') + 'INVALID UPSTREAM NODE NUMBER IN LINK FILE: ' + ,nod,CHAR(0) CALL DYNA_ERROR(ostr + ,DYNA_FATAL_ERROR + ,DYNA_INPUT_ERROR + ,DYNA_INVALID_NODENUM) ENDIF nod = link.idnod link.idnod = 0 IF (nod.GT.0 + .OR.nod.LE.MAX_NO) THEN link.idnod = net.nodenum(nod) ENDIF IF (link.idnod.EQ.0) THEN WRITE(ostr,'(A,I5,A)') + 'INVALID DOWNSTREAM NODE NUMBER IN LINK FILE: ' + ,nod,CHAR(0) CALL DYNA_ERROR(ostr + ,DYNA_FATAL_ERROR + ,DYNA_INPUT_ERROR + ,DYNA_INVALID_NODENUM) ENDIF link.length = REAL(link.length)/5280.D0 link.sat = link.sat * link.nlanes demfrom = link.ildem IF (demfrom.EQ.0) THEN link.ildem = 0 ELSE IF (demfrom.EQ.1) THEN link.ildem = link.iunod ELSE IF (demfrom.EQ.2) THEN link.ildem = link.idnod ELSE link.ildem = 0 ENDIF C - the demand zone of the link is determined in RECONCILE ENDIF C --- ================================================================== C - Initialize the arrays for link-link flux limits C - with high numbers to prevent that check, if needed C --- ================================================================== c **************************************** c Initialize the arrays for the link-entry c and the link end queues c **************************************** link.p = log((link.vmax/2-EPS)/ + (link.vmax-EPS))/log(1.-2./3.) link.speed = link.vmax link.statmpt = link.length/link.speed link.cmax = DENSJAM CR - Make sure that all links have enough length for at least one CR - vehicle to fit on them per lane link.xl = link.nlanes*link.length IF (link.length.LT.AVGVEHLEN/5280.0) THEN CR970805: For really short links, we don't need the speed effects (in cr fact they will cause blocks in the system as their speed cr will be jam speed every time a vehicle enters them. As cr such, just make their length enough to hold as many vehicles cr as can enter the link in a time step per lane and set the cr CMAX to be infinite (so the speed on the link will be cr inconsequential high enough as to not block vehicles) cr link.xl=AVGVEHLEN/5280.0 cr + *link.sat*sim.timestep*60.0 cr + *link.nlanes link.length = 2*link.vmax*sim.timestep link.xl=link.length*link.nlanes ! long enough so veh wont ! overshoot link link.xl=INFINITY WRITE(ostr,'(A,I5,A,I5,A,F10.5,A)') + 'Null ln miles [',link.iunod + ,'->',link.idnod,'] -- '// + 'setting to minimum: [',link.xl,']'//CHAR(0) CALL DYNA_ERROR(ostr + ,DYNA_NONFATAL_WARNING + ,DYNA_INPUT_ERROR + ,DYNA_NULL_LANE_MILES) ENDIF link.seccap = anint(sim.timestep*link.sat*60.0) net.link(lnum) = link net.nlinks = net.nlinks + 1 CR - NOTES: Should check: vmax and type parameters ADD_LINK = 0 RETURN END SUBROUTINE ADD_MOVE(sim,net,move) #include "dyna.inc" #include "sim.inc" #include "activity.inc" #include "network.inc" RECORD /Sim_Data/ sim RECORD /Activity/ act RECORD /Road_Network/ net RECORD /Move_Data/ move INTEGER mnum INTEGER lf,lt INTEGER j,k C - Add a movement to the network mnum = net.nmoves + 1 IF (mnum.GT.NU_MV) THEN WRITE(ostr,692) mnum,NU_MV,CHAR(0) 692 FORMAT(/'ERROR: Number of moves ['I4 + ,'] greater than array parameter NU_MV ['I4']'A) CALL DYNA_ERROR(ostr + ,DYNA_FATAL_ERROR + ,DYNA_OUT_OF_MEMORY + ,DYNA_TOO_MANY_MOVES) ENDIF net.movement(mnum) = move C - Set up pointers to downstream and upstream moves lf = move.fromlink lt = move.tolink net.link(lf).numdslinks = net.link(lf).numdslinks + 1 net.link(lf).dsmoveptr(net.link(lf).numdslinks) = mnum net.link(lt).numuslinks = net.link(lt).numuslinks + 1 net.link(lt).usmoveptr(net.link(lt).numuslinks) = mnum net.nmoves = net.nmoves + 1 RETURN END