1!$Id:$
2      subroutine plfacn(ix,ia,nen,numel,nface,ie,nie)
3
4!      * * F E A P * * A Finite Element Analysis Program
5
6!....  Copyright (c) 1984-2017: Regents of the University of California
7!                               All rights reserved
8
9!-----[--.----+----.----+----.-----------------------------------------]
10!      Purpose: Determines which exterior faces are directed toward
11!               view point.
12
13!      Inputs:
14!         ix(nen1,*)- Element nodal connection lists
15!         ia(*)     - Active element plots based on materials
16!         nen       - Number nodes/element
17!         numel     - Number of elements/faces
18!         ie(nie,*) - Material set assembly data
19!         nie       - Dimension of ie array
20
21!      Outputs:
22!         nface     - Number of faces
23!-----[--.----+----.----+----.-----------------------------------------]
24      implicit  none
25
26      include  'iofile.h'
27      include  'pbody.h'
28      include  'pdata5.h'
29      include  'pdata6.h'
30      include  'plclip.h'
31      include  'qudshp.h'
32      include  'sdata.h'
33
34      include  'pointer.h'
35      include  'comblk.h'
36
37      logical   lclip,addfac
38      integer   nen,numel,nface,nie, i,j,m,n, iel,iiel, ien,nel,pstyp
39      integer   ufac
40      integer   ix(nen1,numel), ia(*), ie(nie,*), iq(4,6), it(3,4)
41      integer   it2(3,16)
42
43      save
44
45!     8-node brick faces
46
47      data iq/3,2,1,4, 1,2,6,5, 2,3,7,6, 3,4,8,7, 4,1,5,8, 5,6,7,8/
48
49!     4-node tet faces
50
51      data it/1,2,4, 2,3,4, 3,1,4, 1,3,2/
52
53!     10-node tet faces
54
55      data it2 / 1, 5, 8,  5, 2, 9,  5, 9, 8,  8, 9, 4,
56     &           2, 6, 9,  6, 3,10,  6,10, 9,  9,10, 4,
57     &           3, 7,10,  7, 1, 8,  7, 8,10, 10, 8, 4,
58     &           1, 7, 5,  7, 3, 6,  7, 6, 5,  5, 6, 2 /
59
60!     Compute location of boundary faces
61
62      nface = 0
63      do n = 1,numel
64        if(ix(nen1-1,n).ge.0 .and. ia(n).ge.0) then
65          pstyp = ie(1,ix(nen1,n))
66          if(pstyp.gt.0) then
67            iel = ie(nie-1,ix(nen1,n))
68            do j = nen,1,-1
69              if(ix(j,n).gt.0) then
70                nel = j
71                exit
72              endif
73            end do ! j
74
75!           Get plot type
76
77            call plftyp(pstyp,nel,iel)
78
79            if(iel.gt.0) then
80              iiel = inord(iel)
81            else
82              iiel = exord(-iel)
83            endif
84
85!           6-node triangle
86
87            if(iiel.eq.7) then
88              ien = 3
89            else
90              ien = nen
91            endif
92
93!           No face if iiel < 0
94
95            if     (iiel.lt.0) then
96
97!           1-d elements
98
99            elseif(pstyp .eq. 1) then
100
101!             Set space for line elements
102
103              if( iiel.gt.0 .and. iiel.le.3 ) then
104
105                if( lclip(ix(1,n),2,hr(npxx),ndm) ) then
106                  nface = nface + 1
107                endif
108              endif ! iiel > 0
109
110!           2-d elements
111
112            elseif(pstyp .eq. 2) then
113
114!             Set space for top and bottom faces
115
116              if( lclip(ix(1,n),min(4,ien),hr(npxx),ndm) ) then
117
118                nface = nface + 2
119
120              end if ! iiel
121
122!           3-d element plots
123
124            elseif(pstyp .eq. 3) then
125
126!             Set for linear tetrahedral element faces
127
128              if (iiel .eq. 9) then
129
130                if( lclip(ix(1,n),4,hr(npxx),ndm) ) then
131                  do m = 1,4
132                    addfac = .true.
133                    do j = 1,3
134                      i = ix(it(j,m),n) - 1
135                      if(mr(nprn+i).eq.0) then
136                        addfac = .false.
137                      endif
138                    end do ! j
139                    if(addfac) then
140                      nface = nface + 1
141                    endif
142                  end do ! m
143                end if
144
145!             Set for quadratic tetrahedral element faces
146
147              elseif (iiel .eq. 15) then
148
149                if( lclip(ix(1,n),4,hr(npxx),ndm) ) then
150                  do m = 1,16
151                    addfac = .true.
152                    do j = 1,3
153                      i = ix(it2(j,m),n) - 1
154                      if(mr(nprn+i).eq.0) then
155                        addfac = .false.
156                      endif
157                    end do ! j
158                    if(addfac) then
159                      nface = nface + 1
160                    endif
161                  end do ! m
162                end if
163
164!             64 node cubic brick
165
166              elseif (iiel .eq. 46 .and. .not.nurbfl) then
167
168                if( lclip(ix(1,n),nen,hr(npxx),ndm) ) then
169                  call pfacepqr( 3,ipu,ufac)
170                  do m = 1,ufac
171                    addfac = .true.
172                    do j = 1,4
173                      i = ix(ipu(j,m),n) - 1
174                      if(mr(nprn+i).eq.0) then
175                        addfac = .false.
176                      endif
177                    end do ! j
178                    if(addfac) then
179                      nface = nface + 1
180                    endif
181                  end do ! m
182                end if
183
184!             Set for 8 to 27 node brick element faces
185
186              elseif (iiel .gt. 10 ) then
187
188                if( lclip(ix(1,n),8,hr(npxx),ndm) ) then
189                  do m = 1,6
190                    addfac = .true.
191                    do j = 1,4
192                      i = ix(iq(j,m),n) - 1
193                      if(mr(nprn+i).eq.0) then
194                        addfac = .false.
195                      endif
196                    end do ! j
197                    if(addfac) then
198                      nface = nface + 1
199                    endif
200                  end do ! m
201                endif
202
203              endif ! iiel
204
205            endif ! pstyp > 0
206
207!         User tests
208
209          elseif(pstyp.lt.0) then
210
211            if( lclip(ix(1,n),nen,hr(npxx),ndm) ) then
212              call ufacelib(pstyp,nel,ipu,ufac)
213              do m = 1,ufac
214                addfac = .true.
215                do j = 1,4
216                  i = ix(ipu(j,m),n) - 1
217                  if(mr(nprn+i).eq.0) then
218                    addfac = .false.
219                  endif
220                end do ! j
221                if(addfac) then
222                  nface = nface + 1
223                endif
224              end do ! m
225            end if
226
227          end if ! pstyp
228        end if ! pty
229      end do ! n
230
231      end
232