sub qrdec.for

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

	SUBROUTINE QRDEC(N,M,NAMAX,R,Q,JRANK,ZERO)
	DOUBLE PRECISION R(NAMAX,N),Q(NAMAX,N),GAMMA,C,S,V,W,ZERO
	LOGICAL JZERO
	JN=MIN0(M,N-1)
	JRANK=0
	DO 2 I=1,N
		DO 1 J=1,N
			Q(I,J)=0.0
1		CONTINUE
		Q(I,I)=1.0D0
2	CONTINUE
	DO 6 I=1,JN
		JZERO=.TRUE.
		DO 5 J=I+1,N
			GAMMA=R(I,I)**2+R(J,I)**2
			IF (GAMMA.LT.ZERO)GOTO 5
			JZERO=.FALSE.
			GAMMA=DSQRT(GAMMA)
			C=R(I,I)/GAMMA
			S=R(J,I)/GAMMA
			DO 3 L=I,M
				V=R(I,L)
				W=R(J,L)
				R(I,L)=C*V+S*W
				R(J,L)=-S*V+C*W
3			CONTINUE
			DO 4 K=1,N
				V=Q(K,I)
				W=Q(K,J)
				Q(K,I)=C*V+S*W
				Q(K,J)=-S*V+C*W
4			CONTINUE
5		CONTINUE
		IF (JZERO)THEN
			JRANK=I
			RETURN
		ENDIF
6	CONTINUE
	RETURN
	END