1!$Id:$ 2 subroutine meshck(ip,ie,iedof,id,nty,ix,nie,nen,nen1,ndf, 3 & numnp,numel,nummat,errs) 4 5! * * F E A P * * A Finite Element Analysis Program 6 7!.... Copyright (c) 1984-2017: Regents of the University of California 8! All rights reserved 9 10!-----[--.----+----.----+----.-----------------------------------------] 11! Purpose: Perform check on mesh data to ensure nodes/elements input 12 13! Inputs: 14! ie(nie,*) - Material set assembly information 15! iedof(ndf,nen,*) - Assembly information 16! id(ndf,*) - Boundary condition and equation number array 17! nty(*) - Nodal type 18! ix(nen1,*) - Element nodal connection lists 19! nie - Dimension of ie array 20! nen - Maximum number of nodes/element 21! nen1 - Dimension for ix array 22! ndf - Number dof/node 23! numnp - Number of nodes in mesh 24! numel - Number of elemenst in mesh 25! nummat - Number of material sets 26 27! Outputs: 28! ip(ndf,*) - List of active nodes, used for graphics 29! errs - Flag, true if errors detected 30!-----[--.----+----.----+----.-----------------------------------------] 31 implicit none 32 33 include 'cblend.h' 34 include 'elflag.h' 35 include 'iofile.h' 36 include 'prflag.h' 37 38 include 'pointer.h' 39 include 'comblk.h' 40 41 logical errs 42 integer i,ii,j,ma,mg,n,nen,nen1,nie,ndf,numnp,numel,nummat 43 44 integer ip(ndf,*), id(ndf,*), ie(nie,*), iedof(ndf,nen,*) 45 integer ix(nen1,*), nty(*) 46 47 save 48 49! Perform mesh checks to ensure nodes/elements input 50 51 errs = .false. 52 do n = 1,numel 53 if (ix(nen1,n).le.0 .or. ix(nen1,n).gt.nummat) then 54 write(iow,2000) n 55 if(ior.lt.0) write(*,2000) n 56 errs = .true. 57 else 58 do i = 1,nen 59 ii = ix(i,n) 60 if(ii.gt.numnp .or. ii.lt.0) then 61 write(iow,2001) ii,n 62 if(ior.lt.0) write(*,2001) ii,n 63 errs = .true. 64 elseif(ii.ne.0 .and. nty(ii).lt.0) then 65 write(iow,2002) ii,n 66 if(ior.lt.0) write(*,2002) ii,n 67 errs = .true. 68 endif 69 end do 70 endif 71 end do 72 73! Remove unused dof's using ie(nie,*) array 74 75 do n = 1,numnp 76 do j = 1,ndf 77 ip(j,n) = 0 78 end do ! j 79 end do ! n 80 81! Check nodes on each element for active dof's 82 83 do n = 1,numel 84 mg = ix(nen1,n) 85 86! Loop over the material sets 87 88 do ma = 1,nummat 89 if(ie(nie-2,ma).eq.mg) then 90 do i = 1,nen 91 ii = ix(i,n) 92 if(ii.gt.0) then 93 do j = 1,ndf 94 if(iedof(j,i,ma).gt.0) then 95 ip(iedof(j,i,ma),ii) = 1 96 endif 97 end do ! j 98 endif 99 end do ! i 100 endif 101 end do ! ma 102 end do 103 104! Set b.c. restraints for unused dof's 105 106 do n = 1,numnp 107 do j = 1,ndf 108 if(ip(j,n).eq.0) then 109 id(j,n) = -1000 110 end if 111 end do ! j 112 end do ! n 113 114! Remove unused nodes - for graphics 115 116 do n = 1,numnp 117 ip(1,n) = 0 118 end do ! n 119 120 do n = 1,numel 121 do i = 1,nen 122 ii = ix(i,n) 123 if(ii.gt.0) ip(1,ii) = 1 124 end do ! i 125 end do ! n 126 127! Set flat to indicate node is not used 128 129 do n = 1,numnp 130 if(ip(1,n) .eq. 0) then 131 nty(n) = -1 132 end if 133 end do 134 135! Fix all unspecified coordinate dof's 136 137 do n = 1,numnp 138 if(nty(n).lt.0) then 139 do i = 1,ndf 140 id(i,n) = 1 141 end do 142 endif 143 enddo 144 145! If supernodes used then 146 147 if(numbd.gt.0) then 148 if(numsn.gt.0) then 149 if(numsd.gt.0) then 150 call mshcksn(mr(np(162)),mr(np(164)),numsd,numsn,numbd,errs) 151 else 152 write(iow,2003) 153 if(ior.lt.0) write(*,2003) 154 errs = .true. 155 endif 156 else 157 write(iow,2004) 158 if(ior.lt.0) write(*,2004) 159 errs = .true. 160 endif 161 endif 162 163! Set first and last element numbers for each material type 164 165 do ma = 1,min(80,nummat) 166 do n = 1,numel 167 if(ix(nen1,n).eq.ma) then 168 elstart(ma) = n 169 go to 100 170 endif 171 end do ! n 172100 do n = numel,1,-1 173 if(ix(nen1,n).eq.ma) then 174 ellast(ma) = n 175 go to 200 176 endif 177 end do ! n 178200 continue 179 end do ! ma 180 181! Compute nodal spacing data for tolerance use 182 183 call phsize(hr(np(43)),hr(np(44)),mr(np(33))) 184 185! Formats 186 1872000 format(10x,' *ERROR* Data for element ',i6,' not input') 188 1892001 format(10x,' *ERROR* Data for node ',i6,' on element',i6, 190 & ' greater than maximum or negative') 1912002 format(10x,' *ERROR* Data for node ',i6,' on element',i6, 192 & ' not input') 193 1942003 format(10x,' *ERROR* Blending functions used but no SIDEs', 195 & ' exist') 196 1972004 format(10x,' *ERROR* Blending functions used but no SNODes', 198 & ' exist') 199 end 200 201 subroutine mshcksn(is,iblend,numsd,numsn,numbd,errs) 202 203 implicit none 204 205 include 'iofile.h' 206 207 logical errs 208 integer numsd,numsn,numbd,n,i,inc 209 integer is(16,numsd),iblend(21,numbd) 210 211 save 212 213! Loop over SIDE nodes to check if any greater than number SNODes 214 215 do n = 1,numsd 216 if(is(1,n).eq.2) then 217 inc = 2 218 else 219 inc = 1 220 endif 221 do i = 2,16,inc 222 if(is(i,n).gt.numsn) then 223 write(iow,2000) n, numsn, i 224 errs = .true. 225 endif 226 end do ! i 227 end do ! n 228 229! Loop over BLENd nodes to check if any greater than number SNODes 230 231 do n = 1,numbd 232 do i = 11,18 233 if(iblend(i,n).gt.numsn) then 234 write(iow,2001) n, numsn, i 235 errs = .true. 236 endif 237 end do ! i 238 end do ! n 239 240! Formats 241 2422000 format(' *ERROR* SIDE',i5,' has value greater than maximum SNODE' 243 & ,' (',i5,') at entry',i5/) 244 2452001 format(' *ERROR* BLENd',i5,' has value greater than maximum SNODE' 246 & ,' (',i5,') at entry',i5/) 247 248 end 249