SUBROUTINE CMS_CLEAR(cms) #include "dyna.inc" #include "cms.inc" RECORD /CMS_Data/ cms INTEGER j,k cms.number = 0 cms.onlink = 0 cms.nummsgs = 0 DO j = 1,MAX_CMS_MSG_NUMBER cms.msgnumber(j) = 0 ENDDO DO j = 1,MAX_CMS_MSGS cms.msglist(j).cmsnum = 0 cms.msglist(j).number = 0 DO k = 1,80 cms.msglist(j).message(k:k) = ' ' ENDDO cms.msglist(j).numpath = 0 DO k = 1,MAX_CMS_PATH_EFFECT cms.msglist(j).path(k) = 0 ENDDO cms.msglist(j).on = .FALSE. ENDDO RETURN END C ---------------------------------------------------------------------- SUBROUTINE CMS_INIT(net) C ---------------------------------------------------------------------- C - Initializes the CMS data structures C - INCLUDED FILES: #include "dyna.inc" #include "network.inc" C - UNMODIFIED ARGUMENTS: C - MODIFIED ARGUMENTS: RECORD /Road_Network/ net C - LOCAL VARIABLES: INTEGER i,j,k,izn C - FUNCTIONS CALLED: C - RETURN VALUE: C ---------------------------------------------------------------------- DO i = 1,NU_LI DO izn = 1,NU_ZN net.link(i).cmslink(izn) = 0 ENDDO ENDDO DO i = 1,MAX_CMS net.cms(i).number = i CALL CMS_CLEAR(net.cms(i)) ENDDO net.ncp = 0 DO i = 1,MAX_CMSP DO k = 1,NU_PA net.cmspath(i).list(k) = 0 ENDDO net.cmspath(i).next = 0 net.cmspath(i).priority = 0.D0 net.cmspath(i).on = .FALSE. ENDDO DO i = 1,MAX_CMS_NUMBER net.cmsnumber(i) = 0 ENDDO RETURN END C ---------------------------------------------------------------------- INTEGER FUNCTION READ_CMS_PATHS(unit,net,act) C ---------------------------------------------------------------------- C - Reads the data associated with CMS locations in the network. This C - data includes the CMS locations, the various messages possible at C - these locations, and the estimated path effects of these C - messages. C - INCLUDED FILES: #include "dyna.inc" #include "network.inc" #include "activity.inc" C - UNMODIFIED ARGUMENTS: INTEGER unit RECORD /Activity/ act C - MODIFIED ARGUMENTS: RECORD /Road_Network/ net C - MODIFIED GLOBAL DATA: ! ostr (see dyna.inc) C - LOCAL VARIABLES: INTEGER i,j,k INTEGER itmp INTEGER il INTEGER idn,idz INTEGER icp INTEGER numinpath,pathlist(NU_PA) REAL priority INTEGER cms INTEGER cmsi ! cmsindex INTEGER msg INTEGER msgi ! msgindex INTEGER message INTEGER fromnode,tonode,il CHARACTER buf*1024,tmpstr*80,divstr*10 INTEGER from INTEGER rindex,aindex RECORD /CMS_Data/ cmsdat C - FUNCTIONS CALLED: INTEGER LINKNUM ! function INTEGER VERIFY_PATH ! function INTEGER READ_NEXT ! function ! FND C - RETURN VALUE: ! Non-zero if there was an error C ---------------------------------------------------------------------- READ_CMS_PATHS = 0 divstr = ' ,'//CHAR(0) DO WHILE(.TRUE.) CALL FND(CMS_FILE) READ(CMS_FILE,'(A1024)',END=999) buf from = 1 from = READ_NEXT(buf,3,divstr,from,tmpstr) IF (tmpstr(1:3).EQ.'cms') THEN CR - Read CMS number from = READ_NEXT(buf,1,divstr,from,cms) cmsi = net.numcms + 1 IF (cmsi.GT.MAX_CMS) THEN WRITE(ostr,'(A,I5,A)') + 'NUMBER OF CMS''s EXCEEDS MAXIMUM. IGNORING'// + 'CMS [',cms,']'//CHAR(0) CALL DYNA_ERROR(ostr + ,DYNA_NONFATAL_WARNING + ,DYNA_OUT_OF_MEMORY + ,DYNA_TOO_MANY_CMS) GOTO 10 ENDIF IF (net.cms(cmsi).number.NE.0) THEN WRITE(ostr,'(A,I5,A)') + 'DUPLICATE CMS ENTRY [',cms,']...IGNORING'//CHAR(0) CALL DYNA_ERROR(ostr + ,DYNA_NONFATAL_WARNING + ,DYNA_INPUT_ERROR + ,DYNA_DUPLICATE_CMS) GOTO 10 ENDIF CR - Read link string from = READ_NEXT(buf,3,divstr,from,tmpstr) IF (tmpstr(1:4).NE.'link') THEN CALL DYNA_ERROR( + 'Invalid ENTRY in CMS FILE'//CHAR(0) + ,DYNA_NONFATAL_WARNING + ,DYNA_INPUT_ERROR + ,DYNA_UNKNOWN_ERROR) GOTO 10 ENDIF CR - Read node numbers of link from = READ_NEXT(buf,1,divstr,from,fromnode) from = READ_NEXT(buf,1,divstr,from,tonode) CR - Convert to DYNASMART node numbers itmp = fromnode fromnode = net.nodenum(fromnode) IF (fromnode.LE.0.OR.fromnode.GT.MAX_NO) THEN WRITE(ostr,'(A,I5,A)') 'Invalid node in CMS file [',itmp + ,'] Ignoring...'//CHAR(0) CALL DYNA_ERROR(ostr + ,DYNA_NONFATAL_WARNING + ,DYNA_INPUT_ERROR + ,DYNA_INVALID_NODENUM) GOTO 10 ENDIF itmp = tonode tonode = net.nodenum(tonode) IF (tonode.LE.0.OR.tonode.GT.MAX_NO) THEN WRITE(ostr,'(A,I5,A)') 'Invalid node in CMS file [',itmp + ,'] Ignoring...'//CHAR(0) CALL DYNA_ERROR(ostr + ,DYNA_NONFATAL_WARNING + ,DYNA_INPUT_ERROR + ,DYNA_INVALID_NODENUM) GOTO 10 ENDIF CR - Get link number from node numbers il = LINKNUM(net.spd.fs,fromnode,tonode,rindex,aindex) IF (il.LE.0) THEN WRITE(ostr,'(A,I5,A,I5,A)') + 'Invalid LINK [',net.node(fromnode).number + ,'->',net.node(tonode).number + ,'] in CMS FILE'//CHAR(0) CALL DYNA_ERROR(ostr + ,DYNA_NONFATAL_WARNING + ,DYNA_INPUT_ERROR + ,DYNA_INVALID_LINK) GOTO 10 ENDIF net.cmsnumber(cms) = cmsi net.cms(cmsi).number = cms net.cms(cmsi).onlink = il net.cms(cmsi).nummsgs = 0 net.numcms = net.numcms + 1 ELSE IF (tmpstr(1:7).EQ.'message') THEN CR - Get CMS number of message from = READ_NEXT(buf,1,divstr,from,cms) IF (cms.LE.0.OR.cms.GT.MAX_CMS_NUMBER) THEN WRITE(ostr,'(A,I5,A)') + 'Invalid CMS number [',cms + ,'] in message def...IGNORING'//CHAR(0) CALL DYNA_ERROR(ostr + ,DYNA_NONFATAL_WARNING + ,DYNA_INPUT_ERROR + ,DYNA_INVALID_CMS_NUMBER) GOTO 10 ENDIF CR - Get index of cms message cmsi = net.cmsnumber(cms) IF (cmsi.LE.0.OR.cmsi.GT.MAX_CMS) THEN WRITE(ostr,'(A,I5,A)') + 'Invalid CMS [',cms + ,'] (index not found) in msg def...IGNORING' + //CHAR(0) CALL DYNA_ERROR(ostr + ,DYNA_NONFATAL_WARNING + ,DYNA_INPUT_ERROR + ,DYNA_INVALID_CMS_NUMBER) GOTO 10 ENDIF IF (net.cms(cmsi).number.EQ.0) THEN WRITE(ostr,*) + 'Attempt to define message for undefined CMS' CALL DYNA_ERROR(ostr + ,DYNA_NONFATAL_WARNING + ,DYNA_INPUT_ERROR + ,DYNA_INVALID_CMS_NUMBER) GOTO 10 ENDIF CR - Get message number from = READ_NEXT(buf,1,divstr,from,msg) IF (msg.LE.0.OR.msg.GT.MAX_CMS_MSG_NUMBER) THEN WRITE(ostr,'(A,I5,A)') + 'Invalid CMS message number [',msg + ,'] in message def...IGNORING'//CHAR(0) CALL DYNA_ERROR(ostr + ,DYNA_NONFATAL_WARNING + ,DYNA_INPUT_ERROR + ,DYNA_INVALID_MSG_NUMBER) GOTO 10 ENDIF CR - Get index of cms message msgi = net.cms(cmsi).nummsgs + 1 IF (msgi.LE.0.OR.msgi.GT.MAX_CMS) THEN WRITE(ostr,'(A,I5,A)') + 'Too many messages defined for CMS [' + ,net.cms(cmsi).number + ,']...IGNORING' + //CHAR(0) CALL DYNA_ERROR(ostr + ,DYNA_NONFATAL_WARNING + ,DYNA_OUT_OF_MEMORY, + ,DYNA_TOO_MANY_MSGS) GOTO 10 ENDIF CR - Get message text divstr = '"'//CHAR(0) from = READ_NEXT(buf,3,divstr + ,from+INDEX(buf(from:LEN(buf)),'"') + ,net.cms(cmsi).msglist(msgi).message) divstr = ' ,'//CHAR(0) net.cms(cmsi).msglist(msgi).cmsnum = cmsi net.cms(cmsi).msglist(msgi).number = msg net.cms(cmsi).msgnumber(msg) = msgi net.cms(cmsi).nummsgs = net.cms(cmsi).nummsgs + 1 ELSE IF (tmpstr(1:4).EQ.'path') THEN CR - Get CMS number with which the path is associated from = READ_NEXT(buf,1,divstr,from,cms) IF (cms.LE.0.OR.cms.GT.MAX_CMS_NUMBER) THEN WRITE(ostr,'(A,I5,A)') + 'Invalid CMS number [',cms + ,'] in path def...IGNORING'//CHAR(0) CALL DYNA_ERROR(ostr + ,DYNA_NONFATAL_WARNING + ,DYNA_INPUT_ERROR + ,DYNA_INVALID_CMS_NUMBER) GOTO 10 ENDIF CR - Get index of cms message cmsi = net.cmsnumber(cms) IF (cmsi.LE.0.OR.cmsi.GT.MAX_CMS) THEN WRITE(ostr,'(A,I5,A)') + 'Invalid CMS [',cms + ,'] (index not found) in path def...IGNORING' + //CHAR(0) CALL DYNA_ERROR(ostr + ,DYNA_NONFATAL_WARNING + ,DYNA_INPUT_ERROR + ,DYNA_INVALID_CMS_NUMBER) GOTO 10 ENDIF IF (net.cms(cmsi).number.EQ.0) THEN WRITE(ostr,*) + 'Attempt to define path for undefined CMS' + //CHAR(0) CALL DYNA_ERROR(ostr + ,DYNA_NONFATAL_WARNING + ,DYNA_INPUT_ERROR + ,DYNA_INVALID_CMS_NUMBER) GOTO 10 ENDIF CR - Get the message number with which the path is associated from = READ_NEXT(buf,1,divstr,from,message) IF (msg.LE.0.OR.msg.GT.MAX_CMS_MSG_NUMBER) THEN WRITE(ostr,'(A,I5,A)') + 'Invalid MSG number [',msg + ,'] in path def...IGNORING'//CHAR(0) CALL DYNA_ERROR(ostr + ,DYNA_NONFATAL_WARNING + ,DYNA_INPUT_ERROR + ,DYNA_INVALID_MSG_NUMBER) GOTO 10 ENDIF CR - Get index of cms message msgi = net.cms(cmsi).msgnumber(msg) IF (msgi.LE.0.OR.msgi.GT.MAX_CMS_MSGS) THEN WRITE(ostr,'(A,I5,A)') + 'Invalid MSG [',msg + ,'] (index not found) in path def...IGNORING' + //CHAR(0) CALL DYNA_ERROR(ostr + ,DYNA_NONFATAL_WARNING + ,DYNA_INPUT_ERROR + ,DYNA_INVALID_MSG_NUMBER) GOTO 10 ENDIF IF (net.cms(cmsi).msglist(msgi).number.EQ.0) THEN WRITE(ostr,*) + 'Attempt to define path for undefined CMS,MSG PAIR' + //CHAR(0) CALL DYNA_ERROR(ostr + ,DYNA_NONFATAL_WARNING + ,DYNA_INPUT_ERROR + ,DYNA_INVALID_CMS_NUMBER) GOTO 10 ENDIF CR - Get the number of nodes in the path from = READ_NEXT(buf,1,divstr,from,numinpath) CR - Read path list DO i = 1,numinpath from = READ_NEXT(buf,1,divstr,from,pathlist(i)) IF (pathlist(i).LE.0.OR.pathlist(i).GT.MAX_NO) THEN WRITE(ostr,'(A,I5,A)') 'Invalid node [',pathlist(i) + ,'] in READ_CMS_PATHS...IGNORING'//CHAR(0) CALL DYNA_ERROR(ostr + ,DYNA_NONFATAL_WARNING + ,DYNA_INPUT_ERROR + ,DYNA_INVALID_NODENUM) GOTO 10 ENDIF CR - Convert to DYNASMART node number itmp = pathlist(i) pathlist(i) = net.nodenum(pathlist(i)) IF (pathlist(i).LE.0) THEN WRITE(ostr,'(A,I5,A)') 'Invalid node [',itmp + ,'] in READ_CMS_PATHS...IGNORING'//CHAR(0) GOTO 10 ENDIF ENDDO pathlist(numinpath+1) = 0 ! Tells Verify path the end of ! the path CR - Read the path's priority from = READ_NEXT(buf,2,divstr,from,priority) CR - Verify the path's validity (i.e., that its connected) IF (VERIFY_PATH(net,pathlist).EQ.1) THEN CALL DYNA_ERROR( + 'Invalid path in READ_CMS_PATHS...IGNORING'//CHAR(0) + ,DYNA_NONFATAL_WARNING + ,DYNA_INPUT_ERROR + ,DYNA_INVALID_PATH) GOTO 10 ENDIF CR - Get the link number of the path's starting link il = LINKNUM(net.spd.fs,pathlist(1),pathlist(2),rindex + ,aindex) IF (il.EQ.0) THEN ! Redundant, VERIFY_PATH will confirm the ! validity of the path WRITE(ostr,'(A,I5,A,I5,A)') + 'BAD ORIGIN LINK IN CMSPATH [',pathlist(1) + ,'->',pathlist(2),']...IGNORING PATH'//CHAR(0) CALL DYNA_ERROR(ostr + ,DYNA_NONFATAL_WARNING + ,DYNA_INPUT_ERROR + ,DYNA_INVALID_LINK) GOTO 10 ENDIF CR - Check that the last node is a destination node and retreive CR - its destination zone number idn = pathlist(numinpath) idz = net.node(idn).nidest IF (idz.LE.0) THEN WRITE(ostr,'(A,I5,A)') + 'BAD DESTINATION NODE IN CMSPATH [' + ,net.node(pathlist(numinpath)).number + ,']...IGNORING PATH'//CHAR(0) CALL DYNA_ERROR(ostr + ,DYNA_NONFATAL_WARNING + ,DYNA_INPUT_ERROR + ,DYNA_INVALID_DESTNODE) GOTO 10 ENDIF CR: OK: Add the path to the cmspath list icp = net.link(il).cmslink(idz) IF (icp.NE.0) THEN ! Already a path for this link-dest pair !find the last path associated with this link-dest pair DO WHILE(net.cmspath(icp).next.NE.0) icp = net.cmspath(icp).next ENDDO net.cmspath(icp).next = net.ncp + 1 ELSE net.link(il).cmslink(idz) = net.ncp + 1 ENDIF net.ncp = net.ncp + 1 icp = net.ncp net.cmspath(icp).next = 0 DO i = 1,numinpath+1 !+1 to copy the null net.cmspath(icp).list(i) = pathlist(i) ENDDO net.cms(cmsi).msglist(msgi).numpath = + net.cms(cmsi).msglist(msgi).numpath + 1 net.cms(cmsi).msglist(msgi).path( + net.cms(cmsi).msglist(msgi).numpath) = icp net.cmspath(icp).priority = priority net.cmspath(icp).on = .FALSE. ENDIF 10 ENDDO 999 RETURN END C ---------------------------------------------------------------------- INTEGER FUNCTION ADD_CMS(net,cms) C ---------------------------------------------------------------------- C - Adds a CMS to the network C - INCLUDED FILES: #include "dyna.inc" #include "network.inc" C - UNMODIFIED ARGUMENTS: RECORD /Road_Network/ net C - MODIFIED ARGUMENTS: RECORD /CMS_Data/ cms C - MODIFIED GLOBAL DATA: ! ostr (see dyna.inc) C - LOCAL VARIABLES: INTEGER cmsi ! cms index C - FUNCTIONS CALLED: ! SET_CMS_PATH ! SIMMSG C - RETURN VALUE: ! Non-zero if there was an error C ---------------------------------------------------------------------- ADD_CMS = 0 cmsi = net.numcms IF (cmsi.GT.MAX_CMS) THEN WRITE(ostr,'(A,I5,A)') + 'NUMBER OF CMS''s EXCEEDS MAXIMUM. IGNORING'// + 'CMS [',cms.number,']'//CHAR(0) CALL DYNA_ERROR(ostr + ,DYNA_NONFATAL_WARNING + ,DYNA_OUT_OF_MEMORY + ,DYNA_TOO_MANY_CMS) ADD_CMS = 1 RETURN ENDIF IF (net.cms(cmsi).number.NE.0) THEN WRITE(ostr,'(A,I5,A)') + 'DUPLICATE CMS ENTRY [',cms.number + ,']...IGNORING'//CHAR(0) CALL DYNA_ERROR(ostr + ,DYNA_NONFATAL_WARNING + ,DYNA_INPUT_ERROR + ,DYNA_DUPLICATE_CMS) ADD_CMS = 1 RETURN ENDIF RETURN END C ---------------------------------------------------------------------- INTEGER FUNCTION SET_CMS(net,cms) C ---------------------------------------------------------------------- C - Changes the message currently displayed at CMS cmsnum to msgnum or C - deactivates the CMS if msgnum is already displayed (a toggle). 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: LOGICAL on,activated INTEGER i,j CHARACTER active*80 INTEGER cmsi INTEGER msgi INTEGER cmsnum INTEGER msgnum C - FUNCTIONS CALLED: ! SET_CMS_PATH ! SIMMSG C - RETURN VALUE: ! Non-zero if there was an error C ---------------------------------------------------------------------- SET_CMS = 0 cmsnum = cms.id.number msgnum = cms.msg activated = .FALSE. active = '' 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) SET_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) SET_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) SET_CMS = 1 RETURN ENDIF CR - Loop to determine which paths are on DO i = 1,net.cms(cmsi).nummsgs on = .FALSE. IF (net.cms(cmsi).msglist(i).number.EQ.msgnum) THEN on = .TRUE. activated = .TRUE. active = net.cms(cmsi).msglist(i).message ENDIF net.cms(cmsi).msglist(i).on = on ENDDO Cr - Print out the message status IF (activated) THEN WRITE(ostr,'(A,I2,A,I2,A)') 'Activated MSG [',msgnum + ,'] at CMS [',net.cms(cmsi).number,']'//CHAR(0) CALL SIMMSG(STATUS,ostr) ELSE WRITE(ostr,'(A,I2,A,I2,A)') 'Deactivated CMS [' + ,net.cms(cmsi).number,']'//CHAR(0) CALL SIMMSG(STATUS,ostr) ENDIF WRITE(ostr,'(3A)') ' --> MESSAGE: "',active(1:LTR(active)) + ,'"'//CHAR(0) CALL SIMMSG(STATUS,ostr) Cr - Print out the CMS path status DO i = 1,net.cms(cmsi).nummsgs DO j = 1,net.cms(cmsi).msglist(i).numpath on = net.cms(cmsi).msglist(i).on CALL SET_CMS_PATH(net,net.cms(cmsi).msglist(i).path(j),on) ENDDO ENDDO RETURN END C ---------------------------------------------------------------------- INTEGER FUNCTION SET_CMS_PATH(net,pathno,on) C ---------------------------------------------------------------------- C - Sets the "on" flag for a given CMS path to the value of the C - argument on (either T or F). If True, the path is active and will C - be considered by vehicle passing it's associated CMS C - INCLUDED FILES: #include "dyna.inc" #include "network.inc" C - UNMODIFIED ARGUMENTS: INTEGER pathno LOGICAL on C - MODIFIED ARGUMENTS: RECORD /Road_Network/ net C - MODIFIED GLOBAL DATA: ! ostr (see dyna.inc) C - LOCAL VARIABLES: INTEGER ipp C - FUNCTIONS CALLED: ! SIMMSG C - RETURN VALUE: ! Non-zero if there was an error C ---------------------------------------------------------------------- SET_CMS_PATH = 0 ipp = pathno net.cmspath(ipp).on = on IF (net.cmspath(ipp).on) THEN WRITE(ostr,600) ipp,CHAR(0) 600 FORMAT(' . CMSPATH 'I6' TURNED ON',A) ELSE WRITE(ostr,601) ipp,CHAR(0) 601 FORMAT(' . CMSPATH 'I6' TURNED OFF',A) ENDIF CALL SIMMSG(STATUS,ostr) RETURN END