MatrixNorm_spec.F
c**********************************************************************
#include "author.inc"
c* $Id: MatrixNorm_spec.F,v 1.2 1995/12/21 00:08:51 turner Exp $
c*
c* Computes the norm of a rectangular matrix.
c*
c* WARNING: Note that JT_MatrixNorm_Full *must* be declared real in
c* routines that use it.
c*
c* <PARAMETER LIST>
c*
c* Input:
c* norm - determines which norm to use
c* 0 ==> infinity norm
c* 1 ==> 1-norm
c* 2 ==> Frobenius norm
c* idim - leading dimension of a
c* nrows - number of rows in a
c* ncols - number of columns in a
c* a - matrix
c* n
c* ---
c* \
c* infinity norm ==> max / | a |
c* 1<=i<=m --- ij
c* j=1
c* m
c* ---
c* \
c* 1-norm ==> max / | a |
c* 1<=j<=n --- ij
c* i=1
c* m n
c* --- ---
c* \ \ 2
c* Frobenius norm ==> sqrt / / a
c* --- --- ij
c* i=1 j=1
c*
c* Output:
c* status - return status
c* -3 ==> internal error
c* -2 ==> memory allocation failure
c* -1 ==> invalid argument(s)
c* 0 ==> success
c*
c* <FUNCTIONS REQUIRED>
c*
c* JT_MatrixNorm0_Full
c* JT_MatrixNormF_Full
c* JT_VectorNorm
c*
#include "copyright.inc"
c**********************************************************************
real function JT_MatrixNorm_Full (norm, idim, nrows, ncols, a,
& status)
implicit none
c
c ... Input:
integer idim, norm, nrows, ncols
real a(idim,ncols)
c
c ... Output:
integer status
c
c ... Local:
integer j
real colsum, maxcolsum, zero
real JT_VectorNorm, JT_MatrixNorm0_Full, JT_MatrixNormF_Full
c
parameter (zero=0.0d0)
c
c ... Initialize return status.
status = 0
c
c ... Initialize function result.
JT_MatrixNorm_Full = zero
c
if (norm .eq. 0) then
JT_MatrixNorm_Full = JT_MatrixNorm0_Full(idim, nrows, ncols, a,
& status)
elseif (norm .eq. 1) then
maxcolsum = zero
do j=1,ncols
colsum = JT_VectorNorm(1, nrows, a(1,j), status)
maxcolsum = MAX(colsum, maxcolsum)
enddo
JT_MatrixNorm_Full = maxcolsum
elseif (norm .eq. 2) then
JT_MatrixNorm_Full = JT_MatrixNormF_Full(idim, nrows, ncols, a,
& status)
else
status = -1
return
endif
c
if (status .eq. -1) status = -3
c
return
end
c**********************************************************************
#include "author.inc"
c* $Id: MatrixNorm_spec.F,v 1.2 1995/12/21 00:08:51 turner Exp $
c*
c* Computes the norm of a matrix in ELL format.
c*
c* WARNING: Note that JT_MatrixNorm_ELL *must* be declared real in
c* routines that use it.
c*
c* <PARAMETER LIST>
c*
c* Input:
c* norm - determines which norm to use
c* 0 ==> infinity norm
c* 1 ==> 1-norm (NOT IMPLEMENTED)
c* 2 ==> Frobenius norm
c* idim - leading dimension of a
c* n - number of rows in a
c* maxnz - maximum number of non-zero elements in any row of a
c* a - matrix
c* ja - column map for matrix
c* n
c* ---
c* \
c* infinity norm ==> max / | a |
c* 1<=i<=m --- ij
c* j=1
c* m
c* ---
c* \
c* 1-norm ==> max / | a |
c* 1<=j<=n --- ij
c* i=1
c* m n
c* --- ---
c* \ \ 2
c* Frobenius norm ==> sqrt / / a
c* --- --- ij
c* i=1 j=1
c*
c* Output:
c* status - return status
c* -3 ==> internal error
c* -2 ==> memory allocation failure
c* -1 ==> invalid argument(s)
c* 0 ==> success
c*
c* <FUNCTIONS REQUIRED>
c*
c* JT_MatrixNorm0_Full
c* JT_MatrixNormF_Full
c*
#include "copyright.inc"
c**********************************************************************
real function JT_MatrixNorm_ELL (norm, idim, n, maxnz, a, ja,
& status)
implicit none
c
c ... Input:
integer idim, norm, n, maxnz
integer ja(idim,maxnz)
real a(idim,maxnz)
c
c ... Output:
integer status
c
c ... Local:
real zero
real JT_MatrixNorm0_Full, JT_MatrixNormF_Full
c
parameter (zero=0.0d0)
c
c ... Initialize return status.
status = 0
c
c ... Initialize function result.
JT_MatrixNorm_ELL = zero
c
if (norm .eq. 0) then
JT_MatrixNorm_ELL = JT_MatrixNorm0_Full(idim, n, maxnz, a,
& status)
c
c elseif (norm .eq. 1) then
c
c Need a chunk of code here to do 1-norm.
c
elseif (norm .eq. 2) then
JT_MatrixNorm_ELL = JT_MatrixNormF_Full(idim, n, maxnz, a,
& status)
else
status = -1
return
endif
c
if (status .eq. -1) status = -3
c
return
end
c**********************************************************************
#include "author.inc"
c* $Id: MatrixNorm_spec.F,v 1.2 1995/12/21 00:08:51 turner Exp $
c*
c* Computes the norm of a matrix in coordinate format.
c*
c* WARNING: Note that JT_MatrixNorm_COO *must* be declared real in
c* routines that use it.
c*
c* <PARAMETER LIST>
c*
c* Input:
c* norm - determines which norm to use
c* 0 ==> infinity norm (NOT IMPLEMENTED)
c* 1 ==> 1-norm (NOT IMPLEMENTED)
c* 2 ==> Frobenius norm
c* nelem - number of active elements in a
c* n - number of rows in a
c* a - matrix
c* ja - column map for matrix
c* n
c* ---
c* \
c* infinity norm ==> max / | a |
c* 1<=i<=m --- ij
c* j=1
c* m
c* ---
c* \
c* 1-norm ==> max / | a |
c* 1<=j<=n --- ij
c* i=1
c* m n
c* --- ---
c* \ \ 2
c* Frobenius norm ==> sqrt / / a
c* --- --- ij
c* i=1 j=1
c*
c* Output:
c* status - return status
c* -3 ==> internal error
c* -2 ==> memory allocation failure
c* -1 ==> invalid argument(s)
c* 0 ==> success
c*
#include "copyright.inc"
c**********************************************************************
real function JT_MatrixNorm_COO (norm, nelem, n, a, ja, status)
implicit none
c
c ... Input:
integer nelem, norm, n
integer ja(2*nelem)
real a(nelem)
c
c ... Output:
integer status
c
c ... Local:
integer i
real zero
c
parameter (zero=0.0d0)
c
c ... Initialize return status.
status = 0
c
c ... Initialize function result.
JT_MatrixNorm_COO = zero
c
c if (norm .eq. 0) then
c
c Need a chunk of code here to do 0-norm.
c
c elseif (norm .eq. 1) then
c
c Need a chunk of code here to do 1-norm.
c
if (norm .eq. 2) then
JT_MatrixNorm_COO = zero
do i=1,nelem
JT_MatrixNorm_COO = JT_MatrixNorm_COO + a(i)*a(i)
enddo
JT_MatrixNorm_COO = SQRT(JT_MatrixNorm_COO)
else
status = -1
return
endif
c
if (status .eq. -1) status = -3
c
return
end
c**********************************************************************
#include "author.inc"
c* $Id: MatrixNorm_spec.F,v 1.2 1995/12/21 00:08:51 turner Exp $
c*
c* Computes the norm of a matrix in RSS format.
c*
c* WARNING: Note that JT_MatrixNorm_RSS *must* be declared real in
c* routines that use it.
c*
c* <PARAMETER LIST>
c*
c* Input:
c* norm - determines which norm to use
c* 0 ==> infinity norm (NOT IMPLEMENTED)
c* 1 ==> 1-norm (NOT IMPLEMENTED)
c* 2 ==> Frobenius norm
c* nelem - number of active elements in a
c* n - number of rows in a
c* a - matrix
c* ja - column map for matrix
c* n
c* ---
c* \
c* infinity norm ==> max / | a |
c* 1<=i<=m --- ij
c* j=1
c* m
c* ---
c* \
c* 1-norm ==> max / | a |
c* 1<=j<=n --- ij
c* i=1
c* m n
c* --- ---
c* \ \ 2
c* Frobenius norm ==> sqrt / / a
c* --- --- ij
c* i=1 j=1
c*
c* Output:
c* status - return status
c* -3 ==> internal error
c* -2 ==> memory allocation failure
c* -1 ==> invalid argument(s)
c* 0 ==> success
c*
#include "copyright.inc"
c**********************************************************************
real function JT_MatrixNorm_RSS (norm, nelem, n, a, ja, status)
implicit none
c
c ... Input:
integer nelem, norm, n
integer ja(nelem)
real a(nelem)
c
c ... Output:
integer status
c
c ... Local:
integer i
real zero
c
parameter (zero=0.0d0)
c
c ... Initialize return status.
status = 0
c
c ... Initialize function result.
JT_MatrixNorm_RSS = zero
c
c if (norm .eq. 0) then
c
c Need a chunk of code here to do 0-norm.
c
c elseif (norm .eq. 1) then
c
c Need a chunk of code here to do 1-norm.
c
if (norm .eq. 2) then
JT_MatrixNorm_RSS = zero
do i=1,nelem
JT_MatrixNorm_RSS = JT_MatrixNorm_RSS + a(i)*a(i)
enddo
JT_MatrixNorm_RSS = SQRT(JT_MatrixNorm_RSS)
else
status = -1
return
endif
c
if (status .eq. -1) status = -3
c
return
end
c**********************************************************************
#include "author.inc"
c* $Id: MatrixNorm_spec.F,v 1.2 1995/12/21 00:08:51 turner Exp $
c*
c* Computes the norm of a matrix in CSS format.
c*
c* WARNING: Note that JT_MatrixNorm_CSS *must* be declared real in
c* routines that use it.
c*
c* <PARAMETER LIST>
c*
c* Input:
c* norm - determines which norm to use
c* 0 ==> infinity norm (NOT IMPLEMENTED)
c* 1 ==> 1-norm (NOT IMPLEMENTED)
c* 2 ==> Frobenius norm
c* nelem - number of active elements in a
c* n - number of rows in a
c* a - matrix
c* ja - column map for matrix
c* n
c* ---
c* \
c* infinity norm ==> max / | a |
c* 1<=i<=m --- ij
c* j=1
c* m
c* ---
c* \
c* 1-norm ==> max / | a |
c* 1<=j<=n --- ij
c* i=1
c* m n
c* --- ---
c* \ \ 2
c* Frobenius norm ==> sqrt / / a
c* --- --- ij
c* i=1 j=1
c*
c* Output:
c* status - return status
c* -3 ==> internal error
c* -2 ==> memory allocation failure
c* -1 ==> invalid argument(s)
c* 0 ==> success
c*
#include "copyright.inc"
c**********************************************************************
real function JT_MatrixNorm_CSS (norm, nelem, n, a, ja, status)
implicit none
c
c ... Input:
integer nelem, norm, n
integer ja(nelem)
real a(nelem)
c
c ... Output:
integer status
c
c ... Local:
integer i
real zero
c
parameter (zero=0.0d0)
c
c ... Initialize return status.
status = 0
c
c ... Initialize function result.
JT_MatrixNorm_CSS = zero
c
c if (norm .eq. 0) then
c
c Need a chunk of code here to do 0-norm.
c
c elseif (norm .eq. 1) then
c
c Need a chunk of code here to do 1-norm.
c
if (norm .eq. 2) then
JT_MatrixNorm_CSS = zero
do i=1,nelem
JT_MatrixNorm_CSS = JT_MatrixNorm_CSS + a(i)*a(i)
enddo
JT_MatrixNorm_CSS = SQRT(JT_MatrixNorm_CSS)
else
status = -1
return
endif
c
if (status .eq. -1) status = -3
c
return
end