C ---------------------------------------------------------------------- INTEGER FUNCTION INIT_PATHS(io,sim,net,act) C ---------------------------------------------------------------------- C - Top level routine used to completely initialize the shortest and C - equilibrium paths in the network C - INCLUDED FILES: #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 C - MODIFIED ARGUMENTS: RECORD /Road_Network/ net RECORD /Activity/ act C - MODIFIED GLOBAL DATA: ! NONE C - LOCAL VARIABLES: INTEGER i,k INTEGER izn C - FUNCTIONS CALLED: ! READ_CMS_PATHS ! UPDATEPATHS C - RETURN VALUE: ! Non-zero if there was an error C ---------------------------------------------------------------------- INIT_PATHS = 0 C - zero EQ path pointers DO i = 1,NU_LI DO izn = 1,NU_ZN net.link(i).linkdest(izn) = 0 ENDDO ENDDO C - zero EQ path list net.npp = 0 DO i = 1,MAX_EQP DO k = 1,NU_PA net.eqpath(i).list(k) = 0 ENDDO net.eqpath(i).next = 0 net.eqpath(i).priority = 0.D0 net.eqpath(i).tot = 0 ENDDO CALL UPDATEPATHS(io,sim,net,act,3) ! initialize shortest & eq paths CALL CMS_INIT(net) REWIND(CMS_FILE) CALL READSTAT('cms data',CMS_FILE) CALL READ_CMS_PATHS(CMS_FILE,net,act) RETURN END C ---------------------------------------------------------------------- INTEGER FUNCTION UPDATEPATHS(io,sim,net,act,ijob) C ---------------------------------------------------------------------- C - Routine which calls the k-shortest path update routine, C - equilibrium path update routine (either rebuild if ipinit = 1 or C - read from file if ipinit = 2). The path updates occur at C - intervals specified by the user in opts.dat and read in DYNAINIT C - (if ijob = 1 or 3?) or immediately (if ijob = 2?) C - INCLUDED FILES: #include "dyna.inc" #include "io.inc" #include "sim.inc" #include "network.inc" #include "activity.inc" C - UNMODIFIED ARGUMENTS: RECORD /Io_Data/ io INTEGER ijob ! command flag C - MODIFIED ARGUMENTS: RECORD /Sim_Data/ sim RECORD /Road_Network/ net RECORD /Activity/ act C - MODIFIED GLOBAL DATA: ! ostr (see dyna.inc) C - LOCAL VARIABLES: INTEGER ires C - FUNCTIONS CALLED: INTEGER KSHORT !function INTEGER PATH_UPDATE !function C - RETURN VALUE: ! Simulation status C ---------------------------------------------------------------------- C - PERFORM SHORTEST PATH CALCULATIONS C - Shortest paths on the network are recalculated at a frequency C - specified by the kspstep parameter (read from opts datafile). IF (((sim.iter)/sim.kspstep)*sim.kspstep + .EQ.sim.iter + .OR. + ijob.EQ.1.OR.ijob.EQ.3) THEN CALL SIMMSG(STATUS,'Updating Shortest Paths...') net.spd.p.kay = sim.kay ires = KSHORT(net,act) IF (ires.EQ.1) sim.status = SIM_ERROR IF (sim.status.EQ.SIM_ERROR) THEN UPDATEPATHS = 1 RETURN ENDIF ELSE IF (((sim.iter)/sim.pustep)*sim.pustep + .EQ.sim.iter) THEN ires = PATH_update(net,act) IF (ires.EQ.1) sim.status = SIM_ERROR IF (sim.status.EQ.SIM_ERROR) THEN UPDATEPATHS = 1 RETURN ENDIF ENDIF C --- ================================================================== C - PERFORM EQULIBRIUM PATH CALCULATIONS C [CHANGE NEEDED] Once again, the way equilibrium paths are handled C really needs to be updated. C - Equilibrium paths are calculated from the shortest paths at the C - end of the warm-up period (when vehicles start getting tagged) and C - are updated every keqpstep iterations thereafter. IF ((((sim.iter)/sim.keqpstep)*sim.keqpstep + .EQ.sim.iter.OR. + sim.iter.EQ.NINT(sim.starttm/sim.timestep)) + .OR. + ijob.EQ.2.OR.ijob.EQ.3) THEN CALL COPY_EQ_PATHS(net,act) ENDIF IF (sim.ipinit.EQ.2) THEN CALL GET_NEXT_EQPATH(io,sim,net) ENDIF UPDATEPATHS = sim.status RETURN END C ---------------------------------------------------------------------- REAL FUNCTION PATHTIME(veh,net,act) C ---------------------------------------------------------------------- C - Calculate the current travel time for a given vehicle's jpath. C - INCLUDED FILES: #include "dyna.inc" #include "vehicle.inc" #include "network.inc" #include "activity.inc" C - UNMODIFIED ARGUMENTS: RECORD /Vehicle_Data/ veh RECORD /Road_Network/ net RECORD /Activity/ act C - MODIFIED ARGUMENTS: ! NONE C - MODIFIED GLOBAL DATA: ! ostr (see dyna.inc) C - LOCAL VARIABLES: INTEGER itodz,itodn,np,np2,icu,k,nexnod,l,in,il INTEGER np1 INTEGER rindex,aindex C - FUNCTIONS CALLED: ! SIMMSG INTEGER LINKNUM !function C - RETURN VALUE: ! The travel cost (in minutes) along a vehicle's path starting ! from it's current location (icurrnt) to its destination C ---------------------------------------------------------------------- PATHTIME = 0.0 itodz = veh.jdest itodn = act.destlist(itodz) IF (veh.jpath(veh.icurrnt-1).EQ.itodn.OR. + veh.jpath(veh.icurrnt).EQ.itodn) RETURN CRMI c$$$ np = net.fs.npoint(veh.jpath(veh.icurrnt)) c$$$ np2 = net.fs.npoint(veh.jpath(veh.icurrnt)+1) c$$$ c$$$ DO WHILE(net.fs.ifwdarc(np,1).NE.veh.jpath(veh.icurrnt-1) c$$$ + .AND.np.LE.np2) c$$$ np = np + 1 c$$$ ENDDO c$$$ c$$$ icu = net.fs.ifwdarc(np,2) c$$$ c$$$ IF (np.GT.np2) THEN c$$$ WRITE(ostr,'(2A)') 'pathtime: link not found',CHAR(0) c$$$ CALL SIMMSG(STATUS,ostr) c$$$ RETURN c$$$ ENDIF icu = LINKNUM(net.fs,INT(veh.jpath(veh.icurrnt-1)) + ,INT(veh.jpath(veh.icurrnt)),rindex,aindex) np = aindex IF (veh.jpath(veh.icurrnt).EQ.itodn) RETURN DO k = veh.icurrnt+1,NU_PA nexnod = veh.jpath(k) DO l=net.fs.npoint(nexnod),net.fs.npoint(nexnod+1)-1 IF (veh.jpath(k-1).EQ.net.fs.ifwdarc(l,1)) then PATHTIME = PATHTIME + + net.link(net.fs.ifwdarc(l,2)).statmpt go to 94 endif ENDDO 94 continue in = net.fs.ifwdarc(l,1) il = net.fs.ifwdarc(l,2) c -- c -- penalty for movements c -- nexnod -> backpointr -> backstr1 ->iunod ->backstr1 c -- penalty ip ii c -- c IF (use_file(99)) THEN c write(99,*) 'l-no ',icu,in,il,nexnod c write(99,*) 'po: ',nexnod,backpointr(nexnod) c + ,backpointr(nexnod+1) c ENDIF np1 = net.spd.bsd.backpointr(in) np2 = net.spd.bsd.backpointr(in+1)-1 np = np1 DO WHILE(np.LE.np2 + .AND. + net.spd.bsd.backstr1(np) + .NE. + net.link(icu).iunod) np = np + 1 ENDDO IF (np.GT.np2) THEN CALL DYNA_ERROR('Error calculating penalty'//CHAR(0) + ,DYNA_FATAL_ERROR + ,DYNA_LOGIC_BUG + ,DYNA_PENALTYCAL_ERROR) ENDIF PATHTIME = PATHTIME + net.spd.pn.penalty(l,np-np1+1) c$$$ do kk=net.spd.bsd.backpointr(nexnod), c$$$ + net.spd.bsd.backpointr(nexnod+1)-1 c$$$ c$$$ if (net.spd.bsd.backstr1(kk).eq.in) then c$$$ ii = 1 c$$$ do ik=net.spd.bsd.backpointr(in), c$$$ + net.spd.bsd.backpointr(in+1)-1 c$$$ c$$$ if (net.spd.bsd.backstr1(ik) c$$$ + .NE. c$$$ + net.link(icu).iunod) then c$$$ ii = ii + 1 c$$$ else c$$$ PATHTIME = PATHTIME + net.spd.pn.penalty(kk,ii) c$$$ go to 99 c$$$ endif c$$$ end do c$$$ endif c$$$ end do c$$$ 99 continue icu = il IF (nexnod.EQ.act.destlist(veh.jdest)) RETURN ENDDO WRITE(ostr,'(A,I6,2A)') 'Vehicle ',veh.number + ,'''s destination not found in it''s path!',CHAR(0) CALL SIMMSG(STATUS,ostr) RETURN END C ---------------------------------------------------------------------- INTEGER FUNCTION GET_NEXT_EQPATH(io,sim,net) C ---------------------------------------------------------------------- C - Reads equilibrium paths starting at the current record in the path C - file until the timestamp of the path read is greater than the C - current simulation time. C - INCLUDED FILES: #include "dyna.inc" #include "io.inc" #include "sim.inc" #include "network.inc" C - UNMODIFIED ARGUMENTS: RECORD /Io_Data/ io RECORD /Sim_Data/ sim C - MODIFIED ARGUMENTS: RECORD /Road_Network/ net C - MODIFIED GLOBAL DATA: REAL eqptime LOGICAL first_call COMMON /LOCAL_GET_NEXT_EQ_PATH/ eqptime,first_call ! ostr (see dyna.inc) C - LOCAL VARIABLES: INTEGER i,k,il,itodz,itmp INTEGER eqplen,idum INTEGER pathlist(NU_PA) REAL priority INTEGER kn,ipp INTEGER rindex,aindex C - DATA STATEMENTS: DATA first_call/.TRUE./ C - FUNCTIONS CALLED: INTEGER LINKNUM !function INTEGER VERIFY_PATH !function C - RETURN VALUE: ! N/A ! Non-zero if there was an error C ---------------------------------------------------------------------- GET_NEXT_EQPATH = 0 IF (first_call) THEN eqptime = -1.D0 first_call = .FALSE. CALL FND(EXT_PATH_FILE) READ(EXT_PATH_FILE,424,END=999) eqptime, eqplen, pathlist(1) + ,(pathlist(KN),KN=2,eqplen) !,idum,priority 424 FORMAT(F5.1,100I5) ENDIF DO WHILE (eqptime.LE.sim.time.minutes) CR - Convert user nodes to DYNASMART nodes DO i = 1,eqplen itmp = pathlist(i) pathlist(i) = net.nodenum(pathlist(i)) IF (pathlist(i).LE.0.OR.pathlist(i).GT.MAX_NO) THEN WRITE(ostr,'(A,I5,A)') + 'INVALID NODE IN NEXT_EQPATH [',itmp + ,']...IGNORING PATH'//CHAR(0) CALL DYNA_ERROR(ostr + ,DYNA_NONFATAL_WARNING + ,DYNA_INPUT_ERROR + ,DYNA_INVALID_NODENUM) GOTO 10 ENDIF ENDDO il = LINKNUM(net.spd.fs,pathlist(1),pathlist(2),rindex,aindex) IF (il.LE.0) THEN WRITE(ostr,'(A,I5,A,I5,A)') + 'BAD ORIGIN LINK IN NEXT_EQPATH [' + ,net.node(pathlist(1)).number + ,'->' + ,net.node(pathlist(2)).number + ,']...IGNORING PATH'//CHAR(0) CALL DYNA_ERROR(ostr + ,DYNA_NONFATAL_WARNING + ,DYNA_INPUT_ERROR + ,DYNA_INVALID_LINK) GOTO 10 ENDIF itodz = net.node(pathlist(eqplen)).nidest IF (itodz.EQ.0) THEN WRITE(ostr,'(A,I5,A)') + 'BAD DESTINATION NODE IN NEXT_EQPATH [' + ,net.node(pathlist(eqplen)).number + ,']...IGNORING PATH'//CHAR(0) CALL DYNA_ERROR(ostr + ,DYNA_NONFATAL_WARNING + ,DYNA_INPUT_ERROR + ,DYNA_INVALID_DESTNODE) GOTO 10 ENDIF pathlist(eqplen+1) = 0 !Null terminate IF (VERIFY_PATH(sim,net,pathlist).EQ.1) THEN CALL DYNA_ERROR('ERROR IN PATH'//CHAR(0) + ,DYNA_NONFATAL_WARNING + ,DYNA_INPUT_ERROR + ,DYNA_INVALID_PATH) GOTO 10 ENDIF ipp = net.link(il).linkdest(itodz) if (ipp.NE.0) THEN CR - there is already a path for this link-destination pair CR - overwrite it CONTINUE ELSE CR - there is not a path for this link-destination pair CR - add a new one! net.npp = net.npp + 1 ipp = net.npp net.eqpath(ipp).next = 0 ! No next path net.link(il).linkdest(itodz) = ipp ENDIF net.eqpath(ipp).list(1) = pathlist(1) DO k = 2,eqplen net.eqpath(ipp).list(k) = pathlist(k) ENDDO net.eqpath(ipp).list(k) = 0 net.eqpath(ipp).priority = 1.D0 !100% priority CR - zero priorities of other paths to destination i = net.eqpath(ipp).next DO WHILE(i.NE.0) net.eqpath(i).priority = 0.D0 i = net.eqpath(i).next ENDDO 10 CALL FND(EXT_PATH_FILE) READ(EXT_PATH_FILE,424,END=999) eqptime, eqplen, pathlist(1) + ,(pathlist(KN),KN=2,eqplen) !,idum,priority ENDDO 999 BACKSPACE(EXT_PATH_FILE) RETURN END C ---------------------------------------------------------------------- INTEGER FUNCTION VERIFY_PATH(net,pathlist) C ---------------------------------------------------------------------- C - Verify the validity of a given path (pathlist) in the network C - (net) in terms of node-link connectivity and link to link movement C - restrictions. C - INCLUDED FILES: #include "dyna.inc" #include "network.inc" C - UNMODIFIED ARGUMENTS: RECORD /Road_Network/ net INTEGER pathlist(NU_PA) C - MODIFIED GLOBAL DATA: ! ostr (see dyna.inc) C - LOCAL VARIABLES: INTEGER i,ii INTEGER ifrom,ito,inext INTEGER il,ilfrom,ilto INTEGER rindex,aindex C - FUNCTIONS CALLED: INTEGER LINKNUM !function C - RETURN VALUE: ! Non-zero if the specified path is invalid C ---------------------------------------------------------------------- VERIFY_PATH = 0 CR TRAVERSE PATH LIST TO MAKE SURE IT'S CONNECTED ifrom = pathlist(1) ito = pathlist(2) il = LINKNUM(net.spd.fs,ifrom,ito,rindex,aindex) ilfrom = il i = 3 DO WHILE(pathlist(i).NE.0.AND.i.LE.NU_PA) inext = pathlist(i) ilto = LINKNUM(net.spd.fs,ito,inext,rindex,aindex) IF (ilfrom.LE.0.OR.ilto.LE.0) THEN WRITE(ostr,'(A,I5,A,I5,A)') + 'PATH CONTAINS INVALID NODE PAIR [' + ,net.node(ito).number,'->' + ,net.node(inext).number,']...IGNORING'//CHAR(0) CALL DYNA_ERROR(ostr + ,DYNA_NONFATAL_WARNING + ,DYNA_INPUT_ERROR + ,DYNA_INVALID_LINK) VERIFY_PATH = 1 RETURN ENDIF ii = 1 DO WHILE(.NOT.( + net.movement(net.link(ilfrom).dsmoveptr(ii)).fromlink + .EQ.ilfrom + .AND. + net.movement(net.link(ilfrom).dsmoveptr(ii)).tolink + .EQ.ilto).AND. + ii.LE.net.link(ilfrom).numdslinks) ii = ii + 1 ENDDO IF (ii.GT.net.link(ilfrom).numdslinks) THEN WRITE(ostr,'(A,I5,A,I5,A,I5,A)') + 'PATH VIOLATES MOVEMENT RESTRICTIONS [' + ,net.node(net.link(ilfrom).iunod).number,'->' + ,net.node(net.link(ilfrom).idnod).number,'->' + ,net.node(net.link(ilto).idnod).number + ,']...IGNORING'//CHAR(0) CALL DYNA_ERROR(ostr + ,DYNA_NONFATAL_WARNING + ,DYNA_INPUT_ERROR + ,DYNA_ILLEGAL_MOVEMENT) VERIFY_PATH = 1 RETURN ENDIF ilfrom = ilto ifrom = ito ito = inext i = i + 1 ENDDO VERIFY_PATH = 0 RETURN END INTEGER FUNCTION COPY_EQ_PATHS(net,act) #include "dyna.inc" #include "network.inc" #include "activity.inc" RECORD /Road_Network/ net RECORD /Activity/ act INTEGER i,j,k,l,m INTEGER li,li2 INTEGER im,know INTEGER bp1,bp2,bp INTEGER know,move,node INTEGER newnode INTEGER link INTEGER LINKMOVEINDEX !function CR - Copy the current shortest paths to the eqpath storage WRITE(ostr,'(2A)') 'Copying Equilibrium Paths',CHAR(0) CALL SIMMSG(STATUS,ostr) COPY_EQ_PATHS = 0 CRlp------- crmi DO i = 1,act.ndests crmi DO j = 1,net.nlinks crmi li = LINKMOVEINDEX(net,j,0) crmi DO k = 1,net.spd.p.kay crmi node = net.link(j).idnod crmi crmi net.leqpd.labelout(i,j,k) = crmi + net.spd.od.labelout(i,node,k,li) crmi net.leqpd.labelpointerout(i,j,k) = crmi + net.spd.od.labelpointerout(i,node,k,li) crmi move = net.spd.od.pathpointerout(i,node,k,3,li) crmi know = net.spd.od.pathpointerout(i,node,k,2,li) crmi newnode = net.spd.od.pathpointerout(i,node,k,1,li) crmi crmi IF (newnode.EQ.0) THEN crmi IF ((newnode+know+move.GT.0 crmi + .OR. crmi + net.spd.od.labelout(i,node,k,li).LT.INFINITY) crmi + .AND. crmi + net.link(j).idnod.NE.act.destlist(i)) THEN crmiCR - the last condition insures that links whose ds node is the crmiCR - destination wont cause problems crmi WRITE(ostr,'(A)') 'eq link path error' crmi CALL DYNA_ERROR(ostr crmi + ,DYNA_FATAL_ERROR crmi + ,DYNA_LOGIC_BUG crmi + ,DYNA_UNKNOWN_ERROR) crmi ENDIF crmi ELSE crmi li2 = net.spd.fs.ifwdarc( crmi + net.spd.fs.npoint(newnode)+move-1,2) crmi crmi IF (net.link(li2).iunod.NE.node) THEN crmi WRITE(ostr,'(A)') 'eq link path error' crmi CALL DYNA_ERROR(ostr crmi + ,DYNA_FATAL_ERROR crmi + ,DYNA_LOGIC_BUG crmi + ,DYNA_UNKNOWN_ERROR) crmi ENDIF crmi crmi net.leqpd.pathpointerout(i,j,k,2) = know crmi net.leqpd.pathpointerout(i,j,k,1) = li2 crmi ENDIF crmi ENDDO crmi ENDDO crmi ENDDO DO i = 1,act.ndests DO j = 1,net.nlinks DO k = 1,net.spd.p.kay DO l = 1,2 net.leqpd.pathpointerout(i,j,k,l) = + net.spd.lod.pathpointerout(i,j,k,l) ENDDO net.leqpd.labelout(i,j,k) = net.spd.lod.labelout(i,j,k) net.leqpd.labelpointerout(i,j,k) = + net.spd.lod.labelpointerout(i,j,k) ENDDO ENDDO ENDDO RETURN END