1!$Id:$ 2 subroutine numass(b,neq,mq) 3 4! * * F E A P * * A Finite Element Analysis Program 5 6!.... Copyright (c) 1984-2017: Regents of the University of California 7! All rights reserved 8 9!-----[--.----+----.----+----.-----------------------------------------] 10! Purpose: Determine number of diagonal entries in B array of 11! generalized eigen problem: A*x = B*x*lambda 12 13! Inputs: 14! b(*) - Diagonals of B array 15! neq - Number of equations 16 17! Outputs: 18! mq - Number of non-zero entries in B-diagonal 19!-----[--.----+----.----+----.-----------------------------------------] 20 implicit none 21 22 include 'iofile.h' 23 24 integer n,nn,neq,mq 25 real*8 b(*) 26 27 nn = 0 28 do n = 1,neq 29 if(b(n).ne.0.0d0) nn = nn + 1 30 end do 31 32 if(nn.lt.mq) then 33 write(iow,2000) nn 34 if(ior.lt.0) then 35 write(*,2000) nn 36 endif 37 endif 38 39 mq = min0(mq,nn) 40 41! Format 42 432000 format(' Subspace reduced to',i4,' by number of nonzero', 44 & ' diagonal mass terms') 45 46 end 47