SUBROUTINE VEHICLE_CLEAR(veh) #include "dyna.inc" #include "vehicle.inc" RECORD /Vehicle_Data/ veh INTEGER i veh.index = 0 veh.number = 0 veh.prevveh = NULLP veh.nextveh = NULLP veh.decision = 0 veh.stime = 0.D0 veh.atime = 0.D0 veh.curlink = 0 veh.isec = 0 veh.zfrom_index = 0 veh.xpar = 0.D0 veh.distans = 0.D0 veh.qstatus = IN_NETWORK veh.mvindex = 0 veh.tleft = 0.D0 veh.tqwait = 0.D0 veh.tqtot = 0.D0 veh.ribf = 0.D0 veh.ifamiliar = 0 veh.ttilnow = 0.d0 veh.jdest = 0 DO i = 1,NU_PA veh.jpath(i) = 0 ENDDO veh.icurrnt = 0 veh.jpflag = 0 veh.info = 0 veh.itag = 0 veh.switch = 0 veh.tocross = 0.D0 RETURN END SUBROUTINE VEHICLE_INIT(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 WRITE(ostr,'(2A)') 'Initializing Vehicle Arrays',CHAR(0) CALL SIMMSG(STATUS,ostr) Cr - Initialize vehicle list do i=1,NU_VE CALL VEHICLE_CLEAR(veh(i)) veh(i).nextveh = i+1 veh(i).prevveh = i-1 sim.veh_ptr(i) = 0 ENDDO DO i = NU_VE,MAX_VE sim.veh_ptr(i) = 0 ENDDO veh(1).prevveh = NULLP veh(NU_VE).nextveh = NULLP sim.freeslot.first = 1 sim.freeslot.last = NU_VE RETURN END C ---------------------------------------------------------------------- INTEGER FUNCTION ADDVEH(first,last,veh,num2add) C ---------------------------------------------------------------------- C - Adds a vehicle (indexed by num2add) to the vehicle list defined by C - the first and last pointers C - INCLUDED FILES: #include "dyna.inc" #include "vehicle.inc" C - UNMODIFIED ARGUMENTS: RECORD /Vehicle_Data/ veh(NU_VE) INTEGER num2add ! *index* (not number) of the vehicle to add C - MODIFIED ARGUMENTS: INTEGER first !in list INTEGER last !in list C - MODIFIED GLOBAL DATA: ! NONE C - LOCAL VARIABLES: INTEGER j C - FUNCTIONS CALLED: ! NONE C - RETURN VALUE: ! Non-zero if there was an error C ---------------------------------------------------------------------- ADDVEH = 0 j = num2add !should be index IF (last.EQ.NULLP) THEN CR - There are no vehicles in the list first = j last = j veh(j).prevveh = NULLP veh(j).nextveh = NULLP ELSE CR - There are vehicles in the list, put the new one at the end veh(last).nextveh = j ! L -> (*J) veh(j).prevveh = last !(*L) <- J veh(j).nextveh = NULLP ! J = L last = j ENDIF RETURN END C ---------------------------------------------------------------------- SUBROUTINE REMOVEVEH(first,last,veh,num2rem) C ---------------------------------------------------------------------- C - Removes a vehicle (indexed by num2rem) from the vehicle list C - defined by the first and last pointers C - INCLUDED FILES: #include "dyna.inc" #include "vehicle.inc" C - UNMODIFIED ARGUMENTS: RECORD /Vehicle_Data/ veh(NU_VE) INTEGER num2rem ! *index* (not number) of the vehicle to remove C - MODIFIED ARGUMENTS: INTEGER first !in list INTEGER last !in list C - MODIFIED GLOBAL DATA: ! NONE C - LOCAL VARIABLES: INTEGER j j = num2rem IF (veh(j).prevveh.EQ.NULLP) THEN CR - Veh was first in the list IF (veh(j).nextveh.EQ.NULLP) THEN CR - Veh was last (the only one) in the list first = NULLP last = NULLP ELSE Cr - Veh was first in a list of at least two vehicles first = veh(j).nextveh veh(first).prevveh = NULLP ENDIF ELSEIF (veh(j).nextveh.EQ.NULLP) THEN CR - Veh was last in the list (of at least two vehicles) last = veh(j).prevveh veh(last).nextveh = NULLP ELSE CR - Veh was in the middle of the list (with three or more vehs) veh(veh(j).prevveh).nextveh = veh(j).nextveh ! *->(*)->* veh(veh(j).nextveh).prevveh = veh(j).prevveh ! *<-(*)<-* ENDIF RETURN END C ---------------------------------------------------------------------- INTEGER FUNCTION PATHUPDATE(pathtype,net,act,fromlink,veh,index) C ---------------------------------------------------------------------- C - Changes the chosen route (jpath) of the vehicle veh beginning at C - index (i.e. jpath(index)). The update inserts a path at that C - index starting from the end of fromlink to the vehicles C - destination. The actual path selected depends on the pathtype C - parameter which, if positive, indicates that pathtype'th shortest C - path should be used, and if negative that the -pathtypes'th C - equilibrium path should be used C - INCLUDED FILES: #include "dyna.inc" #include "network.inc" #include "activity.inc" #include "vehicle.inc" C - UNMODIFIED ARGUMENTS: RECORD /Road_Network/ net RECORD /Activity/ act INTEGER pathtype INTEGER index INTEGER fromlink C - MODIFIED ARGUMENTS: RECORD /Vehicle_Data/ veh C - MODIFIED GLOBAL DATA: ! NONE C - LOCAL VARIABLES: INTEGER type,i,icur INTEGER ifrom,itodz,itodn,movet,m,k,know,ibest,ifromtmp,ktemp + ,movetemp,kk INTEGER ip,ipp,kn INTEGER jjj CHARACTER str1*3 INTEGER prob INTEGER link,linktmp C - FUNCTIONS CALLED: INTEGER LINKMOVEINDEX !function C - RETURN VALUE: ! Non-zero if there was an error C ---------------------------------------------------------------------- PATHUPDATE = 0 prob = 0 type = pathtype cr j = vehnum i = fromlink icur = index - 1 IF (type.EQ.0) THEN WRITE(ostr,699) type,CHAR(0) 699 FORMAT('Illegal path type ['I3'] in pathupdate'A) CALL DYNA_ERROR(ostr + ,DYNA_FATAL_ERROR + ,DYNA_LOGIC_BUG + ,DYNA_ILLEGAL_PATH_TYPE) ENDIF IF (pathtype.LT.-100 + .AND. + pathtype.GE.-200) THEN ! Use external EQ path CR - Retreive the number of the ext eq path we want ibest = ABS(100+pathtype) CR - Check that we have a pointer to this ibest'th path ip = 1 ipp = net.link(i).linkdest(veh.jdest) DO WHILE(ipp.NE.0 + .AND. + ip.LT.ibest) ipp = net.eqpath(ipp).next ip = ip + 1 ENDDO IF (ipp.EQ.0) THEN CALL DYNA_ERROR( + 'illegal ext eq path requested'//CHAR(0) + ,DYNA_FATAL_ERROR + ,DYNA_LOGIC_BUG + ,DYNA_UNKNOWN_ERROR) ENDIF ip = 2 veh.jpath(icur) = net.link(i).iunod DO WHILE (ip.LE.NU_PA + .AND. + net.eqpath(ipp).list(ip).NE.0) veh.jpath(icur+ip-1) = net.eqpath(ipp).list(ip) ip = ip + 1 ENDDO veh.jpath(icur+ip-1) = 0 RETURN ELSE IF (pathtype.LT.-200) THEN CR - Retreive the number of the cms path we want ibest = ABS(200+pathtype) CR - Check that we have a pointer to this cms path ip = 1 ipp = net.link(i).cmslink(veh.jdest) DO WHILE(ipp.NE.0 + .AND. + ip.LT.ibest) ipp = net.eqpath(ipp).next ip = ip + 1 ENDDO IF (ipp.EQ.0) THEN CALL DYNA_ERROR( + 'illegal cms path requested'//CHAR(0) + ,DYNA_FATAL_ERROR + ,DYNA_LOGIC_BUG + ,DYNA_UNKNOWN_ERROR) ENDIF ip = 2 veh.jpath(icur) = net.link(i).iunod DO WHILE (ip.LE.NU_PA + .AND. + net.cmspath(ipp).list(ip).NE.0) veh.jpath(icur+ip-1) = net.cmspath(ipp).list(ip) ip = ip + 1 ENDDO veh.jpath(icur+ip) = 0 RETURN ENDIF CR - Ext path not requested, assign shortest or internal eq path ibest = ABS(type) ifrom = net.link(i).idnod veh.jpath(icur) = net.link(i).iunod itodz = veh.jdest itodn = act.destlist(itodz) crpt--- link = i CRMI----- movet = LINKMOVEINDEX(net,i,0) IF (type.GT.0) THEN know = net.spd.lod.labelpointerout(itodz,i,ibest) ELSEIF (type.LT.0) THEN know = net.leqpd.labelpointerout(itodz,i,ibest) ENDIF k = icur + 1 do while(ifrom.ne.itodn.and.k.le.NU_PA) veh.jpath(k) = ifrom k = k + 1 ifromtmp = ifrom ktemp = know movetemp = movet IF (type.GT.0) THEN !shortest path linktmp = link know = net.spd.lod.pathpointerout(itodz,linktmp,ktemp,2) link = net.spd.lod.pathpointerout(itodz,linktmp,ktemp,1) ifrom = net.link(link).idnod IF (net.spd.lod.labelout(itodz,link,know) + .GE.INFINITY) THEN WRITE(ostr,696) ifromtmp,ifrom, + net.spd.lod.labelout(itodz,link,know) + ,CHAR(0) 696 FORMAT('Vehicle path illegal from 'I3'->'I3':'F10.5,A) CALL DYNA_ERROR(ostr + ,DYNA_NONFATAL_WARNING + ,DYNA_LOGIC_BUG + ,DYNA_INVALID_PATH) PATHUPDATE = 1 RETURN ENDIF ELSE IF (type.LT.0) THEN ! eqpath linktmp = link know = net.leqpd.pathpointerout(itodz,linktmp,ktemp,2) link = net.leqpd.pathpointerout(itodz,linktmp,ktemp,1) ifrom = net.link(link).idnod IF (net.leqpd.labelout(itodz,link,know) + .GT.9999.9) THEN WRITE(ostr,696) ifromtmp,ifrom + ,net.leqpd.labelout(itodz,link,know) + ,CHAR(0) CALL DYNA_ERROR(ostr + ,DYNA_NONFATAL_WARNING + ,DYNA_LOGIC_BUG + ,DYNA_INVALID_PATH) PATHUPDATE = 1 RETURN ENDIF ENDIF IF (ifrom.EQ.0) THEN WRITE(ostr,697) veh.number,veh.jdest + ,(veh.jpath(kk),kk=1,k),CHAR(0) 697 FORMAT('Vehicle ['I6'] path error to dest ['I3']'/ + :10(' path:'10(I5)/)A) CALL DYNA_ERROR(ostr + ,DYNA_NONFATAL_WARNING + ,DYNA_LOGIC_BUG + ,DYNA_INVALID_PATH) PATHUPDATE = 1 RETURN ENDIF IF (k.GT.NU_PA) THEN Cr - This path has gotten long, wrap it back around CALL SIMMSG(STDERR + ,'Path too long...increase NU_PA parameter') WRITE(ostr,6997) veh.number,veh.jdest,CHAR(0) 6997 FORMAT('Vehicle ['I6'] to dest ['I4']'A) CALL SIMMSG(STDERR,ostr) IF (icur.EQ.1) THEN CALL DYNA_ERROR('VEHICLE PATH TOO LONG'//CHAR(0) + ,DYNA_FATAL_ERROR + ,DYNA_OUT_OF_MEMORY + ,DYNA_PATH_TOO_LONG) ENDIF DO jjj = icur,NU_PA veh.jpath(jjj-icur+1) = veh.jpath(jjj) ENDDO k = jjj-icur+1 DO JJJ = jjj-icur+2,NU_PA veh.jpath(jjj) = 0 ! clear the rest of the path ENDDO veh.icurrnt = 2 prob = 1 ENDIF ENDDO veh.jpath(k)=itodn IF (prob.EQ.1) THEN CALL SIMMSG(STDERR,'Path offset to increase space') ENDIF DO m = k+1,NU_PA veh.jpath(m) = 0 ENDDO RETURN END