cnmn06 Subroutine

    subroutine cnmn06(me, x, vlb, vub, g, scal, df, s, g1, g2, ctam, ctbm, slope, alp, a2, a3, a4, &
                      f1, f2, f3, cv1, cv2, cv3, cv4, alpca, alpfes, alpln, alpmin, alpnc, &
                      alpsav, alpsid, alptot, isc, ncal, nvc, icount, igood1, &
                      igood2, igood3, igood4, ibest, iii, nlnc, jgoto)

        !!  Routine to solve one-dimensional search problem for constrained
        !!  function minimization.
        !!
        !!  BY G. N. VANDERPLAATS, AUG., 1974.
        !!
        !!  * OBJ = INITIAL AND FINAL FUNCTION VALUE.
        !!  * ALP = MOVE PARAMETER.
        !!  * SLOPE = INITIAL SLOPE.
        !!  * ALPSID = MOVE TO SIDE CONSTRAINT.
        !!  * ALPFES = MOVE TO FEASIBLE REGION.
        !!  * ALPNC = MOVE TO NEW NON-LINEAR CONSTRAINT.
        !!  * ALPLN = MOVE TO LINEAR CONSTRAINT.
        !!  * ALPCA = MOVE TO RE-ENCOUNTER CURRENTLY ACTIVE CONSTRAINT.
        !!  * ALPMIN = MOVE TO MINIMIZE FUNCTION.
        !!  * ALPTOT = TOTAL MOVE PARAMETER.

        class(conmin_class), intent(inout) :: me
        real(wp), intent(inout)   :: x(:), vlb(:), vub(:), g(:), scal(:), df(:), &
                                     s(:), g1(:), g2(:), ctam, ctbm, slope, alp, &
                                     a2, a3, a4, f1, f2, f3, cv1, cv2, cv3, cv4, &
                                     alpca, alpfes, alpln, alpmin, alpnc, alpsav, &
                                     alpsid, alptot
        integer, intent(inout)     :: isc(:), ncal(2), nvc, icount, igood1, igood2, &
                                      igood3, igood4, ibest, iii, nlnc, jgoto

        real(wp)  :: alpa, alpb, c1, c2, c3, cc, f4, gi, si, xi, xi1, xi2
        integer   :: i, ii, jbest, ksid, nvc1
        real(wp), parameter :: zro = 0.0_wp

        if (jgoto /= 0) then
            select case (jgoto)
            case (1); go to 70
            case (2); go to 140
            case (3); go to 230
            end select
        end if
        if (me%iprint >= 5) write (me%iunit, 5100)
        alpsav = alp
        icount = 0
        alptot = 0.0_wp
        ! TOLERANCES.
        ctam = abs(me%ctmin)
        ctbm = abs(me%ctlmin)
        ! PROPOSED MOVE.
        ! ------------------------------------------------------------------
        ! *****  BEGIN SEARCH OR IMPOSE SIDE CONSTRAINT MODIFICATION  *****
        ! ------------------------------------------------------------------
10      a2 = alpsav
        icount = icount + 1
        alpsid = me%large
        ! INITIAL ALPHA AND OBJ.
        alp = 0.0_wp
        f1 = me%obj
        ksid = 0
        if (me%nside /= 0) then
            ! ------------------------------------------------------------------
            ! FIND MOVE TO SIDE CONSTRAINT AND INSURE AGAINST VIOLATION OF
            ! SIDE CONSTRAINTS
            ! ------------------------------------------------------------------
            do i = 1, me%ndv
                si = s(i)
                if (abs(si) <= me%small) then
                    ! ITH COMPONENT OF S IS SMALL.  SET TO ZERO.
                    s(i) = 0.0_wp
                    slope = slope - si*df(i)
                else
                    xi = x(i)
                    si = 1.0_wp/si
                    if (si <= 0.0_wp) then
                        ! LOWER BOUND.
                        xi2 = vlb(i)
                        xi1 = abs(xi2)
                        if (xi1 < 1.0_wp) xi1 = 1.0_wp
                        ! CONSTRAINT VALUE.
                        gi = (xi2 - xi)/xi1
                        if (gi > -1.0e-6_wp) go to 20
                        ! PROPOSED MOVE TO LOWER BOUND.
                        alpa = (xi2 - xi)*si
                        if (alpa < alpsid) alpsid = alpa
                        cycle
                    end if
                    ! UPPER BOUND.
                    xi2 = vub(i)
                    xi1 = abs(xi2)
                    if (xi1 < 1.0_wp) xi1 = 1.0_wp
                    ! CONSTRAINT VALUE.
                    gi = (xi - xi2)/xi1
                    if (gi <= -1.0e-6_wp) then
                        ! PROPOSED MOVE TO UPPER BOUND.
                        alpa = (xi2 - xi)*si
                        if (alpa < alpsid) alpsid = alpa
                        cycle
                    end if

                    ! MOVE WILL VIOLATE SIDE CONSTRAINT.  SET S(I)=0.
