SUBROUTINE LANE_INIT(net) C - INCLUDED FILES: #include "dyna.inc" #include "network.inc" C - UNMODIFIED ARGUMENTS: ! NONE C - MODIFIED ARGUMENTS: RECORD /Road_Network/ net INTEGER i,j C Set up lanemove array: lanemove(i,j) C For a movement type i, gives the jth lane type which allows C that type of movement. (Should be datafile or block data) DO i = 1,6 DO j = 1,MAX_LANE_TYPE ! MAX_LANE_TYPE is wrong here should ! be something like ! MAX_LANETYPES_PER_MOVETYPE net.lanemove(i,j) = 0 ENDDO ENDDO net.lanemove(1,1) = 1 net.lanemove(1,2) = 7 net.lanemove(1,3) = 10 net.lanemove(1,4) = 12 net.lanemove(1,5) = 6 net.lanemove(1,6) = 13 net.lanemove(1,7) = 14 net.lanemove(1,8) = 16 net.lanemove(2,1) = 2 net.lanemove(2,2) = 6 net.lanemove(2,3) = 9 net.lanemove(2,4) = 11 net.lanemove(2,5) = 13 net.lanemove(2,6) = 14 net.lanemove(2,7) = 15 net.lanemove(2,8) = 16 net.lanemove(3,1) = 3 net.lanemove(3,2) = 8 net.lanemove(3,3) = 7 net.lanemove(3,4) = 12 net.lanemove(3,5) = 9 net.lanemove(3,6) = 13 net.lanemove(3,7) = 15 net.lanemove(3,8) = 16 net.lanemove(4,1) = 4 net.lanemove(4,2) = 8 net.lanemove(4,3) = 10 net.lanemove(4,4) = 11 net.lanemove(4,5) = 12 net.lanemove(4,6) = 14 net.lanemove(4,7) = 15 net.lanemove(4,8) = 16 net.lanemove(5,1) = 17 ! If it's an "other" move net.lanemove(6,1) = 5 DO i = 1,MAX_LANE_TYPE net.lanesat(i) = 0.5 ENDDO net.lanesat(1) = 0.542 !left turn cap net.lanesat(2) = 0.488 !thru cap net.lanesat(3) = 0.425 !right turn cap net.lanesat(9) = 0.488 !shared right turn cap net.lanesat(5) = 1.000 !connector cap net.lanesat(17) = 1.000 !other cap REWIND(LANE_FILE) CALL READSTAT('link-end lane striping',LANE_FILE) CALL READLANE(LANE_FILE,net) RETURN END C ---------------------------------------------------------------------- INTEGER FUNCTION READLANE(unit,net) C ---------------------------------------------------------------------- C - Reads in lane striping info from the lane.dat file (for C - calculating intersection signalization capacity C - INCLUDED FILES: #include "dyna.inc" #include "network.inc" C - UNMODIFIED ARGUMENTS: INTEGER unit C - MODIFIED ARGUMENTS: RECORD /Road_Network/ net C - MODIFIED GLOBAL DATA: ! NONE C - LOCAL VARIABLES: INTEGER lanedat(16) C - LOCAL VARIABLES: INTEGER ifrom,ito,j,ilink,inod,np,k,ilane,im,il,imm,ill,ilthere + ,lp,lm,i,isum,imt,ilm,nolanespec INTEGER imp INTEGER k1 INTEGER rindex,aindex C - FUNCTIONS CALLED: INTEGER LINKNUM INTEGER LINKMOVEINDEX C - RETURN VALUE: ! Non-zero if there was an error C ---------------------------------------------------------------------- READLANE = 0 C -- Loop through and read lane file until end is reached DO WHILE (.TRUE.) CALL FND(unit) READ(unit,600,END=998) ifrom,ito,(lanedat(j),j=1,16) 600 FORMAT(2I5,16I2) Cr - Check from node validity IF (ifrom.LE.0.OR.ifrom.GT.MAX_NO + .OR. + net.nodenum(ifrom).LE.0 + .OR. + net.nodenum(ifrom).GT.net.nnodes) THEN WRITE(ostr,'(A,I5,A)') + 'Invalid node in lane file [',ifrom + ,']...Ignoring'//CHAR(0) CALL DYNA_ERROR(ostr + ,DYNA_NONFATAL_WARNING + ,DYNA_INPUT_ERROR + ,DYNA_INVALID_NODENUM) RETURN ENDIF ifrom = net.nodenum(ifrom) Cr - Check to node validity IF (ito.LE.0.OR.ito.GT.MAX_NO + .OR. + net.nodenum(ito).LE.0 + .OR. + net.nodenum(ito).GT.net.nnodes) THEN WRITE(ostr,'(A,I5,A)') + 'Invalid node in lane file [',ito + ,']...Ignoring'//CHAR(0) CALL DYNA_ERROR(ostr + ,DYNA_NONFATAL_WARNING + ,DYNA_INPUT_ERROR + ,DYNA_INVALID_NODENUM) RETURN ENDIF ito = net.nodenum(ito) C -- Retreive link number from end nodes and verify it ilink = LINKNUM(net.spd.fs,ifrom,ito,rindex,aindex) IF (ilink.EQ.0) THEN WRITE(ostr,'(A,I5,A,I5,A)') 'Bad link in lane file [' + ,net.node(ifrom).number,'->' + ,net.node(ito).number,']...Ignoring'//CHAR(0) CALL DYNA_ERROR(ostr + ,DYNA_NONFATAL_WARNING + ,DYNA_INPUT_ERROR + ,DYNA_INVALID_LINK) RETURN ENDIF inod = ito CRMI------- k = LINKMOVEINDEX(net,ilink,0) C -- Store lane information for that approach link DO ilane = 1,16 net.node(inod).lanenum(k,ilane) = lanedat(ilane) ENDDO CR -- Lane/move conflict check! C -- Loop over all movement types DO im = 1,6 C -- Find movement from ilink which matches move type im il = 1 DO WHILE( + net.movement(net.link(ilink).dsmoveptr(il)).type.NE.im + .AND. + il.LE.net.link(ilink).numdslinks) il = il + 1 ENDDO IF (il.GT.net.link(ilink).numdslinks) THEN C -- Movement doesn't exist, zero movement type and number imm = 0 ill = 0 ELSE C -- Store corresponding movement type and number imm = im ill = il ENDIF ilthere = 0 lp = 1 C -- Loop over the possible lane types for movement im DO WHILE(net.lanemove(im,lp).NE.0) lm = net.lanemove(im,lp) IF (net.node(inod).lanenum(k,lm).GT.0) THEN C -- Lane file specifies a lane of that type ilthere = 1 IF (ill.EQ.0) THEN C -- The movement file doesn't specify C -- a move of that type: Print ERROR WRITE(ostr,'(2A)') + 'Lane file has lane for move' + ,' not coded in move file:' CALL SIMMSG(STATUS,ostr) WRITE(ostr,610) im,ifrom,ito,lm,CHAR(0) 610 FORMAT('lane/move ['I1'] err: ['I3'->'I3 + '] lm:['I2'] -> [xxxx] >>>move=0<<<'A) CALL DYNA_ERROR(ostr + ,DYNA_FATAL_ERROR + ,DYNA_INPUT_ERROR + ,DYNA_LANE_WITH_NO_MOVE) ENDIF ENDIF lp = lp + 1 ENDDO IF (ilthere.EQ.0.AND.imm.NE.0) THEN C -- Move file allows movement for which there is no lane in c -- the lane file. WRITE(ostr,'(2A)') + 'Move file has move for which Lane file' + ,' has no lane coded:' WRITE(ostr,620) im,ifrom,ito + ,net.movement(net.link(ilink).dsmoveptr(ill)).tolink + ,imm,CHAR(0) 620 FORMAT('lane/move ['I1'] err: ['I3'->'I3 + '] lm:[xxxx] -> ['I3'] >>>move=['I1']<<<'A) CALL DYNA_ERROR(ostr + ,DYNA_FATAL_ERROR + ,DYNA_INPUT_ERROR + ,DYNA_MOVE_WITH_NO_LANE) ENDIF ENDDO ENDDO nolanespec = 0 C -- Look for links with no end-of-link lane information and C -- give them default laneage. 998 DO i = 1,net.nlinks ilink = i inod = net.link(ilink).idnod CRMI----- k = LINKMOVEINDEX(net,ilink,0) C -- Sum the number of end-of-link lanes for this link isum = 0 DO ilane = 1,16 isum = isum + net.node(inod).lanenum(k,ilane) ENDDO IF (isum.EQ.0) THEN C -- No lanes specified for the link: set default to be C -- the number of lanes on the link for every movement C -- allowed in the move file ifrom = net.link(ilink).iunod ito = net.link(ilink).idnod WRITE(ostr,630) ifrom,ito,CHAR(0) 630 FORMAT('No lanes specified for ['I4'->'I4 + '] assuming full lanes',A) crcrcr CALL SIMMSG(STATUS,ostr) cr lanenum(inod,k,16) = nlanes(ilink) C -- Loop over connections leaving from the link DO im = 1,net.link(ilink).numdslinks imt = net.movement(net.link(ilink).dsmoveptr(im)).type IF (imt.NE.0) THEN C -- If the movement is allowed assign nlanes C -- dedicated purely to that movement type ilm = net.lanemove(imt,1) net.node(inod).lanenum(k,ilm) = net.link(ilink).nlanes ENDIF ENDDO nolanespec = nolanespec + 1 ENDIF CR -- Determine number of lanes serving each movement: Presently, cr - this assumes that shared lanes count as a full lane for every cr - movement type they serve. This will overestimate the capacity cr - of shared-lane movements DO im = 1,net.link(ilink).numdslinks imp = net.link(ilink).dsmoveptr(im) imt = net.movement(imp).type ilm = 1 DO WHILE(ilm.LE.MAX_MOVE_TYPE + .AND. + net.lanemove(imt,ilm).NE.0) net.movement(imp).nlanes = net.movement(imp).nlanes + + net.node(inod).lanenum(k,net.lanemove(imt,ilm)) ilm = ilm + 1 ENDDO ENDDO ENDDO IF (nolanespec.NE.0) THEN WRITE(ostr,'(A,I5,2A)') 'WARNING: ' + ,nolanespec,' links had no lane info. Default used' + ,CHAR(0) CALL SIMMSG(STATUS,ostr) ENDIF RETURN END