ogexcl Subroutine

private subroutine ogexcl(me, Exc, error)

REMOVE CONSTRAINT TO ACTIVE SET AND REDUCES DERIVATIVES

2008/01/16 | J. SCHOENMAEKERS | NEW

Type Bound

optgra

Arguments

Type IntentOptional Attributes Name
class(optgra), intent(inout) :: me
integer(kind=ip), intent(in) :: Exc

CONSTRAINT TO BE REMOVED SEQUENCE NUMBER IN ACTIVE LIST
logical, intent(out) :: error

if there was a fatal error (constraints singular)

Calls

proc~~ogexcl~~CallsGraph proc~ogexcl optgra%ogexcl proc~ogwrit optgra%ogwrit proc~ogexcl->proc~ogwrit

Called by

proc~~ogexcl~~CalledByGraph proc~ogexcl optgra%ogexcl proc~ogcorr optgra%ogcorr proc~ogcorr->proc~ogexcl proc~ogopti optgra%ogopti proc~ogopti->proc~ogexcl proc~ogexec optgra%ogexec proc~ogexec->proc~ogcorr proc~ogexec->proc~ogopti

Source Code

   subroutine ogexcl(me,Exc,error)

      !! REMOVE CONSTRAINT TO ACTIVE SET AND REDUCES DERIVATIVES
      !!
      !! 2008/01/16 | J. SCHOENMAEKERS | NEW

      class(optgra),intent(inout) :: me
      integer(ip),intent(in) :: Exc !! CONSTRAINT TO BE REMOVED
                                    !! SEQUENCE NUMBER IN ACTIVE LIST
      logical,intent(out) :: error !! if there was a fatal error (constraints singular)

      real(wp) :: val , bet , gam
      integer(ip) :: row , col , act , con
      character(len=str_len) :: str

      error = .false.

      ! ======================================================================
      ! ADJUST LIST OF ACTIVE CONSTRAINTS
      ! ----------------------------------------------------------------------
      con = me%Actcon(Exc)
      me%Conact(con) = 0
      me%Numact = me%Numact - 1
      do act = Exc , me%Numact
         con = me%Actcon(act+1)
         me%Actcon(act) = con
         me%Conact(con) = me%Conact(con) - 1
      end do
      ! ======================================================================
      ! REDUCE FOR SUBSEQUENT CONSTRAINTS
      ! ----------------------------------------------------------------------
      do act = Exc , me%Numact
         con = me%Actcon(act)
         val = 0.0_wp
         do col = act , act + 1
            val = val + me%Conred(con,col)**2
         end do
         val = sqrt(val)
         if ( me%Conred(con,act)>0.0_wp ) val = -val
         if ( abs(val)<1.0e-15_wp ) then
            write (me%Loglun,*) "OGEXCL-ERROR: CONSTRAINTS SINGULAR"
            call me%ogwrit(2,str)
            write (me%Loglun,*) "VAL=" , val
            call me%ogwrit(2,str)
            error = .true.
            return   ! fatal error
         end if
         me%Conred(con,act) = me%Conred(con,act) - val
         bet = 1.0_wp/(val*me%Conred(con,act))
         do row = 1 , me%Numcon + 3
            if ( me%Conact(row)>act .or. me%Conact(row)<=0 ) then
               gam = 0.0_wp
               do col = act , act + 1
                  if ( me%Conred(row,col)/=0.0_wp ) gam = gam + me%Conred(row,col)*me%Conred(con,col)
               end do
               if ( gam/=0.0_wp ) then
                  gam = gam*bet
                  do col = act , act + 1
                     me%Conred(row,col) = me%Conred(row,col) + me%Conred(con,col)*gam
                  end do
               end if
            end if
         end do
         me%Conred(con,act) = val
         do col = act + 1 , act + 1
            me%Conred(con,col) = 0.0_wp
         end do
      end do
      ! ======================================================================
   end subroutine ogexcl