GENETIC 알고리즘인데 무엇이 잘못된거져?

[@이리]

IMPLICIT DOUBLE PRECISION (A-H,O-Z)
DIMENSION X(20),XMAX(20),XL(20),XU(20),FC(40)
CHARACTER POP1(40)*320,POP2(40)*320
INTEGER SEED
PRINT *, '***** GENETIC ALGORITHM *****'
PRINT *, '* A.D.BELEGUNDU & T.R.CHANDRUPATLA *'
PRINT *, '*****************************************'
PRINT *, 'Input SEED <upto 9 digit odd number>'
READ (5,*) SEED
C ----- #Variables N, #Binary Digits NB, #Population Size IZ,
C Number of Generations NGEN
DATA N,NB,IZ,NGEN / 6,8,8,50 /
C ----- Crossover Probability CP, Bitwise Mutation Prob. BP
DATA CP,BP / 1,.008 /
DATA (XL(I), I=1,6)/ 0.,0.,0.,0. /
DATA (XU(I), I=1,6)/ 10.,10.,10.,10. /
NFV = 0
C ----- Create Initial Population
CALL GETPOP(POP1,IZ,NB,N,SEED)
PRINT *, 'GENER# FITNESS'
IGEN = 0
10 IGEN = IGEN + 1
CALL EVAL‎(POP1,IZ,NB,N,FC,XL,XU,X,NFV,FIT,FMAX,XMAX)
C --- Stopping Criterion is based on number of generations
IF (IGEN .GT. NGEN) THEN
PRINT '(1X,A,I4,A)', 'Number of Generations Limit ', NGEN,
+ ' reached.'
GOTO 20
END IF
PRINT '(1X,I4,E12.4)', IGEN, FIT
C ----- Genetic Operations
CALL REPROD(POP1,POP2,FC,IZ)
CALL CROSVR(POP1,POP2,CP,IZ,NB,N,SEED)
CALL MUTATE(POP1,BP,IZ,NB,N,SEED)
GOTO 10
20 CONTINUE
PRINT '(1X,A,I4)', 'Number of Function Eval‎uations = ', NFV
PRINT '(1X,A,E12.4)', 'FMAX = ', FMAX
PRINT *, 'X() = '
PRINT '(1X,5E12.4/)', (XMAX(J),J=1,N)
END

FUNCTION RAND(K)
INTEGER K,M
REAL RAND
SAVE
DATA M /0/
IF (M.EQ.0) M=K
M=M*65539
IF (M.LT.0) M=(M+1)+2147483647
RAND = M*.4656613E-9
END

SUBROUTINE CROSVR (POP1,POP2,CP,IZ,NB,N,SEED)
IMPLICIT DOUBLE PRECISION (A-H,O-Z)
CHARACTER POP1(40)*320,POP2(40)*320,CC1*1,CC2*1
INTEGER SEED
REAL RAND
NBN = NB * N
IZ2 = IZ/2
DO 20 I = 1,IZ2
II = INT(RAND(SEED)*(NBN - 1)) + 1
I1 = 2 * I - 1
I2 = 2 * I
IF (I2 .GT. IZ) I2 = 1
IF (RAND(SEED).LE.CP) THEN
DO 10 K = 1,II
CC1 = POP2(I1)(K:K)
CC2 = POP2(I2)(K:K)
POP2(I1)(K:K) = CC2
POP2(I2)(K:K) = CC1
10 CONTINUE
END IF
20 CONTINUE
DO 30 I = 1,IZ
30 POP1(I) = POP2(I)
END

SUBROUTINE EVAL‎ (POP1,IZ,NB,N,FC,XL,XU,X,NFV,FIT,FMAX,XMAX)
IMPLICIT DOUBLE PRECISION (A-H,O-Z)
DIMENSION X(20),XMAX(20),XL(20),XU(20),FC(40)
CHARACTER POP1(40)*320
C --- DECODE BINARY STRING
FIT = 0
NSTEP = 2 ** NB - 1
NBN = NB * N
DO 40 I = 1,IZ
DO 10 J = 1,N
IB = 1
X(J) = XL(J)
D = (XU(J) - XL(J)) / NSTEP
KK = NBN
DO 10 K = 1,NB
IF (POP1(I)(KK:KK) .EQ.'0') V = 0.
IF (POP1(I)(KK:KK) .EQ.'1') V = 1.
X(J) = X(J) + IB * V
IB = 2 * IB
10 KK = KK - 1
CALL GETFUN(X,F,NFV)
AI = I
FIT = FIT + (F - FIT) / AI
IF (NFV .EQ. 1) THEN
FMAX = F
DO 20 J = 1,N
20 XMAX(J) = X(J)
ELSE
IF (FMAX .LT. F) THEN
FMAX = F
DO 30 J = 1,N
30 XMAX(J) = X(J)
END IF
END IF
40 FC(I) = F
END