20                  slope = slope - s(i)*df(i)
                    s(i) = 0.0_wp
                    ksid = ksid + 1
                end if
            end do
            ! ALPSID IS UPPER BOUND ON ALPHA.
            if (a2 > alpsid) a2 = alpsid
        end if
        ! ------------------------------------------------------------------
        !           CHECK ILL-CONDITIONING
        ! ------------------------------------------------------------------
        if (ksid == me%ndv .or. icount > 10) go to 340
        if (nvc == 0 .and. slope > 0.0_wp) go to 340
        alpfes = -1.0_wp
        alpmin = -1.0_wp
        alpln = 1.1_wp*alpsid
        alpnc = alpsid
        alpca = alpsid
        if (me%ncon /= 0) then
            ! STORE CONSTRAINT VALUES IN G1.
            do i = 1, me%ncon
                g1(i) = g(i)
            end do
        end if
        !  ------------------------------------------------------------------
        !               MOVE A DISTANCE A2*S
        !  ------------------------------------------------------------------
        alptot = alptot + a2
        do i = 1, me%ndv
            x(i) = x(i) + a2*s(i)
        end do
        if (me%iprint >= 5) then
            write (me%iunit, 5200) a2
            if (me%nscal /= 0) then
                do i = 1, me%ndv
                    g(i) = scal(i)*x(i)
                end do
                write (me%iunit, 5300) (g(i), i=1, me%ndv)
            else
                write (me%iunit, 5300) (x(i), i=1, me%ndv)
            end if
        end if
        ! ------------------------------------------------------------------
        !               UPDATE FUNCTION AND CONSTRAINT VALUES
        ! ------------------------------------------------------------------
        ncal(1) = ncal(1) + 1
        jgoto = 1
        return

70      f2 = me%obj
        if (me%iprint >= 5) write (me%iunit, 5400) f2
        if (me%iprint >= 5 .and. me%ncon /= 0) then
            write (me%iunit, 5500)
            write (me%iunit, 5300) (g(i), i=1, me%ncon)
        end if
        ! ------------------------------------------------------------------
        !           IDENTIFY ACCAPTABILITY OF DESIGNS F1 AND F2
        ! ------------------------------------------------------------------
        ! IGOOD = 0 IS ACCAPTABLE.
        ! CV = MAXIMUM CONSTRAINT VIOLATION.
        igood1 = 0
        igood2 = 0
        cv1 = 0.0_wp
        cv2 = 0.0_wp
        nvc1 = 0
        if (me%ncon /= 0) then
            do i = 1, me%ncon
                cc = ctam
                if (isc(i) > 0) cc = ctbm
                c1 = g1(i) - cc
                c2 = g(i) - cc
                if (c2 > 0.0_wp) nvc1 = nvc1 + 1
                if (c1 > cv1) cv1 = c1
                if (c2 > cv2) cv2 = c2
            end do
            if (cv1 > 0.0_wp) igood1 = 1
            if (cv2 > 0.0_wp) igood2 = 1
        end if
        alp = a2
        me%obj = f2
        ! ------------------------------------------------------------------
        ! IF F2 VIOLATES FEWER CONSTRAINTS THAN F1 BUT STILL HAS CONSTRAINT
        ! VIOLATIONS RETURN
        ! ------------------------------------------------------------------
        if (nvc1 < nvc .and. nvc1 > 0) go to 340
        ! ------------------------------------------------------------------
        !         IDENTIFY BEST OF DESIGNS F1 ANF F2
        ! ------------------------------------------------------------------
        ! IBEST CORRESPONDS TO MINIMUM VALUE DESIGN.
        ! IF CONSTRAINTS ARE VIOLATED, IBEST CORRESPONDS TO MINIMUM
        ! CONSTRAINT VIOLATION.
        if (igood1 /= 0 .or. igood2 /= 0) then
            ! VIOLATED CONSTRAINTS.  PICK MINIMUM VIOLATION.
            ibest = 1
            if (cv1 >= cv2) ibest = 2
        else
            ! NO CONSTRAINT VIOLATION.  PICK MINIMUM F.
            ibest = 1
            if (f2 <= f1) ibest = 2
        end if
        ii = 1
        ! ------------------------------------------------------------------
        ! IF CV2 IS GREATER THAN CV1, SET MOVE LIMITS TO A2.
        ! PROGRAM MOD-FEB, 1981, GV.
        ! ------------------------------------------------------------------
        if (cv2 > cv1) then
            alpln = a2
            alpnc = a2
            alpca = a2
        end if
        if (me%ncon /= 0) then
            ! ------------------------------------------------------------------
            ! *****                 2 - POINT INTERPOLATION                *****
            ! ------------------------------------------------------------------
            iii = 0
