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