SUBROUTINE GETPOP (POP1,IZ,NB,N,SEED)
IMPLICIT DOUBLE PRECISION (A-H,O-Z)
CHARACTER POP1(40)*320
INTEGER SEED
REAL RAND
DO 10 I = 1,IZ
DO 10 J = 1,N
JJ = (J-1)*NB
DO 10 K = 1,NB
JK = JJ + K
C = RAND(SEED)
IF (C .GT. .5) THEN
POP1(I)(JK:JK) = '1'
ELSE
POP1(I)(JK:JK) = '0'
END IF
10 CONTINUE
END

SUBROUTINE MUTATE (POP1,BP,IZ,NB,N,SEED)
IMPLICIT DOUBLE PRECISION (A-H,O-Z)
CHARACTER POP1(40)*320,CC*1
INTEGER SEED
REAL RAND
DO 10 I = 1,IZ
KK = 0
DO 10 J = 1,N
DO 10 K = 1,NB
KK = KK + 1
IF (RAND(SEED) .LE. BP) THEN
C --- Mutation Used
CC = POP1(I)(KK:KK)
IF (CC .EQ. '0') THEN
CC = '1'
ELSE
CC = '0'
END IF
POP1(I)(KK:KK) = CC
C --- Following one may be tried
C --- IF (RAND(SEED) .GT. .5) THEN CC = '1' ELSE CC = '0'
END IF
10 CONTINUE
END

SUBROUTINE REPROD (POP1,POP2,FC,IZ)
IMPLICIT DOUBLE PRECISION (A-H,O-Z)
DIMENSION FC(40)
CHARACTER POP1(40)*320,POP2(40)*320, CC*320
FL = FC(1)
FH = FC(1)
DO 10 I = 1,IZ
IF (FL .GT. FC(I)) FL = FC(I)
IF (FH .LT. FC(I)) FH = FC(I)
10 CONTINUE
SUM = 0.
C = ABS(FH)
IF (C .LT. 1) C = 1.
DO 20 I = 1,IZ
FC(I) = (FC(I) - FL) / C
20 SUM = SUM + FC(I)
IF (SUM .EQ. 0.) THEN
DO 30 I = 1,IZ
30 FC(I) = 1.
ELSE
C ----- Determination of String Count for Mating FC()
ISUM = 0
PSUM = 0
DO 40 I = 1,IZ
PSUM = PSUM + FC(I)
I1 = INT(IZ * PSUM / SUM + .001)
FC(I) = I1 - ISUM
40 ISUM = I1
END IF
C ----- Reproduction by Proportionate Selection
INEXT = 0
DO 60 I = 1,IZ
CC = POP1(I)
IFC=FC(I)
IF (IFC.GT.0) THEN
DO 50 K = 1,IFC
INEXT = INEXT + 1
50 POP2(INEXT) = CC
END IF
60 CONTINUE
END


SUBROUTINE GETFUN (X,F,NFV)
IMPLICIT DOUBLE PRECISION (A-H,O-Z)
DIMENSION X(25),EL(4),S(4)
EL(1) = 3.
EL(2) = 4.
EL(3) = 5.
EL(4) = 6.
S(1) = 500000.
S(2) = 375000.
S(3) = 300000.
S(4) = 250000.
F = 0.
DO 10 I = 1,4
IF (I .EQ. 1) THEN
X1 = 0.
Y1 = 0
ELSE
X1 = X(2 * I - 3)
Y1 = X(2 * I - 2)
END IF
IF (I .EQ. 4) THEN
X2 = 16.
Y2 = 0.
ELSE
X2 = X(2 * I - 1)
Y2 = X(2 * I)
END IF
D = SQRT((X2 - X1)**2 + (Y2 - Y1)**2) - EL(I)
IF (D .GT. 0.) F = F + .5 * S(I) * D**2
10 CONTINUE
F = F - 100. * X(2) - 100. * X(4) - 100. * X(6)
NFV = NFV + 1
END

유전자(돌연변이) 알고리즘이라고 하는 것인데 원래 예제 프로그램에서 첨에 N값이랑 마지막에 function 부분인 EL(1) , EL(2)로 시작하는 부분만 바꾸었는데 에러는 안나는데 원하는 값이 안나오네요.. 좀 길어서 ㅈㅅ해요.

[최권일]

제가 자세하게 보지는 못했는데요... 15번째줄에 DATA (XL(I), I=1,6)/ 0.,0.,0.,0. /에서 앞에 4개만 값이 들어가고, 뒤에 2개는 값이 쓰레기 값으로 들어갈것 같네요... 즉, xl(5)와 xl(6)에는 값이 정의가 안되어 있는것 같습니다.

[최권일]

array xu도 마찬가지가 되겠네요