fortran多目标灰狼优化算法代码

以下是Fortran语言实现的多目标灰狼优化算法代码示例：

PROGRAM MOGWO

! 多目标灰狼优化算法

IMPLICIT NONE

INTEGER, PARAMETER :: N = 30 ! 优化问题的维数
INTEGER, PARAMETER :: M = 2 ! 目标函数的数量
INTEGER, PARAMETER :: MAX_ITER = 100 ! 最大迭代次数
INTEGER, PARAMETER :: POP_SIZE = 50 ! 种群大小
REAL, PARAMETER :: LB = -10.0 ! 优化问题的下限
REAL, PARAMETER :: UB = 10.0 ! 优化问题的上限
REAL, PARAMETER :: A = 2.0 ! 系数A
REAL, PARAMETER :: R1 = 0.5 ! 系数R1
REAL, PARAMETER :: R2 = 0.5 ! 系数R2

REAL, DIMENSION(POP_SIZE, N) :: X ! 种群中所有个体的位置
REAL, DIMENSION(POP_SIZE, N) :: V ! 种群中所有个体的速度
REAL, DIMENSION(POP_SIZE, M) :: F ! 种群中所有个体的目标函数值
REAL, DIMENSION(POP_SIZE) :: D ! 种群中所有个体的拥挤度
INTEGER, DIMENSION(POP_SIZE) :: RANK ! 种群中所有个体的非支配排名
INTEGER, DIMENSION(POP_SIZE) :: CROWDING_DIST ! 种群中所有个体的拥挤距离
REAL, DIMENSION(2) :: Z ! 对于每个目标函数，种群中所有个体目标函数值的最小值
INTEGER, DIMENSION(2) :: Z_IDX ! 对于每个目标函数，最优个体在种群中的索引
REAL, DIMENSION(N) :: LB_ARR, UB_ARR ! 每个维度的下限和上限
INTEGER :: I, J, K, L, M1, M2, N1, N2, ITER, IDX1, IDX2, POP_SIZE2, RANK_SIZE
REAL :: U, W, Z_MIN, Z_MAX, DIST, DIST_SUM, DIST_SUM_MAX, OBJ1, OBJ2
LOGICAL :: DOMINATES

! 初始化下限和上限
LB_ARR = LB
UB_ARR = UB

! 初始化种群
DO I = 1, POP_SIZE
    DO J = 1, N
        X(I, J) = LB_ARR(J) + (UB_ARR(J) - LB_ARR(J)) * RAND()
        V(I, J) = 0.0
    END DO
END DO

