SUBROUTINEDPOTF2F(UPLO,N,A,LDA,INFO)**--LAPACKroutine(version3.0)--*Univ.ofTennessee,Univ.ofCaliforniaBerkeley,NAGLtd.,*CourantInstitute,ArgonneNationalLab,andRiceUniversity*February29,1992**..ScalarArguments..CHARACTERUPLOINTEGERINFO,LDA,N*..*..ArrayArguments..DOUBLE PRECISIONA(LDA,*)*..**Purpose*=======**DPOTF2computestheCholeskyfactorizationofarealsymmetric*positivedefinitematrixA.**Thefactorizationhastheform*A=U' * U , if UPLO = 'U', or* A = L * L',ifUPLO='L',*whereUisanuppertriangularmatrixandLislowertriangular.**Thisistheunblockedversionofthealgorithm,callingLevel2BLAS.**Arguments*=========**UPLO(input)CHARACTER*1*Specifieswhethertheupperorlowertriangularpartofthe*symmetricmatrixAisstored.*='U':Uppertriangular*='L':Lowertriangular**N(input)INTEGER*TheorderofthematrixA.N>=0.**A(input/output)DOUBLE PRECISIONarray,dimension(LDA,N)*Onentry,thesymmetricmatrixA.IfUPLO='U',theleading*nbynuppertriangularpartofAcontainstheupper*triangularpartofthematrixA,andthestrictlylower*triangularpartofAisnotreferenced.IfUPLO='L',the*leadingnbynlowertriangularpartofAcontainsthelower*triangularpartofthematrixA,andthestrictlyupper*triangularpartofAisnotreferenced.**Onexit,ifINFO=0,thefactorUorLfromtheCholesky*factorizationA=U'*U or A = L*L'.**LDA(input)INTEGER*TheleadingdimensionofthearrayA.LDA>=max(1,N).**INFO(output)INTEGER*=0:successfulexit*<0:ifINFO=-k,thek-thargumenthadanillegalvalue*>0:ifINFO=k,theleadingminoroforderkisnot*positivedefinite,andthefactorizationcouldnotbe*completed.**=====================================================================**..Parameters..DOUBLE PRECISIONONE,ZEROPARAMETER(ONE=1.0D+0,ZERO=0.0D+0)*..*..LocalScalars..LOGICALUPPERINTEGERJDOUBLE PRECISIONAJJ*..*..ExternalFunctions..LOGICALLSAMEDOUBLE PRECISIONDDOTEXTERNALLSAME,DDOT*..*..ExternalSubroutines..EXTERNALDGEMV,DSCAL,XERBLA*..*..IntrinsicFunctions..INTRINSICMAX,SQRT*..*..ExecutableStatements..**Testtheinputparameters.*INFO=0UPPER=LSAME(UPLO,'U')IF(.NOT.UPPER.AND..NOT.LSAME(UPLO,'L'))THENINFO=-1ELSEIF(N.LT.0)THENINFO=-2ELSEIF(LDA.LT.MAX(1,N))THENINFO=-4ENDIFIF(INFO.NE.0)THENCALLXERBLA('DPOTF2',-INFO)RETURNENDIF**Quickreturnifpossible*IF(N.EQ.0)$RETURN*IF(UPPER)THEN**ComputetheCholeskyfactorizationA=U'*U.*DO 10 J = 1, N** Compute U(J,J) and test for non-positive-definiteness.*AJJ = A( J, J ) - DDOT( J-1, A( 1, J ), 1, A( 1, J ), 1 )IF( AJJ.LE.ZERO ) THENA( J, J ) = AJJGO TO 30END IFAJJ = SQRT( AJJ )A( J, J ) = AJJ** Compute elements J+1:N of row J.*IF( J.LT.N ) THENCALL DGEMV( 'Transpose', J-1, N-J, -ONE, A( 1, J+1 ),$ LDA, A( 1, J ), 1, ONE, A( J, J+1 ), LDA )CALL DSCAL( N-J, ONE / AJJ, A( J, J+1 ), LDA )END IF10 CONTINUEELSE** Compute the Cholesky factorization A = L*L'.*DO20J=1,N**ComputeL(J,J)andtestfornon-positive-definiteness.*AJJ=A(J,J)-DDOT(J-1,A(J,1),LDA,A(J,1),$LDA)IF(AJJ.LE.ZERO)THENA(J,J)=AJJGO TO30ENDIFAJJ=SQRT(AJJ)A(J,J)=AJJ**ComputeelementsJ+1:NofcolumnJ.*IF(J.LT.N)THENCALLDGEMV('No transpose',N-J,J-1,-ONE,A(J+1,1),$LDA,A(J,1),LDA,ONE,A(J+1,J),1)CALLDSCAL(N-J,ONE/AJJ,A(J+1,J),1)ENDIF20CONTINUEENDIFGO TO40*30CONTINUEINFO=J*40CONTINUERETURN**EndofDPOTF2*END
此处可能存在不合适展示的内容,页面不予展示。您可通过相关编辑功能自查并修改。
如您确认内容无涉及 不当用语 / 纯广告导流 / 暴力 / 低俗色情 / 侵权 / 盗版 / 虚假 / 无价值内容或违法国家有关法律法规的内容,可点击提交进行申诉,我们将尽快为您处理。