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 gen3dmembrane(ipompc,nodempc,coefmpc,nmpc,nmpc_,
20     &  mpcfree,ikmpc,ilmpc,labmpc,nk,ithermal,i)
21!
22!     connects nodes of 1-D and 2-D elements, for which SPC's were
23!     defined, to the nodes of their expanded counterparts
24!
25      implicit none
26!
27      character*20 labmpc(*)
28!
29      integer ipompc(*),nodempc(3,*),nmpc,nmpc_,mpcfree,
30     &  ikmpc(*),ilmpc(*),i,j,idir,nk,newnode,idof,id,mpcfreenew,
31     &  ithermal(*),jstart,jend
32!
33      real*8 coefmpc(*)
34!
35!     generating a hinge at a node of a membrane element
36!
37!     u(n_1)+u(n_3)=2*u(n)
38!
39      newnode=nk-1
40!
41      if(ithermal(2).le.1) then
42         jstart=1
43         jend=3
44      elseif(ithermal(2).eq.2) then
45         jstart=0
46         jend=0
47      else
48         jstart=0
49         jend=3
50      endif
51!
52      do idir=jstart,jend
53         idof=8*(newnode-1)+idir
54         call nident(ikmpc,idof,nmpc,id)
55         if((id.le.0).or.(ikmpc(id).ne.idof)) then
56            nmpc=nmpc+1
57            if(nmpc.gt.nmpc_) then
58               write(*,*)
59     &              '*ERROR in gen3dmembrane: increase nmpc_'
60               call exit(201)
61            endif
62            labmpc(nmpc)='                    '
63            ipompc(nmpc)=mpcfree
64            do j=nmpc,id+2,-1
65               ikmpc(j)=ikmpc(j-1)
66               ilmpc(j)=ilmpc(j-1)
67            enddo
68            ikmpc(id+1)=idof
69            ilmpc(id+1)=nmpc
70            nodempc(1,mpcfree)=newnode
71            nodempc(2,mpcfree)=idir
72            coefmpc(mpcfree)=1.d0
73            mpcfree=nodempc(3,mpcfree)
74            if(mpcfree.eq.0) then
75               write(*,*)
76     &              '*ERROR in gen3dmembrane: increase memmpc_'
77               call exit(201)
78            endif
79            nodempc(1,mpcfree)=nk+1
80            nodempc(2,mpcfree)=idir
81            coefmpc(mpcfree)=1.d0
82            mpcfree=nodempc(3,mpcfree)
83            if(mpcfree.eq.0) then
84               write(*,*)
85     &              '*ERROR in gen3dmembrane: increase memmpc_'
86               call exit(201)
87            endif
88            nodempc(1,mpcfree)=i
89            nodempc(2,mpcfree)=idir
90            coefmpc(mpcfree)=-2.d0
91            mpcfreenew=nodempc(3,mpcfree)
92            if(mpcfreenew.eq.0) then
93               write(*,*)
94     &              '*ERROR in gen3dmembrane: increase memmpc_'
95               call exit(201)
96            endif
97            nodempc(3,mpcfree)=0
98            mpcfree=mpcfreenew
99         endif
100      enddo
101!
102      return
103      end
104