90          iii = iii + 1
            c1 = g1(iii)
            c2 = g(iii)
            if (isc(iii) /= 0) then
                ! ------------------------------------------------------------------
                !                    LINEAR CONSTRAINT
                ! ------------------------------------------------------------------
                if (c1 >= 1.0e-5_wp .and. c1 <= ctbm) go to 100
                call me%cnmn07(ii, alp, zro, zro, c1, a2, c2, zro, zro)
                if (alp <= 0.0_wp) go to 100
                if (c1 > ctbm .and. alp > alpfes) alpfes = alp
                if (c1 < me%ctl .and. alp < alpln) alpln = alp
            else
                ! ------------------------------------------------------------------
                !                 NON-LINEAR CONSTRAINT
                ! ------------------------------------------------------------------
                if (c1 < 1.0e-5_wp .or. c1 > ctam) then
                    call me%cnmn07(ii, alp, zro, zro, c1, a2, c2, zro, zro)
                    if (alp > 0.0_wp) then
                        if (c1 > ctam .and. alp > alpfes) alpfes = alp
                        if (c1 < me%ct .and. alp < alpnc) alpnc = alp
                    end if
                end if
            end if

100         if (iii < me%ncon) go to 90
        end if
        if (me%linobj <= 0 .and. slope < 0.0_wp) then
            ! CALCULATE ALPHA TO MINIMIZE FUNCTION.
            call me%cnmn04(ii, alpmin, zro, zro, f1, slope, a2, f2, zro, zro, zro, zro)
        end if
        ! ------------------------------------------------------------------
        !                     PROPOSED MOVE
        ! ------------------------------------------------------------------
        ! MOVE AT LEAST FAR ENOUGH TO OVERCOME CONSTRAINT VIOLATIONS.
        a3 = alpfes
        ! MOVE TO MINIMIZE FUNCTION.
        if (alpmin > a3) a3 = alpmin
        ! IF A3<=0, SET A3 = ALPSID.
        if (a3 <= 0.0_wp) a3 = alpsid
        ! LIMIT MOVE TO NEW CONSTRAINT ENCOUNTER.
        if (a3 > alpnc) a3 = alpnc
        if (a3 > alpln) a3 = alpln
        ! MAKE A3 NON-ZERO.
        if (a3 <= me%small) a3 = me%small
        ! IF A3=A2=ALPSID AND F2 IS BEST, GO INVOKE SIDE CONSTRAINT
        ! MODIFICATION.
        alpb = 1.0_wp-a2/a3
        alpa = 1.0_wp-alpsid/a3
        jbest = 0
        if (abs(alpb) < 1.0e-10_wp .and. abs(alpa) < 1.0e-10_wp) jbest = 1
        if (jbest == 1 .and. ibest == 2) go to 10
        ! SIDE CONSTRAINT CHECK NOT SATISFIED.
        if (me%ncon /= 0) then
            ! STORE CONSTRAINT VALUES IN G2.
            do i = 1, me%ncon
                g2(i) = g(i)
            end do
        end if
        ! IF A3=A2, SET A3=.9*A2.
        if (abs(alpb) < 1.0e-10_wp) a3 = 0.9_wp*a2
        ! MOVE AT LEAST .01*A2.
        if (a3 < (0.01_wp*a2)) a3 = 0.01_wp*a2
        ! LIMIT MOVE TO 5.*A2.
        if (a3 > (5.0_wp*a2)) a3 = 5.0_wp*a2
        ! LIMIT MOVE TO ALPSID.
        if (a3 > alpsid) a3 = alpsid
        ! MOVE A DISTANCE A3*S.
        alp = a3 - a2
        alptot = alptot + alp
        do i = 1, me%ndv
            x(i) = x(i) + alp*s(i)
        end do
        if (me%iprint >= 5) then
            write (me%iunit, 5600)
            write (me%iunit, 5200) a3
            if (me%nscal /= 0) then
                g(1:me%ndv) = scal(1:me%ndv)*x(1:me%ndv)
                write (me%iunit, 5300) g(1:me%ndv)
            else
                write (me%iunit, 5300) x(1:me%ndv)
            end if
        end if
        ! ------------------------------------------------------------------
        !          UPDATE FUNCTION AND CONSTRAINT VALUES
        ! ------------------------------------------------------------------
        ncal(1) = ncal(1) + 1
        jgoto = 2
        return

