C ---------------------------------------------------------------------- SUBROUTINE CONTROL_CLEAR(sim,net) C ---------------------------------------------------------------------- C - INCLUDED FILES: #include "dyna.inc" #include "sim.inc" #include "network.inc" #include "par.inc" ! includes Signal_Param C - UNMODIFIED ARGUMENTS: RECORD /Sim_Data/ sim C - MODIFIED ARGUMENTS: RECORD /Road_Network/ net C - MODIFIED GLOBAL DATA: ! ostr (see dyna.inc) C - LOCAL VARIABLES: INTEGER i,j,k,kg INTEGER iii,jjj INTEGER iph RECORD /Signal_PARAM/ sig C - FUNCTIONS CALLED: INTEGER READ_CONTROL ! function ! READSTAT ! SIMMSG ! FND C - RETURN VALUE: ! Non-zero if there was an error C ---------------------------------------------------------------------- Cr - Zero phase data storage DO i = 1,net.nnodes net.node(i).numplans = 0 ENDDO DO kg = 1,NU_PH net.phase(kg).number = 0 net.phase(kg).offset = 0 net.phase(kg).time = 0 net.phase(kg).min = 0 net.phase(kg).max = 0 net.phase(kg).change = 0 net.phase(kg).numapp = 0 DO j = 1,MAX_IN net.phase(kg).nummove(j) = 0 DO k = 1,MAX_MOVE_TYPE net.phase(kg).movelist(j,k) = 0 !Pointers to movements net.phase(kg).movevol(j,k) = 0 ENDDO ENDDO net.phase(kg).active = 0 ENDDO RETURN END SUBROUTINE CONTROL_INIT(sim,net) #include "dyna.inc" #include "sim.inc" #include "network.inc" RECORD /Sim_Data/ sim RECORD /Road_Network/ net INTEGER ires INTEGER CONTROL_READ !function CALL CONTROL_CLEAR(sim,net) REWIND(SIGNAL_FILE) CALL READSTAT('node control data',SIGNAL_FILE) ires = CONTROL_READ(SIGNAL_FILE,sim,net) RETURN END C ---------------------------------------------------------------------- INTEGER FUNCTION CONTROL_READ(unit,sim,net) C ---------------------------------------------------------------------- C - Reads node control data from the signal.dat input file and primes C - the control arrays C - INCLUDED FILES: #include "dyna.inc" #include "sim.inc" #include "network.inc" #include "par.inc" ! includes Signal_Param C - UNMODIFIED ARGUMENTS: INTEGER unit RECORD /Sim_Data/ sim C - MODIFIED ARGUMENTS: RECORD /Road_Network/ net C - MODIFIED GLOBAL DATA: ! ostr (see dyna.inc) C - LOCAL VARIABLES: INTEGER i,j,k,kg INTEGER iii,jjj INTEGER iph RECORD /Signal_PARAM/ sig C - FUNCTIONS CALLED: INTEGER ADD_NODE_CONTROL ! function ! READSTAT ! SIMMSG ! FND C - RETURN VALUE: ! Non-zero if there was an error C ---------------------------------------------------------------------- CONTROL_READ = 0 Cr - Read each line of the signal file net.numph = 1 DO WHILE(.TRUE.) CALL FND(unit) READ(unit,19222,END=6060) + sig.usernode + ,sig.type + ,sig.num_phases + ,sig.cycle 19222 FORMAT(I5,I2,I2,I4) CR - Only read phases for signalized control types IF ((sig.type.NE.CTL_PRETIMED + .AND. + sig.type.NE.CTL_ACTUATED) + .OR. + sig.num_phases.LT.0) sig.num_phases = 0 Cr - Loop once for each of the inum phases to be associated with Cr - the control plan DO iph = 1,sig.num_phases IF (iph.GT.MAX_PLAN_PHASES) THEN WRITE(ostr,'(A)') + 'Too many phases specified [' + ,iph + ,'] for node [',sig.usernode,']'//CHAR(0) CALL DYNA_ERROR(ostr + ,DYNA_FATAL_ERROR + ,DYNA_OUT_OF_MEMORY + ,DYNA_TOO_MANY_PHASES) ENDIF CALL FND(unit) IF (sig.type.EQ.CTL_PRETIMED) THEN READ(unit,19223) + sig.phase(iph).number + ,sig.phase(iph).offset + ,sig.phase(iph).duration + ,sig.phase(iph).numapp + ,(sig.phase(iph).approach(iii).upnode,iii=1,6) + ,((sig.phase(iph).approach(iii).movecode(jjj), + jjj=1,5),iii=1,6) 19223 FORMAT(4X,I4,I4,I4,I4,6(I4),6(5(I2))) ELSE IF (sig.type.EQ.CTL_ACTUATED) THEN READ(unit,19224) + sig.phase(iph).number + ,sig.phase(iph).offset + ,sig.phase(iph).min + ,sig.phase(iph).max + ,sig.phase(iph).numapp + ,(sig.phase(iph).approach(iii).upnode,iii=1,6) + ,((sig.phase(iph).approach(iii).movecode(jjj), + jjj=1,5),iii=1,6) 19224 FORMAT(4X,I4,I4,I4,I4,I4,6(I4),6(5(I2))) ENDIF ENDDO IF (ADD_NODE_CONTROL(sim,net,sig).NE.0) THEN CALL SIMMSG(STATUS + ,'ERROR READING SIGNAL...Ignoring'//CHAR(0)) ENDIF ENDDO 6060 CONTINUE C - Assume those nodes which where node specified in the signal file C - are uncontrolled j = 0 DO i = 1,net.nnodes IF (net.node(i).numplans.EQ.0) THEN net.node(i).numplans = 1 net.node(i).plan(1).type = CTL_NONE net.node(i).plan(1).numphases = 0 net.node(i).plan(1).active = 0 net.node(i).curplan = 1 j = j + 1 ENDIF ENDDO IF (j.GT.0) THEN WRITE(ostr,'(A,I5,A)') 'WARNING: ',j,' nodes had no' + //' signalization info. Assuming uncontrolled.' + //CHAR(0) CALL SIMMSG(STATUS,ostr) ENDIF RETURN END C ---------------------------------------------------------------------- INTEGER FUNCTION ADD_NODE_CONTROL(sim,net,sig) C ---------------------------------------------------------------------- C - Updates the network structure to include a new control plan for C - a given node specified in the sig structure #include "dyna.inc" #include "sim.inc" #include "network.inc" #include "par.inc" ! for signal_param C - UNMODIFIED ARGUMENTS: RECORD /Sim_Data/ sim RECORD /Signal_Param/ sig C - MODIFIED ARGUMENTS: RECORD /Road_Network/ net C - MODIFIED GLOBAL DATA: ! ostr (see dyna.inc) C - LOCAL VARIABLES: INTEGER np2,npi,movegt,mv,j,mi INTEGER inod INTEGER i1 ! plan number INTEGER il ! link index INTEGER kg ! phase pointer INTEGER ip ! approach pointer (for ifwdarc) INTEGER i2 ! approach counter (total approaches at this node) INTEGER i3 ! approach counter (for indexing to this node) INTEGER im ! movement pointer INTEGER i4 ! movement type storage INTEGER icyc ! cycle length sum INTEGER iii ! approach index INTEGER jjj ! movetype index INTEGER ipnum ! phase index (at local node) INTEGER tmpnod ! upstream node of approach INTEGER np,np1 ! fs pointers INTEGER jj ! counter INTEGER rindex INTEGER aindex C - FUNCTIONS CALLED: ! READSTAT ! SIMMSG ! FND INTEGER LINKNUM C - RETURN VALUE: ! Non-zero if there was an error C ---------------------------------------------------------------------- ADD_NODE_CONTROL = 0 Cr - Retreive DYNASMART (packed) node number of sig.usernode IF (sig.usernode.LE.0 + .OR. + sig.usernode.GT.MAX_NO) THEN WRITE(ostr,'(A,I5,A)') + 'Invalid node [',sig.usernode + ,'] defined in signal file'//CHAR(0) CALL DYNA_ERROR(ostr + ,DYNA_NONFATAL_WARNING + ,DYNA_INPUT_ERROR + ,DYNA_INVALID_NODENUM) ADD_NODE_CONTROL = 1 RETURN ENDIF inod = net.nodenum(sig.usernode) IF (inod.LE.0.OR.inod.GT.net.nnodes) THEN WRITE(ostr,'(A,I5,A)') + 'Invalid node [',sig.usernode + ,'] specified in signal.dat'//CHAR(0) CALL DYNA_ERROR(ostr + ,DYNA_NONFATAL_WARNING + ,DYNA_INPUT_ERROR + ,DYNA_INVALID_NODENUM) ADD_NODE_CONTROL = 1 RETURN ENDIF Cr - Add a plan for node: inod net.node(inod).numplans = net.node(inod).numplans + 1 i1 = net.node(inod).numplans IF (sig.type.EQ.0) sig.type = 1 IF (sig.num_phases.EQ.0) sig.num_phases = 1 if (net.use_signals.eq.0) sig.type = 1 !If index_sig = 0 use !no control Cr - Store plan info net.node(inod).plan(i1).number = i1 net.node(inod).plan(i1).type = sig.type net.node(inod).plan(i1).numphases = sig.num_phases Cr - Non signalized intersections (uncontrolled, yield, stop, etc) Cr - store a dummy phase in the phase list IF (sig.type.LT.CTL_PRETIMED) THEN kg = net.numph net.node(inod).plan(i1).numphases = 1 net.node(inod).plan(i1).phaselist(1) = kg icyc = sim.timestep * 60.D0 + 0.0005 !make cycle one timestep net.phase(kg).number = 1 net.phase(kg).change = 0 !? what's this for? net.phase(kg).time = sim.timestep * 60.D0 + 0.0005 sig.phase(1).offset = 0 ! no offset i2 = 0 DO ip = net.fs.npoint(inod),net.fs.npoint(inod+1)-1 il = net.fs.ifwdarc(ip,2) i2 = i2 + 1 i3 = ip - net.fs.npoint(inod) + 1 DO im = 1,net.link(il).numdslinks IF (net.movement(net.link(il).dsmoveptr(im)).type + .NE.0) THEN i4 = net.movement(net.link(il).dsmoveptr(im)).type net.phase(kg).movelist(i3,i4) = + net.link(il).dsmoveptr(im) ENDIF ENDDO net.phase(kg).nummove(i3) = net.link(il).numdslinks ENDDO net.phase(kg).numapp = i2 net.phase(kg).active = 0 net.numph = net.numph + 1 IF (net.numph.GT.NU_PH) THEN CALL DYNA_ERROR( + 'Too many phases, increase NU_PH parameter!'// + CHAR(0) + ,DYNA_FATAL_ERROR + ,DYNA_OUT_OF_MEMORY + ,DYNA_TOO_MANY_PHASES) ENDIF ELSE IF (sig.type.EQ.CTL_PRETIMED) THEN Cr - For pretimed intersections (uncontrolled, yield, stop, etc) Cr - store a dummy phase in the phase list icyc = 0 DO ipnum = 1,sig.num_phases kg = net.numph net.phase(kg).number = ipnum icyc = icyc + sig.phase(ipnum).duration ! Increment cycle length ! from phase data Cr - Loop over each approach with allowed movements DO iii = 1,sig.phase(ipnum).numapp Cr - Convert approach user node number to DYNASMART node Cr - number tmpnod = net.nodenum(sig.phase(ipnum) + .approach(iii).upnode) IF (tmpnod.LE.0.OR.tmpnod.GT.net.nnodes) THEN WRITE(ostr,'(A,I5,A)') + 'Invalid node [' + ,sig.phase(ipnum).approach(iii).upnode + ,'] specified in signal.dat'//CHAR(0) CALL DYNA_ERROR(ostr + ,DYNA_NONFATAL_WARNING + ,DYNA_INPUT_ERROR + ,DYNA_INVALID_NODENUM) ADD_NODE_CONTROL = 1 RETURN ENDIF sig.phase(ipnum).approach(iii).upnode = tmpnod c$$$Cr - Using the ustream node number of the approach, c$$$Cr - determine the forward star index associated with the c$$$Cr - approach c$$$ np1 = net.fs.npoint(inod) c$$$ np = np1 c$$$ DO WHILE (net.fs.ifwdarc(np,1) c$$$ + .NE. c$$$ + sig.phase(ipnum).approach(iii).upnode c$$$ + .AND. c$$$ + np.LT.net.fs.npoint(inod+1)) c$$$ np = np + 1 c$$$ ENDDO np1 = LINKNUM(net.fs + ,sig.phase(ipnum).approach(iii).upnode + ,inod,rindex,aindex) IF (np1.LE.0) THEN Cr - Couldn't find pointer to approach CALL SIMMSG(STATUS,'Error reading phases') WRITE(ostr,6551) + net.node( + sig.phase(ipnum).approach(iii).upnode).number + ,net.node(inod).number + ,CHAR(0) 6551 FORMAT('Cant find approach from node ['I4 + '] to node ['I4 + ']. Check signal file'A) CALL DYNA_ERROR(ostr + ,DYNA_NONFATAL_WARNING + ,DYNA_INPUT_ERROR + ,DYNA_INVALID_LINK) ADD_NODE_CONTROL = 1 RETURN ENDIF Cr - Loop over each movement type to store allowed Cr - movements from this approach during this phase i4 = 0 DO jjj = 1,5 c$$$ phasecode(kg,np-npoint(inod)+1,jjj) = c$$$ + imovecode(ipnum,iii,jjj) IF (sig.phase(ipnum).approach(iii).movecode(jjj) + .EQ. + 1) THEN i2 = net.fs.ifwdarc(aindex,2) ! app. link num jj = 1 DO WHILE (net. + movement(net.link(i2).dsmoveptr(jj)) !movetype + .type.NE.jjj.AND.jj.LE.net.link(i2) + .numdslinks) jj = jj + 1 ENDDO IF (jj.GT.net.link(i2).numdslinks) THEN WRITE(ostr,60011) jjj + ,net.link(i2).iunod + ,net.link(i2).idnod + ,CHAR(0) 60011 FORMAT('Unable to find move type ['I5']' + 'from approach ['I5'->'I5'] in sig file.'A) CALL DYNA_ERROR(ostr + ,DYNA_NONFATAL_WARNING + ,DYNA_INPUT_ERROR + ,DYNA_INVALID_MOVE_TYPE) ADD_NODE_CONTROL = 1 RETURN ENDIF ! found associated movement i4 = i4 + 1 net.phase(kg).movelist(rindex,jjj) = + net.link(i2).dsmoveptr(jj) Cr - Add to movement time available during cycle net.movement(net.link(i2).dsmoveptr(jj)).cycgreen = + net.movement(net.link(i2).dsmoveptr(jj)) + .cycgreen + + sig.phase(ipnum).duration ENDIF ENDDO net.phase(kg).nummove(iii) = i4 ENDDO net.phase(kg).numapp = sig.phase(ipnum).numapp net.phase(kg).time = sig.phase(ipnum).duration net.phase(kg).min = sig.phase(ipnum).duration net.phase(kg).max = sig.phase(ipnum).duration net.node(inod).plan(i1).phaselist(ipnum) = kg net.numph = net.numph + 1 IF (net.numph.GT.NU_PH) THEN CALL DYNA_ERROR( + 'Too many phases, increase NU_PH parameter!'// + CHAR(0) + ,DYNA_FATAL_ERROR + ,DYNA_OUT_OF_MEMORY + ,DYNA_TOO_MANY_PHASES) + ENDIF ENDDO net.node(inod).plan(i1).cycle = icyc ELSE IF (sig.type.EQ.CTL_ACTUATED) THEN Cr - For pretimed intersections (uncontrolled, yield, stop, etc) Cr - store a dummy phase in the phase list icyc = 0 DO ipnum = 1,sig.num_phases kg = net.numph net.phase(kg).number = ipnum Cr - Loop over each approach with allowed movements DO iii = 1,sig.phase(ipnum).numapp Cr - Convert approach user node number to DYNASMART node Cr - number tmpnod = net.nodenum(sig.phase(ipnum) + .approach(iii).upnode) IF (tmpnod.LE.0.OR.tmpnod.GT.net.nnodes) THEN WRITE(ostr,'(A,I5,A)') + 'Invalid node [' + ,sig.phase(ipnum).approach(iii).upnode + ,'] specified in signal.dat'//CHAR(0) CALL DYNA_ERROR(ostr + ,DYNA_NONFATAL_WARNING + ,DYNA_INPUT_ERROR + ,DYNA_INVALID_NODENUM) ADD_NODE_CONTROL = 1 RETURN ENDIF sig.phase(ipnum).approach(iii).upnode = tmpnod c$$$Cr - Using the ustream node number of the approach, c$$$Cr - determine the forward star index associated with the c$$$Cr - approach c$$$ np1 = net.fs.npoint(inod) c$$$ np = np1 c$$$ DO WHILE (net.fs.ifwdarc(np,1) c$$$ + .NE. c$$$ + sig.phase(ipnum).approach(iii).upnode c$$$ + .AND. c$$$ + np.LT.net.fs.npoint(inod+1)) c$$$ np = np + 1 c$$$ ENDDO np1 = LINKNUM(net.fs + ,sig.phase(ipnum).approach(iii).upnode + ,inod,rindex,aindex) IF (np1.LE.0) THEN Cr - Couldn't find pointer to approach CALL SIMMSG(STATUS,'Error reading phases') WRITE(ostr,655) + net.node( + sig.phase(ipnum).approach(iii).upnode).number + ,net.node(inod).number + ,CHAR(0) 655 FORMAT('Cant find approach from node ['I4 + '] to node ['I4 + ']. Check signal file'A) CALL DYNA_ERROR(ostr + ,DYNA_NONFATAL_WARNING + ,DYNA_INPUT_ERROR + ,DYNA_INVALID_LINK) ADD_NODE_CONTROL = 1 RETURN ENDIF Cr - Loop over each movement type to store allowed Cr - movements from this approach during this phase i4 = 0 DO jjj = 1,5 c$$$ phasecode(kg,np-npoint(inod)+1,jjj) = c$$$ + imovecode(ipnum,iii,jjj) IF (sig.phase(ipnum).approach(iii).movecode(jjj) + .EQ. + 1) THEN i2 = net.fs.ifwdarc(aindex,2) ! app. link num jj = 1 DO WHILE (net. + movement(net.link(i2).dsmoveptr(jj)) !movetype + .type.NE.jjj.AND.jj.LE.net.link(i2) + .numdslinks) jj = jj + 1 ENDDO IF (jj.GT.net.link(i2).numdslinks) THEN WRITE(ostr,6001) jjj + ,net.link(i2).iunod + ,net.link(i2).idnod + ,CHAR(0) 6001 FORMAT('Unable to find move type ['I5']' + 'from approach ['I5'->'I5'] in sig file.'A) CALL DYNA_ERROR(ostr + ,DYNA_NONFATAL_WARNING + ,DYNA_INPUT_ERROR + ,DYNA_INVALID_MOVE_TYPE) ADD_NODE_CONTROL = 1 RETURN ENDIF ! found associated movement i4 = i4 + 1 net.phase(kg).movelist(rindex,jjj) = + net.link(i2).dsmoveptr(jj) Cr - Add to movement time available during cycle net.movement(net.link(i2).dsmoveptr(jj)).cycgreen = + net.movement(net.link(i2).dsmoveptr(jj)) + .cycgreen + + sig.phase(ipnum).max ENDIF ENDDO net.phase(kg).nummove(iii) = i4 ENDDO net.phase(kg).numapp = sig.phase(ipnum).numapp net.phase(kg).time = 0 ! will be calculated net.phase(kg).min = sig.phase(ipnum).min net.phase(kg).max = sig.phase(ipnum).max net.node(inod).plan(i1).phaselist(ipnum) = kg net.numph = net.numph + 1 IF (net.numph.GT.NU_PH) THEN CALL DYNA_ERROR( + 'Too many phases, increase NU_PH parameter!'// + CHAR(0) + ,DYNA_FATAL_ERROR + ,DYNA_OUT_OF_MEMORY + ,DYNA_TOO_MANY_PHASES) + ENDIF ENDDO net.node(inod).plan(i1).cycle = sig.cycle ELSE CALL DYNA_ERROR( + 'Signal file using unsupported control type'//CHAR(0) + ,DYNA_NONFATAL_WARNING + ,DYNA_INPUT_ERROR + ,DYNA_INVALID_CONTROL_TYPE) ADD_NODE_CONTROL = 1 RETURN ENDIF net.node(inod).plan(i1).offset = sig.phase(1).offset net.node(inod).plan(i1).active = 1 cr net.node(inod).curplan = 1 Cr - Use the most recently load plan. net.node(inod).curplan = net.node(inod).numplans CR DIAGNOSTIC: Loop over every approach and verify that all CR allowed movements on the approach receive some green time. IF (net.node(inod).plan(net.node(inod).curplan).type + .EQ.CTL_PRETIMED) THEN np1 = net.fs.npoint(inod) np2 = net.fs.npoint(inod+1)-1 CR - Loop over each approach DO np = np1,np2 npi = np - np1 + 1 ! approach index il = net.fs.ifwdarc(np,2) ! app. link num Cr - Loop over each movement from this approach DO im = 1,net.link(il).numdslinks movegt = 0 mv = net.link(il).dsmoveptr(im) ! move num CR - Loop over all phases to find if this movement is served ip = net.node(inod).curplan DO j = 1,net.node(inod).plan(ip).numphases ipnum = net.node(inod).plan(ip).phaselist(j) CR - Loop over signalization movement types DO mi = 1,5 IF (net.phase(ipnum).movelist(npi,mi).EQ.mv) THEN movegt = movegt + net.phase(ipnum).time ENDIF ENDDO ENDDO CR - Verify all movements receive some green time during the CR - cycle...CONNECTOR movements are exempted because they CR - receive perpetual green IF (net.movement(mv).type.NE.CONNECTOR + .AND. + movegt.LE.0) THEN WRITE(ostr,6002) + movestring(net.movement(mv).type) + (1:LTR(movestring(net.movement(mv).type))) + ,net.node(net.link(net.movement(mv).fromlink) + .iunod).number + ,net.node(net.link(net.movement(mv).fromlink) + .idnod).number + ,net.node(net.link(net.movement(mv).tolink) + .idnod).number + ,CHAR(0) 6002 FORMAT('The 'A' movement: ['I5'->'I5'->'I5'] receives' + ' no green time'A) CALL DYNA_ERROR(ostr + ,DYNA_NONFATAL_WARNING + ,DYNA_INPUT_ERROR + ,DYNA_NO_GREEN_TIME) ENDIF ENDDO ENDDO ENDIF RETURN END C ---------------------------------------------------------------------- INTEGER FUNCTION SIGFUN(sim,net) C ---------------------------------------------------------------------- C - Top level routine which calls NODE_SIGFUN for all nodes in the C - network to update their control C - INCLUDED FILES: #include "dyna.inc" #include "sim.inc" #include "network.inc" C - UNMODIFIED ARGUMENTS: RECORD /Sim_Data/ sim C - MODIFIED ARGUMENTS: RECORD /Road_Network/ net C - MODIFIED GLOBAL DATA: ! NONE C - LOCAL VARIABLES: INTEGER i C - FUNCTIONS CALLED: INTEGER NODE_SIGFUN ! Function C - RETURN VALUE: ! Simulation status C ---------------------------------------------------------------------- c i = 1 DO WHILE(i.LE.net.nnodes + .AND. + NODE_SIGFUN(sim,net,i).EQ.SIM_IN_PROGRESS) i = i + 1 ENDDO SIGFUN = sim.status RETURN END C ---------------------------------------------------------------------- INTEGER FUNCTION NODE_SIGFUN(sim,net,i) C ---------------------------------------------------------------------- C - Mid level routine which calls the appropriate control procedure C - for node number i to adjust the green time for each movement C - through the node during the next time step. C - INCLUDED FILES: #include "dyna.inc" #include "sim.inc" #include "network.inc" C - UNMODIFIED ARGUMENTS: RECORD /Sim_Data/ sim C - MODIFIED ARGUMENTS: RECORD /Road_Network/ net C - MODIFIED GLOBAL DATA: ! ostr (see dyna.inc) C - LOCAL VARIABLES: INTEGER i,j,k,ip INTEGER np1,np2 C - FUNCTIONS CALLED: ! NOCONTROL ! YIELDCONTROL ! STOPCONTROL ! PRETIMED ! ACTUATED C - RETURN VALUE: ! Simulation status C ---------------------------------------------------------------------- cr np1 = net.fs.npoint(net.node(i).number) cr np2 = net.fs.npoint(net.node(i).number+1) - 1 np1 = net.fs.npoint(i) np2 = net.fs.npoint(i+1) - 1 Cr - Zero green and capacity of all movements through the Cr - intersection (node) DO j = np1,np2 ip = net.fs.ifwdarc(j,2) DO k = 1,net.link(ip).numdslinks net.movement(net.link(ip).dsmoveptr(k)).green = 0 ENDDO ENDDO ip = net.node(i).curplan IF (ip.NE.0) THEN IF (net.node(i).plan(ip).type.EQ.CTL_NONE) THEN CALL NOCONTROL(sim,net,i) c$$$ ELSEIF (net.node(i).plan(ip).type.EQ.CTL_YIELD) THEN c$$$ CALL STOPCONTROL(i) ELSEIF (net.node(i).plan(ip).type.EQ.CTL_STOP) THEN CALL STOPCONTROL(sim,net,i) ELSEIF (net.node(i).plan(ip).type.EQ.CTL_PRETIMED) THEN CALL PRETIME(sim,net,i) ELSEIF (net.node(i).plan(ip).type.EQ.CTL_ACTUATED) THEN CALL ACTUATED(sim,net,i) ELSE Cr - Oops, there's a problem, assume uncontrolled WRITE(ostr,'(A,I5,A,I5)') 'Unrecognized control type [' + ,net.node(i).plan(ip).type,'] at node [' + ,i,']...assuming UNCONTROLLED.'//CHAR(0) CALL SIMMSG(STATUS, ostr) CALL NOCONTROL(sim,net,i) ENDIF ELSE WRITE(ostr,'(A,I5,A,I5)') 'No control defined for node [' + ,net.node(i).number + ,']...assuming UNCONTROLLED.'//CHAR(0) CALL SIMMSG(STATUS, ostr) CALL NOCONTROL(sim,net,i) ENDIF NODE_SIGFUN = sim.status RETURN END C ---------------------------------------------------------------------- INTEGER FUNCTION NOCONTROL(sim,net,nodenumber) C ---------------------------------------------------------------------- C - Adjusts movement green time for the next time step for all C - movements through node nodenumber. No conflict between any C - movements so that full green is always given for all movements C - (based on the number of lanes serving each movement). C - INCLUDED FILES: #include "dyna.inc" #include "sim.inc" #include "network.inc" C - UNMODIFIED ARGUMENTS: RECORD /Sim_Data/ sim C - MODIFIED ARGUMENTS: RECORD /Road_Network/ net C - MODIFIED GLOBAL DATA: ! NONE C - LOCAL VARIABLES: INTEGER nodenumber,nn,i1,i2,ii,il,j,imove INTEGER mp INTEGER lanecnt(MAX_MOVE_TYPE) INTEGER lanedem(MAX_LANE_TYPE) C - FUNCTIONS CALLED: ! NONE C - RETURN VALUE: ! Non-zero if there was an error C ---------------------------------------------------------------------- NOCONTROL = 0 nn = nodenumber i1 = net.fs.npoint(nn) i2 = net.fs.npoint(nn+1)-1 DO j = 1,MAX_MOVE_TYPE lanecnt(j) = 0 ENDDO DO j = 1,MAX_LANE_TYPE lanedem(j) = 0 ENDDO C --- Loop over all links approaching node do ii = i1,i2 il = net.fs.ifwdarc(ii,2) C --- Loop over all links leaving approach link (i.e. look over C --- all possible movements from the link DO j = 1,net.link(il).numdslinks mp = net.link(il).dsmoveptr(j) imove = net.movement(mp).type IF (imove.NE.0) THEN C --- Move is physically allowed (by move.dat) C --- Loop over all lane types that allow the this C --- move type and assign green net.movement(mp).green = sim.timestep*60.0 ENDIF ENDDO ENDDO RETURN END c$$$ c$$$c *************** c$$$c stopcontrol c$$$c ************** c$$$ SUBROUTINE stopcontrol(sim,net,nodenumber) c$$$c -- c$$$#include "dyna.inc" c$$$#include "sim.inc" c$$$#include "network.inc" c$$$ c$$$ INTEGER nodenumber c$$$ RECORD /Sim_Data/ sim c$$$ RECORD /Road_Network/ net c$$$ c$$$ LOGICAL set(MAX_LANE_TYPE) c$$$ c$$$C - Implicit defs c$$$ INTEGER nn,i1,i2,i,il,ii,ilm,j,imove,numlm,ilp,imn c$$$ + ,icap,iln,itmp c$$$ INTEGER nwq ! The number of approaches with a vehicle queue c$$$ INTEGER mp c$$$ REAL fg !float green c$$$ INTEGER ig !integer green c$$$ INTEGER total_volume,move_volume c$$$ REAL ttmp,ttmpg,cyc,expg,varg c$$$ c$$$ c$$$ nn = nodenumber c$$$ i1 = net.fs.npoint(nn) c$$$ i2 = net.fs.npoint(nn+1)-1 c$$$ total_volume = 0 c$$$ c$$$C --- Sum the queued vehicles: WE SHOULD REALLY CONSIDER MOVEMENTS AS c$$$C --- OPPOSED TO APPROACHES. c$$$ nwq = 0 c$$$ DO i=i1,i2 c$$$ il = net.fs.ifwdarc(i,2) c$$$ c$$$ move_volume = 0 c$$$ c$$$Cr - Determine the total movement demand from the approach resulting c$$$Cr - from vehicles reaching the end of the link during this step c$$$Cr - (plus those which were already queued) c$$$ DO j = 1,net.link(il).numdslinks c$$$ imn = net.link(il).dsmoveptr(j) c$$$ IF (net.movement(imn).type.LT.4) THEN c$$$ move_volume = move_volume + net.movement(imn).demand c$$$ ENDIF c$$$ ENDDO c$$$ c$$$Cr - The number in the queue is the number of vehicles which were c$$$Cr - queued at the end of the previous time step. If none were then c$$$Cr - the approach won't get any capacity. In this way we "model" c$$$Cr - the forced stop of vehicles at a stop sign. c$$$ total_volume = total_volume + move_volume c$$$ IF (total_volume.GT.0) THEN c$$$ nwq = nwq + 1 c$$$ ENDIF c$$$ ENDDO c$$$ c$$$ nn = nodenumber c$$$ i1 = net.fs.npoint(nn) c$$$ i2 = net.fs.npoint(nn+1)-1 c$$$ c$$$ IF (total_volume.EQ.0) RETURN !All green times will be zero c$$$ c$$$ c$$$C --- Loop over all links approaching node c$$$ do ii = i1,i2 c$$$ il = net.fs.ifwdarc(ii,2) c$$$ c$$$C --- Loop over all links leaving approach link (i.e. look over c$$$C --- all possible movements from the link c$$$ DO j = 1,net.link(il).numdslinks c$$$ mp = net.link(il).dsmoveptr(j) c$$$ imove = net.movement(mp).type c$$$ c$$$ IF (imove.NE.0) THEN c$$$C --- Move is physically allowed (by move.dat) c$$$ c$$$C --- Loop over all lane types that allow the this c$$$C --- move type and assign green: c$$$C - Green is assigned here based on the movement's fraction c$$$C - of the total queued volume at the intersection. c$$$ IF (net.link(il).vehicle_queue.NE.0) THEN c$$$c$$$ fg = sim.timestep*60.0 * c$$$c$$$ + net.link(il).vehicle_queue/total_volume c$$$ fg = sim.timestep*60.0 * c$$$ + net.movement(mp).demand/total_volume c$$$ ELSE c$$$ fg = 0.D0 c$$$ ENDIF c$$$ c$$$Cr - Ensure reduced capacity caused by stop sign (no more than c$$$Cr - one vehicle per lane, per timestep. This should really c$$$Cr - be handled directly via capacity reduction, but we'll c$$$Cr - just modify capacity indirectly using the green time. c$$$ IF (fg.GT.2.D0) fg = 2.D0 c$$$ c$$$C - probablistically determine if we get the extra fraction c$$$C - of green which doesn't fall on the integer second c$$$ ig = fg + 0.00005 c$$$ IF (fg-ig.GT.RAN1(sim.iseed)) ig = ig + 1 c$$$ net.movement(mp).green = ig c$$$ ENDIF c$$$ ENDDO c$$$ ENDDO c$$$ c$$$ return c$$$ end C ---------------------------------------------------------------------- INTEGER FUNCTION STOPCONTROL(sim,net,nodenumber) C ---------------------------------------------------------------------- C - Assigns green time for the next time step for all movements C - through node nodenumber. Reduces green time for all movements to C - reflect the effects of a forced stop. Green time is further C - reduced on selected movements based on the relative demand for C - right-of-way through the intersection C - INCLUDED FILES: #include "dyna.inc" #include "sim.inc" #include "network.inc" C - UNMODIFIED ARGUMENTS: INTEGER nodenumber RECORD /Sim_Data/ sim C - MODIFIED ARGUMENTS: RECORD /Road_Network/ net C - MODIFIED GLOBAL DATA: ! NONE C - LOCAL VARIABLES: INTEGER nn,i1,i2,i,il,ii,j,imove,imn + ,itmp INTEGER nwq ! The number of approaches with a vehicle queue INTEGER mp REAL fg !float green INTEGER ig !integer green INTEGER total_volume,move_volume C - FUNCTIONS CALLED: ! NONE C - RETURN VALUE: ! Non-zero if there was an error C ---------------------------------------------------------------------- STOPCONTROL = 0 nn = nodenumber i1 = net.fs.npoint(nn) i2 = net.fs.npoint(nn+1)-1 total_volume = 0 C --- Sum the queued vehicles: WE SHOULD REALLY CONSIDER MOVEMENTS AS C --- OPPOSED TO APPROACHES. nwq = 0 DO i=i1,i2 il = net.fs.ifwdarc(i,2) move_volume = 0 c$$$ DO j = 1,net.link(il).numdslinks c$$$ imn = net.link(il).dsmoveptr(j) Cr - Determine the total movement demand from the approach resulting Cr - from vehicles reaching the end of the link during this step Cr - (plus those which were already queued) DO j = 1,net.link(il).numdslinks imn = net.link(il).dsmoveptr(j) IF (net.movement(imn).type.LE.4) THEN move_volume = move_volume + net.movement(imn).demand ENDIF ENDDO Cr - The number in the queue is the number of vehicles which were Cr - queued at the end of the previous time step. If none were then Cr - the approach won't get any capacity. In this way we "model" Cr - the forced stop of vehicles at a stop sign. total_volume = total_volume + move_volume IF (total_volume.GT.0) THEN nwq = nwq + 1 ENDIF ENDDO nn = nodenumber i1 = net.fs.npoint(nn) i2 = net.fs.npoint(nn+1)-1 IF (total_volume.EQ.0) RETURN !All green times will be zero C --- Loop over all links approaching node do ii = i1,i2 il = net.fs.ifwdarc(ii,2) C --- Loop over all links leaving approach link (i.e. look over C --- all possible movements from the link DO j = 1,net.link(il).numdslinks mp = net.link(il).dsmoveptr(j) imove = net.movement(mp).type IF (imove.EQ.OTHER.OR.imove.EQ.CONNECTOR) THEN ! always can move net.movement(mp).green = sim.timestep*60.0 ELSE IF (imove.NE.0) THEN C --- Move is physically allowed (by move.dat) C --- Loop over all lane types that allow the this C --- move type and assign green: C - Green is assigned here based on the movement's fraction C - of the total queued volume at the intersection. IF (net.movement(mp).queued.NE.0) THEN c$$$ fg = sim.timestep*60.0 * c$$$ + net.link(il).vehicle_queue/total_volume fg = sim.timestep*60.0 * + net.movement(mp).demand/total_volume ELSE fg = 0.D0 ENDIF Cr - Ensure reduced capacity caused by stop sign (no more than Cr - one vehicle per lane, per timestep. This should really Cr - be handled directly via capacity reduction, but we'll Cr - just modify capacity indirectly using the green time. IF (fg.GT.2.D0) fg = 2.D0 C - probablistically determine if we get the extra fraction C - of green which doesn't fall on the integer second ig = fg + 0.00005 IF (fg-ig.GT.RAN1(sim.iseed)) ig = ig + 1 net.movement(mp).green = ig ENDIF ENDDO ENDDO RETURN END C ---------------------------------------------------------------------- INTEGER FUNCTION PRETIME(sim,net,nodenumber) C ---------------------------------------------------------------------- C - Adjusts movement green time for the next time step for all C - movements through node nodenumber. Green time is allotted based C - on the current pretimed signal indications. C - INCLUDED FILES: #include "dyna.inc" #include "sim.inc" #include "network.inc" C - UNMODIFIED ARGUMENTS: INTEGER nodenumber RECORD /Sim_Data/ sim C - MODIFIED ARGUMENTS: RECORD /Road_Network/ net C - MODIFIED GLOBAL DATA: ! NONE C - LOCAL VARIABLES: INTEGER i,j REAL fg INTEGER nn,ip,n1,iflag_l,n2,itmp,i1,i2,ii,il,imove + ,ig,ipo,icyc,kk INTEGER mp REAL t_now,t_next,t_old,tmp,offset,dummy C - FUNCTIONS CALLED: ! NONE C - RETURN VALUE: ! Non-zero if there was an error C ---------------------------------------------------------------------- PRETIME = 0 t_now = sim.time.minutes*60.0 t_next = (sim.time.minutes + sim.timestep)*60.0 nn = nodenumber ip = net.node(nn).curplan n1 = net.node(nn).plan(ip).phaselist(net.node(nn).plan(ip).active) n2 = n1 + net.node(nn).plan(ip).numphases - 1 cr cycle = plancyc(nn,ip) !cycle = cycle length iflag_l = 0 c print *,'t_next, t_now , nsign(n2, ',t_next,t_now,nsign(n2,13) if (t_next.gt.net.phase(n2).end) then t_next = net.phase(n2).end iflag_l = 1 t_old = t_next itmp = 0 cr CALL SIGPLAN(nn) endif C --- Loop over all phases for the signal at the node 12 do 100 i=n1,n2 fg = 0.0 net.phase(i).active = 0 C --- Determine the amount of green the phase gets during the current C --- timestep IF (NINT(t_now).GE.net.phase(i).start + .AND. + NINT(t_next).LE.net.phase(i).end) THEN C --- Phase is active during entire timestep fg = t_next - t_now net.phase(i).active = 1 ELSEIF (NINT(t_now).LT.net.phase(i).end + .AND. + NINT(t_next).GT.net.phase(i).end) THEN C --- Phase is active, but ends during timestep fg = net.phase(i).end - t_now net.phase(i).active = 2 ELSEIF (NINT(t_next).GT.net.phase(i).start + .AND. + NINT(t_now).LT.net.phase(i).start) then C --- Phase is not active, but begins during timestep fg = t_next - net.phase(i).start net.phase(i).active = 3 endif if (fg.gt.sim.timestep*60) fg = sim.timestep*60 if (fg.lt.0.05) fg = 0.0 nn = nodenumber i1 = net.fs.npoint(nn) i2 = net.fs.npoint(nn+1)-1 C --- Loop over all links approaching node do ii = i1,i2 il = net.fs.ifwdarc(ii,2) C --- Loop over all links leaving approach link (i.e. look over C --- all possible movement from the link DO j = 1,net.link(il).numdslinks mp = net.link(il).dsmoveptr(j) imove = net.movement(mp).type IF (imove.NE.0) THEN C --- Move is physically allowed (by move.dat) IF (net.phase(i).movelist(ii-i1+1,imove).NE.0) THEN C --- Move is allowed during current phasing C - probablistically determine if we get the extra fraction C - of green which doesn't fall on the integer second ig = fg + 0.00005 IF (fg-ig.GT.RAN1(sim.iseed)) ig = ig + 1 !CR: The green has to be summed (and zeroed ! elsewhere before the timestep) net.movement(mp).green = + net.movement(mp).green + ig IF (net.movement(mp).green.GT. + sim.timestep*60.D0) + net.movement(mp).green = + 60*sim.timestep+0.0001 ELSE IF (imove.EQ.CONN) THEN ! Connectors always get green net.movement(mp).green = sim.timestep*60.0 ENDIF ENDIF ENDDO ENDDO fg = 0.0 100 continue if(iflag_l.eq.0) go to 1200 1000 tmp = t_next ipo = ip ip = net.node(nodenumber).curplan n1 = net.node(nodenumber). + plan(net.node(nodenumber).curplan).phaselist(1) n2 = n1 + net.node(nodenumber). + plan(net.node(nodenumber).curplan).numphases - 1 i1 = net.fs.npoint(nodenumber) i2 = net.fs.npoint(nodenumber+1)-1 DO nn = n1,n2 net.phase(nn).start = tmp tmp = net.phase(nn).start + net.phase(nn).time net.phase(nn).end = tmp ENDDO if (sim.iter.eq.0) then offset = + net.node(nodenumber).plan(net.node(nodenumber).curplan). + offset icyc = 0 DO nn = n1,n2 icyc = icyc + net.phase(nn).time ENDDO DO nn = n1,n2 net.phase(nn).start = net.phase(nn).start + offset net.phase(nn).end = net.phase(nn).end + offset IF (offset.GT.0) THEN !CR: Adjust so cycle starts !properly relative to the offset DO kk = 12,14 net.phase(nn).start = net.phase(nn).start - icyc net.phase(nn).start = net.phase(nn).start - icyc ENDDO ENDIF ENDDO endif if (iflag_l.eq.1) then t_next = t_now+sim.timestep*60 t_now = t_old iflag_l = 0 go to 12 endif 1200 dummy = 0 return end C ---------------------------------------------------------------------- INTEGER FUNCTION ACTUATED(sim,net,nodenumber) C ---------------------------------------------------------------------- C - Adjusts movement green time for the next time step for all C - movements through node nodenumber. Green time is allotted based C - on the current pretimed signal indications. C - INCLUDED FILES: #include "dyna.inc" #include "sim.inc" #include "network.inc" C - UNMODIFIED ARGUMENTS: INTEGER nodenumber RECORD /Sim_Data/ sim C - MODIFIED ARGUMENTS: RECORD /Road_Network/ net C - MODIFIED GLOBAL DATA: ! NONE C - LOCAL VARIABLES: INTEGER i,j REAL fg INTEGER nn,ip,n1,iflag_l,n2,itmp,i1,i2,ii,il,imove + ,ig,ipo,icyc,kk,ph INTEGER mp REAL t_now,t_next,t_old,tmp,offset,dummy INTEGER critmove(MAX_PLAN_PHASE,2) REAL critvs(MAX_PLAN_PHASE) REAL critsat(MAX_PLAN_PHASE) REAL vsmax REAL v,s,vs REAL totmin ! sum of minumum greens for a cycle INTEGER iapp,imv INTEGER mvcount REAL gvar REAL vssum REAL freegreen REAL minsum INTEGER node C - FUNCTIONS CALLED: ! NONE C - RETURN VALUE: ! Non-zero if there was an error C ---------------------------------------------------------------------- ACTUATED = 0 t_now = sim.time.minutes*60.0 t_next = (sim.time.minutes + sim.timestep)*60.0 node = nodenumber ip = net.node(node).curplan n1 = net.node(node).plan(ip).phaselist(net.node(node).plan(ip) + .active) n2 = n1 + net.node(node).plan(ip).numphases - 1 cr cycle = plancyc(node,ip) !cycle = cycle length iflag_l = 0 c print *,'t_next, t_now , nsign(n2, ',t_next,t_now,nsign(n2,13) CR - Check to see if the cycle ends during this timestep if (t_next.gt.net.phase(n2).end) then t_next = net.phase(n2).end iflag_l = 1 t_old = t_next itmp = 0 cr CALL SIGPLAN(node) CR - Now recalculate the splits based on volumes from the previous CR - cycle CR - First, find each phase's critical movement vssum = 0.D0 totmin = 0.D0 DO ph = n1,n2 vsmax = -1 mvcount = 0 cr DO iapp = 1,net.phase(ph).numapp DO iapp = 1,MAX_IN DO imv = 1,MAX_MOVE_TYPE imove = net.phase(ph).movelist(iapp,imv) IF (imove.NE.0) THEN ! move exists of this type mvcount = mvcount + 1 v = net.phase(ph).movevol(iapp,imv) + +net.movement(imove).queued CR - Zero the move vol for the next round net.phase(ph).movevol(iapp,imv) = 0 CR -- This sat calc is flawed in that the saturation CR - flow rate for a given movement depends jointly on CR - the number of lanes available for the movement and CR - the prevailing saturation flow rate on those CR - lanes. If a movement uses shared lanes, this CR - calculation becomes complex. For now, just assume CR - 1800-vph for each lane serving the movement (with CR - shared lanes counting as a full lane for every CR - movement they serve (see Lane.for)) s = net.movement(imove).nlanes* + 0.50 IF (s.EQ.0) THEN ! No cap, sat flow = 0 CALL DYNA_ERROR( + 'Movement has no cap in sig calc'//CHAR(0) + ,DYNA_FATAL_ERROR + ,DYNA_LOGIC_BUG + ,DYNA_UNKNOWN_ERROR) ELSE vs = v/s ENDIF IF (vs.GT.vsmax) THEN ! new crit movement for ! phase vsmax = vs critvs(ph-n1+1) = vs critsat(ph-n1+1) = s critmove(ph-n1+1,1) = iapp critmove(ph-n1+1,2) = imv ENDIF ENDIF ENDDO ENDDO IF (mvcount.EQ.0) THEN !Assume this is a red phase critvs(ph-n1+1) = 0 ELSE IF (vsmax.LT.0) THEN CALL DYNA_ERROR('No crit move found for phase!'//CHAR(0) + ,DYNA_FATAL_ERROR + ,DYNA_LOGIC_BUG + ,DYNA_UNKNOWN_ERROR) ENDIF CR - Check to see if min green will satisfy this phase. If so, CR - don't include it in the variable green calculations IF (net.phase(ph).min.GE.critvs(ph-n1+1)) THEN critvs(ph-n1+1) = 0 ENDIF vssum = vssum + critvs(ph-n1+1) totmin = totmin + net.phase(ph).min ENDDO CR NO VOLUME: Assume the phases balance IF (vssum.EQ.0) THEN DO ph = n1,n2 critvs(ph-n1+1) = 500.0 !All phases (high) w/same v/s vssum = vssum + critvs(ph-n1+1) ENDDO ELSE IF (vssum.LT.0) THEN CALL DYNA_ERROR('invalid vssum in actuated calc'//CHAR(0) + ,DYNA_FATAL_ERROR + ,DYNA_LOGIC_BUG + ,DYNA_UNKNOWN_ERROR) ENDIF CR - Now recalculate the phases by reallocating the available CR - variable green time freegreen = net.node(node).plan(ip).cycle - totmin IF (freegreen.LT.0) THEN CALL DYNA_ERROR('Min green greater than cycle length' + ,DYNA_FATAL_ERROR + ,DYNA_INPUT_ERROR + ,DYNA_UNKNOWN_ERROR) ENDIF DO ph = n1,n2 gvar = critvs(ph-n1+1)/vssum*freegreen cr gvar = AMIN0(gvar,critvs(ph-n1+1)) cr gvar = AMIN0(gvar,net.phase(ph).max) ! no max restriction now net.phase(ph).time = NINT(gvar) + net.phase(ph).min CR - Recalculate the cyc green CR - Reset the cycle green for this movement since we'll CR - be recalculating it when we adjust the green times DO iapp = 1,MAX_IN DO imv = 1,MAX_MOVE_TYPE imove = net.phase(ph).movelist(iapp,imv) IF (imove.NE.0) THEN net.movement(imove).cycgreen = 0 ENDIF ENDDO ENDDO DO iapp = 1,MAX_IN DO imv = 1,MAX_MOVE_TYPE imove = net.phase(ph).movelist(iapp,imv) IF (imove.NE.0) THEN ! move exists of this type net.movement(imove).cycgreen = + net.movement(imove).cycgreen + + net.phase(ph).time ENDIF ENDDO ENDDO ENDDO crcr FIX: external crcr#ifdef DYNA_DYNAVIEW crcr IF (node.EQ.sim.watchnode) THEN crcr CALL SIG_DUMP(sim,net,sim.watchnode) crcr ENDIF crcr#endif ENDIF C --- Loop over all phases for the signal at the node 12 do 100 i=n1,n2 fg = 0.0 net.phase(i).active = 0 C --- Determine the amount of green the phase gets during the current C --- timestep IF (NINT(t_now).GE.net.phase(i).start + .AND. + NINT(t_next).LE.net.phase(i).end) THEN C --- Phase is active during entire timestep fg = t_next - t_now net.phase(i).active = 1 ELSEIF (NINT(t_now).LT.net.phase(i).end + .AND. + NINT(t_next).GT.net.phase(i).end) THEN C --- Phase is active, but ends during timestep fg = net.phase(i).end - t_now net.phase(i).active = 2 ELSEIF (NINT(t_next).GT.net.phase(i).start + .AND. + NINT(t_now).LT.net.phase(i).start) then C --- Phase is not active, but begins during timestep fg = t_next - net.phase(i).start net.phase(i).active = 3 endif if (fg.gt.sim.timestep*60) fg = sim.timestep*60 if (fg.lt.0.05) fg = 0.0 node = nodenumber i1 = net.fs.npoint(node) i2 = net.fs.npoint(node+1)-1 C --- Loop over all links approaching node do ii = i1,i2 il = net.fs.ifwdarc(ii,2) C --- Loop over all links leaving approach link (i.e. look over C --- all possible movement from the link DO j = 1,net.link(il).numdslinks mp = net.link(il).dsmoveptr(j) imove = net.movement(mp).type IF (imove.NE.0) THEN C --- Move is physically allowed (by move.dat) IF (net.phase(i).movelist(ii-i1+1,imove).NE.0) THEN C --- Move is allowed during current phasing C - probablistically determine if we get the extra fraction C - of green which doesn't fall on the integer second ig = fg + 0.00005 IF (fg-ig.GT.RAN1(sim.iseed)) ig = ig + 1 !CR: The green has to be summed (and zeroed ! elsewhere before the timestep) net.movement(mp).green = + net.movement(mp).green + ig IF (net.movement(mp).green.GT.sim.timestep*60.D0) + net.movement(mp).green = + 60*sim.timestep+0.0001 ELSE IF (imove.EQ.CONN) THEN ! Connectors always get green net.movement(mp).green = sim.timestep*60.0 ENDIF ENDIF ENDDO ENDDO fg = 0.0 100 continue if(iflag_l.eq.0) go to 1200 1000 tmp = t_next ipo = ip ip = net.node(nodenumber).curplan n1 = net.node(nodenumber). + plan(net.node(nodenumber).curplan).phaselist(1) n2 = n1 + net.node(nodenumber). + plan(net.node(nodenumber).curplan).numphases - 1 i1 = net.fs.npoint(nodenumber) i2 = net.fs.npoint(nodenumber+1)-1 DO nn = n1,n2 net.phase(nn).start = tmp tmp = net.phase(nn).start + net.phase(nn).time net.phase(nn).end = tmp ENDDO if (sim.iter.eq.0) then offset = + net.node(nodenumber).plan(net.node(nodenumber).curplan). + offset icyc = 0 DO nn = n1,n2 icyc = icyc + net.phase(nn).time ENDDO DO nn = n1,n2 net.phase(nn).start = net.phase(nn).start + offset net.phase(nn).end = net.phase(nn).end + offset IF (offset.GT.0) THEN !CR: Adjust so cycle starts !properly relative to the offset DO kk = 12,14 net.phase(nn).start = net.phase(nn).start - icyc net.phase(nn).start = net.phase(nn).start - icyc ENDDO ENDIF ENDDO endif if (iflag_l.eq.1) then t_next = t_now+sim.timestep*60 t_now = t_old iflag_l = 0 go to 12 endif 1200 dummy = 0 return end C ---------------------------------------------------------------------- INTEGER FUNCTION MOVECNT(sim,net,l,m) C ---------------------------------------------------------------------- C - Determine the number of vehicles at the end of link l making C - moves of type m. C - INCLUDED FILES: #include "dyna.inc" #include "sim.inc" #include "network.inc" C - UNMODIFIED ARGUMENTS: RECORD /Sim_Data/ sim RECORD /Road_Network/ net INTEGER l !link number INTEGER m !move type C - MODIFIED ARGUMENTS: ! NONE C - MODIFIED GLOBAL DATA: ! NONE C - LOCAL VARIABLES: INTEGER i C - FUNCTIONS CALLED: ! NONE C - RETURN VALUE: ! The number of vehicles making the indicated movement C ---------------------------------------------------------------------- MOVECNT = 0 Cr - Determine the total demand at the end of the link DO i = 1,net.link(l).numdslinks IF (net.movement(net.link(l).dsmoveptr(i)).type.EQ.m) THEN MOVECNT = net.movement(net.link(l).dsmoveptr(i)).demand ENDIF ENDDO RETURN END C ---------------------------------------------------------------------- INTEGER FUNCTION MOVEVOL(sim,net,l,m) C ---------------------------------------------------------------------- C - Determine the average volume (vph) over the rolling horizon making C - moves of type m at the end of link l. Movement type m = 0 returns C - the total volume for all movements on approach C - INCLUDED FILES: #include "dyna.inc" #include "sim.inc" #include "network.inc" C - UNMODIFIED ARGUMENTS: RECORD /Sim_Data/ sim RECORD /Road_Network/ net INTEGER l !link number INTEGER m !move type C - MODIFIED ARGUMENTS: ! NONE C - MODIFIED GLOBAL DATA: ! NONE C - LOCAL VARIABLES: INTEGER i,j C - FUNCTIONS CALLED: ! NONE C - RETURN VALUE: ! The hourly volume making the indicated movement C ---------------------------------------------------------------------- MOVEVOL = 0 Cr - Determine the total demand at the end of the link DO i = 1,net.link(l).numdslinks IF (net.movement(net.link(l).dsmoveptr(i)).type.EQ.m + .OR. + m.EQ.0) THEN DO j = 1,NU_DS MOVEVOL = MOVEVOL + + net.movement(net.link(l).dsmoveptr(i)).volume(j) ENDDO ENDIF ENDDO MOVEVOL = NINT(MOVEVOL/(NU_DS*sim.timestep)*60.0) RETURN END SUBROUTINE ADJUSTCAP(sim,net,veh) #include "dyna.inc" #include "sim.inc" #include "network.inc" #include "vehicle.inc" RECORD /Sim_Data/ sim RECORD /Road_Network/ net RECORD /Vehicle_Data/ veh(NU_VE) INTEGER i,j INTEGER ADJUSTNODECAP !function DO i = 1,net.nnodes j = ADJUSTNODECAP(sim,net,veh,i) ENDDO RETURN END INTEGER FUNCTION ADJUSTNODECAP(sim,net,veh,n) C - ACCOMPLISH THIS AS FOLLOWS: C - (1) Determine movement splits C - (2) Determine lane utilization C - (3) For each approach: C - (3a) Determine lane saturations based on shared usage and C - opposing traffic C - (3b) Sum sat*green to find resulting capacity for each C - movement #include "dyna.inc" #include "sim.inc" #include "network.inc" #include "vehicle.inc" RECORD /Sim_Data/ sim RECORD /Road_Network/ net RECORD /Vehicle_Data/ veh(NU_VE) INTEGER n !node number INTEGER i,i1,i2 INTEGER l INTEGER im,m i1 = net.fs.npoint(n) i2 = net.fs.npoint(n+1)-1 Cr - Determine lane utilization for this time step crcr#ifdef DO_LANE_OPTIMIZATION crcr CALL NODE_LANEOPT(sim,net,n) crcr#endif Cr - Loop over approaching links DO i = i1,i2 l = net.fs.ifwdarc(i,2) Cr - Adjust the capacities for each movement exiting from the link Cr - based on lane saturation flows DO im = 1,net.link(l).numdslinks m = net.link(l).dsmoveptr(im) CALL ADJUSTMOVECAP(sim,net,veh,m,i) ENDDO ENDDO ADJUSTNODECAP = sim.status RETURN END SUBROUTINE ADJUSTMOVECAP(sim,net,veh,m,fsp) Cr - Adjust the capacities for each movement exiting from the link Cr - based on lane saturation flows #include "dyna.inc" #include "sim.inc" #include "network.inc" #include "vehicle.inc" RECORD /Sim_Data/ sim RECORD /Road_Network/ net RECORD /Vehicle_Data/ veh(NU_VE) INTEGER m !movement pointer INTEGER fsp !ifwdarc index of link movement resides on (hack) INTEGER mtype !movement type INTEGER nd !node number INTEGER ilp !lane index pointer INTEGER ln !lane index INTEGER numln !holder for number of lanes INTEGER i1 !fs pointers INTEGER i2 ! INTEGER ip ! REAL fc !float capacity INTEGER ic !integer capacity INTEGER im ! movement index INTEGER mv ! movement number INTEGER fl ! movement from link INTEGER tl ! movement to link INTEGER iapp ! approach index (bs ptr) INTEGER appflag(6) ! descriptive flags for each approach ! 0 = subject approach ! 1 = opposing approach ! -1 = conflicting approach INTEGER v_s,v_o,v_c,v_ol,v_cl,v_or,v_cr INTEGER v_t INTEGER l_s,l_o REAL v_ps,v_po,lt_po,rt_po,lt_pc,rt_pc REAL ctot INTEGER j,k INTEGER MOVEVOL ! function INTEGER REVERSE_LINK ! function mtype = net.movement(m).type net.movement(m).capacity = 0 fc = 0.D0 C - for back compat (need to change how lanes are stored!) nd = net.link(net.movement(m).fromlink).idnod i1 = net.fs.npoint(nd) i2 = net.fs.npoint(nd+1)-1 c$$$ c$$$ IF (net.node(nd).plan(net.node(nd).curplan).type.EQ.CTL_STOP) THEN c$$$ c$$$ fl = net.movement(m).fromlink c$$$ c$$$C - Find through link c$$$ tl = 0 c$$$ DO ip = 1,net.link(fl).numdslinks c$$$ mv = net.link(fl).dsmoveptr(ip) c$$$ IF (net.movement(mv).type.EQ.THROUGH) THEN c$$$ tl = net.movement(mv).tolink c$$$ ENDIF c$$$ ENDDO c$$$ c$$$C - Loop over each approach to the node to determine opposing and c$$$C - conflicting approaches (and calculate relavant intersection c$$$C - volumes). c$$$ v_s = 0 c$$$ v_o = 0 c$$$ v_c = 0 c$$$ v_t = 0 c$$$ v_ol = 0 c$$$ v_cl = 0 c$$$ v_or = 0 c$$$ v_cr = 0 c$$$ l_s = 0 c$$$ l_o = 0 c$$$ DO ip = i1,i2 c$$$ iapp = net.fs.ifwdarc(ip,2) c$$$ IF (iapp.EQ.fl) THEN c$$$ appflag(ip-i1+1) = 0 c$$$ v_s = v_s + MOVEVOL(sim,net,iapp,0) c$$$ ! Sum the number of lanes c$$$cr DO ilp = 1,MAX_LANE_TYPE c$$$cr l_s = l_s + net.node(nd).lanenum(ip-i1+1,ilp) c$$$cr ENDDO c$$$ l_s = net.link(iapp).nlanes c$$$ ELSE IF (tl.NE.0 c$$$ + .AND.iapp.EQ.REVERSE_LINK(net,tl)) THEN c$$$ appflag(ip-i1+1) = 1 c$$$ v_o = v_o + MOVEVOL(sim,net,iapp,0) c$$$ v_ol = v_ol + MOVEVOL(sim,net,iapp,INT(LEFT)) + c$$$ + MOVEVOL(sim,net,iapp,UTURN) c$$$ v_or = v_or + MOVEVOL(sim,net,iapp,INT(RIGHT)) c$$$ ! Sum the number of lanes c$$$cr DO ilp = 1,MAX_LANE_TYPE c$$$cr l_o = l_o + net.node(nd).lanenum(ip-i1+1,ilp) c$$$cr ENDDO c$$$ l_o = net.link(iapp).nlanes c$$$ ELSE c$$$ appflag(ip-i1+1) = -1 c$$$ v_c = v_c + MOVEVOL(sim,net,iapp,0) c$$$ v_cl = v_cl + MOVEVOL(sim,net,iapp,INT(LEFT)) c$$$ + + MOVEVOL(sim,net,iapp,UTURN) c$$$ v_cr = v_cr + MOVEVOL(sim,net,iapp,INT(RIGHT)) c$$$ ENDIF c$$$ c$$$C - Calculate total intersection volume: c$$$ v_t = v_t + MOVEVOL(sim,net,iapp,0) ! redundant (using to c$$$ ! check whether total c$$$ ! matches sum c$$$ c$$$ ENDDO c$$$ c$$$ IF (v_s + v_o + v_c .GT. 0) THEN c$$$ v_ps = v_s / REAL(v_s + v_o + v_c) c$$$ v_po = v_o / REAL(v_s + v_o + v_c) c$$$ ELSE c$$$ v_ps = 0.D0 c$$$ v_po = 0.D0 c$$$ ENDIF c$$$ c$$$ IF (v_o.GT.0) THEN c$$$ lt_po = v_ol / REAL(v_o) c$$$ rt_po = v_or / REAL(v_o) c$$$ ELSE c$$$ lt_po = 0.D0 c$$$ rt_po = 0.D0 c$$$ ENDIF c$$$ c$$$ IF (v_c.GT.0) THEN c$$$ lt_pc = v_cl / REAL(v_c) c$$$ rt_pc = v_cr / REAL(v_c) c$$$ ELSE c$$$ lt_pc = 0.D0 c$$$ rt_pc = 0.D0 c$$$ ENDIF c$$$ c$$$C - OK, all approaches are classified, now use HCM 1994 EQ (10-15) c$$$C - p 10-36 for adjusting movement capacity c$$$ ctot = 1000*v_ps + 700*v_po + 200*l_s - 100*l_o - 300*lt_po c$$$ + + 200*rt_po - 300*lt_pc + 300*rt_pc c$$$ c$$$ IF (v_s.GT.0) THEN c$$$ fc = fc + net.movement(m).green * ctot * c$$$ + MOVEVOL(sim,net,INT(net.movement(m).fromlink),mtype) / c$$$ + REAL(v_s) * sim.timestep / 60.0 c$$$ ELSE c$$$ fc = 0.D0 c$$$ ENDIF c$$$ c$$$ c$$$ ELSE C - Loop over all lane types that allow this move type and increment C - the movement's capacity based on each lane. C - STILL NEEDED HERE IS A CALL TO A LANE SATURATION CALCUATION WHICH C - ADJUSTS LANE SATS FOR SHARED MOVEMENTS ACCORDING TO PREVAILING C - CONDITIONS. IF (mtype.EQ.CONNECTOR + .OR. + mtype.EQ.OTHER) THEN Cr - Give lots of capacity to other and connector movements fc = net.lanesat(5)*9*sim.timestep*60.0 ELSE ilp = 1 DO WHILE(net.lanemove(mtype,ilp).NE.0) ln = net.lanemove(mtype,ilp) numln = net.node(nd).lanenum(fsp-i1+1,ln) IF (numln.GT.0) THEN CR070808: - For freeways, make sure that the saturation flow rate is CR - equal to the sat flow rate on the freeway section -- in CR - fact SHOULD THIS BE TRUE FOR ALL THROUGH MOVEMENTS? IF (net.link(net.movement(m).fromlink).type + .EQ.FREEWAY + .AND. + net.link(net.movement(m).tolink).type + .EQ.FREEWAY) THEN fc = fc + net.movement(m).green* + net.link(net.movement(m).fromlink).sat* + numln ELSE fc = fc + + net.movement(m).green*net.lanesat(ln)*numln ENDIF ENDIF ilp = ilp + 1 ENDDO ENDIF c$$$ ENDIF C - Check to see if movement is effected by an incident DO j = 1,sim.numincidents IF (sim.incident(j).starttime.LE.sim.time.minutes + .AND. + sim.incident(j).endtime.GT.sim.time.minutes) THEN DO k = 1,sim.incident(j).numeffects IF (sim.incident(j).effect(k).movenum.EQ.m) THEN fc = fc* + sim.incident(j).effect(k).capacity_reduction ENDIF ENDDO ENDIF ENDDO ic = fc+0.00005 !drop the floating point IF (fc-ic.GT.RAN1(sim.iseed)) ic = ic + 1 net.movement(m).capacity = ic RETURN END