1!
2!     CalculiX - A 3-dimensional finite element program
3!              Copyright (C) 1998-2021 Guido Dhondt
4!
5!     This program is free software; you can redistribute it and/or
6!     modify it under the terms of the GNU General Public License as
7!     published by the Free Software Foundation(version 2);
8!
9!
10!     This program is distributed in the hope that it will be useful,
11!     but WITHOUT ANY WARRANTY; without even the implied warranty of
12!     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
13!     GNU General Public License for more details.
14!
15!     You should have received a copy of the GNU General Public License
16!     along with this program; if not, write to the Free Software
17!     Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
18!
19      subroutine nmatrix(ad,au,jqs,irows,ndesi,nodedesi,dgdxglob,
20     &   nactive,nobject,nnlconst,ipoacti,nk)
21!
22!     calculates the values of the expression: N^(T)N
23!
24      implicit none
25!
26      integer jqs(*),irows(*),ndesi,nodedesi(*),idof,i,j,jdof,
27     &   nactive,nobject,nnlconst,ipos,jpos,ipoacti(*),nk,node
28!
29      real*8 ad(*),au(*),dgdxglob(2,nk,nobject)
30!
31      do idof=1,nactive
32         if(idof.le.nnlconst) then
33            ipos=ipoacti(idof)
34            do i=1,ndesi
35               node=nodedesi(i)
36               ad(idof)=ad(idof)+dgdxglob(2,node,ipos)**2
37            enddo
38            do i=jqs(idof),jqs(idof+1)-1
39               jdof=irows(i)
40               if(jdof.le.nnlconst) then
41                  jpos=ipoacti(i)
42                  do j=1,ndesi
43                     node=nodedesi(j)
44                     au(i)=au(i)+dgdxglob(2,node,ipos)
45     &                          *dgdxglob(2,node,jpos)
46                  enddo
47               else
48                  node=nodedesi(ipoacti(i))
49                  au(i)=dgdxglob(2,node,ipos)
50               endif
51            enddo
52         else
53            ad(idof)=1
54         endif
55      enddo
56!
57      return
58      end
59
60
61
62
63