lapack1.f

这是一个实用的并行计算源代码

      PROGRAM TEST
* .. Scalar Arguments ..
      INTEGER INFO, LDA, LDB, N, NRHS
      PARAMETER ( N = 500, NRHS = 20, LDA = N, LDB = N ) 
* .. Array Arguments ..
      INTEGER IPIV( N )
      DOUBLE PRECISION A( LDA, N ), B( LDB, NRHS )
* .. External Subroutines ..
      EXTERNAL DGETRF, DGETRS
* .. Intrinsic Functions ..
      INTRINSIC MAX

* .. Executable Statements ..
*     Get the value of matrix
*     Matrix values are $L=\min(i,j)$, $A_{ij}=\sum_{1\le k\le L}(i+j)$
      CALL INITMTRA(N, N, A, LDA)
* Compute the LU factorization of A.
      CALL DGETRF( N, N, A, LDA, IPIV, INFO )
      IF( INFO.EQ.0 ) THEN
*        Generate the right hand side of linear equations
*        Matrix values are $L=\min(i,j)$, $B_{ij}=\sum_{1\le k\le L}(1+j)/(i+k)$
         CALL INITMTRB(N, NRHS, B, LDB)
*        Solve the system A*X = B, overwriting B with X.
         CALL DGETRS( 'No transpose', N, NRHS, A, LDA, IPIV, B, LDB,
     &                INFO )
      END IF
      STOP
      END

*********************************************************************
* 初始化矩阵的子程序
*********************************************************************

      SUBROUTINE INITMTRA( M, N, A, LDA )
* ..Scalar Arguments..
      INTEGER M, N, LDA
* ..Array Arguments..
      DOUBLE PRECISION A(LDA,*)
* ..Intrinsic Funtions..
      INTRINSIC MIN
* ..Local Arguments..
      INTEGER I, J, K

      DO 30 J = 1, N
      DO 20 I = 1, M
         A(I,J) = 0.0
         DO 10 K = 1, MIN(I,J)
            A(I,J) = A(I,J) + I + J
   10    CONTINUE
   20 CONTINUE
   30 CONTINUE
      RETURN
      END

*********************************************************************

      SUBROUTINE INITMTRB( M, N, B, LDB )
* ..Scalar Arguments..
      INTEGER M, N, LDB
* ..Array Arguments..
      DOUBLE PRECISION B(LDB,*)
* ..Intrinsic Funtions..
      INTRINSIC MIN
* ..Local Arguments..
      INTEGER I, J, K

      DO 30 J = 1, N
      DO 20 I = 1, M
         B(I,J) = 0.0
         DO 10 K = 1, MIN(I,J)
            B(I,J) = B(I,J) + (1 + J) / (I + K)
   10    CONTINUE
   20 CONTINUE
   30 CONTINUE
      RETURN
      END