C ---------------------------------------------------------------------- INTEGER FUNCTION REPORT_STATUS(io,sim,net,act) C ---------------------------------------------------------------------- C - Prints a simulation and network status report #include "dyna.inc" #include "io.inc" #include "sim.inc" #include "network.inc" #include "activity.inc" C - UNMODIFIED ARGUMENTS: RECORD /Io_Data/ io RECORD /Sim_Data/ sim RECORD /Road_Network/ net RECORD /Activity/ act C - MODIFIED ARGUMENTS: ! NONE C - MODIFIED GLOBAL DATA: ! ostr (see dyna.inc) C - LOCAL VARIABLES: INTEGER tmpval,ihr,imin,isc,ihld C - FUNCTIONS CALLED: ! INTEGER LTR ! function C - RETURN VALUE: ! Non-zero if there was an error C ---------------------------------------------------------------------- REPORT_STATUS = 0 C - Print general simulation stats: WRITE(ostr,600) CHAR(0) 600 FORMAT('--- Simulation status ---'A) CALL SIMMSG(STATUS,ostr) WRITE(ostr,601) io.netfile(1:LTR(io.netfile)),CHAR(0) 601 FORMAT('\n . Network file : ['A']'A) CALL SIMMSG(STATUS,ostr) IF (LTR(io.gt_hostname).NE.0.OR. + io.gt_port.NE.0) THEN WRITE(ostr,602) io.gt_hostname(1:LTR(io.gt_hostname)) + ,io.gt_port,CHAR(0) 602 FORMAT(' . Graphtool connection : (host:'A + ') (port:'I5')'A) CALL SIMMSG(STATUS,ostr) ENDIF IF (LTR(io.dd_hostname).NE.0.OR. + io.dd_port.NE.0) THEN WRITE(ostr,603) io.dd_hostname(1:LTR(io.dd_hostname)) + ,io.dd_port,CHAR(0) 603 FORMAT(' . Dynaview connection : (host:'A + ') (port:'I5')'A) CALL SIMMSG(STATUS,ostr) ENDIF tmpval = (sim.time.minutes+sim.time.offset_from_midnight)*60 ihr = tmpval / 3600 ihld = tmpval - 3600 * ihr imin = ihld / 60 isc = ihld - 60 * imin ihr = MOD(INT(ihr),24) ! 24-hour time -- wrap at midnight WRITE(ostr,605) sim.time.minutes,ihr,imin,isc,CHAR(0) 605 FORMAT('\n . Simulation time : elapsed: 'F8.1' minutes\n' + ' : clocktime: ' + I2.2':'I2.2':'I2.2,A) CALL SIMMSG(STATUS,ostr) tmpval = (sim.starttm+sim.time.offset_from_midnight)*60 ihr = tmpval / 3600 ihld = tmpval - 3600 * ihr imin = ihld / 60 isc = ihld - 60 * imin ihr = MOD(INT(ihr),24) ! 24-hour time -- wrap at midnight WRITE(ostr,607) ihr,imin,isc,CHAR(0) 607 FORMAT(' : starttime: ' + I2.2':'I2.2':'I2.2,A) CALL SIMMSG(STATUS,ostr) tmpval = (sim.endtm+sim.time.offset_from_midnight)*60 ihr = tmpval / 3600 ihld = tmpval - 3600 * ihr imin = ihld / 60 isc = ihld - 60 * imin ihr = MOD(INT(ihr),24) ! 24-hour time -- wrap at midnight WRITE(ostr,608) ihr,imin,isc,CHAR(0) 608 FORMAT(' : endtime: ' + I2.2':'I2.2':'I2.2,A) CALL SIMMSG(STATUS,ostr) CALL SIMMSG(STATUS,CHAR(0)) CALL SIMMSG(STATUS,' --- Network status ---'//CHAR(0)) WRITE(ostr,604) net.nnodes,net.nlinks,act.nzones + ,act.ndests,sim.jj,net.nin_tag,net.nout_tag,CHAR(0) 604 FORMAT( + '\n . # of nodes : 'I5'\n' + ' . # of links : 'I5'\n' + ' . # of zones : 'I5' ('I5' destinations)\n' + ' . # of vehicles : generated : 'I6'\n' + ' . # of vehicles : tagged in : 'I6'\n' + ' . # of vehicles : tagged out : 'I6'\n'A) CALL SIMMSG(STATUS,ostr) CALL SIMMSG(STATUS,' --- Simulation parameters ---'//CHAR(0)) WRITE(ostr,606) sim.kay,INT(act.dem.fracinf*100.0) + ,INT(act.dem.ribfa*100.0) + ,INT(sim.do_inc_det*100.0) + ,INT(sim.cms_response_level*100.0) + ,CHAR(0) 606 FORMAT( + '\n . k-shrt paths: 'I5'\n' + ' . frac with info: 'I5'%\n' + ' . indiff band: 'I5'%\n' + ' . move inc det %: 'I5'%\n' + ' . cms resp level: 'I5'%\n'A) CALL SIMMSG(STATUS,ostr) RETURN END C ---------------------------------------------------------------------- INTEGER FUNCTION REPORT_NODE(sim,net,dnnum) C ---------------------------------------------------------------------- C - Prints a report about node dnnum. C - INCLUDED FILES: #include "dyna.inc" #include "sim.inc" #include "network.inc" C - UNMODIFIED ARGUMENTS: RECORD /Sim_Data/ sim RECORD /Road_Network/ net INTEGER dnnum ! DYNASMART node number (as opposed to ! user-node number) C - MODIFIED ARGUMENTS: ! NONE C - MODIFIED GLOBAL DATA: ! ostr (see dyna.inc) C - LOCAL VARIABLES: INTEGER nnum ! node number INTEGER l,l1,l2 ! link indices INTEGER im,mv ! movement indices INTEGER kg,np1,np2,np INTEGER icp INTEGER i,j,k INTEGER dsmp CHARACTER activestr*3 C - FUNCTIONS CALLED: INTEGER LTR_C ! function C - RETURN VALUE: ! Non-zero if there was an error C ---------------------------------------------------------------------- REPORT_NODE = 0 nnum = 0 IF (dnnum.GT.0.AND.dnnum.LE.NU_NO) nnum = net.node(dnnum).number IF (nnum.EQ.0) THEN WRITE(ostr,600) nnum,CHAR(0) 600 FORMAT(''A) CALL SIMMSG(STATUS,ostr) REPORT_NODE = 1 RETURN ENDIF WRITE(ostr,601) nnum,dnnum,CHAR(0) 601 FORMAT('---> Node ['I6'](DYNANODE:'I6'):'A) CALL SIMMSG(STATUS,' ') CALL SIMMSG(STATUS,ostr) CR - List the links that enter the node l1 = net.spd.fs.npoint(dnnum) l2 = net.spd.fs.npoint(dnnum+1)-1 IF (l1.LE.l2) THEN WRITE(ostr,602) ' * Links entering node:'//CHAR(0) CALL SIMMSG(STATUS,ostr) 602 FORMAT(A) DO l = l1,l2 WRITE(ostr,603) net.spd.fs.ifwdarc(l,2) + ,net.node(net.spd.fs.ifwdarc(l,1)).number + ,net.link(net.spd.fs.ifwdarc(l,2)).numdslinks + ,CHAR(0) 603 FORMAT(' . #'I5' from node ',I5,': has 'I2 + ' exiting movements',A) CALL SIMMSG(STATUS,ostr) WRITE(ostr,690) CHAR(0) 690 FORMAT(' mv-type to-node grn cap mvd qed'A) CALL SIMMSG(STATUS,ostr) DO im = 1,net.link(net.spd.fs.ifwdarc(l,2)).numdslinks mv = net.link(net.spd.fs.ifwdarc(l,2)).dsmoveptr(im) WRITE(ostr,604) + movestring(net.movement(mv).type)(1:LTR( + movestring(net.movement(mv).type))) + ,net.node(net.link(net.movement(mv).tolink) + .idnod).number,net.movement(mv).green + ,net.movement(mv).capacity + ,net.movement(mv).moved + ,net.movement(mv).queued + ,CHAR(0) 604 FORMAT(' . 'A7,I8,4I4,A) CALL SIMMSG(STATUS,ostr) ENDDO ENDDO ENDIF Cr - Print out the signalization data icp = net.node(dnnum).curplan WRITE(ostr,'(A,I1,A)') + 'Current signalization [' + ,net.node(dnnum).plan(icp).type + ,']'//CHAR(0) CALL SIMMSG(STATUS,ostr) DO i = 1,LEN(ostr) ostr(i:i) = ' ' ENDDO DO i = 1,net.node(dnnum).plan(icp).numphases kg = net.node(dnnum).plan(icp).phaselist(i) IF (net.phase(kg).active.EQ.1) THEN activestr = '==>' ELSE IF (net.phase(kg).active.EQ.2) THEN activestr = ' ->' ELSE IF (net.phase(kg).active.EQ.3) THEN activestr = ' +>' ELSE activestr = ' ' ENDIF WRITE(ostr,'(aA,I2,A,I3,A)') + activestr,' #',i,': [' + ,net.phase(kg).time + ,'s] '//CHAR(0) np1 = net.fs.npoint(dnnum) np2 = net.fs.npoint(dnnum+1)-1 l = 0 DO np = np1,np2 WRITE(ostr,692) ostr(1:LTR_C(ostr)) + ,net.node(net.fs.ifwdarc(np,1)).number + ,net.node(dnnum).number,CHAR(0) 692 FORMAT(A'('I4'->'I4': 'A) k = 0 DO j = 1,5 dsmp = net.phase(kg).movelist(np-np1+1,j) IF (dsmp.NE.0) THEN k = k + 1 l = l + 1 WRITE(ostr,693) ostr(1:LTR_C(ostr)) + ,net.node(net.link( + net.movement(dsmp).tolink).idnod).number + ,movestring(net.movement(dsmp).type)(1: + LTR(movestring(net.movement(dsmp).type))) + ,CHAR(0) 693 FORMAT(A,I4,':'2A) ENDIF ENDDO IF (k.GT.0) THEN WRITE(ostr,'(2A)') ostr(1:LTR_C(ostr)),')'//CHAR(0) CALL SIMMSG(STATUS,ostr) ELSE IF (l.EQ.0.AND.np.EQ.np2) THEN WRITE(ostr(17:100),'(2A)') '(clearance)'//CHAR(0) CALL SIMMSG(STATUS,ostr) ENDIF IF (l.NE.0) THEN WRITE(ostr,'(A)') ' '//CHAR(0) ELSE WRITE(ostr(17:17),'(A)') CHAR(0) ENDIF ENDDO ENDDO RETURN END C ---------------------------------------------------------------------- INTEGER FUNCTION REPORT_LINK(sim,net,qtype,lnum) C ---------------------------------------------------------------------- C - Prints a report about link lnum. (what does qtype do?) C - INCLUDED FILES: #include "dyna.inc" #include "sim.inc" #include "network.inc" #include "queries.inc" C - UNMODIFIED ARGUMENTS: RECORD /Sim_Data/ sim RECORD /Road_Network/ net INTEGER qtype ! query type (see queries.inc) INTEGER lnum ! link number C - MODIFIED ARGUMENTS: ! NONE C - MODIFIED GLOBAL DATA: ! ostr (see dyna.inc) C - LOCAL VARIABLES: INTEGER i,j ! counters INTEGER mv ! move pointer INTEGER ip ! plan index INTEGER n ! node number REAL delaysum !temp var for calculating delay on a movement INTEGER dc ! delay counter REAL tmp REAL critval INTEGER lfrom,lto INTEGER llnum CHARACTER str*20 CHARACTER incstr*5 C - FUNCTIONS CALLED: INTEGER MOVEVOL ! function C - RETURN VALUE: ! Non-zero if there was an error C ---------------------------------------------------------------------- REPORT_LINK = 0 IF (qtype.NE.Q_L_NUMBER) THEN lfrom = 1 lto = net.nlinks critval = lnum ELSE lfrom = lnum lto = lnum ENDIF DO llnum = lfrom,lto IF (llnum.LE.0.OR.llnum.GT.net.nlinks) THEN WRITE(ostr,600) llnum,CHAR(0) 600 FORMAT(''A) CALL SIMMSG(STATUS,ostr) REPORT_LINK = 1 RETURN ELSE IF (qtype.EQ.Q_L_NUMBER.OR. + (qtype.EQ.Q_L_DENSITY.AND. + net.link(llnum).conc.GE.critval).OR. + (qtype.EQ.Q_L_QUEUE.AND. + net.link(llnum).vehicle_queue.GE.critval)) THEN WRITE(ostr,601) llnum,CHAR(0) 601 FORMAT('---> Link ['I6']:'A) CALL SIMMSG(STATUS,' ') CALL SIMMSG(STATUS,ostr) C - Print node numbers WRITE(ostr,602) net.node(net.link(llnum).iunod).number + ,net.node(net.link(llnum).idnod).number + ,CHAR(0) 602 FORMAT(' connects: 'I4'->'I4,A) CALL SIMMSG(STATUS,ostr) C - Print type IF (net.link(llnum).type.EQ.FREEWAY) THEN str = 'freeway' ELSE IF (net.link(llnum).type.EQ.ONRAMP) THEN str = 'on-ramp' ELSE IF (net.link(llnum).type.EQ.OFFRAMP) THEN str = 'off-ramp' ELSE IF (net.link(llnum).type.EQ.ARTERIAL) THEN str = 'arterial' ELSE IF (net.link(llnum).type.EQ.CONNECTOR) THEN str = 'connector' ELSE str = 'unknown' ENDIF WRITE(ostr,603) str,CHAR(0) 603 FORMAT(' type: '2A) CALL SIMMSG(STATUS,ostr) C - Print length WRITE(ostr,604) NINT(net.link(llnum).length*5280) + ,CHAR(0) 604 FORMAT(' length: 'I5'-ft',A) CALL SIMMSG(STATUS,ostr) C - Print number of lanes WRITE(ostr,605) net.link(llnum).nlanes + ,CHAR(0) 605 FORMAT(' # lanes: 'I1,A) CALL SIMMSG(STATUS,ostr) C - Print speed WRITE(ostr,606) net.link(llnum).speed*60.0 + ,CHAR(0) 606 FORMAT(' speed: 'F4.1'-mph',A) CALL SIMMSG(STATUS,ostr) C - Print travel time WRITE(ostr,636) net.link(llnum).statmpt + ,CHAR(0) 636 FORMAT(' avg time: 'F5.2'-min',A) CALL SIMMSG(STATUS,ostr) C - Print average density (concentration) WRITE(ostr,607) NINT(net.link(llnum).conc) + ,CHAR(0) 607 FORMAT('av density: 'I3'-vpmpl',A) CALL SIMMSG(STATUS,ostr) C - Print number of vehicles on the link WRITE(ostr,608) net.link(llnum).npar + ,CHAR(0) 608 FORMAT(' # veh: 'I3,A) CALL SIMMSG(STATUS,ostr) C - Write the link incident flag IF (net.link(llnum).incident_code.NE.0) THEN WRITE(ostr,611) CHAR(0) 611 FORMAT(' status: --- INCIDENT ---'A) CALL SIMMSG(STATUS,ostr) ENDIF C - Print control n = net.link(llnum).idnod ip = net.node(n).curplan IF (net.node(n).plan(ip).type.EQ.CTL_NONE) THEN str = 'none' ELSE IF (net.node(n).plan(ip).type.EQ.CTL_YIELD) THEN str = 'yield' ELSE IF (net.node(n).plan(ip).type.EQ.CTL_STOP) THEN str = 'stop' ELSE IF (net.node(n).plan(ip).type.EQ.CTL_PRETIMED) THEN str = 'pretimed' ELSE IF (net.node(n).plan(ip).type.EQ.CTL_ACTUATED) THEN str = 'actuated' ELSE IF (net.node(n).plan(ip).type.EQ.CTL_EXTERNAL) THEN str = 'external' ELSE str = 'unknown' ENDIF WRITE(ostr,620) str(1:LTR(str)),CHAR(0) 620 FORMAT('ds control: '2A) CALL SIMMSG(STATUS,ostr) C - Print movement information WRITE(ostr,610) CHAR(0) 610 FORMAT(' movements: '10X + ' to | dem | grn | cap | mvd | qed | vol | dly | inc'A) CALL SIMMSG(STATUS,ostr) DO i = 1,net.link(llnum).numdslinks mv = net.link(llnum).dsmoveptr(i) IF (net.movement(mv).type.EQ.LEFT) THEN str = ' left turn:' ELSE IF (net.movement(mv).type.EQ.THROUGH) THEN str = ' through movement:' ELSE IF (net.movement(mv).type.EQ.RIGHT) THEN str = ' right turn:' ELSE IF (net.movement(mv).type.EQ.UTURN) THEN str = ' U-turn:' ELSE IF (net.movement(mv).type.EQ.OTHER) THEN str = ' other movement:' ELSE IF (net.movement(mv).type.EQ.CONN) THEN str = 'connector movement:' ELSE str = 'unknown movement' ENDIF cr$$$ delaysum = 0.D0 cr$$$ dc = 0 cr$$$ DO j = 1,NU_DS cr$$$ IF (net.movement(mv).delaytime(j).GT.0) THEN cr$$$ tmp = MOD(net.movement(mv).delaytime(j),10000.0) cr$$$ delaysum = delaysum + tmp cr$$$ dc = dc + INT(net.movement(mv).delaytime(j)/10000) cr$$$ ENDIF cr$$$ ENDDO cr$$$ IF (dc.GT.0) THEN cr$$$ delaysum = delaysum/dc cr$$$ ELSE cr$$$C - Delay is longer than rolling horizon period, use length cr$$$C - of queue as estimate (bad -- see penaltycal) cr$$$ delaysum = net.movement(mv).queued*sim.timestep cr$$$ ENDIF IF (net.movement(mv).incident_code.NE.0) THEN incstr = ' Yes' ELSE incstr = ' ' ENDIF WRITE(ostr,609) str(1:LTR(str)) + ,net.node( + net.link(net.movement(mv).tolink).idnod).number + ,net.movement(mv).demand + ,net.movement(mv).green + ,net.movement(mv).capacity + ,net.movement(mv).moved + ,net.movement(mv).queued + ,MOVEVOL(sim,net,llnum,INT(net.movement(mv).type)) + ,net.movement(mv).penalty + ,CHAR(0) 609 FORMAT('. 'A,7I6,F7.2,A5,A) CALL SIMMSG(STATUS,ostr) ENDDO ENDIF ENDDO RETURN END C ---------------------------------------------------------------------- INTEGER FUNCTION REPORT_ZONE(sim,net,act,zindex) C ---------------------------------------------------------------------- C - Prints a report about zone znum. C - INCLUDED FILES: #include "dyna.inc" #include "sim.inc" #include "network.inc" #include "activity.inc" C - UNMODIFIED ARGUMENTS: RECORD /Sim_Data/ sim RECORD /Road_Network/ net RECORD /Activity/ act INTEGER zindex !DYNASMART zone index C - MODIFIED ARGUMENTS: ! NONE C - MODIFIED GLOBAL DATA: ! ostr (see dyna.inc) C - LOCAL VARIABLES: INTEGER i,j,k INTEGER zonenum INTEGER gen INTEGER reach INTEGER destnode REAL infotto REAL noinfotto INTEGER tinfogen INTEGER tnoinfogen INTEGER tinforeach INTEGER tnoinforeach C - FUNCTIONS CALLED: ! NONE C - RETURN VALUE: ! Non-zero if there was an error C ---------------------------------------------------------------------- REPORT_ZONE = 0 IF (act.zone(zindex).number.EQ.0) THEN WRITE(ostr,600) zindex,CHAR(0) 600 FORMAT(''A) CALL SIMMSG(STATUS,ostr) REPORT_ZONE = 1 RETURN ENDIF zonenum = act.zone(zindex).number destnode = act.zone(zindex).destnode IF (destnode.LE.0) THEN destnode = 0 ELSE destnode = net.node(destnode).number ENDIF WRITE(ostr,'(A,I5,A,I5,A,I5,A,I5,A)') + 'ZONE [',zonenum,'] (DYNAzone = ',zindex + ,') (Destindex = ',act.zone(zindex).destindex + ,') (Destnode = ',destnode + ,')'//CHAR(0) CALL SIMMSG(STATUS,ostr) reach = 0 gen = 0 infotto = 0.D0 noinfotto = 0D0 tinfogen = 0 tnoinfogen = 0 tinforeach = 0 tnoinforeach = 0 DO i = 1,act.nzones DO j = 0,1 DO k = 0,1 gen = gen + act.zone(zindex).ngen(j,k,i) reach = reach + act.zone(zindex).nreach(i,j,k) ENDDO ENDDO tinfogen = tinfogen + act.zone(zindex).ngen(1,1,i) tnoinfogen = tnoinfogen + act.zone(zindex).ngen(1,0,i) tinforeach = tinforeach + act.zone(zindex).nreach(i,1,1) tnoinforeach = tnoinforeach + act.zone(zindex).nreach(i,1,0) infotto = infotto + act.zone(zindex).tto(i,1) noinfotto = noinfotto + act.zone(zindex).tto(i,0) ENDDO WRITE(ostr,601) gen,tinfogen,tnoinfogen,CHAR(0) 601 FORMAT(' Generated: t['I5'] info['I5'] noinfo['I5']'A) CALL SIMMSG(STATUS,ostr) WRITE(ostr,602) reach,tinforeach,infotto/tinforeach + ,tnoinforeach,noinfotto/tnoinforeach,CHAR(0) 602 FORMAT(' Reached: t['I5'] info(#['I5'] avtm[' + ,F4.1']) ','noinfo(#['I5'] avtm['F4.1'])'A) CALL SIMMSG(STATUS,ostr) RETURN END C ---------------------------------------------------------------------- INTEGER FUNCTION SHOW_VEHICLE(sim,net,act,veh,jnum,jind) C ---------------------------------------------------------------------- C - Prints a report about vehicle jnum, lists all vehicles in the C - network (jnum = 0), or lists all vehicles on a given link (jnum) C - INCLUDED FILES: #include "dyna.inc" #include "sim.inc" #include "network.inc" #include "activity.inc" #include "vehicle.inc" C - UNMODIFIED ARGUMENTS: RECORD /Sim_Data/ sim RECORD /Road_Network/ net RECORD /Activity/ act RECORD /Vehicle_Data/ veh(NU_VE) INTEGER jnum ! vehicle number INTEGER jind ! vehicle index C - MODIFIED ARGUMENTS: ! NONE C - MODIFIED GLOBAL DATA: ! ostr (see dyna.inc) C - LOCAL VARIABLES: INTEGER il,im,atn,dsn REAL tmp CHARACTER str*20 C - FUNCTIONS CALLED: ! NONE C - RETURN VALUE: ! Non-zero if there was an error C ---------------------------------------------------------------------- SHOW_VEHICLE = 0 WRITE(ostr,601) jnum,jind,CHAR(0) 601 FORMAT('---> Vehicle ['I6']('I6'):'A) CALL SIMMSG(STATUS,' ') CALL SIMMSG(STATUS,ostr) IF (jind.EQ.-1) THEN CALL SIMMSG(STATUS,' has exited the network') ELSE C - Print operational information about the vehicle WRITE(ostr,610) veh(jind).info,CHAR(0) 610 FORMAT(' info: ['I1']'A) CALL SIMMSG(STATUS,ostr) WRITE(ostr,611) veh(jind).ifamiliar,CHAR(0) 611 FORMAT(' familiar: ['I1']'A) CALL SIMMSG(STATUS,ostr) WRITE(ostr,620) veh(jind).zfrom_index,CHAR(0) 620 FORMAT(' origin: ['I4']'A) CALL SIMMSG(STATUS,ostr) WRITE(ostr,621) veh(jind).stime,CHAR(0) 621 FORMAT(' start tm: ['F7.2']-mins from simulation start'A) CALL SIMMSG(STATUS,ostr) WRITE(ostr,612) veh(jind).jdest + ,act.zone(act.dest2zone(veh(jind).jdest)).number + ,net.node(act.zone( + act.dest2zone(veh(jind).jdest)) + .destnode).number,CHAR(0) 612 FORMAT(' dest: ['I4'] zone: ['I3 + '] node: ['I4']'A) CALL SIMMSG(STATUS,ostr) C - Print the vehicle's current link # il = veh(jind).curlink WRITE(ostr,602) il + ,net.node(net.link(il).iunod).number + ,net.node(net.link(il).idnod).number + ,CHAR(0) 602 FORMAT(' link: ['I4'] ('I4'->'I4')'A) CALL SIMMSG(STATUS,ostr) C - Print the vehicle's current position IF (veh(jind).qstatus.EQ.IN_GENQ) THEN C - The vehicle is in a generation queue WRITE(ostr,6013) CHAR(0) 6013 FORMAT(' position: in the generation queue'A) CALL SIMMSG(STATUS,ostr) ELSE C - The vehicle is in the network WRITE(ostr,603) NINT(veh(jind).xpar*5280) + ,NINT((net.link(il).length-veh(jind).xpar)/ + net.link(il).length*100.0) + ,CHAR(0) 603 FORMAT(' position: 'I5'-ft from the downstream node' + ,'('I3'% of link length)'A) CALL SIMMSG(STATUS,ostr) C - Print the vehicle's current speed IF (veh(jind).qstatus.EQ.IN_ENDQ) THEN im = net.movement(veh(jind).mvindex).type atn = net.link(net.movement(veh(jind).mvindex) + .tolink).iunod dsn = net.link(net.movement(veh(jind).mvindex) + .tolink).idnod IF (im.EQ.1) str = 'left turn' IF (im.EQ.2) str = 'through move' IF (im.EQ.3) str = 'right turn' IF (im.EQ.4) str = 'U turn' IF (im.EQ.5) str = 'unknown move' IF (im.EQ.6) str = 'connector move' WRITE(ostr,604) veh(jind).tqwait + ,net.node(atn).number + ,str(1:LTR(str)) + ,net.node(dsn).number,CHAR(0) 604 FORMAT(' queued: for ['F6.2']-mins at node [' + I4'] making a ' + A' to node ['I4']'A) ELSE tmp = net.link(il).speed*60.0 WRITE(ostr,605) tmp,CHAR(0) 605 FORMAT(' speed: 'F4.1'-mph',A) ENDIF CALL SIMMSG(STATUS,ostr) ENDIF C - Show the vehicle's travel time and queued time WRITE(ostr,606) veh(jind).ttilnow,veh(jind).tqtot,CHAR(0) 606 FORMAT(' ttime: ['F6.1'] total; ['F6.1'] queued'A) CALL SIMMSG(STATUS,ostr) Cr - Show the vehicle's path CALL SHOW_PATH(net,act,veh(jind),'path: ') ENDIF RETURN END C ---------------------------------------------------------------------- INTEGER FUNCTION REPORT_VEHICLE(sim,net,act,veh,jnum,flag) C ---------------------------------------------------------------------- C - Prints a report about vehicle jnum, lists all vehicles in the C - network (jnum = 0), or lists all vehicles on a given link (jnum) C - INCLUDED FILES: #include "dyna.inc" #include "sim.inc" #include "network.inc" #include "activity.inc" #include "vehicle.inc" C - UNMODIFIED ARGUMENTS: RECORD /Sim_Data/ sim RECORD /Road_Network/ net RECORD /Activity/ act RECORD /Vehicle_Data/ veh(NU_VE) INTEGER jnum ! vehicle number (if > 0) ! link index (if < 0) INTEGER flag ! for link search ! = ON_LINK for veh on link ! = ON_ENDQ for veh on endq ! = ON_GENQ for veh on genq C - MODIFIED ARGUMENTS: ! NONE C - MODIFIED GLOBAL DATA: ! ostr (see dyna.inc) C - LOCAL VARIABLES: INTEGER jind ! vehicle index INTEGER i C - FUNCTIONS CALLED: ! NONE C - RETURN VALUE: ! Non-zero if there was an error C ---------------------------------------------------------------------- REPORT_VEHICLE = 0 IF (jnum.LT.-net.nlinks.OR.jnum.GT.MAX_VE) THEN Cr - This is an invalid flag WRITE(ostr,633) jnum,CHAR(0) 633 FORMAT(''A) CALL DYNA_ERROR(ostr + ,DYNA_NONFATAL_WARNING + ,DYNA_INPUT_ERROR + ,DYNA_INVALID_VEHICLE) REPORT_VEHICLE = 1 RETURN ENDIF IF (jnum.EQ.0) THEN ! request to find all tagged vehicles DO i = 1,sim.jj jind = sim.veh_ptr(i) IF ( jind.GT.0 ) THEN IF (jind.GT.NU_VE) THEN WRITE(ostr,'(A,I6,A,I6,A)') + 'Invalid vehicle index in report [' + ,jind,', ',i,']'//CHAR(0) CALL DYNA_ERROR(ostr + ,DYNA_FATAL_ERROR + ,DYNA_LOGIC_BUG + ,DYNA_INVALID_VEHICLE) ELSE IF (veh(jind).itag.EQ.1) THEN CALL SHOW_VEHICLE(sim,net,act,veh,i,jind) ENDIF ENDIF ENDDO ELSE IF (jnum.LT.0) THEN CALL SIMMSG(STATUS,'--- Vehicles waiting to be generated'// + ' on link ---'//CHAR(0)) jind = net.link(-jnum).on_genq.first DO WHILE(jind.NE.-1) CALL SHOW_VEHICLE(sim,net,act,veh,veh(jind).number,jind) jind = veh(jind).nextveh ENDDO CALL SIMMSG(STATUS,'--- Vehicles moving on link ---'//CHAR(0)) jind = net.link(-jnum).on_link.first DO WHILE(jind.NE.-1) CALL SHOW_VEHICLE(sim,net,act,veh,veh(jind).number,jind) jind = veh(jind).nextveh ENDDO CALL SIMMSG(STATUS,'--- Vehicles queued on link ---'//CHAR(0)) jind = net.link(-jnum).on_endq.first DO WHILE(jind.NE.-1) CALL SHOW_VEHICLE(sim,net,act,veh,veh(jind).number,jind) jind = veh(jind).nextveh ENDDO ELSE jind = sim.veh_ptr(jnum) IF (jind.EQ.0) THEN WRITE(ostr,600) jnum,CHAR(0) 600 FORMAT(''A) CALL SIMMSG(STATUS,ostr) ELSE CALL SHOW_VEHICLE(sim,net,act,veh,jnum,jind) ENDIF ENDIF RETURN END C ---------------------------------------------------------------------- INTEGER FUNCTION SHOW_PATH(net,act,veh,label) C ---------------------------------------------------------------------- C - Prints a report about a vehicle's path with the text label: label C - INCLUDED FILES: #include "dyna.inc" #include "network.inc" #include "vehicle.inc" #include "activity.inc" C - UNMODIFIED ARGUMENTS: RECORD /Road_Network/ net RECORD /Vehicle_Data/ veh RECORD /Activity/ act CHARACTER label*(*) C - MODIFIED ARGUMENTS: ! NONE C - MODIFIED GLOBAL DATA: ! ostr (see dyna.inc) C - LOCAL VARIABLES: INTEGER ii INTEGER jj INTEGER ilnk INTEGER itodn REAL psum CHARACTER spacefmt*80 CHARACTER ostrl*1024 LOGICAL done INTEGER ithk INTEGER icol INTEGER rindex,aindex C - FUNCTIONS CALLED: REAL PATHTIME ! function INTEGER LTR_C ! function INTEGER LINKNUM ! function C - RETURN VALUE: ! Non-zero if there was an error C ---------------------------------------------------------------------- SHOW_PATH = 0 psum = 1000000.0 itodn = act.destlist(veh.jdest) ii = 1 done = .FALSE. DO WHILE(.NOT.done + .AND. + ii.LE.NU_PA) IF (ii.EQ.1) THEN WRITE(ostrl,603) label,PATHTIME(veh,net,act) + ,NINT(exp(-1.D0*PATHTIME(veh,net,act))/ + psum*100.0) + ,CHAR(0) 603 FORMAT(' 'A'('F6.2')<'I3'>: ',A) WRITE(spacefmt,60001) LTR_C(ostrl)-2 60001 FORMAT('('I3'X2H: ,A)') ELSE WRITE(ostrl,spacefmt) CHAR(0) ENDIF jj = 1 DO WHILE(MOD(INT(jj),10).NE.0 + .AND. + veh.jpath(ii).NE.itodn + .AND. + ii.LE.NU_PA) WRITE(ostrl(LTR_C(ostrl)+1:200),604) + net.node(veh.jpath(ii)).number,CHAR(0) 604 FORMAT(I4,A) ii = ii + 1 jj = jj + 1 C - EXTERNAL: Plot the path on GRAPHTOOL CR - FIX: IF (ii.LE.NU_PA.AND.veh.jpath(ii).NE.0) THEN ilnk = LINKNUM(net.fs,int(veh.jpath(ii-1)) + ,int(veh.jpath(ii)),rindex,aindex) ithk = 1 icol = 0 net.link(ilnk).holdc = -10000 ! force redraw crcrcr CALL GT_LINK_DRAW(ilnk,ithk,icol) ENDIF ENDDO WRITE(ostrl(LTR_C(ostrl)+1:200),604) + net.node(veh.jpath(ii)).number,CHAR(0) CALL SIMMSG(STATUS,ostrl) IF (veh.jpath(ii).EQ.itodn) THEN done = .TRUE. ELSE ii = ii + 1 ENDIF ENDDO RETURN END C ---------------------------------------------------------------------- INTEGER FUNCTION REPORT_PATH(sim,net,act,nfrom,nat,dest) C ---------------------------------------------------------------------- C - Prints a report about all paths (shortest, equilibrium, and cms C - [not cms yet!!!]) from the end of the link (nfrom->nat) to the C - destination zone dest (note that dest is a zone number, not a C - destination index). C - INCLUDED FILES: #include "dyna.inc" #include "sim.inc" #include "network.inc" #include "vehicle.inc" #include "activity.inc" C - UNMODIFIED ARGUMENTS: RECORD /Sim_Data/ sim RECORD /Road_Network/ net RECORD /Vehicle_Data/ veh RECORD /Activity/ act INTEGER nfrom INTEGER nat INTEGER dest C - MODIFIED ARGUMENTS: ! NONE C - MODIFIED GLOBAL DATA: ! ostr (see dyna.inc) C - LOCAL VARIABLES: INTEGER ik INTEGER il INTEGER itodz ! destination index of zone dest INTEGER itodn ! destination node of dest REAL psum CHARACTER tmpstr*40 INTEGER ires ! function call result INTEGER rindex INTEGER aindex INTEGER im INTEGER know INTEGER ip,ipp C - FUNCTIONS CALLED: INTEGER LINKNUM ! function INTEGER LINKMOVEINDEX !function INTEGER PATHUPDATE ! function !SHOW_PATH C - RETURN VALUE: ! Non-zero if there was an error C ---------------------------------------------------------------------- REPORT_PATH = 0 Cr - Verify link number il = LINKNUM(net.fs,nfrom,nat,rindex,aindex) IF (il.EQ.0) THEN WRITE(ostr,600) nfrom,nat,CHAR(0) 600 FORMAT(''I5']>',A) CALL SIMMSG(STATUS,ostr) RETURN ENDIF Cr - Verify zone exists and is a destination itodz = act.zone(dest).destindex IF (itodz.LE.0) THEN WRITE(ostr,601) dest,CHAR(0) 601 FORMAT('',A) CALL SIMMSG(STATUS,ostr) RETURN ENDIF itodn = act.destlist(itodz) WRITE(ostr,602) nfrom,nat,dest,CHAR(0) 602 FORMAT('---> Paths from ['I5'->'I5'] to zone ['I5']:',A) CALL SIMMSG(STATUS,ostr) Cr - Determine the movement index of the entering link im = LINKMOVEINDEX(net,il,0) Cr - Get the logit sum of the shortest path travel times psum = 0.D0 DO ik = 1,sim.kay know = net.spd.lod.labelpointerout(itodz,il,ik) psum = psum + EXP(-1.D0*net.spd.lod.labelout(itodz,il,know) + *sim.logit_smooth_factor) ENDDO DO ik = 1,sim.kay Cr - Retreive the ik'th shortest path veh.jdest = itodz veh.icurrnt = 2 know = net.spd.lod.labelpointerout(itodz,il,ik) IF (know.NE.0) THEN ires = PATHUPDATE(ik,net,act,il,veh,2) WRITE(tmpstr,60069) ik + ,net.spd.lod.labelout(itodz,il,know) + ,NINT(EXP(-1.D0* + net.spd.lod.labelout(itodz,il,know) + )*sim.logit_smooth_factor/psum*act.dem.fracinf*100) 60069 FORMAT('SRT PATH 'I1' ('F6.2')<'I3'>:'A) CALL SHOW_PATH(net,act,veh,tmpstr(1:LTR(tmpstr))) ELSE WRITE(ostr,60080) ik,CHAR(0) 60080 FORMAT(' - No 'I1'th path from this link -'A) CALL SIMMSG(STATUS,ostr) ENDIF ENDDO tmpstr = 'EQUL' veh.jdest = itodz Cr - Get the logit sum of the eq path travel times psum = 0.D0 ik = 1 DO WHILE(ik.LE.sim.kay) know = net.leqpd.labelpointerout(itodz,il,ik) psum = psum + EXP(-1.D0*net.leqpd.labelout(itodz,il,know) + *sim.logit_smooth_factor) ik = ik + 1 ENDDO ik = 1 ires = 0 DO WHILE(ik.LE.sim.kay + .AND. + ires.EQ.0) veh.icurrnt = 2 know = net.leqpd.labelpointerout(itodz,il,ik) IF (know.NE.0) THEN ires = PATHUPDATE(-ik,net,act,il,veh,2) IF (ires.EQ.0) THEN WRITE(tmpstr,60070) ik + ,net.leqpd.labelout(itodz,il,know) + ,NINT(EXP(-1.D0* + net.leqpd.labelout(itodz,il,know) + )*sim.logit_smooth_factor/psum* + (1.D0-act.dem.fracinf) + *100) 60070 FORMAT('EQL PATH 'I1' ('F6.2')<'I3'>:'A) CALL SHOW_PATH(net,act,veh,tmpstr(1:LTR(tmpstr))) ELSE WRITE(ostr,60080) ik,CHAR(0) ENDIF ENDIF ik = ik + 1 ENDDO tmpstr = 'EXT ' veh.jdest = itodz ipp = net.link(il).linkdest(veh.jdest) ip = 1 DO WHILE(ipp.NE.0) veh.icurrnt = 2 ires = PATHUPDATE(-ip-100,net,act,il,veh,2) IF (ires.EQ.0) THEN WRITE(tmpstr,60071) ik 60071 FORMAT('EXT PATH 'I1' ') CALL SHOW_PATH(net,act,veh,tmpstr(1:LTR(tmpstr))) ELSE WRITE(ostr,60080) ik,CHAR(0) ENDIF ipp = net.eqpath(ipp).next ip = ip + 1 ENDDO tmpstr = 'CMS ' veh.jdest = itodz ipp = net.link(il).cmslink(veh.jdest) ip = 1 DO WHILE(ipp.NE.0) veh.icurrnt = 2 ires = PATHUPDATE(-ip-200,net,act,il,veh,2) IF (ires.EQ.0) THEN WRITE(tmpstr,60072) ik 60072 FORMAT('CMS PATH 'I1' ') CALL SHOW_PATH(net,act,veh,tmpstr(1:LTR(tmpstr))) ELSE WRITE(ostr,60080) ik,CHAR(0) ENDIF ipp = net.cmspath(ipp).next ip = ip + 1 ENDDO RETURN END C ---------------------------------------------------------------------- INTEGER FUNCTION REPORT_CMS(net,cms) C ---------------------------------------------------------------------- C - Reports the currently displayed message at CMS cmsnum or, if C - specified the information about a specific message msgnum which is C - available at the CMS. C - INCLUDED FILES: #include "dyna.inc" #include "network.inc" #include "par.inc" C - UNMODIFIED ARGUMENTS: RECORD /Road_Network/ net RECORD /CMS_PARAM/ cms C - MODIFIED ARGUMENTS: ! NONE C - MODIFIED GLOBAL DATA: ! ostr (see dyna.inc) C - LOCAL VARIABLES: INTEGER from,to INTEGER i INTEGER cmsi INTEGER msgi INTEGER cmsnum INTEGER msgnum C - FUNCTIONS CALLED: ! SIMMSG C - RETURN VALUE: ! Non-zero if there was an error C ---------------------------------------------------------------------- REPORT_CMS = 0 cmsnum = cms.id.number msgnum = cms.msg IF (cmsnum.LE.0.OR.cmsnum.GT.MAX_CMS_NUMBER) THEN WRITE(ostr,'(A,I5,A)') + 'Invalid CMS number [',cmsnum + ,'] requested'//CHAR(0) CALL DYNA_ERROR(ostr + ,DYNA_NONFATAL_WARNING + ,DYNA_INPUT_ERROR + ,DYNA_INVALID_CMS_NUMBER) REPORT_CMS = 1 RETURN ENDIF CR - Get index of cms message cmsi = net.cmsnumber(cmsnum) IF (cmsi.LE.0.OR.cmsi.GT.MAX_CMS) THEN WRITE(ostr,'(A,I5,A)') + 'Invalid CMS [',cmsnum + ,'] requested' + //CHAR(0) CALL DYNA_ERROR(ostr + ,DYNA_NONFATAL_WARNING + ,DYNA_INPUT_ERROR + ,DYNA_INVALID_CMS_NUMBER) REPORT_CMS = 1 RETURN ENDIF IF (net.cms(cmsi).number.EQ.0) THEN WRITE(ostr,'(A,I5,A)') + 'Invalid CMS [',cmsnum + ,'] requested' + //CHAR(0) CALL DYNA_ERROR(ostr + ,DYNA_NONFATAL_WARNING + ,DYNA_INPUT_ERROR + ,DYNA_INVALID_CMS_NUMBER) REPORT_CMS = 1 RETURN ENDIF IF (msgnum.EQ.0) THEN from = 1 to = net.cms(cmsi).nummsgs ELSE IF (msgnum.LT.0.OR.msgnum.GT.MAX_CMS_MSG_NUMBER) THEN WRITE(ostr,'(A,I5,A)') + 'Invalid MSG number [',msgnum + ,'] requested'//CHAR(0) CALL DYNA_ERROR(ostr + ,DYNA_NONFATAL_WARNING + ,DYNA_INPUT_ERROR + ,DYNA_INVALID_MSG_NUMBER) REPORT_CMS = 1 RETURN ENDIF msgi = net.cms(cmsi).msgnumber(msgnum) IF (msgi.LE.0.OR.msgi.GT.MAX_CMS_MSGS) THEN WRITE(ostr,'(A,I5,A)') + 'Invalid MSG [',msgnum + ,'] requested' + //CHAR(0) CALL DYNA_ERROR(ostr + ,DYNA_NONFATAL_WARNING + ,DYNA_INPUT_ERROR + ,DYNA_INVALID_MSG_NUMBER) REPORT_CMS = 1 RETURN ENDIF IF (net.cms(cmsi).msglist(msgi).number.EQ.0) THEN WRITE(ostr,'(A,I5,A)') + 'Invalid CMS MSG [',msgnum + ,'] requested' + //CHAR(0) CALL DYNA_ERROR(ostr + ,DYNA_NONFATAL_WARNING + ,DYNA_INPUT_ERROR + ,DYNA_INVALID_CMS_NUMBER) REPORT_CMS = 1 RETURN ENDIF from = msgi to = msgi ENDIF DO i = from,to IF (net.cms(cmsi).msglist(i).on) THEN WRITE(ostr,'(A,I2,3A)') '. #' + ,net.cms(cmsi).msglist(i).number + ,' ACTIVE MESSAGE: "' + ,net.cms(cmsi).msglist(i).message(1: + LTR(net.cms(cmsi).msglist(i).message)) + ,'"'//CHAR(0) ELSE WRITE(ostr,'(A,I2,3A)') '. #' + ,net.cms(cmsi).msglist(i).number + ,' INACTIVE MESSAGE: "' + ,net.cms(cmsi).msglist(i).message(1: + LTR(net.cms(cmsi).msglist(i).message)) + ,'"'//CHAR(0) ENDIF CALL SIMMSG(STATUS,ostr) ENDDO RETURN END