00001 C Work performed under the auspices of the U.S. Department of Energy 00002 C by Lawrence Livermore National Laboratory under contract number 00003 C W-7405-Eng-48. 00004 C 00005 SUBROUTINE DORTH (VNEW, V, HES, N, LL, LDHES, KMP, SNORMW) 00006 C 00007 C***BEGIN PROLOGUE DORTH 00008 C***DATE WRITTEN 890101 (YYMMDD) 00009 C***REVISION DATE 900926 (YYMMDD) 00010 C 00011 C 00012 C----------------------------------------------------------------------- 00013 C***DESCRIPTION 00014 C 00015 C This routine orthogonalizes the vector VNEW against the previous 00016 C KMP vectors in the V array. It uses a modified Gram-Schmidt 00017 C orthogonalization procedure with conditional reorthogonalization. 00018 C 00019 C On entry 00020 C 00021 C VNEW = The vector of length N containing a scaled product 00022 C OF The Jacobian and the vector V(*,LL). 00023 C 00024 C V = The N x LL array containing the previous LL 00025 C orthogonal vectors V(*,1) to V(*,LL). 00026 C 00027 C HES = An LL x LL upper Hessenberg matrix containing, 00028 C in HES(I,K), K.LT.LL, scaled inner products of 00029 C A*V(*,K) and V(*,I). 00030 C 00031 C LDHES = The leading dimension of the HES array. 00032 C 00033 C N = The order of the matrix A, and the length of VNEW. 00034 C 00035 C LL = The current order of the matrix HES. 00036 C 00037 C KMP = The number of previous vectors the new vector VNEW 00038 C must be made orthogonal to (KMP .LE. MAXL). 00039 C 00040 C 00041 C On return 00042 C 00043 C VNEW = The new vector orthogonal to V(*,I0), 00044 C where I0 = MAX(1, LL-KMP+1). 00045 C 00046 C HES = Upper Hessenberg matrix with column LL filled in with 00047 C scaled inner products of A*V(*,LL) and V(*,I). 00048 C 00049 C SNORMW = L-2 norm of VNEW. 00050 C 00051 C----------------------------------------------------------------------- 00052 C***ROUTINES CALLED 00053 C DDOT, DNRM2, DAXPY 00054 C 00055 C***END PROLOGUE DORTH 00056 C 00057 INTEGER N, LL, LDHES, KMP 00058 DOUBLE PRECISION VNEW, V, HES, SNORMW 00059 DIMENSION VNEW(*), V(N,*), HES(LDHES,*) 00060 INTEGER I, I0 00061 DOUBLE PRECISION ARG, DDOT, DNRM2, SUMDSQ, TEM, VNRM 00062 C 00063 C----------------------------------------------------------------------- 00064 C Get norm of unaltered VNEW for later use. 00065 C----------------------------------------------------------------------- 00066 VNRM = DNRM2 (N, VNEW, 1) 00067 C----------------------------------------------------------------------- 00068 C Do Modified Gram-Schmidt on VNEW = A*V(LL). 00069 C Scaled inner products give new column of HES. 00070 C Projections of earlier vectors are subtracted from VNEW. 00071 C----------------------------------------------------------------------- 00072 I0 = MAX0(1,LL-KMP+1) 00073 DO 10 I = I0,LL 00074 HES(I,LL) = DDOT (N, V(1,I), 1, VNEW, 1) 00075 TEM = -HES(I,LL) 00076 CALL DAXPY (N, TEM, V(1,I), 1, VNEW, 1) 00077 10 CONTINUE 00078 C----------------------------------------------------------------------- 00079 C Compute SNORMW = norm of VNEW. 00080 C If VNEW is small compared to its input value (in norm), then 00081 C Reorthogonalize VNEW to V(*,1) through V(*,LL). 00082 C Correct if relative correction exceeds 1000*(unit roundoff). 00083 C Finally, correct SNORMW using the dot products involved. 00084 C----------------------------------------------------------------------- 00085 SNORMW = DNRM2 (N, VNEW, 1) 00086 IF (VNRM + 0.001D0*SNORMW .NE. VNRM) RETURN 00087 SUMDSQ = 0.0D0 00088 DO 30 I = I0,LL 00089 TEM = -DDOT (N, V(1,I), 1, VNEW, 1) 00090 IF (HES(I,LL) + 0.001D0*TEM .EQ. HES(I,LL)) GO TO 30 00091 HES(I,LL) = HES(I,LL) - TEM 00092 CALL DAXPY (N, TEM, V(1,I), 1, VNEW, 1) 00093 SUMDSQ = SUMDSQ + TEM**2 00094 30 CONTINUE 00095 IF (SUMDSQ .EQ. 0.0D0) RETURN 00096 ARG = MAX(0.0D0,SNORMW**2 - SUMDSQ) 00097 SNORMW = SQRT(ARG) 00098 RETURN 00099 C 00100 C------END OF SUBROUTINE DORTH------------------------------------------ 00101 END
1.7.1
