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 changekon(ne,ipkon,lakon,mi,nkon,thicke,ielmat,kon) 20! 21! for composites the connectivity has to be changed to 22! allow for the multiple expansions of the composite elements. 23! 24! for a 8-node composite shell the connectivity is set up as follows: 25! 1..20: simple expansion of the shell 26! 21..28: original connectivity of the element 27! 29..48: expansion of the first layer of the shell 28! 49..68: expansion of the second layer of the shell 29! .. 30! 29+(n-1)*20..28+n*20: expansion of the nth layer of the shell 31! 32! similar for 6-node composite shell elements; at the start of the present 33! routine the connectivity does not provide for the expansion of the 34! layers yet. At the end of the routine appropriate space has been 35! provided and the regular connectivity of the elements appropriately 36! moved 37! 38 implicit none 39! 40 character*8 lakon(*) 41! 42 integer ne,ipkon(*),mi(*),nkon,ielmat(mi(3),*),nkondiff,i,j,k, 43 & kon(*),nexp,nopeexp,nlayer,ipointer 44! 45 real*8 thicke(mi(3),*) 46! 47 integer,dimension(:),allocatable::koncp 48 real*8,dimension(:,:),allocatable::thickecp 49! 50! calculate the extra space needed in kon 51! 52 nkondiff=0 53 do i=1,ne 54 if(ipkon(i).lt.0) cycle 55 if(lakon(i)(1:1).ne.'S') cycle 56 if(lakon(i)(8:8).ne.'C') cycle 57 do j=1,mi(3) 58 if(ielmat(j,i).ne.0) then 59 if(lakon(i)(2:2).eq.'8') then 60 nkondiff=nkondiff+20 61 elseif(lakon(i)(2:2).eq.'6') then 62 nkondiff=nkondiff+15 63 endif 64 endif 65 enddo 66 enddo 67! 68! move the topology in order to create appropriate space 69! 70 nkon=nkon+nkondiff 71 ipointer=nkon 72! 73 allocate(koncp(nkon)) 74 allocate(thickecp(mi(3),nkon)) 75! 76 do i=ne,1,-1 77 if(ipkon(i).lt.0) cycle 78! 79! calculating the size of the expanded connectivity 80! 81 if(lakon(i)(1:5).eq.'C3D8I') then 82 nopeexp=11 83 elseif(lakon(i)(4:5).eq.'20') then 84 nopeexp=20 85 elseif( 86 & (lakon(i)(1:4).eq.'CPE8').or.(lakon(i)(1:4).eq.'CPS8').or. 87 & (lakon(i)(1:4).eq.'CAX8').or.(lakon(i)(1:2).eq.'S8')) then 88 nopeexp=28 89 elseif( 90 & (lakon(i)(1:4).eq.'CPE6').or.(lakon(i)(1:4).eq.'CPS6').or. 91 & (lakon(i)(1:4).eq.'CAX6').or.(lakon(i)(1:2).eq.'S6')) then 92 nopeexp=21 93 elseif(lakon(i)(1:1).eq.'B') then 94 nopeexp=23 95 elseif(lakon(i)(4:4).eq.'8') then 96 nopeexp=8 97 elseif(lakon(i)(4:5).eq.'10') then 98 nopeexp=10 99 elseif(lakon(i)(4:4).eq.'4') then 100 nopeexp=4 101 elseif(lakon(i)(4:5).eq.'15') then 102 nopeexp=15 103 elseif(lakon(i)(4:4).eq.'6') then 104 nopeexp=6 105 elseif(lakon(i)(1:8).eq.'DASHPOTA') then 106 nopeexp=2 107 elseif(lakon(i)(1:1).eq.'D') then 108 nopeexp=3 109 elseif(lakon(i)(1:1).eq.'G') then 110 nopeexp=2 111 elseif(lakon(i)(1:7).eq.'SPRINGA') then 112 nopeexp=2 113 else 114 write(*,*) '*ERROR in changekon: element type unknown:', 115 & ' element: ',i,' type: ',lakon(i) 116 call exit(201) 117 endif 118! 119 nlayer=0 120! 121 if(lakon(i)(8:8).eq.'C') then 122 do j=1,mi(3) 123 if(ielmat(j,i).ne.0) then 124 nlayer=nlayer+1 125 else 126 exit 127 endif 128 enddo 129 endif 130! 131 nexp=0 132! 133 if(lakon(i)(2:2).eq.'8') then 134 nexp=20 135 elseif(lakon(i)(2:2).eq.'6') then 136 nexp=15 137 endif 138! 139 ipointer=ipointer-nopeexp-nlayer*nexp 140! 141 do j=nopeexp,1,-1 142 koncp(ipointer+j)=kon(ipkon(i)+j) 143 do k=1,mi(3) 144 thickecp(k,ipointer+j)=thicke(k,ipkon(i)+j) 145 enddo 146 enddo 147 ipkon(i)=ipointer 148c write(*,*) 'changekon ' 149c write(*,*) i,ipkon(i) 150c write(*,*) (kon(ipointer+j),j=1,nopeexp+nlayer*nexp) 151 enddo 152! 153 do i=1,nkon 154 kon(i)=koncp(i) 155 do j=1,mi(3) 156 thicke(j,i)=thickecp(j,i) 157 enddo 158 enddo 159! 160 deallocate(koncp) 161 deallocate(thickecp) 162! 163 return 164 end 165 166 167