SUBROUTINE MOVE_CLEAR(move) #include "dyna.inc" #include "move.inc" RECORD /Move_Data/ move INTEGER i move.fromlink = 0 move.tolink = 0 move.type = 0 move.capacity = 0 move.demand = 0 DO i = 1,NU_DS move.volume(i) = 0 move.delaytime(i) = 0.D0 ENDDO move.green = 0 move.cycgreen = 0 move.nlanes = 0 move.moved = 0 move.queued = 0 move.totmoved = 0 move.totcap = 0 move.delaysum = 0.D0 move.penalty = 0.D0 move.incident_code = 0 RETURN END SUBROUTINE MOVE_READ(unit,move) #include "dyna.inc" #include "move.inc" INTEGER unit RECORD /Move_Data/ move RETURN END C ---------------------------------------------------------------------- SUBROUTINE MOVE_INIT(sim,net) C ---------------------------------------------------------------------- C - Reads in allowed link to link movements from move.dat. 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,j,l INTEGER ico C - FUNCTIONS CALLED: ! NONE C - RETURN VALUE: ! Non-zero if there was an error C ---------------------------------------------------------------------- DO i = 1,NU_MV CALL MOVE_CLEAR(net.movement(i)) ENDDO IF (net.normalize_links) THEN ! Assume compete connectivity, DO i = 1,net.nlinks DO j = 1,net.nlinks IF (net.link(i).idnod.EQ.net.link(j).iunod) THEN ico = ico + 1 IF (ico.GT.NU_MV) THEN WRITE(ostr,6700) ico,NU_MV 6700 FORMAT('Too many movements ['I6'], increase' + ,' NU_MV parameter from ['I6']') CALL DYNA_ERROR(ostr + ,DYNA_FATAL_ERROR + ,DYNA_OUT_OF_MEMORY + ,DYNA_TOO_MANY_MOVES) ENDIF net.movement(ico).fromlink = i net.movement(ico).tolink = j net.movement(ico).type = THROUGH DO l = 1,NU_DS net.movement(ico).delaytime(l) = 0.D0 ENDDO net.link(i).numdslinks = net.link(i).numdslinks + 1 net.link(i).dsmoveptr(net.link(i).numdslinks) = ico net.link(j).numuslinks = net.link(j).numuslinks + 1 net.link(j).usmoveptr(net.link(j).numuslinks) = ico ENDIF ENDDO ENDDO ELSE ! Read connectivity from move.dat REWIND(MOVE_FILE) CALL READSTAT('link to link movements',MOVE_FILE) CALL READMOVE(MOVE_FILE,sim,net) ENDIF RETURN END C ---------------------------------------------------------------------- INTEGER FUNCTION READMOVE(unit,sim,net) C ---------------------------------------------------------------------- C - Reads in allowed link to link movements from move.dat. C - INCLUDED FILES: #include "dyna.inc" #include "sim.inc" #include "network.inc" C - UNMODIFIED ARGUMENTS: INTEGER unit RECORD /Sim_Data/ sim C - MODIFIED ARGUMENTS: RECORD /Road_Network/ net C - MODIFIED GLOBAL DATA: ! NONE C - LOCAL VARIABLES: RECORD /Move_Data/ move INTEGER i,j,k,l INTEGER ilink,ileft,iright,ist,ileft,iu,iconn(5),iother,ifrom,ito INTEGER ico,ityp C - FUNCTIONS CALLED: ! NONE C - RETURN VALUE: ! Non-zero if there was an error C ---------------------------------------------------------------------- READMOVE = 0 CALL FND(unit) Cr - FOR EACH LINK, READ THE DOWNSTREAM NODE MOVEMENT INFORMATION i = 1 DO WHILE (i.LE.net.nlinks) ilink = 0 ileft = 0 ist = 0 iright = 0 iother = 0 DO l = 1,5 iconn(l) = 0 ENDDO CALL FND(unit) READ(unit,10,END=999)ifrom,ito,ileft,ist,iright,iu,iother + ,(iconn(j),j=1,5) C - Convert user nodes to DYNASMART compressed nodes IF (ifrom .NE.0) ifrom = net.nodenum(ifrom) IF (ito .NE.0) ito = net.nodenum(ito) IF (ileft .NE.0) ileft = net.nodenum(ileft) IF (ist .NE.0) ist = net.nodenum(ist) IF (iright.NE.0) iright = net.nodenum(iright) IF (iu .NE.0) iu = net.nodenum(iu) IF (iother.NE.0) iother = net.nodenum(iother) DO j = 1,5 IF (iconn(j).NE.0) iconn(j) = net.nodenum(iconn(j)) ENDDO ileft = -ileft ist = -ist iright = -iright iu = -iu iother = -iother DO j = 1,5 iconn(j) = -iconn(j) ENDDO Cr - FIND THE LINK NUMBERS FOR EACH MOVEMENT TYPE COMING FROM LINK CR - ifrom-ito [ilink] DO j=1,net.nlinks IF (net.link(j).iunod.eq.ifrom.AND. + net.link(j).idnod.eq.ito) ilink = j IF (net.link(j).iunod.eq.ito.AND. + net.link(j).idnod.eq.-ileft) ileft = j IF (net.link(j).iunod.eq.ito.AND. + net.link(j).idnod.eq.-ist) ist = j IF (net.link(j).iunod.eq.ito.AND. + net.link(j).idnod.eq.-iright) iright = j IF (net.link(j).iunod.eq.ito.AND. + net.link(j).idnod.eq.-iu ) iu = j IF (net.link(j).iunod.eq.ito.AND. + net.link(j).idnod.eq.-iother) iother = j DO k = 1,5 IF (net.link(j).iunod.eq.ito.AND. + net.link(j).idnod.eq.-iconn(k)) iconn(k) = j ENDDO end do IF (ilink.EQ.0) THEN WRITE(ostr,'(A,I5,A,I5,A)') 'Bogus link in move.dat: ' + ,net.node(ifrom).number,'->' + ,net.node(ito).number,CHAR(0) CALL DYNA_ERROR(ostr + ,DYNA_FATAL_ERROR + ,DYNA_INPUT_ERROR + ,DYNA_INVALID_LINK) ENDIF IF (ileft.LT.0) THEN WRITE(ostr,6000) 'left turn' + ,net.node(ifrom).number + ,net.node(ito).number + ,net.node(-ileft).number CALL DYNA_ERROR(ostr + ,DYNA_FATAL_ERROR + ,DYNA_INPUT_ERROR + ,DYNA_INVALID_LINK) ELSEIF (ist.LT.0) THEN WRITE(ostr,6000) 'thru' + ,net.node(ifrom).number + ,net.node(ito).number + ,net.node(-ist).number CALL DYNA_ERROR(ostr + ,DYNA_FATAL_ERROR + ,DYNA_INPUT_ERROR + ,DYNA_INVALID_LINK) ELSEIF (iright.LT.0) THEN WRITE(ostr,6000) 'right turn' + ,net.node(ifrom).number + ,net.node(ito).number + ,net.node(-iright).number CALL DYNA_ERROR(ostr + ,DYNA_FATAL_ERROR + ,DYNA_INPUT_ERROR + ,DYNA_INVALID_LINK) ELSEIF (iu.LT.0) THEN WRITE(ostr,6000) 'u-turn' + ,net.node(ifrom).number + ,net.node(ito).number + ,net.node(-iu).number CALL DYNA_ERROR(ostr + ,DYNA_FATAL_ERROR + ,DYNA_INPUT_ERROR + ,DYNA_INVALID_LINK) ELSEIF (iother.LT.0) THEN WRITE(ostr,6000) 'other' + ,net.node(ifrom).number + ,net.node(ito).number + ,net.node(-iother).number CALL DYNA_ERROR(ostr + ,DYNA_FATAL_ERROR + ,DYNA_INPUT_ERROR + ,DYNA_INVALID_LINK) ENDIF DO k = 1,5 IF (iconn(k).LT.0) THEN WRITE(ostr,6000) 'connector' + ,net.node(ifrom).number + ,net.node(ito).number + ,net.node(-iconn(k)).number CALL DYNA_ERROR(ostr + ,DYNA_FATAL_ERROR + ,DYNA_INPUT_ERROR + ,DYNA_INVALID_LINK) ENDIF ENDDO 6000 FORMAT('Illegal 'A' move specified ['I5'->'I5'->'I5']') Cr - DO j=1,net.nlinks Cr - FOR THE LINK WE ARE ON, DO THE FOLLOWING: IF (net.link(j).iunod.eq.ifrom.AND. + net.link(j).idnod.eq.ito ) THEN Cr - NOTE: THE INFORMATION IN move CORRESPONDS DIRECTLY TO THE DOWNSTREAM Cr - LINKS STORED IN llink Cr - Cr - SPECIFY IN move,FOR THE DOWNSTREAM LINKS TO LINK ifrom-ito, Cr - THE TYPE OF MOVEMENT IT TAKES TO GET TO THOSE LINKS DO k=1,net.nlinks ityp = 0 IF (k.EQ.ileft) ityp = LEFT IF (k.EQ.ist) ityp = THROUGH IF (k.EQ.iright) ityp = RIGHT IF (k.EQ.iu) ityp = UTURN IF (k.EQ.iother) ityp = OTHER DO l = 1,5 IF (k.EQ.iconn(l)) ityp = CONN ENDDO IF (ityp.NE.0) THEN move.fromlink = j move.tolink = k move.type = ityp CALL ADD_MOVE(sim,net,move) ENDIF ENDDO ENDIF ENDDO i = i + 1 ENDDO 999 CONTINUE 10 format(20i5) c$$$C --- ================================================================== c$$$C - READ THE LEFT-TURN CAPACITIES c$$$C - c$$$ CALL READSTAT('left turn capacities',LEFT_CAP_FILE) c$$$ c$$$ CALL FND(LEFT_CAP_FILE) !FIND NEXT NON-BLANK AND NON !'d LINE IN FILE c$$$ c$$$ read(LEFT_CAP_FILE,*) c$$$ do 400 k=1,5 c$$$ c$$$ CALL FND(LEFT_CAP_FILE) !FIND NEXT NON-BLANK AND NON !'d LINE IN FILE c$$$ c$$$ READ(LEFT_CAP_FILE,11) gcratio_l c$$$11 format(4x,f3.1) c$$$ c$$$ if (gcratio_l.eq.0.3) igc = 1 c$$$ if (gcratio_l.eq.0.4) igc = 2 c$$$ if (gcratio_l.eq.0.5) igc = 3 c$$$ if (gcratio_l.eq.0.6) igc = 4 c$$$ if (gcratio_l.eq.0.7) igc = 5 c$$$ c$$$ do 300 i=1,3 c$$$ read(LEFT_CAP_FILE,12) itmp,(leftcap(igc,itmp,j),j=1,7) c$$$12 format(i1,3x,7i5) c$$$ c$$$c write(0,12) itmp,(leftcap(igc,itmp,j),j=1,7) c$$$ c$$$300 continue c$$$ c$$$400 continue c$$$ c$$$ c$$$ CALL FND(LEFT_CAP_FILE) !FIND NEXT NON-BLANK AND NON !'d LINE IN FILE c$$$ c$$$ read(LEFT_CAP_FILE,*) c$$$ do 600 i=1,5 c$$$ c$$$ CALL FND(LEFT_CAP_FILE) !FIND NEXT NON-BLANK AND NON !'d LINE IN FILE c$$$ c$$$ read(LEFT_CAP_FILE,11) gcratio_l c$$$ if (gcratio_l.eq.0.3) igc = 1 c$$$ if (gcratio_l.eq.0.4) igc = 2 c$$$ if (gcratio_l.eq.0.5) igc = 3 c$$$ if (gcratio_l.eq.0.6) igc = 4 c$$$ if (gcratio_l.eq.0.7) igc = 5 c$$$ c$$$ do 500 k=1,ifix(gcratio_l*10)*3 c$$$ read(LEFT_CAP_FILE,13) ivolume,itmp c$$$ + ,(leftcap2(igc,itmp,ivolume,j),j=1,7) c$$$ 13 format(i1,i4,i4,6i5) c$$$ c$$$500 continue c$$$ c$$$ 600 continue c$$$ c$$$ REWIND(LEFT_CAP_FILE) 6700 FORMAT('Too many movements ['I6'], increase' + ,' NU_MV parameter from ['I6']') RETURN END