C ---------------------------------------------------------------------- INTEGER FUNCTION STD_KSHORT(net,act) C ---------------------------------------------------------------------- C - Routine called to determine the K-shortest paths in the C - network from every node approach (the end of every link) to every C - destination node C - INCLUDED FILES: #include "dyna.inc" #include "network.inc" #include "activity.inc" C - UNMODIFIED ARGUMENTS: RECORD /Activity/ act C - MODIFIED ARGUMENTS: RECORD /Road_Network/ net C - MODIFIED GLOBAL DATA: LOGICAL patherror COMMON /spfirst/ patherror DATA patherror/.FALSE./ C - LOCAL VARIABLES: INTEGER idzn ! the destination node number of a given zone INTEGER ires ! result storage INTEGER kpass ! C - FUNCTIONS CALLED: INTEGER INITIALIZEARRAYS INTEGER KSHORTESTPATHCALC INTEGER INTEGRATEIT C - RETURN VALUE: ! Non-zero if there was an error C ---------------------------------------------------------------------- CR - Loop over all zones with destinations DO idzn = 1,net.spd.nd.noofdestinations IF (idzn.NE.0) THEN net.spd.nd.ides = idzn ! Destination number (not zone num) net.spd.nd.destin = act.destlist(idzn) ! dest node of zone kpass = net.spd.p.kay net.spd.p.kay = ABS(kpass) ires = INITIALIZEARRAYS(net.spd) IF (ires.NE.0) THEN STD_KSHORT = 1 RETURN ENDIF IF (kpass.LT.0) net.spd.p.kay = 0 ires = KSHORTESTPATHCALC(net.spd) IF (ires.NE.0) THEN STD_KSHORT = 1 RETURN ENDIF net.spd.p.kay = ABS(kpass) ires = INTEGRATEIT(net,act) IF (ires.NE.0) THEN STD_KSHORT = 1 RETURN ENDIF ENDIF ENDDO IF (patherror) THEN CALL SIMMSG(STATUS,'ERROR IN NETWORK PATHS!'//CHAR(0)) STD_KSHORT = 1 RETURN ENDIF STD_KSHORT = 0 RETURN END C ---------------------------------------------------------------------- INTEGER FUNCTION IntegrateIt(net,act) C ---------------------------------------------------------------------- C - This Sub integrates the shortest paths into for all the C - destinations into a unique array. C - INCLUDED FILES: #include "dyna.inc" #include "network.inc" #include "activity.inc" C - UNMODIFIED ARGUMENTS: RECORD /Activity/ act C - MODIFIED ARGUMENTS: RECORD /Road_Network/ net C - MODIFIED GLOBAL DATA: LOGICAL patherror COMMON /spfirst/ patherror C - LOCAL VARIABLES: INTEGER kpaths,k,nd,im,m,iusn,ilink,ik,know,ktemp INTEGER ides INTEGER rindex,aindex INTEGER firstptr INTEGER newlink INTEGER nodeto C - FUNCTIONS CALLED: INTEGER LINKNUM C - RETURN VALUE: ! Non-zero if there was an error C ---------------------------------------------------------------------- INTEGRATEIT = 0 kpaths = net.spd.p.kay ides = net.spd.nd.ides Do K = 1,KPaths Do ND = 1,net.spd.nd.NoOfNodes IM = net.spd.bsd.BackPointr(ND+1)- + net.spd.bsd.BackPointr(ND) Do M = 1,IM ilink = net.spd.fs.ifwdarc( + net.spd.fs.npoint(nd)+m-1,2) net.spd.lod.labelout(ides,ilink,k) = + net.spd.ld.label(nd,k,m) nodeto = net.spd.ld.pathpointer(nd,k,1,m) IF (nodeto.GT.0) THEN newlink = LINKNUM(net.spd.fs,nd,nodeto,rindex,aindex) ELSE newlink = 0 ENDIF net.spd.lod.pathpointerout(ides,ilink,k,1) = newlink net.spd.lod.pathpointerout(ides,ilink,k,2) = + net.spd.ld.pathpointer(nd,k,2,m) CR Check that all gen links have paths that make sense IF (m.LT.im) THEN iusn =net.spd.bsd.backstr1( + net.spd.bsd.backpointr(nd)+m-1) IF (ilink.EQ.0) THEN CALL DYNA_ERROR( + 'Integrateit: ilink error!'//CHAR(0) + ,DYNA_FATAL_ERROR + ,DYNA_LOGIC_BUG + ,DYNA_INVALID_LINK) ENDIF IF (net.spd.lod.labelout(ides,ilink,k).GE.INFINITY + .AND. + net.link(ilink).ildem.NE.0) THEN WRITE(ostr,610) + net.node(net.spd.bsd. + backstr1( + net.spd.bsd.backpointr(nd)+m-1)).number + ,net.node(nd).number + ,act.zone(act.dest2zone(ides)).number + ,net.node(act.destlist(ides)).number,CHAR(0) 610 FORMAT('No path! 'I3'->'I3'->Z'I3' ['I3']',A) CALL SIMMSG(STATUS,ostr) patherror = .TRUE. ENDIF ENDIF ENDDO ENDDO ENDDO Do Nd = 1,net.spd.nd.NoOfNodes IM=net.spd.bsd.BackPointr(Nd+1)-net.spd.bsd.BackPointr(Nd) !+1 Do M=1,IM Know=net.spd.ld.FirstLabel(Nd,M) +0.005 !Int conversion ilink = net.spd.fs.ifwdarc( + net.spd.fs.npoint(nd)+m-1,2) CR - Count how many labels are set ik = 0 firstptr = 0 ktemp = know DO WHILE (ktemp.GT.0) CR - Trap invalid paths and omit them IF (net.spd.ld.label(nd,ktemp,m) + .LT.INFINITY) THEN ik = ik + 1 IF (ik.EQ.1) firstptr = ktemp ENDIF ktemp = net.spd.ld.labelpointer(nd,ktemp,m) ENDDO know = firstptr IF (ik.NE.0) THEN CR - Know will be zero if nd == the destination node! net.spd.lod.labelpointerout(ides,ilink,ik)=know Do While (know.GT.0 + .AND. + IK.GT.1) KTemp=Know Know=net.spd.ld.LabelPointer(Nd,KTemp,M) CR - Trap invalid paths and omit them IF (net.spd.ld.label(nd,ktemp,m).LT.INFINITY) THEN IK=IK-1 net.spd.lod.labelpointerout(ides,ilink,ik)=know ELSE net.spd.lod.labelpointerout(ides,ilink,ik)=0 ENDIF ENDDO ENDIF ENDDO ENDDO RETURN END C ---------------------------------------------------------------------- INTEGER FUNCTION InitializeArrays(spd) C ---------------------------------------------------------------------- C - Primes the shortest path data structures for calculating the C - k-shortest paths C - INCLUDED FILES: #include "dyna.inc" #include "spstruct.inc" C - UNMODIFIED ARGUMENTS: ! NONE C - MODIFIED ARGUMENTS: RECORD /SP_Data/ spd C - MODIFIED GLOBAL DATA: ! NONE C - LOCAL VARIABLES: INTEGER kpaths,maxim,i1,i2,i,immindex,lod1,lod2,move,im,k INTEGER NoOfNodes C - FUNCTIONS CALLED: ! NONE C - RETURN VALUE: ! Non-zero if there was an error C ---------------------------------------------------------------------- INITIALIZEARRAYS = 0 Kpaths = spd.p.kay NoOfNodes = spd.nd.noofnodes MaxIm=7 Do I1 = 1,Kpaths Do IM = 1,7 Do I2 = 1,NoOfNodes spd.ld.Label(I2,I1,IM)=INFINITY spd.ld.Pathpointer(I2,I1,1,IM)=NIL spd.ld.Pathpointer(I2,I1,2,IM)=NIL spd.ld.Pathpointer(I2,I1,3,IM)=NIL spd.dq.DequeLabel1(I2,I1,IM)=0 spd.dq.DequeLabel2(I2,I1,IM)=0 ENDDO ENDDO ENDDO Do IM=1,7 Do I2=1,NoOfNodes spd.ld.FirstLabel(I2,IM)=NIL spd.ld.FirstGoodLabel(I2,IM)=NIL spd.dq.DequeLabelCounter(I2,IM)=NIL ENDDO ENDDO Do I = 1,NoOfNodes spd.dq.StatusInDeque(I)=0 ENDDO Do IM=1,MaxIM c -- c -- locat the destion node position c -- and add the penalties to the destination nodes only c -- a bug from Thanasis c -- CR ---> This makes no sense to me. I don't have the labelforods array. CR ---> Bypassing for now, no dest nodes will have a penalty associated CR ---> with move to them. c$$$ immindex=0 c$$$ do imm=1,spd.nd.nzones c$$$ if(spd.nd.destin.eq.spd.nd.destination(imm)) immindex=imm c$$$ end do immindex = 0 if(immindex.ne.0) then lod1=spd.dsn.labelforods(immindex,im,1) lod2=spd.dsn.labelforods(immindex,im,2) if(lod1.ne.0) then spd.ld.Label(spd.nd.Destin,1,IM) = + spd.pn.penalty(lod1,lod2) else spd.ld.Label(spd.nd.Destin,1,IM)=0 endif else spd.ld.Label(spd.nd.Destin,1,IM)=0 endif c -- spd.ld.LabelPointer(spd.nd.Destin,1,IM)=NIL spd.ld.PathPointer(spd.nd.Destin,1,1,IM)=NIL spd.ld.PathPointer(spd.nd.Destin,1,2,IM)=NIL spd.ld.PathPointer(spd.nd.Destin,1,3,IM)=NIL spd.dq.DequeLabel1(spd.nd.Destin,1,IM)=0 spd.dq.DequeLabel2(spd.nd.Destin,1,IM)=1 spd.dq.DequeLabelCounter(spd.nd.Destin,IM)=1 spd.ld.FirstGoodLabel(spd.nd.Destin,IM)=1 spd.ld.FirstLabel(spd.nd.Destin,IM)=1 ENDDO spd.dq.FirstDeque = spd.nd.Destin spd.dq.LastDeque = spd.nd.Destin spd.dq.StatusInDeque(spd.nd.Destin)=INFINITY Do Move = 1,7 Do K = 1,KPaths+1 spd.ud.Update(Move,K)=.FALSE. ENDDO ENDDO Return End C ---------------------------------------------------------------------- INTEGER FUNCTION KShortestPathCalc(spd) C ---------------------------------------------------------------------- C - Determines the shortest path from a given destination node back to C - all nodes including consideration of movement penalties (by C - effectively exploding the network) C - INCLUDED FILES: #include "dyna.inc" #include "spstruct.inc" C - UNMODIFIED ARGUMENTS: ! NONE C - MODIFIED ARGUMENTS: RECORD /SP_Data/ spd C - MODIFIED GLOBAL DATA: ! NONE C - LOCAL VARIABLES: REAL MaxLabel,NextDistance,NewLabel INTEGER CurrentNode,BackPointrCurrent LOGICAL UpdateCombined,Found INTEGER SecondLabel, EmptyLabel INTEGER kpaths,ngenericcounter,noofarcsleaving,i2,node,movements + ,idcounter,im,i3,kprevious,m,ktemp,know,i,i0 C - FUNCTIONS CALLED: ! NONE C - RETURN VALUE: ! Non-zero if there was an error C ---------------------------------------------------------------------- KSHORTESTPATHCALC = 0 kpaths = spd.p.kay c Trap for improper destinations IF (spd.nd.Destin.LE.0) THEN WRITE(ostr,'(A,I5,A)') 'Invalid destination node: [' + ,spd.nd.Destin,']'//CHAR(0) CALL DYNA_ERROR(ostr + ,DYNA_FATAL_ERROR + ,DYNA_LOGIC_BUG + ,DYNA_INVALID_DESTNODE) ENDIF if (spd.bsd.BackPointr(spd.nd.Destin+1) - + spd.bsd.BackPointr(spd.nd.Destin).eq.0) then WRITE (ostr,'(A,I5,A)') + 'Unacceptable isolated destination node: [' + ,spd.nd.Destin,']'//CHAR(0) CALL DYNA_ERROR(ostr + ,DYNA_FATAL_ERROR + ,DYNA_INPUT_ERROR + ,DYNA_ISOLATED_DEST) endif NGenericCounter=0 c write (53,*) 'Starts Calculation of ',KPaths,'-Shortest Paths', c * ' For an ',NoOfNodes,' Node ',NoOfArcs,' NArcs Network' C->DO B.1: Loop over sequence list Do 201 While (spd.dq.FirstDeque .NE. INFINITY) C Take off the first NODE from the head of Deque CurrentNode = spd.dq.FirstDeque Cr - Store next node to be visited spd.dq.FirstDeque = spd.dq.StatusInDeque(CurrentNode) Cr - Get pointer to list of nodes connected to CurrentNode BackPointrCurrent = spd.bsd.BackPointr(CurrentNode) NoOfArcsLeaving = spd.bsd.BackPointr(CurrentNode+1) - + BackPointrCurrent-1 Cr - Mark current node as having been on list spd.dq.StatusInDeque(CurrentNode) = -1 NgenericCounter = NgenericCounter+1 c write (53,*) 'Current ',CurrentNode, ' First ',FirstDeque c * ,' NNDeq ',StatusInDeque(571) C--->DO B.2: Loop over nodes directly connected to CurrentNode Do 202 I2=0,NoOfArcsLeaving Cr - Store node # and cost to get to node Node = spd.bsd.BackStr1(BackPointrCurrent+I2) NextDistance = spd.bsd.BackStr2(BackPointrCurrent+I2) Cr - Store the number of movements connected to the link: Cr - Node->CurrentNode Movements = spd.bsd.BackPointr(Node+1) + - spd.bsd.BackPointr(Node) Cr - IM is the index of link Node->CurrentNode in the Cr - backpointer list for node CurrentNode IM = I2 + 1 Cr - IDCounter = spd.dq.DequeLabelCounter(CurrentNode,IM) spd.dq.DequeLabelCounter(CurrentNode,IM)=0 c write(53,*) 'Node ',Node,' NextDi ',NextDistance,' FirstDe ' c , c + FirstDeque Comment B.1 C--->IF B.1S IF (spd.dq.StatusInDeque(Node).NE.0) Then Cr - Node is not new to the list Cr - Loop over each of the previously set labels for the Cr - CurrentNode Do 203 I3=1,IDCounter Cr - KPrevious stores on which of the k paths the Cr - CurrentNode's label refers to KPrevious = spd.dq.DequeLabel2(CurrentNode,I3,IM) Cr - Loop over all the movements connecting to the arc Cr - we're updating Do 2031 M=1,Movements Cr - Calculate the cost of getting from the end of the Cr - movement stub via the current arc to the dest Cr - (M->Node->CurrentNode) NewLabel = spd.dq.DequeLabel1(CurrentNode,I3,IM) + + NextDistance + + spd.pn.Penalty(BackPointrCurrent+I2,M) C--->IF B.2S If (spd.ld.FirstGoodLabel(Node,M).GE.KPaths) Then Cr - All labels have been set for the movements Cr - emanating from the node so we have to see if Cr - adding the current arc is better than any of the Cr - current labels Cr - MaxLabel is the worst of the labels currently set MaxLabel = + spd.ld.Label(Node,spd.ld.FirstLabel(Node,M) + + 0.005,M) !int conv C--->IF B.3S If (NewLabel.LT. MaxLabel) Then Cr - The new label is better than the worst label Cr - reaching this point. Update the labels. C Call UpdateLabelFull(Node,NewLabel,CurrentNode, C * Kprevious,I3,M) C--Fast Edition instead of Calling C------------------------------------------------------------------------ c --- C--Subroutine UpdateLabelFull(Node,NewLabel,CurrentNode,Kprevious,I3,M) C------------------------------------------------------------------------ c --- Found=.FALSE. spd.ud.Update(M,I3)=.TRUE. Cr - Get the kay of the worst label ?? SecondLabel = + spd.ld.LabelPointer( + Node,spd.ld.FirstLabel(Node,M)+0.005,M) !int conv Cr - Store the position of the label which is Cr - worse than the new label EmptyLabel = spd.ld.FirstLabel(Node,M) +0.005 C---->IF B.4S If (NewLabel.Ge. + spd.ld.Label(Node,SecondLabel,M)) Then spd.ld.PathPointer(Node, + spd.ld.FirstLabel(Node,M)+0.005,1,M) + = CurrentNode spd.ld.PathPointer(Node, + spd.ld.FirstLabel(Node,M)+0.005,2,M) + = Kprevious spd.ld.PathPointer(Node, + spd.ld.FirstLabel(Node,M)+0.005,3,M) + = IM spd.ld.Label(Node, + spd.ld.FirstLabel(Node,M)+0.005,M) + = NewLabel Else C----|IF B.4E Ktemp=SecondLabel Know = spd.ld.LabelPointer(Node, + SecondLabel,M) Do While ((Know .NE. NIL) .AND. (.NOT. + Found)) If (NewLabel .GE. + spd.ld.Label(Node,Know,M)) + Then Found=.TRUE. Else KTemp=Know Know = spd.ld.LabelPointer(Node, + Ktemp,M) EndIf ENDDO spd.ld.FirstLabel(Node+0.005,M) + =SecondLabel spd.ld.Label(Node,EmptyLabel,M)=NewLabel spd.ld.LabelPointer(Node,EmptyLabel,M) + =Know spd.ld.LabelPointer(Node,Ktemp,M) + =EmptyLabel spd.ld.PathPointer(Node,EmptyLabel,1,M) + =CurrentNode spd.ld.PathPointer(Node,EmptyLabel,2,M) + =Kprevious spd.ld.PathPointer(Node,EmptyLabel,3,M)=IM EndIf C----IF B.5S If (NewLabel .Ge. spd.ld.Label(Node, + spd.ld.FirstLabel(Node,M)+0.005 + ,M)) Then spd.ld.LabelPointer(Node, + spd.ld.FirstGoodLabel(Node,M),M) + =spd.ld.FirstLabel(Node,M)+0.005 spd.ld.FirstLabel(Node,M) = + spd.ld.FirstGoodLabel(Node,M) spd.ld.PathPointer(Node, + spd.ld.FirstGoodLabel(Node,M),1,M) + =CurrentNode spd.ld.PathPointer(Node, + spd.ld.FirstGoodLabel(Node,M),2,M) + =Kprevious spd.ld.PathPointer(Node, + spd.ld.FirstGoodLabel(Node,M),3,M) + =IM Else C------|IF B.5S Know=spd.ld.LabelPointer(Node, + spd.ld.FirstLabel(Node,M)+0.005,M) Ktemp=spd.ld.FirstLabel(Node,M) Do While ((Know .NE. NIL) .AND. (.NOT. Found) + ) If (NewLabel .Ge. + spd.ld.Label(Node,Know,M)) Then Found=.TRUE. Else Ktemp=Know Know=spd.ld.LabelPointer(Node,Ktemp,M) EndIf ENDDO spd.ld.LabelPointer(Node, + spd.ld.FirstGoodLabel(Node,M),M) + =Know spd.ld.LabelPointer(Node,Ktemp,M) + =spd.ld.FirstGoodLabel(Node,M) spd.ld.PathPointer(Node, + spd.ld.FirstGoodLabel(Node,M),1,M) + =CurrentNode spd.ld.PathPointer(Node, + spd.ld.FirstGoodLabel(Node,M),2,M) + =Kprevious spd.ld.PathPointer(Node, + spd.ld.FirstGoodLabel(Node,M),3,M) + =IM Endif C-----IF B.2rS If (spd.ld.FirstGoodLabel(Node,M).GE.KPaths) Then MaxLabel=spd.ld.Label(Node, + spd.ld.FirstLabel(Node,M)+0.005,M) c write (6,*) 'In B.2S Max Pos ',Maxlabel,FirstLabel(Node,M) C--->IF B.3rS If (NewLabel.LT. MaxLabel) Then C Call UpdateLabelFull(Node,NewLabel,CurrentNode, C * Kprevious,I3,M) C--Fast Edition instead of Calling C------------------------------------------------------------------------ c --- C--Subroutine UpdateLabelFull(Node,NewLabel,CurrentNode,Kprevious,I3,M) C------------------------------------------------------------------------ c --- Found=.FALSE. SecondLabel=spd.ld.LabelPointer(Node, + spd.ld.FirstLabel(Node,M)+0.005 + ,M) C---->IF B.4rS If (NewLabel.Ge. + spd.ld.Label(Node,SecondLabel,M)) Then spd.ld.PathPointer(Node, + spd.ld.FirstLabel(Node,M)+0.005 + ,1,M) + =CurrentNode spd.ld.PathPointer(Node, + spd.ld.FirstLabel(Node,M)+0.005 + ,2,M) + =Kprevious spd.ld.PathPointer(Node, + spd.ld.FirstLabel(Node,M)+0.005 + ,3,M)=IM spd.ld.Label(Node, + spd.ld.FirstLabel(Node,M)+0.005 + ,M)=NewLabel Else C----|IF B.4rE EmptyLabel= + spd.ld.FirstLabel(Node,M)+0.005 Ktemp=SecondLabel Know=spd.ld.LabelPointer(Node,SecondLabel,M) Do While ((Know .NE. NIL) .AND. (.NOT. Found) + ) If (NewLabel .GE. + spd.ld.Label(Node,Know,M)) Then Found=.TRUE. Else KTemp=Know Know=spd.ld.LabelPointer(Node,Ktemp,M) EndIf ENDDO spd.ld.FirstLabel(Node,M)=SecondLabel spd.ld.Label(Node,EmptyLabel,M)=NewLabel spd.ld.LabelPointer(Node,EmptyLabel,M)=Know spd.ld.LabelPointer(Node,Ktemp,M)=EmptyLabel spd.ld.PathPointer(Node,EmptyLabel,1,M)= + CurrentNode spd.ld.PathPointer(Node,EmptyLabel,2,M)= + Kprevious spd.ld.PathPointer(Node,EmptyLabel,3,M)=IM EndIf C----IF B.3rF C----------------------------------- C--END of Subroutine UpdateLabelFull Real C----------------------------------- c EndIf Else C---|IF B.2E C Call UpdateLabelShort(Node,NewLabel,CurrentNodeKprevious,I3,M) C--Fast Edition instead of Calling -Real C------------------------------------------------------------------------ c --- C--Subroutine UpdateLabelShort(Node,NewLabel,CurrentNode,Kprevious,I3,M) C------------------------------------------------------------------------ c --- Found=.FALSE. spd.ld.FirstGoodLabel(Node,M)= + spd.ld.FirstGoodLabel(Node,M)+1 spd.ld.Label(Node,spd.ld.FirstGoodLabel(Node,M),M)= + NewLabel spd.ld.PathPointer(Node, + spd.ld.FirstGoodLabel(Node,M),1,M) + =CurrentNode spd.ld.PathPointer(Node, + spd.ld.FirstGoodLabel(Node,M),2,M) + =Kprevious spd.ld.PathPointer(Node, + spd.ld.FirstGoodLabel(Node,M),3,M)=IM c write (6,*) 'In LabelShort FGL ',FirstGoodLabel(Node,M) c write (6,*) 'In LabelShort Kprevious ',Kprevious c write (6,*) 'PathPointer(',Node,FirstGoodLabel(Node,M),2,M,'): ' c * , PathPointer(Node,FirstGoodLabel(Node,M),2,M), c * ' CurrentNode: ',CurrentNode C------>IF B.5rS If (NewLabel .Ge. spd.ld.Label(Node, + spd.ld.FirstLabel(Node,M)+0.005,M)) + Then spd.ld.LabelPointer(Node, + spd.ld.FirstGoodLabel(Node,M),M) + =spd.ld.FirstLabel(Node,M)+0.005 spd.ld.FirstLabel(Node,M) = + spd.ld.FirstGoodLabel(Node,M) Else C------|IF B.5rE Know=spd.ld.LabelPointer(Node, + spd.ld.FirstLabel(Node,M)+0.005,M) Ktemp=spd.ld.FirstLabel(Node,M)+0.005 Do While ((Know .NE. NIL) .AND. (.NOT. Found)) If (NewLabel .Ge. + spd.ld.Label(Node,Know,M)) Then Found=.TRUE. Else Ktemp=Know Know=spd.ld.LabelPointer(Node,Ktemp,M) EndIf ENDDO spd.ld.LabelPointer(Node, + spd.ld.FirstGoodLabel(Node,M),M) = Know spd.ld.LabelPointer(Node,Ktemp,M) = + spd.ld.FirstGoodLabel(Node,M) Endif C-----IF B.1F Comment B.2: Check the Update Status and Insert the Node in the Deque UpdateCombined=.FALSE. Do 2032, I3=1,IDCounter Do 2032, M=1,Movements c write (6,*) 'FirstGoodLabel(',Node,M,') =', c * FirstGoodLabel(Node,M) If (spd.ud.Update(M,I3)) Then UpdateCombined=.TRUE. spd.ud.Update(M,I3)=.False. EndIf 2032 Continue M=Movements+1 If (UpdateCombined) Then c Call InsertDeque(Node) C--Fast Edition instead of Calling C------------------------------------------------------------------------ c --- C--Subroutine I n s e r t D e q u e ( N e x t N o d e ) C------------------------------------------------------------------------ c --- c write (53,*) 'Insertin in SE list, Node ',Node,' FD ' c ,FirstDeque If (spd.dq.StatusInDeque(Node) .EQ. 0) Then If (spd.dq.FirstDeque .NE. INFINITY) Then spd.dq.StatusInDeque(spd.dq.LastDeque)=Node spd.dq.StatusInDeque(Node)=INFINITY spd.dq.LastDeque=Node c write (53,*) '--- In Status=0,Fist=NE999,insertLast' Else spd.dq.StatusInDeque(Node)=spd.dq.FirstDeque spd.dq.FirstDeque=Node spd.dq.LastDeque=Node c write (53,*) '--- In Status=0,Fist=9999,insertLast' EndIf Else If (spd.dq.StatusInDeque(Node) .EQ. -1) Then If (spd.dq.FirstDeque.EQ.INFINITY) + spd.dq.LastDeque=Node spd.dq.StatusInDeque(Node)=spd.dq.FirstDeque spd.dq.FirstDeque=Node c write (53,*) '--- In Status=-1,insertFirst' EndIf EndIf C------------------------------------ C--END of Subroutine InsertDeque C------------------------------------ EndIf c write (53,*) 'Insertin in SE list, Node ',Node,' FD ',FirstDeque c * ,' Last ',LastDeque 202 Continue C--