140     f3 = me%obj
        if (me%iprint >= 5) write (me%iunit, 5400) f3
        if (me%iprint >= 5 .and. me%ncon /= 0) then
            write (me%iunit, 5500)
            write (me%iunit, 5300) (g(i), i=1, me%ncon)
        end if
        ! ------------------------------------------------------------------
        !   CALCULATE MAXIMUM CONSTRAINT VIOLATION AND PICK BEST DESIGN
        ! ------------------------------------------------------------------
        cv3 = 0.0_wp
        igood3 = 0
        nvc1 = 0
        if (me%ncon /= 0) then
            do i = 1, me%ncon
                cc = ctam
                if (isc(i) > 0) cc = ctbm
                c1 = g(i) - cc
                if (c1 > cv3) cv3 = c1
                if (c1 > 0.0_wp) nvc1 = nvc1 + 1
            end do
            if (cv3 > 0.0_wp) igood3 = 1
        end if
        ! DETERMINE BEST DESIGN.
        if (ibest /= 2) then
            ! CHOOSE BETWEEN F1 AND F3.
            if (igood1 /= 0 .or. igood3 /= 0) then
                if (cv1 >= cv3) ibest = 3
                go to 160
            end if
            if (f3 <= f1) ibest = 3
        else
            ! CHOOSE BETWEEN F2 AND F3.
            if (igood2 /= 0 .or. igood3 /= 0) then
                if (cv2 >= cv3) ibest = 3
            else
                if (f3 <= f2) ibest = 3
            end if
        end if

160     alp = a3
        me%obj = f3
        ! IF F3 VIOLATES FEWER CONSTRAINTS THAN F1 RETURN.
        if (nvc1 < nvc) go to 340
        ! IF OBJECTIVE AND ALL CONSTRAINTS ARE LINEAR, RETURN.
        if (me%linobj /= 0 .and. nlnc == me%ncon) go to 340
        ! IF A3 = ALPLN AND F3 IS BOTH GOOD AND BEST RETURN.
        alpb = 1.0_wp-alpln/a3
        if (abs(alpb) < me%small .and. ibest == 3 .and. igood3 == 0) go to 340
        ! IF A3 = ALPSID AND F3 IS BEST, GO INVOKE SIDE CONSTRAINT MODIFICATION.
        alpa = 1.0_wp-alpsid/a3
        if (abs(alpa) < me%small .and. ibest == 3) go to 10
        ! ------------------------------------------------------------------
        ! **********            3 - POINT INTERPOLATION            *********
        ! ------------------------------------------------------------------
        alpnc = alpsid
        alpca = alpsid
        alpfes = -1.0_wp
        alpmin = -1.0_wp
        ! ------------------------------------------------------------------
        ! IF A3 IS GREATER THAN A2 AND CV3 IS GREATER THAN CV2, SET
        ! MOVE LIMITS TO A3.  PROGRAM MOD-FEB, 1981, GV.
        ! ------------------------------------------------------------------
        if (a3 > a2 .and. cv3 > cv2) then
            alpln = a3
            alpnc = a3
            alpca = a3
        end if
        if (me%ncon /= 0) then
            iii = 0
