Example 2: DGESV_F90 revisited

The LAPACK90 routine DGESV_F90, as it might have been documented using the ProTeX conventions, is listed again in Table 7.

 

!-------------------------------------------------------------------------
!         LAPACK 90 SUBROUTINE:  With apologies to the LAPACKERS
!-------------------------------------------------------------------------
!BOP
!
! !ROUTINE:  DGESV_F90() --- Fortran90 wrapper to LAPACK DGESV
! 
! !INTERFACE:
   SUBROUTINE DGESV_f90(A,B,IPIV,INFO)
! !USES:
      USE LA_PRECISION, ONLY: WP => DP
      USE LA_AUX, ONLY: ERINFO
      USE LAPACK77_INTERFACES, ONLY: GESV_F77 => DGESV
! 
      IMPLICIT NONE
! !INPUT/OUTPUT PARAMETERS:
      REAL(WP), INTENT(INOUT) :: A(:,:), B(:,:)
! !OUTPUT PARAMETERS:
      INTEGER, INTENT(OUT), OPTIONAL :: INFO
      INTEGER, INTENT(OUT), OPTIONAL, TARGET :: IPIV(:)
! !DESCRIPTION: 
!     This routine provides a Fortran90 wrapper to the LAPACK DGESV
!     routine.  Since it is written in Fortran90 it can determine
!     numerous DGESV arguments at run-time, e.g., leading array dimensions 
!     from the arguments passed to the wrapper.  Thus the wrapper has 
!     {\em fewer} arguments and is nicer to use.
!
!     The basic operation is a decomposition of the matrix A, i.e.,
!     \begin{equation}
!         A = {LR}
!     \end{equation}
!     where $L$ is a left triangular matrix, and $R$
!     is a right triangular matrix with 1's on the diagonal.
!     In order to save space, A is overwritten.
!
! !DEFINED PARAMETERS: 
      CHARACTER(LEN=7), PARAMETER :: SRNAME = 'LA_GESV'
! !LOCAL VARIABLES:
      INTEGER :: LD, LINFO, NRHS, N
!     .. Local Pointers ..
      INTEGER, POINTER :: LPIV(:)
! !SYSTEM ROUTINES:
!     INTRINSIC ALLOCATE, DEALLOCATE, MAX, PRESENT, SIZE
      INTRINSIC MAX, PRESENT, SIZE
! !BUGS:
!     You have got to be kidding --- this is LAPACK90
!
! !REVISION HISTORY:
!   12Feb97   Sawyer     Adaptation from LAPACK90 for this document
!
! !REMARKS:
!     Anyone programming in Fortran90 should call this routine 
!     and not the corresponding LAPACK DGESV routine.  It makes
!     for much cleaner code.
!EOP
!-------------------------------------------------------------------------
!BOC
      LINFO = 0
      N = SIZE(A, 1)
      IF( SIZE( A, 2 ) /= N ) THEN
         LINFO = -1
      ELSE IF( SIZE( B, 1 ) /= N ) THEN
         LINFO = -2
      ELSE
         IF( PRESENT( IPIV ) )THEN
            IF( SIZE( IPIV ) /= N ) LINFO = -3
         END IF
      END IF
!
      IF ( LINFO == 0 ) THEN
         LD = MAX( 1, N )
         NRHS = SIZE(B,2)
         IF( PRESENT( IPIV ) )THEN
            LPIV => IPIV
         ELSE
            ALLOCATE(LPIV(N))
         END IF
         CALL GESV_F77( N, NRHS, A, LD, LPIV, B, LD, LINFO )
         IF(.NOT.PRESENT(IPIV)) DEALLOCATE(LPIV)
      END IF
      CALL ERINFO(LINFO,SRNAME,INFO)
      RETURN
      END SUBROUTINE DGESV_F90
!EOC

 
Table: The LAPACK90 DGESV_F90 as it might look if documented in a ProTeX compliant manner.