sub check.for

来自「非线性回归问题SQP解法」· FOR 代码 · 共 50 行

	SUBROUTINE CHECK(N,ME,MI,M,NAMAX,X,CFUN,CGRA,CGRA1,
     *				D1,AK,W0,W1,W2,W3,W4,CON1,GRAD,CORR,NF,NG)
	DOUBLE PRECISION X(N),CFUN(M),CGRA(NAMAX,M),D1(N),AK(NAMAX,M),
	*                W0(N),W1(N),W2(N),W3(N),W4(N),CON1(M),OBJ1,
     *                CGRA1(NAMAX,M),CI,CA,CD,CAMAX,CDMAX,EPS,SIGMA
	LOGICAL GRAD,CORR,EMPTY
	DATA EPS,SIGMA/1.0D-1,5.0D-2/
	CORR=.FALSE.
	DO 1 J=1,N
		W0(J)=X(J)+D1(J)
1	CONTINUE
	CALL FVAL(N,ME,MI,M,W0,OBJ1,CON1)
	NF=NF+1
	IF (GRAD)THEN
		CALL GVAL(N,ME,MI,M,NAMAX,W0,W1,CGRA1)
		NG=NG+1
	ELSE
		CALL DIF(N,ME,MI,M,NAMAX,W0,W1,CGRA1,W2,W3,W4,NF)
	ENDIF
	DO 2 I=1,M
		DO 2 J=1,N
			AK(J,I)=5.0D-1*(CGRA(J,I)+CGRA1(J,I))
2	CONTINUE
	CAMAX=0.0
	CDMAX=0.0
	EMPTY=.TRUE.
	DO 4 I=1,M
		CI=CFUN(I)
		IF(DABS(CI).GE.EPS)GOTO 4
		EMPTY=.FALSE.
		CA=CI-CON1(I)
		CD=CA
		DO 3 J=1,N
			CA=CA+AK(J,I)*D1(J)
			CD=CD+CGRA(J,I)*D1(J)
3		CONTINUE
		CA=DABS(CA)
		CD=DABS(CD)
		CAMAX=DMAX1(CA,CAMAX)
		CDMAX=DMAX1(CD,CDMAX)
4	CONTINUE
	IF (EMPTY)RETURN
	IF (CAMAX.LT.SIGMA*CDMAX)THEN
		CORR=.TRUE.
		WRITE(6,100)
100		FORMAT('SOLVE MODIFIED QP SUBPROBLEM TO OBTAIN',
     *			' SECOND-ORDER CORRECTION')
	ENDIF
	RETURN
	END