170         iii = iii + 1
            c1 = g1(iii)
            c2 = g2(iii)
            c3 = g(iii)
            if (isc(iii) /= 0) then
                ! ------------------------------------------------------------------
                ! LINEAR CONSTRAINT.  FIND ALPFES ONLY.  ALPLN SAME AS BEFORE.
                ! ------------------------------------------------------------------
                if (c1 <= ctbm) go to 190
                ii = 1
                call me%cnmn07(ii, alp, zro, zro, c1, a3, c3, zro, zro)
                if (alp > alpfes) alpfes = alp
            else
                ! ------------------------------------------------------------------
                !                 NON-LINEAR CONSTRAINT
                ! ------------------------------------------------------------------
                ii = 2
                call me%cnmn07(ii, alp, zro, zro, c1, a2, c2, a3, c3)
                if (alp > zro) then
                    if (c1 < me%ct .or. c1 > 0.0_wp) then
                        if (c1 > ctam .or. c1 < 0.0_wp) go to 180
                    end if
                    ! ALP IS MINIMUM MOVE.  UPDATE FOR NEXT CONSTRAINT ENCOUNTER.
                    alpa = alp
                    call me%cnmn07(ii, alp, alpa, zro, c1, a2, c2, a3, c3)
                    if (alp < alpca .and. alp >= alpa) alpca = alp
                    go to 190

180                 if (alp > alpfes .and. c1 > ctam) alpfes = alp
                    if (alp < alpnc .and. c1 < 0.0_wp) alpnc = alp
                end if
            end if

190         if (iii < me%ncon) go to 170
        end if
        if (me%linobj <= 0 .and. slope <= 0.0_wp) then
            ! ------------------------------------------------------------------
            !          CALCULATE ALPHA TO MINIMIZE FUNCTION
            ! ------------------------------------------------------------------
            ii = 3
            if (a2 > a3 .and. (igood2 == 0 .and. ibest == 2)) ii = 2
            call me%cnmn04(ii, alpmin, zro, zro, f1, slope, a2, f2, a3, f3, zro, zro)
        end if
        ! ------------------------------------------------------------------
        !                   PROPOSED MOVE
        ! ------------------------------------------------------------------
        ! MOVE AT LEAST ENOUGH TO OVERCOME CONSTRAINT VIOLATIONS.
        a4 = alpfes
        ! MOVE TO MINIMIZE FUNCTION.
        if (alpmin > a4) a4 = alpmin
        ! IF A4<=0, SET A4 = ALPSID.
        if (a4 <= 0.0_wp) a4 = alpsid
        ! LIMIT MOVE TO NEW CONSTRAINT ENCOUNTER.
        if (a4 > alpln) a4 = alpln
        if (a4 > alpnc) a4 = alpnc
        ! LIMIT MOVE TO RE-ENCOUNTER CURRENTLY ACTIVE CONSTRAINT.
        if (a4 > alpca) a4 = alpca
        ! LIMIT A4 TO 5.*A3.
        if (a4 > (5.0_wp*a3)) a4 = 5.0_wp*a3
        ! UPDATE DESIGN.
        if (ibest == 3 .and. me%ncon /= 0) then
            ! STORE CONSTRAINT VALUES IN G2.  F3 IS BEST.  F2 IS NOT.
            do i = 1, me%ncon
                g2(i) = g(i)
            end do
        end if
        ! IF A4=A3 AND IGOOD1=0 AND IGOOD3=1, SET A4=.9*A3.
        alp = a4 - a3
        if (igood1 == 0 .and. igood3 == 1 .and. abs(alp) < me%small) a4 = 0.9_wp*a3
        ! ------------------------------------------------------------------
        !               MOVE A DISTANCE A4*S
        ! ------------------------------------------------------------------
        alp = a4 - a3
        alptot = alptot + alp
        do i = 1, me%ndv
            x(i) = x(i) + alp*s(i)
        end do
        if (me%iprint >= 5) then
            write (me%iunit, 5000)
            write (me%iunit, 5200) a4
            if (me%nscal /= 0) then
                g(1:me%ndv) = scal(1:me%ndv)*x(1:me%ndv)
                write (me%iunit, 5300) g(1:me%ndv)
            else
                write (me%iunit, 5300) x(1:me%ndv)
            end if
        end if
        ! ------------------------------------------------------------------
        !          UPDATE FUNCTION AND CONSTRAINT VALUES
        ! ------------------------------------------------------------------
        ncal(1) = ncal(1) + 1
        jgoto = 3
        return

