C ++******************************************************************** C * C DIRNM * C * C ********************************************************************** C=* FROM: SPIDER - MODULAR IMAGE PROCESSING SYSTEM. AUTHOR: J.FRANK * C=* Copyright (C) 1985-2005 Health Research Inc. * C=* * C=* HEALTH RESEARCH INCORPORATED (HRI), * C=* ONE UNIVERSITY PLACE, RENSSELAER, NY 12144-3455. * C=* * C=* Email: spider@wadsworth.org * C=* * C=* This program is free software; you can redistribute it and/or * C=* modify it under the terms of the GNU General Public License as * C=* published by the Free Software Foundation; either version 2 of the * C=* License, or (at your option) any later version. * C=* * C=* This program is distributed in the hope that it will be useful, * C=* but WITHOUT ANY WARRANTY; without even the implied warranty of * C=* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU * C=* General Public License for more details. * C=* * C=* You should have received a copy of the GNU General Public License * C=* along with this program; if not, write to the * C=* Free Software Foundation, Inc., * C=* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. * C=* * C ********************************************************************** C * C DIRNM * C * C PURPOSE: * C * C PARAMETERS: * C * C 0 2 3 4 5 6 7 * C23456789012345678901234567890123456789012345678901234567890123456789012 C*********************************************************************** SUBROUTINE DIRNM(A,M,B,X,XL,XT,IQ) IMPLICIT REAL*8 (A-H,O-Z) IMPLICIT INTEGER*2 (I-N) DIMENSION A(M,M),B(M,M),X(M,M),XL(M),XT(M),IQ(M) IZERO=0 CALL HDIAG(B,M,M,IZERO,X,NR,XT,IQ) DO I=1,M XL(I)=1./SQRT(ABS(B(I,I))) DO J=1,M B(J,I)=X(J,I)*XL(I) ENDDO ENDDO DO I=1,M DO J=1,M X(I,J)=0.0 DO K=1,M X(I,J)=X(I,J)+B(K,I)*A(K,J) ENDDO ENDDO ENDDO DO I=1,M DO J=1,M A(I,J)=0.0 DO K=1,M A(I,J)=A(I,J)+X(I,K)*B(K,J) ENDDO ENDDO ENDDO CALL HDIAG(A,M,M,IZERO,X,NR,XT,IQ) DO I=1,M XL(I)=A(I,I) DO J=1,M A(I,J)=0.0 DO K=1,M A(I,J)=A(I,J)+B(I,K)*X(K,J) ENDDO ENDDO ENDDO DO I=1,M SUMV=0.0 DO J=1,M SUMV=SUMV+A(J,I)*A(J,I) ENDDO DEN=1./SQRT(SUMV) DO J=1,M X(J,I)=A(J,I)*DEN ENDDO ENDDO END