📄 sga.f90
字号:
REAL,DIMENSION(:,:),ALLOCATABLE :: XYcen, XYran
REAL,DIMENSION(:,:),ALLOCATABLE :: XYcenT,XYcen1
REAL,DIMENSION(:),ALLOCATABLE :: XboundL,FIT,Pslt
REAL,DIMENSION(:),ALLOCATABLE :: XYran1,FITNESS
REAL,DIMENSION(:,:),ALLOCATABLE :: XYcen2
REAL,DIMENSION(:,:),ALLOCATABLE :: XYcen3
REAL,DIMENSION(:,:),ALLOCATABLE :: XYcenO
INTEGER,PARAMETER :: Npop=300
INTEGER,PARAMETER :: Nslt=20
REAL,DIMENSION(3):: Urand
REAL,DIMENSION(3*Npop):: FITtmp
REAL,DIMENSION(3*Npop):: FIT0
ALLOCATE(XYcen(2,Npop), XYran(2,Npop))
ALLOCATE(XYcenT(2,3*Npop),XYcen1(2,Npop))
ALLOCATE(XboundL(Npop),FIT(Npop),Pslt(Npop))
ALLOCATE(XYran1(Npop),FITNESS(Npop))
ALLOCATE(XYcen2(2,Npop))
ALLOCATE(XYcen3(2,Npop))
ALLOCATE(XYcenO(2,3*Npop))
OPEN(14,FILE='XYO.DAT')
XboundR=10 !0.0
YboundU=10 !40.0
YboundB=-10 !10.0
! /*父代群体的初始化*/
! CALL RANDOM_SEED()
CALL RANDOM_NUMBER (XYran)
DO I=1,Npop
XYcen(2,i)=YboundB+XYran(2,i)*(YboundU-YboundB)
XboundL(I)=-10 !YboundB-XYcen(2,I)
XYcen(1,I)=XboundL(I)+XYran(1,i)*(XboundR-XboundL(I))
ENDDO
DO I=1,Npop
Xtemp=XYcen(1,I)
ytemp=XYcen(2,I)
FIT(I)=FUNC(Xtemp,ytemp)
ENDDO
! write(14,20)((XYcen(J,I),J=1,2),FIT(I),I=1,Npop)
DO I=1,Npop
FITtmp(I)=FIT(I)
ENDDO
CALL SORT2(Npop,FITtmp)
DO I=1,Npop
DO J=1,Npop
IF(FITtmp(I)==FIT(J))THEN
XYcenT(1,I)=XYcen(1,J)
XYcenT(2,I)=XYcen(2,J)
ENDIF
ENDDO
ENDDO
DO I=1,Npop
FIT(I)=FITtmp(I)
XYcen(1,I)=XYcenT(1,I)
XYcen(2,I)=XYcenT(2,I)
ENDDO
write(14,20)((XYcen(J,I),J=1,2),FIT(I),I=1,Npop)
DO IR=1,7
! /*父代群体的适应度评价*/
DO I=1,Npop
FITNESS(I)=1.0/(FIT(I)*FIT(I)+0.001) !
ENDDO
! write(14,*)'适应度'
! write(14,20)((XYcen(J,I),J=1,2),FITNESS(I),I=1,Npop)
! /*选择操作，产生NO.1 子代群体*/
! /*Pslt(i): 选择概率；子代群体：XYcen1(2,i)*/
SUM=0.0
DO I=1,Npop
SUM=SUM+FITNESS(I)
ENDDO
DO I=1,Npop
Pslt(I)=FITNESS(I)/SUM
ENDDO
DO I=1,Npop
SUM=0.0
DO J=1,I
SUM=SUM+Pslt(J)
ENDDO
FITtmp(I)=SUM
ENDDO
! CALL RANDOM_SEED()
CALL RANDOM_NUMBER (XYran1)
DO I=1,Npop-Nslt
IF(XYran1(I).GT.0.0.AND.XYran1(I).LE.FITtmp(1))THEN
XYcen1(1,I)=XYcen(1,1)
XYcen1(2,I)=XYcen(2,1)
ENDIF
DO J=2,Npop
IF(XYran1(I).GT.FITtmp(J-1).AND.XYran1(I).LE.FITtmp(J))THEN
XYcen1(1,I)=XYcen(1,J)
XYcen1(2,I)=XYcen(2,J)
ENDIF
ENDDO
ENDDO
DO I=1,Nslt
XYcen1(1,I+Npop-Nslt)=XYcen(1,I)
XYcen1(2,I+Npop-Nslt)=XYcen(2,I)
ENDDO
! write(14,*)'选择概率'
! write(14,20)((XYcen(J,I),J=1,2),Pslt(I),I=1,Npop)
! write(14,*)'累计选择概率'
! write(14,20)((XYcen(J,I),J=1,2),FITtmp(I),I=1,Npop)
! write(14,*)'子代群体1'
! write(14,20)((XYcen1(J,I),J=1,2),XYran1(I),I=1,Npop)
! /*杂交操作，产生NO.2 子代群体*/
! /*Pslt(i): 选择概率；子代群体：XYcen2(2,i)*/
DO I=1,Npop
Xtemp1=0.0
Ytemp1=0.0
Xtemp2=0.0
Ytemp2=0.0
Urand=0.0
! CALL RANDOM_SEED()
CALL RANDOM_NUMBER (Urand)
IF(Urand(1).GT.0.0.AND.Urand(1).LE.FITtmp(1))THEN
Xtemp1=XYcen(1,1)
Ytemp1=XYcen(2,1)
ENDIF
DO J=2,Npop
IF(Urand(1).GT.FITtmp(J-1).AND.Urand(1).LE.FITtmp(J))THEN
Xtemp1=XYcen(1,J)
Ytemp1=XYcen(2,J)
ENDIF
ENDDO
IF(Urand(2).GT.0.0.AND.Urand(2).LE.FITtmp(1))THEN
Xtemp2=XYcen(1,1)
Ytemp2=XYcen(2,1)
ENDIF
DO J=2,Npop
IF(Urand(2).GT.FITtmp(J-1).AND.Urand(2).LE.FITtmp(J))THEN
Xtemp2=XYcen(1,J)
Ytemp2=XYcen(2,J)
ENDIF
ENDDO
IF(Urand(3).LT.0.5)THEN
XYcen2(1,I)=Urand(1)*Xtemp1+(1.0-Urand(1))*Xtemp2
XYcen2(2,I)=Urand(1)*Ytemp1+(1.0-Urand(1))*Ytemp2
ENDIF
IF(Urand(3).GE.0.5)THEN
XYcen2(1,I)=Urand(2)*Xtemp1+(1.0-Urand(2))*Xtemp2
XYcen2(2,I)=Urand(2)*Ytemp1+(1.0-Urand(2))*Ytemp2
ENDIF
ENDDO
!! write(14,*)'子代群体2'
!! write(14,20)((XYcen2(J,I),J=1,2),FITtmp(I),I=1,Npop)
! /*变异操作，产生NO.3 子代群体*/
! /*Pslt(i): 选择概率；子代群体：XYcen3(2,i)*/
SUM=0.0
DO I=1,Npop
Pslt(I)=1.0-Pslt(I)
ENDDO
DO I=1,Npop
Urand=0.0
! CALL RANDOM_SEED()
CALL RANDOM_NUMBER (Urand)
IF(Urand(3).LT.Pslt(I))THEN
XYcen3(2,i)=YboundB+Urand(1)*(YboundU-YboundB)
XboundL(I)=-10 !YboundB-XYcen(2,I)
XYcen3(1,I)=XboundL(I)+Urand(2)*(XboundR-XboundL(I))
ENDIF
IF(Urand(3).GE.Pslt(I))THEN
XYcen3(2,i)=XYcen(2,i)
XYcen3(1,I)=XYcen(1,I)
ENDIF
ENDDO
!! write(14,*)'子代群体3'
! ! write(14,20)((XYcen3(J,I),J=1,2),Pslt(I),I=1,Npop)
KM=0
DO I=1,Npop
FLAG=0.0
DO J=1,Npop
IF(XYcen3(1,I)==XYcen(1,J).AND.XYcen3(2,I)==XYcen(2,J))THEN
FLAG=1.0
EXIT
ENDIF
ENDDO
IF(FLAG==0.0)THEN
KM=KM+1
XYcenO(1,KM)=XYcen3(1,I)
XYcenO(2,KM)=XYcen3(2,I)
ENDIF
ENDDO
DO I=1,Npop
FLAG=0.0
DO J=1,Npop
IF(XYcen2(1,I)==XYcen(1,J).AND.XYcen2(2,I)==XYcen(2,J))THEN
FLAG=1.0
EXIT
ENDIF
ENDDO
IF(FLAG==0.0)THEN
KM=KM+1
XYcenO(1,KM)=XYcen2(1,I)
XYcenO(2,KM)=XYcen2(2,I)
ENDIF
ENDDO
DO I=1,Npop
FLAG=0.0
DO J=1,Npop
IF(XYcen1(1,I)==XYcen(1,J).AND.XYcen1(2,I)==XYcen(2,J))THEN
FLAG=1.0
EXIT
ENDIF
ENDDO
IF(FLAG==0.0)THEN
KM=KM+1
XYcenO(1,KM)=XYcen1(1,I)
XYcenO(2,KM)=XYcen1(2,I)
ENDIF
ENDDO
! write(14,*)'子代群体'
! write(14,30)((XYcenO(J,I),J=1,2),I=1,KM)
DO I=1,KM
Xtemp=XYcenO(1,I)
ytemp=XYcenO(2,I)
FIT0(I)=FUNC(Xtemp,ytemp)
ENDDO
! write(14,20)((XYcen(J,I),J=1,2),FIT(I),I=1,Npop)
DO I=1,Npop
FIT0(I+KM)=FIT(I)
ENDDO
DO I=1,Npop
XYcenO(1,I+KM)=XYcen(1,I)
XYcenO(2,I+KM)=XYcen(2,I)
ENDDO
KM=KM+Npop
DO I=1,KM
FITtmp(I)=FIT0(I)
ENDDO
CALL SORT2(KM,FITtmp)
DO I=1,KM
DO J=1,KM
IF(FITtmp(I)==FIT0(J))THEN
XYcenT(1,I)=XYcenO(1,J)
XYcenT(2,I)=XYcenO(2,J)
ENDIF
ENDDO
ENDDO
DO I=1,KM
FIT0(I)=FITtmp(I)
XYcenO(1,I)=XYcenT(1,I)
XYcenO(2,I)=XYcenT(2,I)
ENDDO
write(14,20)((XYcenO(J,I),J=1,2),FIT0(I),I=1,KM)
DO I=1,Npop
FIT(I)=FIT0(I)
XYcen(1,I)=XYcenO(1,I)
XYcen(2,I)=XYcenO(2,I)
ENDDO
ENDDO
! write(14,*)'OVER==============='
write(14,20)((XYcen(J,I),J=1,2),FIT(I),I=1,Npop)
20 format(3f25.10)
write(*,30)((XYran(J,I),J=1,2),I=1,Npop)
30 format(2f25.10)
end
FUNCTION FUNC(X,Y)
FUNC=SIN(3.0*3.1415*X)**2.0+
*(X-1.0)**2.0*(1.0+SIN(3.0*3.1415*X)**2.0)+
*(Y-1.0)**2.0*(1.0+SIN(3.0*3.1415*Y)**2.0)
! 100.0*(X**2.0-Y)**2.0+(1.0-X)**2.0 !(4.0-2.1*(X**2.0)+(X**4.0)/3.0)*(X**2.0)+X*Y+
! *(4.0*(Y**2.0)-4.0)*(Y**2.0) !
END FUNCTION FUNC
SUBROUTINE sort2(n,ra)
REAL ra(n)
INTEGER i,ir,j,l
REAL a,aaa,rra
l=n/2+1
ir=n
do
if (l>1) then
l=l-1
rra=ra(l)
else
rra=ra(ir)
ra(ir)=ra(1)
ir=ir-1
if (ir==1) then
ra(1)=rra
return
endif
endif
i=l
j=l+l
do while(j<=ir)
aaa=1.
if (j<ir) then
if (ra(j)<ra(j+1)) j=j+1
endif
if (rra<ra(j)) then
ra(i)=ra(j)
i=j
j=j+j
else
j=ir+1
endif
end do
ra(i)=rra
end do
END SUBROUTINE sort2
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -