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 createmdelem(imdnode,nmdnode, 20 & ikmpc,ilmpc,ipompc,nodempc,nmpc,imddof,nmddof, 21 & nactdof,mi,imdmpc,nmdmpc,imdboun,nmdboun, 22 & ikboun,nboun,ilboun,ithermal,imdelem,nmdelem, 23 & iponoel,inoel,prlab,prset,nprint,lakon,set,nset, 24 & ialset,ipkon,kon,istartset,iendset,nforc, 25 & ikforc,ilforc) 26! 27! stores the elements 28! 1) for which results are requested in at least one node 29! 2) for which there are *EL PRINT requests 30! 31! stores the nodes, dofs, spcs and mpcs in the elements 32! for which there are *EL PRINT requests 33! 34 implicit none 35! 36 character*6 prlab(*) 37 character*8 lakon(*) 38 character*81 prset(*),noset,set(*) 39! 40 integer iforc,node,imdnode(*),nmdnode,ikmpc(*), 41 & ilmpc(*),ipompc(*),nodempc(3,*),nmpc,imddof(*),nmddof, 42 & mi(*),nactdof(0:mi(2),*),imdmpc(*),nmdmpc,imdboun(*),nmdboun, 43 & ikboun(*),nboun,ilboun(*),ithermal(*),imdelem(*),nmdelem, 44 & iponoel(*),inoel(2,*),index,id,nprint,i,j,k,l,indexe, 45 & nope,nset,nrset,ialset(*),ipkon(*),kon(*),istartset(*), 46 & iendset(*),idof,m,ikforc(*),ilforc(*),nforc 47! 48! storing all elements to which nodes in imdnode belong 49! in imdelem 50! 51 do m=1,nmdnode 52 node=imdnode(m) 53! 54 index=iponoel(node) 55 do 56 if(index.eq.0) exit 57 i=inoel(1,index) 58 call addimd(imdelem,nmdelem,i) 59! 60 index=inoel(2,index) 61 enddo 62 enddo 63! 64! storing the elements for which *EL PRINT was selected 65! 66 do m=1,nprint 67 if((prlab(m)(1:4).eq.'S ').or. 68 & (prlab(m)(1:4).eq.'E ').or. 69 & (prlab(m)(1:4).eq.'PEEQ').or. 70 & (prlab(m)(1:4).eq.'ENER').or. 71 & (prlab(m)(1:4).eq.'SDV ').or. 72 & (prlab(m)(1:4).eq.'ELSE').or. 73 & (prlab(m)(1:4).eq.'ELKE').or. 74 & (prlab(m)(1:4).eq.'EVOL').or. 75 & (prlab(m)(1:4).eq.'HFL ')) then 76 noset=prset(m) 77c nrset=0 78c do k=1,nset 79c if(set(k).eq.noset) then 80c nrset=k 81c exit 82c endif 83c enddo 84 call cident81(set,noset,nset,id) 85 nrset=0 86 if(id.gt.0) then 87 if(noset.eq.set(id)) then 88 nrset=id 89 endif 90 endif 91! 92! adding the elements belonging to nrset 93! 94 do j=istartset(nrset),iendset(nrset) 95 if(ialset(j).gt.0) then 96 i=ialset(j) 97 call addimd(imdelem,nmdelem,i) 98! 99! in order to calculate results at the integration 100! point of an element the results must have been 101! determined at the nodes of this element 102! 103 indexe=ipkon(i) 104c Bernhardi start 105 if(lakon(i)(1:5).eq.'C3D8I') then 106 nope=11 107 elseif(lakon(i)(4:4).eq.'2') then 108c Bernhardi end 109 nope=20 110 elseif(lakon(i)(4:4).eq.'8') then 111 nope=8 112 elseif(lakon(i)(4:5).eq.'10') then 113 nope=10 114 elseif(lakon(i)(4:4).eq.'4') then 115 nope=4 116 elseif(lakon(i)(4:5).eq.'15') then 117 nope=15 118 elseif(lakon(i)(4:4).eq.'6') then 119 nope=6 120 elseif(lakon(i)(1:1).eq.'E') then 121 nope=ichar(lakon(i)(8:8))-47 122 else 123 cycle 124 endif 125! 126 do l=1,nope 127 node=kon(indexe+l) 128 call addimd(imdnode,nmdnode,node) 129 if(ithermal(1).ne.2) then 130 do k=1,3 131 call addimdnodedof(node,k,ikmpc,ilmpc,ipompc, 132 & nodempc,nmpc,imdnode,nmdnode,imddof,nmddof, 133 & nactdof,mi,imdmpc,nmdmpc,imdboun,nmdboun, 134 & ikboun,nboun,ilboun) 135 enddo 136 else 137 k=0 138 call addimdnodedof(node,k,ikmpc,ilmpc,ipompc, 139 & nodempc,nmpc,imdnode,nmdnode,imddof,nmddof, 140 & nactdof,mi,imdmpc,nmdmpc,imdboun,nmdboun, 141 & ikboun,nboun,ilboun) 142 endif 143 enddo 144 else 145 i=ialset(j-2) 146 do 147 i=i-ialset(j) 148 if(i.ge.ialset(j-1)) exit 149 call addimd(imdelem,nmdelem,i) 150! 151! in order to calculate results at the integration 152! point of an element the results must have been 153! determined at the nodes of this element 154! 155 indexe=ipkon(i) 156c Bernhardi start 157 if(lakon(i)(1:5).eq.'C3D8I') then 158 nope=11 159 elseif(lakon(i)(4:4).eq.'2') then 160c Bernhardi end 161 nope=20 162 elseif(lakon(i)(4:4).eq.'8') then 163 nope=8 164 elseif(lakon(i)(4:5).eq.'10') then 165 nope=10 166 elseif(lakon(i)(4:4).eq.'4') then 167 nope=4 168 elseif(lakon(i)(4:5).eq.'15') then 169 nope=15 170 elseif(lakon(i)(4:4).eq.'6') then 171 nope=6 172 elseif(lakon(i)(1:1).eq.'E') then 173 nope=ichar(lakon(i)(8:8))-47 174 else 175 cycle 176 endif 177! 178 do l=1,nope 179 node=kon(indexe+l) 180 call addimd(imdnode,nmdnode,node) 181 if(ithermal(1).ne.2) then 182 do k=1,3 183 call addimdnodedof(node,k,ikmpc,ilmpc, 184 & ipompc,nodempc,nmpc,imdnode,nmdnode, 185 & imddof,nmddof,nactdof,mi,imdmpc, 186 & nmdmpc,imdboun,nmdboun, 187 & ikboun,nboun,ilboun) 188 enddo 189 else 190 k=0 191 call addimdnodedof(node,k,ikmpc,ilmpc,ipompc, 192 & nodempc,nmpc,imdnode,nmdnode,imddof, 193 & nmddof,nactdof,mi,imdmpc,nmdmpc,imdboun, 194 & nmdboun,ikboun, 195 & nboun,ilboun) 196 endif 197 enddo 198 enddo 199 endif 200 enddo 201 endif 202 enddo 203! 204 return 205 end 206 207