ogcorr Subroutine

private subroutine ogcorr(me, Varacc, Finish, Toterr, Norerr, error)

CORRECTION PART

2008/01/16 | J. SCHOENMAEKERS | NEW

Type Bound

optgra

Arguments

Type IntentOptional Attributes Name
class(optgra), intent(inout) :: me
real(kind=wp), intent(inout) :: Varacc
integer(kind=ip), intent(out) :: Finish
real(kind=wp) :: Toterr
real(kind=wp) :: Norerr
logical, intent(out) :: error

if there was a fatal error


Calls

proc~~ogcorr~~CallsGraph proc~ogcorr optgra%ogcorr proc~ogeval optgra%ogeval proc~ogcorr->proc~ogeval proc~ogexcl optgra%ogexcl proc~ogcorr->proc~ogexcl proc~ogincl optgra%ogincl proc~ogcorr->proc~ogincl proc~ogrigt optgra%ogrigt proc~ogcorr->proc~ogrigt proc~ogwrit optgra%ogwrit proc~ogcorr->proc~ogwrit proc~ogeval->proc~ogwrit proc~ogpwri optgra%ogpwri proc~ogeval->proc~ogpwri proc~ogexcl->proc~ogwrit proc~ogincl->proc~ogwrit proc~ogpwri_end optgra%ogpwri_end proc~ogpwri->proc~ogpwri_end proc~ogpwri_start optgra%ogpwri_start proc~ogpwri->proc~ogpwri_start

Called by

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