! 进行迭代
DO ITER = 1, MAX_ITER

    ! 计算所有个体的目标函数值
    DO I = 1, POP_SIZE
        CALL OBJECTIVE(X(I, :), F(I, :))
    END DO

    ! 计算每个目标函数的最优值和最优个体
    DO J = 1, M
        Z(J) = F(1, J)
        Z_IDX(J) = 1
        DO I = 2, POP_SIZE
            IF (F(I, J) < Z(J)) THEN
                Z(J) = F(I, J)
                Z_IDX(J) = I
            END IF
        END DO
    END DO

    ! 计算每个个体的拥挤度
    DO I = 1, POP_SIZE
        D(I) = 0.0
    END DO
    DO J = 1, M
        CALL SORT_BY_OBJ(F(:, J), RANK)
        RANK_SIZE = 0
        DO I = 1, POP_SIZE
            IF (RANK(I) == 1) THEN
                RANK_SIZE = RANK_SIZE + 1
            END IF
        END DO
        IF (RANK_SIZE > 2) THEN
            CROWDING_DIST = 0
            DO I = 1, POP_SIZE
                CROWDING_DIST(I) = CROWDING_DIST(I) + (F(RANK(I) + 1, J) - F(RANK(I) - 1, J)) / (Z(J) - Z(J))
            END DO
            DO I = 1, POP_SIZE
                D(I) = D(I) + CROWDING_DIST(I)
            END DO
        END IF
    END DO

    ! 更新所有个体的速度和位置
    DO I = 1, POP_SIZE
        DO J = 1, N
            V(I, J) = A * V(I, J) + R1 * RAND() * (X(Z_IDX(1), J) - X(I, J)) + R2 * RAND() * (X(Z_IDX(2), J) - X(I, J))
            X(I, J) = X(I, J) + V(I, J)
            IF (X(I, J) < LB_ARR(J)) THEN
                X(I, J) = LB_ARR(J)
                V(I, J) = -V(I, J)
            ELSE IF (X(I, J) > UB_ARR(J)) THEN
                X(I, J) = UB_ARR(J)
                V(I, J) = -V(I, J)
            END IF
        END DO
    END DO

    ! 计算所有个体的目标函数值
    DO I = 1, POP_SIZE
        CALL OBJECTIVE(X(I, :), F(I, :))
    END DO

    ! 计算每个个体的非支配排名
    DO I = 1, POP_SIZE
        RANK(I) = 1
        DO J = 1, POP_SIZE
            IF (I /= J) THEN
                DOMINATES = .TRUE.
                DO K = 1, M
                    IF (F(I, K) > F(J, K)) THEN
                        DOMINATES = .FALSE.
                        EXIT
                    END IF
                END DO
                IF (DOMINATES) THEN
                    RANK(I) = RANK(I) + 1
                END IF
            END IF
        END DO
    END DO

    ! 计算每个非支配层的拥挤距离
    DO J = 1, M
        CALL SORT_BY_OBJ(F(:, J), RANK)
        N1 = 1
        N2 = 1
        CROWDING_DIST = 0
        CROWDING_DIST(1) = HUGE(0.0)
        CROWDING_DIST(POP_SIZE) = HUGE(0.0)
        DO I = 2, POP_SIZE - 1
            CROWDING_DIST(I) = CROWDING_DIST(I) + (F(I + 1, J) - F(I - 1, J)) / (Z(J) - Z(J))
        END DO
        DO I = 1, POP_SIZE
            IF (RANK(I) == N1) THEN
                N2 = N2 + 1
            ELSE
                CALL CALC_CROWDING_DIST(CROWDING_DIST, N1, N2)
                N1 = RANK(I)
                N2 = 1
            END IF
            CROWDING_DIST(I) = CROWDING_DIST(I) / N2
        END DO
        CALL CALC_CROWDING_DIST(CROWDING_DIST, N1, N2)
        DO I = 1, POP_SIZE
            F(I, J + M) = CROWDING_DIST(I)
        END DO
    END DO

    ! 计算所有个体的拥挤度
    DIST_SUM_MAX = 0.0
    DO I = 1, POP_SIZE
        DIST_SUM = 0.0
        DO J = 1, POP_SIZE
            IF (I /= J) THEN
                DIST = 0.0
                DO K = 1, M
                    DIST = DIST + (F(I, K) - F(J, K))**2
                END DO
                DIST_SUM = DIST_SUM + SQRT(DIST)
            END IF
        END DO
        IF (DIST_SUM > DIST_SUM_MAX) THEN
            DIST_SUM_MAX = DIST_SUM
        END IF
        D(I) = DIST_SUM
    END DO

    ! 计算每个个体的非支配排名和拥挤度
    POP_SIZE2 = POP_SIZE / 2
    DO I = 1, POP_SIZE2
        M1 = 2 * I - 1
        M2 = 2 * I
        OBJ1 = F(M1, 1) + F(M1, 2)
        OBJ2 = F(M2, 1) + F(M2, 2)
        IF (RANK(M1) < RANK(M2) .OR. (RANK(M1) == RANK(M2) .AND. D(M1) > D(M2))) THEN
            X(M1, :) = X(M1, :)
            F(M1, :) = F(M1, :)
        ELSE
            X(M1, :) = X(M2, :)
            F(M1, :) = F(M2, :)
        END IF
        IF (RANK(M2) < RANK(M1) .OR. (RANK(M2) == RANK(M1) .AND. D(M2) > D(M1))) THEN
            X(M2, :) = X(M2, :)
            F(M2, :) = F(M2, :)
        ELSE
            X(M2, :) = X(M1, :)
            F(M2, :) = F(M1, :)
        END IF
    END DO

    ! 输出当前迭代次数和每个目标函数的最优值
    WRITE(*, '(I4, 2(F10.6, 1X))') ITER, Z

END DO

END PROGRAM MOGWO


! 计算目标函数值
SUBROUTINE OBJECTIVE(X, F)

IMPLICIT NONE

REAL, DIMENSION(N) :: X ! 个体的位置
REAL, DIMENSION(M) :: F ! 个体的目标函数值

INTEGER :: I

! 计算目标函数值
F(1) = 0.0
F(2) = 0.0
DO I = 1, N
    F(1) = F(1) + X(I)**2
    F(2) = F(2) + (X(I) - 2.0)**2
