sub drop.for

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

	SUBROUTINE DROP(N,NAMAX,M,NJ,MJ,JSET,R,NM,JK,JP,ZERO)
	DOUBLE PRECISION R(NAMAX,N),NM(NAMAX,N),GAMMA,C,S,V,W,ZERO
	INTEGER JSET(M)
	LOGICAL MJ(M)
	IF (JP.EQ.NJ)GOTO 6
	DO 1 I=JP,NJ-1
		DO 1 J=1,N
			R(J,I)=R(J,I+1)
1	CONTINUE
	DO 4 I=JP,NJ-1
		GAMMA=R(I,I)**2+R(I+1,I)**2
		IF (GAMMA.LT.ZERO)GOTO 4
		GAMMA=DSQRT(GAMMA)
		C=R(I,I)/GAMMA
		S=R(I+1,I)/GAMMA
		DO 2 L=I,NJ-1
			V=R(I,L)
			W=R(I+1,L)
			R(I,L)=C*V+W*S
			R(I+1,L)=-S*V+C*W
2		CONTINUE
		DO 3 J=1,N
			V=NM(J,I)
			W=NM(J,I+1)
			NM(J,I)=C*V+S*w
			NM(J,I+1)=-S*V+C*W
3		CONTINUE
4	CONTINUE
	DO 5 I=JP,NJ-1
		JSET(I)=JSET(I+1)
5	CONTINUE
6	MJ(JK)=.FALSE.
	NJ=NJ-1
	RETURN
	END