Source Code

   subroutine ogcorr(me,Varacc,Finish,Toterr,Norerr,error)

      !! CORRECTION PART
      !!
      !! 2008/01/16 | J. SCHOENMAEKERS | NEW

      class(optgra),intent(inout) :: me
      real(wp),intent(inout) :: Varacc
      integer(ip),intent(out) :: Finish
      real(wp)    :: Toterr
      real(wp)    :: Norerr
      logical,intent(out) :: error !! if there was a fatal error

      integer(ip) :: coritr , numfff , minpri , maxpri , curpri, &
                     conind , norind , inelop , maxitr, &
                     con , var , act , ind , len , cos , stp, &
                     typ , cor , pri , vio , fff
      real(wp) :: cornor , foldis , cstval , conerr, &
                  corinv , varvio , conmax , normax, &
                  val , fac , upr , del , co2 , co1 , co0 , de2 , dis, &
                  eps , err , dlt , sca , dif , exc
      character(len=str_len) :: str
      character(len=name_len) :: nam
      real(wp) , dimension(:) , allocatable :: cosact
      real(wp) , dimension(:) , allocatable :: varvec
      real(wp) , dimension(:) , allocatable :: varsav
      real(wp) , dimension(:) , allocatable :: varcor
      real(wp) , dimension(:) , allocatable :: corvec
      real(wp) , dimension(:) , allocatable :: consav
      integer(ip) , dimension(:) , allocatable :: conttt
      integer(ip) , dimension(:) , allocatable :: concor
      integer(ip) , dimension(:) , allocatable :: coninc
      integer(ip) , dimension(:) , allocatable :: conhit
      integer(ip) , dimension(:) , allocatable :: fffcon
      integer(ip) , dimension(:) , allocatable :: prisav
      integer :: ido  !! for a dispatch loop that replaced the original gotos

      error = .false.

      ! initialize   - JW : these could also be in the class.
      !                     that would save the allocate/reallocate
      !                     step every time this routine is called.
      allocate (cosact(me%Numvar))
      allocate (varvec(me%Numvar))
      allocate (varsav(me%Numvar))
      allocate (varcor(me%Numvar))
      allocate (corvec(me%Numvar))
      allocate (consav(me%Numcon+1))
      allocate (conttt(me%Numcon+1))
      allocate (concor(me%Numcon))
      allocate (coninc(me%Numcon))
      allocate (conhit(me%Numcon))
      allocate (fffcon(me%Numcon))
      allocate (prisav(me%Numcon))

      ! ======================================================================
      ! CORRECTION PART
      ! ----------------------------------------------------------------------
      coritr = 0
      maxitr = 10
      if ( me%Senopt/=0 ) maxitr = 1
      ! ======================================================================
      cos = me%Numcon + 1
      vio = me%Numcon + 2
      stp = 0
      Finish = 0
      eps = 1.0e-03_wp
      dlt = 1.0e-06_wp
      varvio = me%Varmax*1.0e+03_wp
      numfff = me%Numact
      fffcon = me%Actcon
      conttt = me%Contyp
      prisav = me%Conpri
      concor = 0
      ! ----------------------------------------------------------------------
      minpri = 1000
      maxpri = -1000
      do con = 1 , me%Numcon
         if ( me%Contyp(con)==-2 ) cycle
         minpri = min(minpri,me%Conpri(con))
         maxpri = max(maxpri,me%Conpri(con))
      end do
      ind = 0
      if ( numfff>0 ) ind = 1
      if ( me%Senopt>0 ) ind = 1
      minpri = minpri - ind
      call me%ogwrit(3,"")
      call me%ogwrit(3,"PRIORITISE CONSTRAINTS")
      call me%ogwrit(3,"")
      if ( me%Senopt<=0 ) then
         do fff = 1 , numfff
            con = fffcon(fff)
            nam = me%Constr(con)
            len = me%Conlen(con)
            typ = me%Contyp(con)
            write (str,'("PRI",1X,I4,1X,I4,1X,A)') con , typ , nam(1:len)
            call me%ogwrit(3,str)
            me%Conpri(con) = minpri
         end do
      end if
      if ( me%Senopt>0 ) then
         do con = 1 , me%Numcon
            if ( me%Contyp(con)==-2 ) cycle
            if ( me%Senact(con)<=0 ) cycle
            nam = me%Constr(con)
            len = me%Conlen(con)
            typ = me%Contyp(con)
            write (str,'("PRI",1X,I4,1X,I4,1X,A)') con , typ , nam(1:len)
            call me%ogwrit(3,str)
            me%Conpri(con) = minpri
         end do
      end if
      call me%ogwrit(3,"")

      ido = 2 ! start the loop
      main: do
         select case (ido)
          case (2)
            ! ======================================================================
            ! Evaluation loop
            ! ----------------------------------------------------------------------
            write (str,'("CORITR=",I2,1X,I2)') coritr , maxitr
            call me%ogwrit(3,str)
            call me%ogwrit(3,"")
            ! ======================================================================
            ! Inequality loop
            ! ----------------------------------------------------------------------
            inelop = 2
            if ( numfff>0 ) inelop = 1
            if ( me%Senopt>0 ) inelop = 1
            varsav = me%Varval
            consav = me%Conval
            ido = 3
          case (3)
            ! ----------------------------------------------------------------------
            write (str,'("INELOP=",I2)') inelop
            call me%ogwrit(3,str)
            call me%ogwrit(3,"")
            ! ----------------------------------------------------------------------
            me%Varval = varsav
            me%Conval = consav
            me%Contyp = conttt
            if ( inelop==1 ) then
               do fff = 1 , numfff
                  con = fffcon(fff)
                  nam = me%Constr(con)
                  len = me%Conlen(con)
                  typ = me%Contyp(con)
                  write (str,'("TYP",1X,I4,1X,I4,1X,A)') con , typ , nam(1:len)
                  call me%ogwrit(3,str)
                  me%Contyp(con) = 0
               end do
            end if
            if ( inelop==1 .and.me%Senopt>0 ) then
               do con = 1 , me%Numcon
                  if ( me%Contyp(con)==-2 ) cycle
                  if ( me%Senact(con)<=0 ) cycle
                  nam = me%Constr(con)
                  len = me%Conlen(con)
                  typ = me%Contyp(con)
                  write (str,'("FIX",1X,I4,1X,I4,1X,A)') con , typ , nam(1:len)
                  call me%ogwrit(2,str)
                  me%Contyp(con) = 0
               end do
            end if
            me%Numact = 0
            me%Conact = 0
            me%Conred(1:me%Numcon+1,:) = me%Conder(1:me%Numcon+1,:)  ! CONRED=constraint gradient matrix (scaled)
            me%Conred(me%Numcon+2,:) = me%Vardir
            ! ----------------------------------------------------------------------
            ! CHECK CONSTRAINTS
            ! ----------------------------------------------------------------------
            conerr = 0.0_wp
            Norerr = 0.0_wp
            conind = 0
            norind = 0
            conmax = 0.0_wp
            normax = 0.0_wp
            do con = 1 , me%Numcon
               if ( me%Contyp(con)==-2 ) cycle
               typ = me%Contyp(con)
               val = me%Conval(con)
               if ( val<-1.0_wp ) then
                  err = abs(val)
               elseif ( typ/=0 ) then
                  err = 0.0_wp
               elseif ( val>1.0_wp ) then
                  err = abs(val)
               else
                  err = 0.0_wp
               end if
               conerr = conerr + err
               if ( err>conmax ) then
                  conind = con
                  conmax = err
               end if
               fac = 0.0_wp
               do var = 1 , me%Numvar
                  if ( me%Vartyp(var)==1 ) cycle
                  fac = fac + me%Conder(con,var)**2
               end do
               fac = sqrt(fac)
               if ( err==0.0_wp ) then
               elseif ( fac/=0.0_wp ) then
                  err = err/fac
               else
                  call me%ogwrit(0,"")
                  call me%ogwrit(0,"ERROR: CONSTRAINT CAN NOT BE SATISFIED")
                  write (str,'("CON/VAL= ",I5,1X,D13.6)') con , val
                  call me%ogwrit(0,str)
                  Finish = 0
                  call done()
                  exit main
               end if
               Norerr = Norerr + err
               if ( err>normax ) then
                  norind = con
                  normax = err
               end if
            end do
            ! ----------------------------------------------------------------------
            Toterr = conerr
            call me%ogwrit(3,"")
            write (str,'("NUMFFF/TOTERR/NORERR/COSVAL=",I4,3(1X,D13.6))') &
                     numfff , Toterr , Norerr , me%Conval(me%Numcon+1)
            call me%ogwrit(2,str)
            call me%ogwrit(3,"")
            write (str,'("MAXIM TOTAL ERROR.: ",D13.6,I6)') conmax , conind
            call me%ogwrit(3,str)
            write (str,'("MAXIM NORM  ERROR.: ",D13.6,I6)') normax , norind
            call me%ogwrit(3,str)
            ! ----------------------------------------------------------------------
            if ( me%Senopt>0 .and. coritr==maxitr ) then
               if ( cstval==0.0_wp ) then
                  Finish = 1
               else
                  Finish = 0
               end if
               exit main
            end if
            if ( coritr==0 .and. conerr==0.0_wp ) then
               me%Numact = numfff
               me%Actcon = fffcon
               Finish = 1
               exit main
            elseif ( coritr/=0 .and. conerr==0.0_wp ) then
               Finish = 1
               exit main
            elseif ( coritr==maxitr ) then
               Finish = 0
               call me%ogwrit(3,"")
               write (str,'("CORITR=",I2)') coritr
               call me%ogwrit(3,str)
               exit main
            else
               Finish = 0
               coritr = coritr + 1
            end if

            ! ======================================================================
            ! Priority loop
            ! ----------------------------------------------------------------------
            curpri = minpri
            ido = 4
          case (4)
            ! ----------------------------------------------------------------------
            write (str,'("CURPRI=",I2,1X,I2)') curpri , maxpri
            call me%ogwrit(3,str)
            call me%ogwrit(3,"")
            ! ======================================================================
            ! MINIMUM NORM CORRECTION
            ! ----------------------------------------------------------------------
            call me%ogwrit(3,"")
            write (str,'("CORRECTION OF CONSTRAINTS")')
            call me%ogwrit(3,str)
            call me%ogwrit(3,"")
            write (str,*) "INELOP/CURPRI=" , inelop , curpri
            call me%ogwrit(3,str)
            ! ----------------------------------------------------------------------
            conerr = 0.0_wp
            do con = 1 , me%Numcon
               if ( me%Contyp(con)==-2 ) cycle
               conhit(con) = 0
               if ( me%Conval(con)<-eps ) then
                  conerr = conerr + abs(me%Conval(con))
               elseif ( me%Contyp(con)/=0 ) then
               elseif ( me%Conval(con)>+eps ) then
                  conerr = conerr + abs(me%Conval(con))
               end if
            end do
            ! ----------------------------------------------------------------------
            call me%ogwrit(3,"")
            write (str,'("LINEAR ERROR.: ",D13.6)') conerr
            call me%ogwrit(3,str)
            ! ----------------------------------------------------------------------
            call me%ogwrit(3,"")
            write (str,'(" ACT  PAS  MOV",'//' " COST___VAL COST___GRD",'//' " DIST___DEL CONSTRAINT")')
            call me%ogwrit(3,str)
            ido = 5
          case (5)
            ! ======================================================================
            ! Move loop
            ! ----------------------------------------------------------------------
            do con = 1 , me%Numcon
               if ( me%Contyp(con)==-2 ) cycle
               coninc(con) = 0
               pri = me%Conpri(con)
               val = me%Conval(con)
               typ = me%Contyp(con)
               act = me%Conact(con)
               cor = concor(con)
               if ( act>0 ) cycle
               if ( pri>curpri ) then
                  me%Conact(con) = -1
               elseif ( val<-dlt ) then
                  me%Conact(con) = -1
               elseif ( val>+dlt ) then
                  me%Conact(con) = -1
               else
                  me%Conact(con) = 0
               end if
               if ( pri>curpri ) then
                  concor(con) = 0
               elseif ( val<-dlt ) then
                  concor(con) = -1
               elseif ( typ/=0 ) then
                  concor(con) = 0
               elseif ( val>+dlt ) then
                  concor(con) = +1
               else
                  concor(con) = 0
               end if
!              IF (ACT /= CONACT(CON) .OR. COR /= CONCOR(CON)) THEN
!                  NAM = CONSTR(CON)
!                  LEN = CONLEN(CON)
!                  WRITE (STR,'(5X,5X,I4,23X,D10.3,1X,A,4I4)') &
!                     CON, CONVAL(CON),NAM(1:LEN), &
!                     CONACT(CON),CONCOR(CON), ACT, COR
!                  CALL me%ogwrit (3,STR)
!              end if
            end do
            ! ======================================================================
            ! STEEPEST ASCENT VECTOR
            ! ======================================================================
            ! MERIT VALUE AND DERIVATIVES
            ! ----------------------------------------------------------------------
            cstval = 0.0_wp
            varvec = 0.0_wp
            me%Conred(vio,:) = 0.0_wp
            ! ----------------------------------------------------------------------
            do con = 1 , me%Numcon
               if ( me%Contyp(con)==-2 ) cycle
               if ( me%Conpri(con)>curpri ) cycle
               if ( concor(con)==0 ) cycle
               fac = concor(con)
               cstval = cstval - me%Conval(con)*fac
               me%Conred(vio,:) = me%Conred(vio,:) - me%Conred(con,:)*fac
               varvec = varvec - me%Conder(con,:)*fac
            end do
            inner: do
               ! ----------------------------------------------------------------------
               ! STEEPEST ASCENT VECTOR
               ! ----------------------------------------------------------------------
               corvec = me%Conred(vio,:)
               ! ----------------------------------------------------------------------
               cornor = sqrt(sum(corvec(me%Numact+1:me%Numvar)**2))
               ! ----------------------------------------------------------------------
               ! MERIT PARTIAL W.R.T. CONSTRAINTS
               ! ----------------------------------------------------------------------
               cosact = me%ogrigt(corvec)
               ! ----------------------------------------------------------------------
               ! CONSTRAINT REMOVAL
               ! ----------------------------------------------------------------------
               ind = 0
               exc = 1.0e-12_wp
               upr = exc
               do act = 1 , me%Numact
                  con = me%Actcon(act)
                  if ( me%Contyp(con)==0 ) cycle
                  val = cosact(act)
                  if ( val<=exc ) cycle
                  if ( val<upr ) cycle
!                 IF (VAL >= UPR .AND. UPR > 0.0_wp) CYCLE
                  upr = val
                  ind = act
               end do
               ! ----------------------------------------------------------------------
               if ( ind/=0 ) then
                  con = me%Actcon(ind)
                  nam = me%Constr(con)
                  len = me%Conlen(con)
                  write (str,'(5X,I4,5X,3(1X,D10.3),1X,A)') con , cstval , cornor , upr , nam(1:len)
                  call me%ogwrit(3,str)
                  call me%ogexcl(ind,error)
                  if (error) return
                  if ( coninc(con)>=5 ) then
                     write (str,'("OGCORR-WARNING: CONSTRAINT INCLUDED")')
                     call me%ogwrit(1,str)
                     write (str,'("CON/INC/UPR=",2I4,1X,D10.3)') con , coninc(con) , upr
                     call me%ogwrit(1,str)
                  end if
                  if ( coninc(con)>=20 ) then
                     Finish = 0
                     call done()
                     exit main
                  end if
                  cycle
               end if
               ! ----------------------------------------------------------------------
               ! NORMALISE STEEPEST ASCEND VECTOR
               ! ----------------------------------------------------------------------
               if ( cstval<-cornor*varvio ) exit inner
               ! ----------------------------------------------------------------------
               corinv = 1.0_wp/cornor
               corvec(me%Numact+1:me%Numvar) = corvec(me%Numact+1:me%Numvar)*corinv
               ! ----------------------------------------------------------------------
               ! CONSTRAINT INCLUSION
               ! ----------------------------------------------------------------------
               ind = 0
               upr = 0.0_wp
               ! ----------------------------------------------------------------------
               do con = 1 , me%Numcon
                  if ( me%Contyp(con)==-2 ) cycle
                  if ( me%Conpri(con)>curpri ) cycle
                  if ( me%Conact(con)/=0 ) cycle
                  del = dot_product(me%Conred(con,me%Numact+1:me%Numvar),me%Conred(vio,me%Numact+1:me%Numvar))
                  val = abs(del)*me%Varmax/cornor
                  if ( val<eps ) cycle
                  fac = dot_product(me%Conred(con,1:me%Numvar),me%Conred(con,1:me%Numvar))
                  del = del/sqrt(fac)
                  if ( del<upr ) then
                     upr = del
                     ind = con
                  end if
                  if ( me%Contyp(con)/=0 ) cycle
                  if ( concor(con)/=0 ) cycle
                  del = -del
                  if ( del<upr ) then
                     upr = del
                     ind = con
                  end if
               end do
               ! ----------------------------------------------------------------------
               if ( ind/=0 ) then
                  con = ind
                  nam = me%Constr(con)
                  len = me%Conlen(con)
                  write (str,'(I4,5X,5X,3(1X,D10.3),1X,A)') con , cstval , cornor , upr , nam(1:len)
                  call me%ogwrit(3,str)
                  call me%ogincl(ind)
                  coninc(con) = coninc(con) + 1
                  cycle inner
               end if
               exit inner
            end do inner
            ! ----------------------------------------------------------------------
            do var = 1 , me%Numvar
               val = varvec(var)
               do act = 1 , me%Numact
                  con = me%Actcon(act)
                  val = val - me%Conder(con,var)*cosact(act)
               end do
               varvec(var) = val*corinv
            end do
            ! ----------------------------------------------------------------------
            varcor = me%Varval - me%Varref
            co2 = dot_product(varvec,varvec)
            co1 = dot_product(varvec,varcor)*0.5_wp
            co0 = dot_product(varcor,varcor) - me%Varmax**2
            de2 = co1**2 - co2*co0
            if ( de2>=0.0_wp .and. co2/=0.0_wp ) then
               dis = (sqrt(de2)-co1)/co2
            else
               dis = 0.0_wp
            end if
            ! ----------------------------------------------------------------------
            do var = 1 , me%Numvar
               fac = varvec(var)
               if ( fac==0.0_wp ) cycle
               dif = me%Varval(var) - me%Varref(var)
               sca = me%Varmax*1.0e-0_wp   ! JW : why is this multiplied by 1 ?
               val = (dif+sca)/fac
               fac = (dif-sca)/fac
               if ( fac>val ) val = fac
               if ( val<dis ) dis = val
            end do
            dis = max(dis, 0.0_wp)
            ! ----------------------------------------------------------------------
            foldis = dis
            ! ======================================================================
            ! OPTIMISE DIRETION OF STEPPEST ASCENT
            ! ======================================================================
            if ( cstval==0.0_wp ) then
               ! ----------------------------------------------------------------------
!              WRITE (STR,'("CNV=",3(1X,D10.3))') CSTVAL/CORNOR/VARVIO
!              CALL me%ogwrit (3,STR)
               write (str,'(4X,5X,5X,3(1X,D10.3))') cstval , cornor , foldis
               call me%ogwrit(3,str)
               call me%ogwrit(3,"")
               if ( curpri>=maxpri ) then
                  write (str,'("MAXPRI=",I3)') maxpri
                  call me%ogwrit(3,str)
                  ! ======================================================================
                  ! MATCHED INEQUALITY CONSTRAINTS + MINIMUM CORRECTION NORM
                  ! ----------------------------------------------------------------------
                  call me%ogwrit(3,"")
                  call me%ogwrit(3,"STATUS OF CONSTRAINTS:")
                  call me%ogwrit(3,"")
                  call me%ogwrit(3," ACT  PAS  NON COST___VAL CONSTRAINT")
                  do con = 1 , me%Numcon
                     if ( me%Contyp(con)==-2 ) cycle
                     nam = me%Constr(con)
                     len = me%Conlen(con)
                     val = me%Conval(con)
                     if ( me%Conact(con)>0 ) then
                        write (str,'( I4,5X,6X,D10.3,1X,A)') con , val , nam(1:len)
                        call me%ogwrit(3,str)
                     elseif ( me%Conact(con)==0 ) then
                        write (str,'( 5X,I4,6X,D10.3,1X,A)') con , val , nam(1:len)
                        call me%ogwrit(3,str)
                     elseif ( me%Conact(con)<0 ) then
                        write (str,'(10X,I4,1X,D10.3,1X,A)') con , val , nam(1:len)
                        call me%ogwrit(3,str)
                     end if
                  end do
                  ! ======================================================================
                  if ( me%Senopt<=0 ) call me%ogeval(me%Varval,me%Conval,0,me%Conder)
                  ido = 2
                  cycle main
               else
                  write (str,'("CURPRI=",I3)') curpri
                  call me%ogwrit(3,str)
                  curpri = curpri + 1
                  ido = 4
                  cycle main
               end if
               ! ----------------------------------------------------------------------
            elseif ( cstval<-cornor*varvio ) then
               ! ----------------------------------------------------------------------
               write (str,'("CNV=",3(1X,D10.3))') cstval/cornor/varvio
               call me%ogwrit(2,str)
               call me%ogwrit(3,"")
               write (str,'("CSTVAL=",3D10.3)') cstval , cornor , varvio
               call me%ogwrit(3,str)
               if ( inelop==1 ) then
                  write (str,'("INELOP=",I3)') inelop
                  call me%ogwrit(3,str)
                  inelop = inelop + 1
                  ido = 3
                  cycle main
               else
                  Finish = 0
                  exit main
               end if
               ! ----------------------------------------------------------------------
            end if
            ! ======================================================================
            ! IF CONSTRAINT IS HIT
            ! ----------------------------------------------------------------------
            ind = 0
            do con = 1 , me%Numcon
               if ( me%Contyp(con)==-2 ) cycle
               if ( me%Conact(con)/=-1 ) cycle
               val = dot_product(me%Conred(con,me%Numact+1:me%Numvar),corvec(me%Numact+1:me%Numvar))
               if ( val==0.0_wp ) cycle
               val = -me%Conval(con)/val
               if ( val<=0.0_wp ) cycle
               if ( val>=foldis ) cycle
               foldis = val
               ind = con
            end do
            ! ======================================================================
            ! UPDATE VARIABLES, CONSTRAINTS AND COST FUNCTION
            ! ----------------------------------------------------------------------
            varvec = varvec*foldis
            ! ----------------------------------------------------------------------
            Varacc = Varacc + foldis
            me%Varval = me%Varval + varvec
            ! ----------------------------------------------------------------------
            do con = 1 , me%Numcon + 1
               val = dot_product(corvec(me%Numact+1:me%Numvar),me%Conred(con,me%Numact+1:me%Numvar))
               me%Conval(con) = me%Conval(con) + val*foldis
            end do
            ! ----------------------------------------------------------------------
            cstval = cstval + foldis*cornor
            ! ======================================================================
            ! MAXIMUM TRAVEL DISTANCE REACHED: NEXT ITERATION
            ! ----------------------------------------------------------------------
            if ( ind==0 ) then
               write (str,'("CNV=",3(1X,D10.3))') cstval/cornor/varvio
               call me%ogwrit(3,str)
               write (str,'(4X,5X,5X,3(1X,D10.3))') cstval , cornor , foldis
               call me%ogwrit(3,str)
               if ( inelop==1 ) then
                  write (str,'("INELOP=",I3)') inelop
                  call me%ogwrit(3,str)
                  inelop = inelop + 1
                  ido = 3
                  cycle main
               else
                  me%Numact = 0
                  exit main
               end if
            end if
            ! ======================================================================
            ! CONSTRAINT HIT: UPDATE CONSTRAINTS + CORRECT
            ! ----------------------------------------------------------------------
            con = ind
            nam = me%Constr(con)
            len = me%Conlen(con)
            val = me%Conval(con)
            write (str,'(5X,5X,I4,3(1X,D10.3),1X,A)') con , cstval , cornor , foldis , nam(1:len)
            call me%ogwrit(3,str)
            if ( conhit(con)>=20 ) then
               write (str,'("OGCORR-WARNING: CONSTRAINT HIT")')
               call me%ogwrit(1,str)
               write (str,'("CON/HIT=",2I4)') con , conhit(con)
               call me%ogwrit(1,str)
               Finish = 0
               call done()
               exit main
            end if
            ! ----------------------------------------------------------------------
            conhit(con) = conhit(con) + 1
            ido = 5
            cycle main

         end select

      end do main

      ! ======================================================================
      ! MATCHED INEQUALITY CONSTRAINTS + MINIMUM CORRECTION NORM
      ! ----------------------------------------------------------------------
      call me%ogwrit(3,"")
      write (str,'("CSTVAL:",D13.6)') cstval
      call me%ogwrit(3,str)
      call me%ogwrit(3,"")
      call me%ogwrit(3,"STATUS OF CONSTRAINTS:")
      call me%ogwrit(3,"")
      call me%ogwrit(3," ACT  PAS  NON COST___VAL CONSTRAINT")
      do con = 1 , me%Numcon
         if ( me%Contyp(con)==-2 ) cycle
         nam = me%Constr(con)
         len = me%Conlen(con)
         val = me%Conval(con)
         if ( me%Conact(con)>0 ) then
            write (str,'( I4,5X,6X,D10.3,1X,A)') con , val , nam(1:len)
            call me%ogwrit(3,str)
         elseif ( me%Conact(con)==0 ) then
            write (str,'( 5X,I4,6X,D10.3,1X,A)') con , val , nam(1:len)
            call me%ogwrit(3,str)
         elseif ( me%Conact(con)<0 ) then
            write (str,'(10X,I4,1X,D10.3,1X,A)') con , val , nam(1:len)
            call me%ogwrit(3,str)
         end if
      end do
      ! ----------------------------------------------------------------------
      call me%ogwrit(3,"")
      call me%ogwrit(3,"STATUS OF VIOLATED CONSTRAINTS:")
      call me%ogwrit(3,"")
      call me%ogwrit(3," CON COST___VAL CONSTRAINT")
      conerr = 0.0_wp
      do con = 1 , me%Numcon
         if ( me%Contyp(con)==-2 ) cycle
         nam = me%Constr(con)
         len = me%Conlen(con)
         val = me%Conval(con)
         if ( val<-dlt ) then
            conerr = conerr + abs(val)
            write (str,'( I4,D11.3,1X,A)') con , val , nam(1:len)
            call me%ogwrit(3,str)
         elseif ( me%Contyp(con)/=0 ) then
         elseif ( val>dlt ) then
            conerr = conerr + abs(val)
            write (str,'( I4,D11.3,1X,A)') con , val , nam(1:len)
            call me%ogwrit(3,str)
         end if
      end do
      ! ----------------------------------------------------------------------
      call me%ogwrit(3,"")
      write (str,'("LINEAR ERROR.: ",D13.6)') conerr
      call me%ogwrit(3,str)
      call done()

   contains

      subroutine done()   ! 7

         me%Contyp = conttt
         me%Conpri = prisav

         deallocate (cosact)
         deallocate (varvec)
         deallocate (varsav)
         deallocate (varcor)
         deallocate (corvec)
         deallocate (consav)
         deallocate (conttt)
         deallocate (concor)
         deallocate (coninc)
         deallocate (conhit)
         deallocate (fffcon)
         deallocate (prisav)

      end subroutine done

   end subroutine ogcorr