FUDforum
Fast Uncompromising Discussions. FUDforum will get your users talking.

Home » Imported messages » comp.lang.php » terminate a PHP script
Show: Today's Messages :: Polls :: Message Navigator
Return to the default flat view Create a new topic Submit Reply
Re: terminate a PHP script [message #172589 is a reply to message #172583] Tue, 22 February 2011 01:47 Go to previous messageGo to previous message
The Natural Philosoph is currently offline  The Natural Philosoph
Messages: 993
Registered: September 2010
Karma:
Senior Member
n00m wrote:
> Does not it (the FORTRAN code below) look charming?
> Btw it works perfectly (some time ago I re-wrote it
> into VB and into Pascal;.. crowds of mad GOTOS =)
> ==================================================================
>
>
> SUBROUTINE JOVOFD(N,C,X,Y,U,V,Z)
> INTEGER C(100,100),X(100),Y(100),U(100),V(100)
> INTEGER H,Z,L0,V0,VJ,DJ,UP,LOW
> INTEGER LAB(100),D(100),FREE(100),COL(100)
> C
> C THIS SUBROUTINE SOLVES THE FULL DENSITY LINEAR ASSIGNMENT PROBLEM
> C ACCORDING TO
> C
> C "A Shortest Augmenting Path Algorithm for Dense and Sparse
> Linear
> C Assignment Problems," Computing 38, 325-340, 1987
> C
> C by
> C
> C R. Jonker and A. Volgenant, University of Amsterdam.
> C
> C INPUT PARAMETERS :
> C N = NUMBER OF ROWS AND COLUMNS
> C C = WEIGHT MATRIX
> C
> C OUTPUT PARAMETERS
> C X = COL ASSIGNED TO ROW
> C Y = ROW ASSIGNED TO COL
> C U = DUAL ROW VARIABLE
> C V = DUAL COLUMN VARIABLE
> C Z = VALUE OF OPTIMAL SOLUTION
> C
> C INITIALIZATION
> DO 10 I=1,N
> X(I)=0
> 10 CONTINUE
> DO 20 J0=1,N
> J=N-J0+1
> VJ=C(J,1)
> I0=1
> DO 15 I=2,N
> IF (C(J,I).LT.VJ) THEN
> VJ=C(J,I)
> I0=I
> END IF
> 15 CONTINUE
> V(J)=VJ
> COL(J)=J
> IF (X(I0).EQ.0) THEN
> X(I0)=J
> Y(J)=I0
> ELSE
> X(I0)=-ABS(X(I0))
> Y(J)=0
> END IF
> 20 CONTINUE
> L=0
> DO 40 I=1,N
> IF (X(I).EQ.0) THEN
> L=L+1
> FREE(L)=I
> GOTO 40
> END IF
> IF (X(I).LT.0) THEN
> X(I)=-X(I)
> ELSE
> J1=X(I)
> MIN=1.E14
> DO 31 J=1,N
> IF (J.EQ.J1) GOTO 31
> IF (C(J,I)-V(J).LT.MIN) MIN=C(J,I)-V(J)
> 31 CONTINUE
> V(J1)=V(J1)-MIN
> END IF
> 40 CONTINUE
> C IMPROVE THE INITIAL SOLUTION
> CNT=0
> IF (L.EQ.0) GOTO 1000
> 41 L0=L
> K=1
> L=0
> 50 I=FREE(K)
> K=K+1
> V0=C(1,I)-V(1)
> J0=1
> VJ=1.E14
> DO 42 J=2,N
> H=C(J,I)-V(J)
> IF (H.LT.VJ) THEN
> IF (H.GE.V0) THEN
> VJ=H
> J1=J
> ELSE
> VJ=V0
> V0=H
> J1=J0
> J0=J
> END IF
> END IF
> 42 CONTINUE
> I0=Y(J0)
> IF (V0.LT.VJ) THEN
> V(J0)=V(J0)-VJ+V0
> ELSE
> IF (I0.EQ.0) GOTO 43
> J0=J1
> I0=Y(J1)
> END IF
> IF (I0.EQ.0) GOTO 43
> IF (V0.LT.VJ) THEN
> K=K-1
> FREE(K)=I0
> ELSE
> L=L+1
> FREE(L)=I0
> END IF
> 43 X(I)=J0
> Y(J0)=I
> IF (K.LE.L0) GOTO 50
> CNT=CNT+1
> IF ((L.GT.0).AND.(CNT.LT.2)) GOTO 41
> C AUGMENTATION PART
> L0=L
> DO 90 L=1,L0
> I0=FREE(L)
> DO 51 J=1,N
> D(J)=C(J,I0)-V(J)
> LAB(J)=I0
> 51 CONTINUE
> UP=1
> LOW=1
> 60 LAST=LOW-1
> MIN=D(COL(UP))
> UP=UP+1
> DO 52 K=UP,N
> J=COL(K)
> DJ=D(J)
> IF (DJ.LE.MIN) THEN
> IF (DJ.LT.MIN) THEN
> MIN=DJ
> UP=LOW
> END IF
> COL(K)=COL(UP)
> COL(UP)=J
> UP=UP+1
> END IF
> 52 CONTINUE
> DO 53 H=LOW,UP-1
> J=COL(H)
> IF (Y(J).EQ.0) GOTO 70
> 53 CONTINUE
> 55 J0=COL(LOW)
> LOW=LOW+1
> I=Y(J0)
> H=C(J0,I)-V(J0)-MIN
> DO 62 K=UP,N
> J=COL(K)
> VJ=C(J,I)-V(J)-H
> IF (VJ.LT.D(J)) THEN
> D(J)=VJ
> LAB(J)=I
> IF (VJ.EQ.MIN) THEN
> IF (Y(J).EQ.0) GOTO 70
> COL(K)=COL(UP)
> COL(UP)=J
> UP=UP+1
> END IF
> END IF
> 62 CONTINUE
> IF (LOW.EQ.UP) GOTO 60
> GOTO 55
> 70 DO 71 K=1,LAST
> J0=COL(K)
> V(J0)=V(J0)+D(J0)-MIN
> 71 CONTINUE
> 80 I=LAB(J)
> Y(J)=I
> K=J
> J=X(I)
> X(I)=K
> IF (I0.NE.I) GOTO 80
> 90 CONTINUE
> Z=0
> DO 100 I=1,N
> U(I)=C(X(I),I)-V(X(I))
> Z=Z+C(X(I),I)
> 100 CONTINUE
> 1000 END
>
>
were comments not a feature of FORTRAN?
[Message index]
 
Read Message
Read Message
Read Message
Read Message
Read Message
Read Message
Read Message
Read Message
Read Message
Read Message
Read Message
Read Message
Read Message
Read Message
Read Message
Read Message
Read Message
Read Message
Read Message
Read Message
Read Message
Read Message
Read Message
Read Message
Read Message
Read Message
Read Message
Read Message
Read Message
Read Message
Read Message
Read Message
Read Message
Read Message
Read Message
Read Message
Read Message
Read Message
Read Message
Read Message
Read Message
Read Message
Read Message
Read Message
Read Message
Read Message
Read Message
Read Message
Read Message
Read Message
Read Message
Read Message
Read Message
Read Message
Read Message
Read Message
Read Message
Read Message
Read Message
Read Message
Read Message
Read Message
Read Message
Read Message
Read Message
Read Message
Read Message
Read Message
Previous Topic: Extralight browser-webserver communication via cookies (+)
Next Topic: Storing multiple character set types (or a representation of em) in a table column
Goto Forum:
  

-=] Back to Top [=-
[ Syndicate this forum (XML) ] [ RSS ]

Current Time: Wed Nov 27 01:35:59 GMT 2024

Total time taken to generate the page: 0.03740 seconds