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!
20!     Generate local transformation matrix \f$ T_e^{lin,-1} \f$ needed for quad-lin mortar method
21!    see phd-thesis Sitzmann equation (4.4) for \f$ T_e^{lin} \f$
22!    Author: Saskia Sitzmann
23!
24!    [in]     ipkon       pointer into field kon
25!    [in]     kon         Field containing the connectivity of the elements in succesive order
26!    [in]     lakon       element label
27!    [in]     islavsurf   islavsurf(1,i) slaveface i islavsurf(2,i) pointer into imastsurf and pmastsurf
28!    [out]    contr       field containing T_e contributions for current face
29!    [out]    icontr1     (i)  row  of contribution(i)
30!    [out]    icontr2     (i)  column of contribution(i)
31!    [out]    icounter    counter variable for contr
32!    [in]     lface	 current slave face
33!
34      subroutine createteleinv_lin(ipkon,kon,lakon,
35     &     islavsurf,
36     &     contr,icontr1,icontr2,icounter,lface)
37!
38!     Generate local transformation matrix T
39!
40!     Author: Sitzmann,Saskia ;
41!
42      implicit none
43!
44      logical debug
45!
46      character*8 lakon(*)
47!
48      integer ipkon(*),kon(*),konl(20),islavsurf(2,*),
49     &     icounter,icontr1(*),icontr2(*),j,nope,lface,
50     &     ifaces,nelems,jfaces,m,nopes,
51     &     ifac,getlocno,lnode(2,8),modf,idummy
52!
53      real*8 contr(*),alpha
54!
55      debug=.false.
56      alpha=1.0/2.0
57      icounter=0
58      ifaces = islavsurf(1,lface)
59      nelems = int(ifaces/10)
60      jfaces = ifaces - nelems*10
61      call getnumberofnodes(nelems,jfaces,lakon,nope,
62     &     nopes,idummy)
63      do j=1,nope
64         konl(j)=kon(ipkon(nelems)+j)
65      enddo
66      do m=1,nopes
67         ifac=getlocno(m,jfaces,nope)
68         lnode(1,m)=konl(ifac)
69      enddo
70      if(nopes.eq.8) then
71         do j=1,4
72            icounter=icounter+1
73            contr(icounter)=1.0
74            icontr1(icounter)=lnode(1,j)
75            icontr2(icounter)=lnode(1,j)
76         enddo
77         do j=5,8
78            icounter=icounter+1
79            contr(icounter)=1.0
80            icontr1(icounter)=lnode(1,j)
81            icontr2(icounter)=lnode(1,j)
82         enddo
83         do j=1,4
84            icounter=icounter+1
85            contr(icounter)=-alpha
86            icontr1(icounter)=lnode(1,j+4)
87            icontr2(icounter)=lnode(1,j)
88            icounter=icounter+1
89            contr(icounter)=-alpha
90            icontr1(icounter)=lnode(1,modf(4,j-1)+4)
91            icontr2(icounter)=lnode(1,j)
92         enddo
93
94      elseif(nopes.eq.4) then
95         do j=1,4
96            icounter=icounter+1
97            contr(icounter)=1.0
98            icontr1(icounter)=lnode(1,j)
99            icontr2(icounter)=lnode(1,j)
100         enddo
101      elseif(nopes.eq.6) then
102         do j=1,3
103            icounter=icounter+1
104            contr(icounter)=1.0
105            icontr1(icounter)=lnode(1,j)
106            icontr2(icounter)=lnode(1,j)
107         enddo
108         do j=4,6
109            icounter=icounter+1
110            contr(icounter)=1
111            icontr1(icounter)=lnode(1,j)
112            icontr2(icounter)=lnode(1,j)
113        enddo
114        do j=1,3
115           icounter=icounter+1
116           contr(icounter)=-alpha
117           icontr1(icounter)=lnode(1,j+3)
118           icontr2(icounter)=lnode(1,j)
119           icounter=icounter+1
120           contr(icounter)=-alpha
121           icontr1(icounter)=lnode(1,modf(3,j-1)+3)
122           icontr2(icounter)=lnode(1,j)
123        enddo
124      else
125         do j=1,3
126            icounter=icounter+1
127            contr(icounter)=1.0
128            icontr1(icounter)=lnode(1,j)
129            icontr2(icounter)=lnode(1,j)
130         enddo
131      endif
132!
133      if(debug)then
134         write(*,*) 'createtele: contri,iscontr,imcontr',lface
135         do j=1, icounter
136            write(*,*)contr(j),icontr1(j),icontr2(j)
137         enddo
138      endif
139!
140      return
141      end
142
143