cnmn08 Subroutine

private subroutine cnmn08(ndb, ner, c, ms1, b, n3, n4)

Routine to solve special linear problem for imposing s-transpose times s<=1 bounds in the modified method of feasible directions.

FORM OF L. P. IS BX=C WHERE 1ST NDB COMPONENTS OF X CONTAIN VECTOR U AND LAST NDB COMPONENTS CONTAIN VECTOR V. CONSTRAINTS ARE U>=0, V>=0, AND U-TRANSPOSE TIMES V = 0.

BY G. N. VANDERPLAATS, APRIL, 1972.

Reference

Arguments

Type IntentOptional Attributes Name
integer, intent(in) :: ndb
integer, intent(out) :: ner

NER = ERROR FLAG. IF NER/=0 ON RETURN, PROCESS HAS NOT CONVERGED IN 5*NDB ITERATIONS.

real(kind=wp), intent(inout) :: c(n4)
integer, intent(out) :: ms1(:)

VECTOR MS1 IDENTIFIES THE SET OF BASIC VARIABLES.

real(kind=wp), intent(inout) :: b(n3,n3)
integer, intent(in) :: n3
integer, intent(in) :: n4

Called by

proc~~cnmn08~~CalledByGraph proc~cnmn08 cnmn08 proc~cnmn05 conmin_class%cnmn05 proc~cnmn05->proc~cnmn08 proc~conmin conmin_class%conmin proc~conmin->proc~cnmn05

Source Code

    subroutine cnmn08(ndb, ner, c, ms1, b, n3, n4)

        !!  Routine to solve special linear problem for imposing s-transpose
        !!  times s<=1 bounds in the modified method of feasible directions.
        !!
        !!  FORM OF L. P. IS BX=C WHERE 1ST NDB COMPONENTS OF X CONTAIN VECTOR
        !!  U AND LAST NDB COMPONENTS CONTAIN VECTOR V.
        !!  CONSTRAINTS ARE U>=0, V>=0, AND U-TRANSPOSE TIMES V = 0.
        !!
        !!  BY G. N. VANDERPLAATS, APRIL, 1972.
        !!
        !!### Reference
        !!  * "[Structural optimization by methods of feasible directions](https://www.sciencedirect.com/science/article/abs/pii/0045794973900552)",
        !!    G. N. Vanderplaats and F. Moses, Journal of computers
        !!    and structures, vol 3, pp 739-755, 1973.

        !  ------------------------------------------------------------------
        !  CHOOSE INITIAL BASIC VARIABLES AS V, AND INITIALIZE VECTOR MS1
        !  ------------------------------------------------------------------

        integer, intent(in)        :: ndb, n3, n4
        integer, intent(out)       :: ner !! NER = ERROR FLAG.  IF NER/=0 ON RETURN, PROCESS HAS NOT
                                          !! CONVERGED IN 5*NDB ITERATIONS.
        integer, intent(out)       :: ms1(:) !! VECTOR MS1 IDENTIFIES THE SET OF BASIC VARIABLES.
        real(wp), intent(inout)   :: c(n4), b(n3, n3)

        integer   :: i, ichk, iter1, j, jj, kk, m2, nmax
        real(wp)  :: bb, bb1, bi, c1, cb, cbmax, cbmin, eps

        ner = 1
        m2 = 2*ndb
        ! CALCULATE CBMIN AND EPS AND INITIALIZE MS1.
        eps = -1.0e+10_wp
        cbmin = 0.0_wp
        do i = 1, ndb
            bi = b(i, i)
            cbmax = 0.
            if (bi < -1.0e-6_wp) cbmax = c(i)/bi
            if (bi > eps) eps = bi
            if (cbmax > cbmin) cbmin = cbmax
            ms1(i) = 0
        end do
        eps = 0.0001_wp*eps
!       IF (EPS<-1.0E-10) EPS=-1.0E-10
!
!  E-10 CHANGED TO E-03 ON 1/12/81
!
        if (eps < -1.0e-03_wp) eps = -1.0e-03_wp
        if (eps > -0.0001_wp) eps = -0.0001_wp
        cbmin = cbmin*1.0e-6_wp
!       IF (CBMIN<1.0e-10_wp) CBMIN=1.0e-10_wp
!
!  E-10 CHANGED TO E-05 ON 1/12/81
!
        if (cbmin < 1.0e-05_wp) cbmin = 1.0e-05_wp
        iter1 = 0
        nmax = 5*ndb
        main: do
            ! ------------------------------------------------------------------
            ! **********             BEGIN NEW ITERATION              **********
            ! ------------------------------------------------------------------
            iter1 = iter1 + 1
            if (iter1 > nmax) return
            ! FIND MAX. C(I)/B(I,I) FOR I=1,NDB.
            cbmax = 0.9_wp*cbmin
            ichk = 0
            do i = 1, ndb
                c1 = c(i)
                bi = b(i, i)
                ! IF (BI>EPS .OR. C1>0.) GO TO 30
                if (bi <= eps .and. c1 <= -1.0e-05_wp) then
                    ! 0. CHANGED TO -1.0E-05 ON 1/12/81
                    cb = c1/bi
                    if (cb > cbmax) then
                        ichk = i
                        cbmax = cb
                    end if
                end if
            end do
            if (cbmax >= cbmin) then
                if (ichk /= 0) then
                    ! UPDATE VECTOR MS1.
                    jj = ichk
                    if (ms1(jj) == 0) jj = ichk + ndb
                    kk = jj + ndb
                    if (kk > m2) kk = jj - ndb
                    ms1(kk) = ichk
                    ms1(jj) = 0
                    ! ------------------------------------------------------------------
                    !                 PIVOT OF B(ICHK,ICHK)
                    ! ------------------------------------------------------------------
                    bb = 1.0_wp/b(ichk, ichk)
                    do j = 1, ndb
                        b(ichk, j) = bb*b(ichk, j)
                    end do
                    c(ichk) = cbmax
                    b(ichk, ichk) = bb
                    ! ELIMINATE COEFICIENTS ON VARIABLE ENTERING BASIS AND STORE
                    ! COEFICIENTS ON VARIABLE LEAVING BASIS IN THEIR PLACE.
                    do i = 1, ndb
                        if (i /= ichk) then
                            bb1 = b(i, ichk)
                            b(i, ichk) = 0.0_wp
                            do j = 1, ndb
                                b(i, j) = b(i, j) - bb1*b(ichk, j)
                            end do
                            c(i) = c(i) - bb1*cbmax
                        end if
                    end do
                    cycle main
                end if
            end if
            exit main
        end do main
        ner = 0
        ! ------------------------------------------------------------------
        ! STORE ONLY COMPONENTS OF U-VECTOR IN 'C'.  USE B(I,1) FOR
        ! TEMPORARY STORAGE
        ! ------------------------------------------------------------------
        b(1:ndb, 1) = c(1:ndb)
        do i = 1, ndb
            c(i) = 0.0_wp
            j = ms1(i)
            if (j > 0) c(i) = b(j, 1)
            if (c(i) < 0.0_wp) c(i) = 0.0_wp
        end do

    end subroutine cnmn08