230     f4 = me%obj
        if (me%iprint >= 5) write (me%iunit, 5400) f4
        if (me%iprint >= 5 .and. me%ncon /= 0) then
            write (me%iunit, 5500)
            write (me%iunit, 5300) g(1:me%ncon)
        end if
        ! DETERMINE ACCAPTABILITY OF F4.
        igood4 = 0
        cv4 = 0.0_wp
        if (me%ncon /= 0) then
            do i = 1, me%ncon
                cc = ctam
                if (isc(i) > 0) cc = ctbm
                c1 = g(i) - cc
                if (c1 > cv4) cv4 = c1
            end do
            if (cv4 > 0.0_wp) igood4 = 1
        end if
        alp = a4
        me%obj = f4
        ! ------------------------------------------------------------------
        !                 DETERMINE BEST DESIGN
        ! ------------------------------------------------------------------
        select case (ibest)
        case (1)
            ! CHOOSE BETWEEN F1 AND F4.
            if (igood1 /= 0 .or. igood4 /= 0) then
                if (cv1 > cv4) go to 340
            else
                if (f4 <= f1) go to 340
            end if
            ! F1 IS BEST.
            alptot = alptot - a4
            me%obj = f1
            x(1:me%ndv) = x(1:me%ndv) - a4*s(1:me%ndv)
            if (me%ncon == 0) go to 340
            g(1:me%ncon) = g1(1:me%ncon)

        case (2)
            ! CHOOSE BETWEEN F2 AND F4.
            if (igood2 /= 0 .or. igood4 /= 0) then
                if (cv2 > cv4) go to 340
            else
                if (f4 <= f2) go to 340
            end if
            ! F2 IS BEST.
            me%obj = f2
            a2 = a4 - a2
            alptot = alptot - a2
            x(1:me%ndv) = x(1:me%ndv) - a2*s(1:me%ndv)
            if (me%ncon == 0) go to 340
            g(1:me%ncon) = g2(1:me%ncon)

        case (3)
            ! CHOOSE BETWEEN F3 AND F4.
            if (igood3 /= 0 .or. igood4 /= 0) then
                if (cv3 > cv4) go to 340
            else
                if (f4 <= f3) go to 340
            end if
            ! F3 IS BEST.
            me%obj = f3
            a3 = a4 - a3
            alptot = alptot - a3
            x(1:me%ndv) = x(1:me%ndv) - a3*s(1:me%ndv)
            if (me%ncon /= 0) then
                g(1:me%ncon) = g2(1:me%ncon)
            end if

        end select

340     alp = alptot
        if (me%iprint >= 5) write (me%iunit, 5700)
        jgoto = 0
        return

        ! ------------------------------------------------------------------
        !                              FORMATS
        ! ------------------------------------------------------------------

5000    format(/t6, 'THREE-POINT INTERPOLATION')
5100    format(///'* * * CONSTRAINED ONE-DIMENSIONAL SEARCH INFORMATION * * *')
5200    format(//t6, 'PROPOSED DESIGN'/t6, 'ALPHA =', e12.5/t6, 'X-VECTOR')
5300    format(' ', 8e12.4)
5400    format(/t6, 'OBJ =', e13.5)
5500    format(/t6, 'CONSTRAINT VALUES')
5600    format(/t6, 'TWO-POINT INTERPOLATION')
5700    format(/t6, '* * * END OF ONE-DIMENSIONAL SEARCH')

    end subroutine cnmn06