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 createinum(ipkon,inum,kon,lakon,nk,ne,cflag,nelemload,
20     &  nload,nodeboun,nboun,ndirboun,ithermal,co,vold,mi,ielmat,
21     &  ielprop,prop)
22!
23!     determines inum in case no extrapolation is requested in the
24!     input deck (e.g. only nodal variables are requested)
25!
26      implicit none
27!
28      logical force
29!
30      character*1 cflag
31      character*8 lakon(*),lakonl
32!
33      integer ipkon(*),inum(*),kon(*),ne,indexe,nope,nfield,mi(*),
34     &  nk,i,j,nelemload(2,*),nload,node,nboun,nlayer,nopeexp,
35     &  nodeboun(*),ndirboun(*),ithermal(*),ielmat(mi(3),*),
36     &  ielprop(*)
37!
38      real*8 yn,co(3,*),vold(0:mi(2),*),prop(*)
39!
40      force=.false.
41!
42      do i=1,nk
43         inum(i)=0
44      enddo
45!
46      do i=1,ne
47!
48         if(ipkon(i).lt.0) cycle
49         indexe=ipkon(i)
50         lakonl=lakon(i)
51!
52         if(lakonl(7:8).eq.'LC') then
53            nlayer=0
54            do j=1,mi(3)
55               if(ielmat(j,i).gt.0) then
56                  nlayer=nlayer+1
57               else
58                  exit
59               endif
60            enddo
61!
62            if(lakonl(4:4).eq.'2') then
63               nopeexp=28
64            elseif(lakonl(4:5).eq.'15') then
65               nopeexp=21
66            endif
67         endif
68!
69         if(lakonl(1:1).eq.'F') then
70            cycle
71         elseif(lakonl(4:4).eq.'2') then
72            nope=20
73         elseif(lakonl(4:4).eq.'8') then
74            nope=8
75         elseif(lakonl(4:5).eq.'10') then
76            nope=10
77         elseif(lakonl(4:4).eq.'4') then
78            nope=4
79         elseif(lakonl(4:5).eq.'15') then
80            nope=15
81         elseif(lakonl(4:4).eq.'6') then
82            nope=6
83         elseif((lakon(i)(1:1).eq.'E').and.
84     &          ((lakon(i)(7:7).eq.'A').or.
85     &           (lakon(i)(7:7).eq.'2'))) then
86            inum(kon(indexe+1))=inum(kon(indexe+1))+1
87            inum(kon(indexe+2))=inum(kon(indexe+2))+1
88            cycle
89         elseif(lakonl(1:7).eq.'ESPRNGF') then
90            read(lakonl(8:8),'(i1)') nope
91            nope=nope+1
92            inum(kon(indexe+nope))=-1
93            cycle
94          elseif(lakonl(1:1).eq.'U') then
95            nope=ichar(lakonl(8:8))
96         else
97            cycle
98         endif
99!
100!        counting the number of elements a node belongs to
101!
102         if(lakonl(7:8).ne.'LC') then
103            do j=1,nope
104               inum(kon(indexe+j))=inum(kon(indexe+j))+1
105            enddo
106         else
107            do j=1,nope*nlayer
108               inum(kon(indexe+nopeexp+j))=inum(kon(indexe+nopeexp+j))+1
109            enddo
110         endif
111c     Bernhardi start
112c        incompatible modes elements
113c         if(lakonl(1:5).eq.'C3D8I') then
114c            do j=1,3
115c               inum(kon(indexe+nope+j))=inum(kon(indexe+nope+j))+1
116c            enddo
117c         endif
118c     Bernhardi end
119!
120      enddo
121!
122!     for 1d and 2d elements only:
123!     finding the solution in the original nodes
124!
125      if((cflag.ne.' ').and.(cflag.ne.'E')) then
126         nfield=0
127         call map3dto1d2d(yn,ipkon,inum,kon,lakon,nfield,nk,ne,cflag,co,
128     &         vold,force,mi,ielprop,prop)
129      endif
130!
131      return
132      end
133