************************************************************************ * * * Package VECLIB * Miscellaneous routines for fundamental operations on vectors * and matrices. Also some other odds and ends. * * * Contains: * s/r matcmp compare two n x m real matrices * s/r rmatcmp = matcmp * s/r imatcmp compare two n x m integer matrices * * s/r matcop copy n x m real matrix * s/r rmatcop = matcop * s/r imatcop copy n x m integer matrix * s/r drmatcop copy n x m double precision matrix to real * * s/r matclr clear n x m real matrix * s/r rmatclr = matclr * s/r imatclr clear n x m integer matrix * s/r dmatclr clear n x m double precision matrix * s/r cmatclr clear n x m character matrix * * s/r rmatset set all elements in n x m real matrix * s/r imatset set all elements in n x m integer matrix * s/r dmatset set all elements in n x m double precision matrix * s/r cmatset set all elements in n x m character matrix * * s/r vecdif subtract two real vectors * s/r vecadd add two real vectors * s/r vecabs abs of real vector elements * s/r rvecdif = vecdif * s/r rvecadd = vecadd * s/r rvecdif = vecdif * s/r rvecmod modulus of real vector * s/r ivecdif subtract two integer vectors * s/r ivecadd add two integer vectors * s/r ivecabs abs of integer vector elements * * s/r ivecf convert integer vector to real * s/r fveci convert real vector to integer * * s/r mtxtps transpose n x m real matrix * s/r mtxinv invert n x n matrix * s/r mtxmlt multiply n x m matrix by m x n matrix * s/r vmxmlt mulitply n x 1 vector by m x n matrix * * s/r transpose transpose n x n real matrix * s/r matinv invert 3 x 3 real matrix * s/r vmtply multiply 3 x 1 vector by 3 x 3 matrix * s/r mmtply multiply 3 x 3 matrix by 3 x 3 matrix * s/r cosabg cosine of three angles * s/r ortho get (de)orthogoanlization matrix from cell * s/r pnt2pln get plane equation from three points * fn plndst distance between point and plane * s/r polar2mtx convert polar angles to matrix * s/r nfold2mtx convert direction cosines and rot angle to matrix * s/r msk .and. two logical vectors, count and point * s/r mskcmp compare two logical vectors * * s/r isort sort real array, co-sort integer vector * s/r fsort sort real array, co-sort real vector * s/r qsortfi quicksort real array, co-sort integer vector * s/r qsortff quicksort real array, co-sort real vector * s/r qsortffi quicksort real array, co-sort real and integer vector * s/r qsortpf quicksort pointers * s/r nsorta Sort N columns on values in key column, acending * * fun det determinant of 3 x 3 matrix * fun vlen length (A) of fractional vector in ]-0.5,0.5[ * fun vlen2 length (A) of fractional vector * * fun imaxvc maximum element in vector (integer) * fun iminvc minimum element in vector (integer) * fun fmaxvc maximum element in vector (real) * fun fminvc minimum element in vector (real) * fun random pseudo-random number generator (real) * ************************************************************************ ************************************************************************ * * Subroutine MATCMP * * Function: * Compare two n x m matrices a and b and return number of matching * elements in match. * * Arguments: * A (i) matrix 1 * B (i) matrix 2 * N (i) first dimension of A and B * M (i) second dimension of A and B * Match (o) number of matching elements * Tol (i) allowed discrepancy * * History: * Written October 1987 S. Knight ************************************************************************ subroutine matcmp ( a , b , n , m , match , tol ) implicit none * Arguments integer n , m , match real a( n,m ) , b( n,m ) real tol * Local variables integer i , j *----------------------------------------------------------------------- match = 0 do i = 1 , m do j = 1 , n if ( abs ( a( j,i ) - b( j,i ) ) .lt. tol ) match = match + 1 end do end do return end