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