END DO

END SUBROUTINE OBJECTIVE


! 按照目标函数值排序
SUBROUTINE SORT_BY_OBJ(F, RANK)

IMPLICIT NONE

REAL, DIMENSION(POP_SIZE, M) :: F ! 种群中所有个体的目标函数值
INTEGER, DIMENSION(POP_SIZE) :: RANK ! 种群中所有个体的非支配排名

INTEGER :: I, J, K, L, N_DOMINATED

LOGICAL :: DOMINATES

! 初始化非支配排名
RANK = 1

! 计算非支配排名
DO I = 1, POP_SIZE
    DO J = 1, POP_SIZE
        IF (I /= J) THEN
            DOMINATES = .TRUE.
            DO K = 1, M
                IF (F(I, K) > F(J, K)) THEN
                    DOMINATES = .FALSE.
                    EXIT
                END IF
            END DO
            IF (DOMINATES) THEN
                RANK(I) = RANK(I) + 1
            END IF
        END IF
    END DO
END DO

! 排序
DO I = 1, POP_SIZE - 1
    DO J = I + 1, POP_SIZE
        IF (RANK(I) > RANK(J)) THEN
            L = I
            I = J
            J = L
        ELSE IF (RANK(I) == RANK(J)) THEN
            N_DOMINATED = 0
            DO K = 1, M
                IF (F(I, K) < F(J, K)) THEN
                    N_DOMINATED = N_DOMINATED + 1
                ELSE IF (F(I, K) > F(J, K)) THEN
                    N_DOMINATED = N_DOMINATED - 1
                END IF
            END DO
            IF (N_DOMINATED > 0) THEN
                L = I
                I = J
                J = L
            END IF
        END IF
    END DO
END DO

END SUBROUTINE SORT_BY_OBJ


! 计算拥挤距离
SUBROUTINE CALC_CROWDING_DIST(DIST, N1, N2)

IMPLICIT NONE

REAL, DIMENSION(POP_SIZE) :: DIST ! 种群中所有个体的拥挤距离
INTEGER :: N1 ! 非支配层的起始排名
INTEGER :: N2 ! 非支配层的大小

INTEGER, DIMENSION(POP_SIZE) :: IDX ! 种群中所有个体的索引
INTEGER, DIMENSION(POP_SIZE) :: SORTED_IDX ! 排序后的个体索引
REAL, DIMENSION(POP_SIZE) :: SORTED_DIST ! 排序后的个体拥挤距离

INTEGER :: I, J, K, L, M

! 初始化索引
DO I = 1, POP_SIZE
    IDX(I) = I
END DO

! 对于每个目标函数，按照目标函数值排序
DO J = 1, M
    DO I = 1, POP_SIZE - 1
        DO K = I + 1, POP_SIZE
            IF (DIST(IDX(I)) < DIST(IDX(K))) THEN
                L = IDX(I)
                IDX(I) = IDX(K)
                IDX(K) = L
            END IF
        END DO
    END DO
    SORTED_IDX = IDX
    DO I = 1, POP_SIZE
        SORTED_DIST(I) = DIST(SORTED_IDX(I))
    END DO
    DO I = 1, N1 - 1
        SORTED_DIST(I) = 0.0
    END DO
    DO I = N1 + N2, POP_SIZE
        SORTED_DIST(I) = 0.0
    END DO
    DO I = N1, N1 + N2 - 1
        IF (SORTED_DIST(I) /= HUGE(0.0)) THEN
            SORTED_DIST(I) = (SORTED_DIST(I + 1) - SORTED_DIST(I - 1)) / (F(SORTED_IDX(I + 1), J) - F(SORTED_IDX(I - 1), J))
        END IF
    END DO
    DO I = 1, POP_SIZE
        DIST(SORTED_IDX(I)) = SORTED_DIST(I)
    END DO
END DO

END SUBROUTINE CALC_CROWDING_DIST

在以上代码中，`OBJECTIVE`子程序计算目标函数值，`SORT_BY_OBJ`子程序按照目标函数值排序，`CALC_CROWDING_DIST`子程序计算拥挤距离。主程序中的第一个循环用于初始化种群，第二个循环用于迭代，其中计算每个个体的目标函数值、拥挤度、非支配排名和拥挤距离，更新所有个体的速度和位置，输出当前迭代次数和每个目标函数的最优值。