subroutine ercmp1(me, Ioptn, Nparm, Numgr, Fun, Ifun, Pttbl, Iptb, Indm, &
Param, Icnuse, Iphse, Iwork, Liwrk, Confun, Icntyp, &
Ipmax, Ismax, Error)
implicit none
class(conmax_solver), intent(inout) :: me
integer, intent(in) :: Ioptn
integer, intent(in) :: Nparm
integer, intent(in) :: Numgr
integer, intent(in) :: Ifun
integer, intent(in) :: Iptb
integer, intent(in) :: Indm
integer, intent(in) :: Icnuse
integer, intent(in) :: Iphse
integer, intent(in) :: Liwrk
integer, intent(out) :: Ipmax
integer, intent(out) :: Ismax
real(wp), intent(in) :: Fun(Ifun)
real(wp), intent(in) :: Pttbl(Iptb, Indm)
real(wp), intent(in) :: Param(Nparm)
integer :: Iwork(Liwrk)
integer :: Icntyp(Numgr)
real(wp) :: Confun(Numgr, Nparm + 1)
real(wp) :: Error(Numgr + 3)
real(wp) :: ei, enor2, enor3, enorm
integer :: i, ilc22, im1, im2, ioptth, ipt, l
! SET MACHINE AND PRECISION DEPENDENT CONSTANTS.
ilc22 = iloc(22, Nparm, Numgr)
ioptth = (Ioptn - (Ioptn/100000)*100000)/10000
if (ioptth <= 0) then
! HERE IOPTTH=0, AND EACH CALL TO FNSET WILL COMPUTE FUNCTION VALUES
! FOR ONLY ONE CONSTRAINT.
do i = 1, Numgr
ipt = i
if (Icnuse <= 0) then
! HERE ICNUSE=0 SO WE WILL ACCEPT AND USE THE ICNTYP(I) COMPUTED BY
! FNSET.
! CALL FNSET WITH INDFN=0 TO COMPUTE CONFUN(I,1) AND ICNTYP(I).
call me%fnset(Nparm, Numgr, Pttbl, Iptb, Indm, Param, ipt, 0, Icntyp, Confun)
! HERE ICNUSE=1 AND THE ICNTYP CARRIED INTO ERCMP1 WILL OVERRIDE THAT
! COMPUTED BY FNSET. THIS WILL ALSO BE TRUE IN ALL SUBROUTINES OTHER
! THAN CONMAX. IF ICNTYP(I)=0 WE WILL SET ERROR(I)=0.0 AND WILL NOT
! NEED TO CALL FNSET.
else if (Icntyp(i) /= 0) then
! CALL FNSET WITH INDFN=0 TO COMPUTE CONFUN(I,1). THE COMPUTED KCNTYP
! WILL NOT BE USED.
call me%fnset(Nparm, Numgr, Pttbl, Iptb, Indm, Param, ipt, 0, Iwork(ilc22), Confun)
else
Error(i) = zero
cycle
end if
call compute_error(i)
end do
else
fnset: block
! HERE IOPTTH=1 AND A SINGLE CALL TO FNSET WITH INDFN=0 WILL COMPUTE
! CONFUN(.,1) AND (IF ICNUSE=0) ICNTYP(.).
if (Icnuse <= 0) then
! HERE IOPTTH=1 AND ICNUSE=0, AND WE SET IPT=0 TO TELL FNSET TO COMPUTE
! ALL CONSTRAINTS (SINCE WE WANT TO BE SURE THAT ALL OF ICNTYP IS
! COMPUTED). NOTE THAT IF INSTEAD WE HAD IOPTTH=0, THEN IPT WOULD
! BE POSITIVE AT EACH FNSET CALL, TELLING FNSET TO COMPUTE CONSTRAINT
! IPT ONLY.
ipt = 0
call me%fnset(Nparm, Numgr, Pttbl, Iptb, Indm, Param, ipt, 0, Icntyp, Confun)
else
! HERE IOPTTH=1 AND ICNUSE=1, AND IF IPHSE IS NEGATIVE WE SET IPT=-1
! TO TELL FNSET THAT ONLY STANDARD CONSTRAINTS NEED TO BE COMPUTED.
! IF IPHSE=0 HERE WE CHECK TO SEE IF ANY ICNTYP(L) IS POSITIVE FOR
! L=1,...,NUMGR, AND IF SO WE SET IPT=0 TO TELL FNSET TO COMPUTE ALL
! CONSTRAINTS, WHILE OTHERWISE WE SET IPT=-1.
if (Iphse >= 0) then
do l = 1, Numgr
if (Icntyp(l) > 0) then
ipt = 0
call me%fnset(Nparm, Numgr, Pttbl, Iptb, Indm, Param, ipt, 0, Iwork(ilc22), Confun)
exit fnset
end if
end do
end if
ipt = -1
call me%fnset(Nparm, Numgr, Pttbl, Iptb, Indm, Param, ipt, 0, Iwork(ilc22), Confun)
end if
end block fnset
! Compute error as above.
do i = 1, Numgr
call compute_error(i)
end do
end if
! HAVING FINISHED COMPUTING ERROR(I) AND (IF ICNUSE=0) ICNTYP(I) FOR
! I=1,...,NUMGR WE NOW COMPUTE THE ERROR NORMS.
! WE ALSO COMPUTE THE INDEX IPMAX OF THE CONSTRAINT WHERE THE PRIMARY
! (I.E. TYPE 1 OR TYPE 2) ERROR NORM OCCURS AND THE INDEX ISMAX OF THE
! CONSTRAINT WHERE THE STANDARD (I.E. TYPE -1 OR TYPE -2) ERROR NORM
! OCCURS.
! FIRST INITIALIZE THE INDICATORS AND ERROR NORMS.
im1 = 0
im2 = 0
Ipmax = 0
Ismax = 0
enorm = zero
enor2 = zero
enor3 = zero
do i = 1, Numgr
ei = Error(i)
if (Icntyp(i) < 0) then
if (Icntyp(i) + 1 < 0) then
! HERE ICNTYP(I)=-2 AND WE DO AS ABOVE EXCEPT WITH IM2 AND ENOR3.
if (im2 > 0) then
if (ei <= enor3) cycle
end if
im2 = i
enor3 = ei
else
! HERE ICNTYP(I)=-1 AND WE DO AS ABOVE EXCEPT WITH IM1 AND ENOR2.
if (im1 > 0) then
if (ei <= enor2) cycle
end if
im1 = i
enor2 = ei
end if
else if (Icntyp(i) /= 0) then
! HERE ICNTYP(I) > 0. IF ICNTYP(I)=2 REPLACE EI BY ABS(EI). IF THIS
! IS THE FIRST I FOUND WITH ICNTYP(I) > 0 WE RESET IPMAX TO I AND PUT
! EI IN ENORM, AND OTHERWISE RESET IPMAX AND PUT EI IN ENORM IF AND ONLY
! IF EI IS BIGGER THAN THE VALUES FOUND SO FAR.
if (Icntyp(i) > 1) ei = abs(ei)
if (Ipmax > 0) then
if (ei <= enorm) cycle
end if
Ipmax = i
enorm = ei
end if
end do
! NOW RESET ISMAX IF THERE ARE ANY STANDARD CONSTRAINTS.
if (im1 <= 0) then
! HERE THERE ARE STANDARD NONLINEAR CONSTRAINTS BUT NO STANDARD LINEAR
! CONSTRAINTS.
if (im2 > 0) Ismax = im2
else if (im2 <= 0) then
! HERE THERE ARE STANDARD LINEAR CONSTRAINTS BUT NO STANDARD NONLINEAR
! CONSTRAINTS.
Ismax = im1
! HERE THERE ARE BOTH STANDARD LINEAR CONSTRAINTS AND STANDARD NONLINEAR
! CONSTRAINTS.
else if (enor3 < enor2) then
Ismax = im1
else
Ismax = im2
end if
! SET ERROR(NUMGR+1) THROUGH ERROR(NUMGR+3).
Error(Numgr + 1) = enorm
Error(Numgr + 2) = enor2
Error(Numgr + 3) = enor3
contains
subroutine compute_error(i)
!! Set error(i)=0.0, or confun(i,1), or fun(i) - confun(i,1) according as
!! icntyp(i) is 0, or -2, -1, 1, or 2.
implicit none
integer, intent(in) :: i
if (Icntyp(i) == 0) then
Error(i) = zero
else if (Icntyp(i) > 1) then
Error(i) = Fun(i) - Confun(i, 1)
else
Error(i) = Confun(i, 1)
end if
end subroutine compute_error
end subroutine ercmp1