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 filters(inpc,textpart,istep,istat,n,iline,ipol,inl,
20     &        ipoinp,inp,ipoinpc,objectset,ier,nobject,nmethod)
21!
22!     reading the input deck: *FILTER
23!
24!     options: TYPE
25!              BOUNDARY WEIGHTING
26!              EDGE PRESERVATION
27!              DIRECTION WEIGHTING
28!
29      implicit none
30!
31      character*1 inpc(*)
32      character*132 textpart(16)
33      character*81 objectset(5,*)
34!
35      integer istep,istat,n,key,i,iline,ipol,inl,ipoinp(2,*),nmethod,
36     &  inp(3,*),ipoinpc(0:*),ipos,boundact,filteract,ier,nobject
37!
38      real*8 radius
39!
40c      if(istep.lt.1) then
41      if(nmethod.ne.12) then
42        write(*,*) '*ERROR reading *FILTER: *FILTER can
43     &only be used within a SENSITIVITY STEP'
44        ier=1
45        return
46      endif
47!
48      if(nobject.eq.0) then
49        write(*,*) '*ERROR reading *FILTER: at least one'
50        write(*,*) '       *DESIGN RESPONSE must have been'
51        write(*,*) '       defined before the definition of'
52        write(*,*) '       a filter'
53        ier=1
54        return
55      endif
56!
57      boundact=0
58      filteract=0
59!
60      do i=2,n
61!
62!        reading filter options:
63!
64!        type of filter
65!
66         if(textpart(i)(1:5).eq.'TYPE=') then
67            objectset(2,1)(1:5)=textpart(i)(6:10)
68            filteract=1
69!
70!        boundary weighting activated
71!
72         elseif(textpart(i)(1:18).eq.'BOUNDARYWEIGHTING=') then
73            if(textpart(i)(19:21).eq.'YES') then
74               boundact=1
75               objectset(2,1)(6:8)='BOU'
76            else
77               boundact=0
78            endif
79!
80!        edge weighting activated
81!
82         elseif(textpart(i)(1:17).eq.'EDGEPRESERVATION=') then
83            if(textpart(i)(18:20).eq.'YES') then
84               objectset(2,1)(10:12)='EDG'
85            endif
86!
87!        direction weighting activated
88!
89         elseif(textpart(i)(1:19).eq.'DIRECTIONWEIGHTING=') then
90            if(textpart(i)(20:22).eq.'YES') then
91               objectset(2,1)(14:16)='DIR'
92            endif
93!
94!        parameter not recognized
95!
96         else
97            write(*,*)
98     &        '*WARNING reading *FILTER: parameter not recognized:'
99            write(*,*) '         ',
100     &                 textpart(i)(1:index(textpart(i),' ')-1)
101            call inputwarning(inpc,ipoinpc,iline,
102     &           "*FILTER%")
103         endif
104      enddo
105!
106!     reading the radii
107!
108      if((filteract.eq.1).or.(boundact.eq.1)) then
109!
110         call getnewline(inpc,textpart,istat,n,key,iline,ipol,inl,
111     &        ipoinp,inp,ipoinpc)
112!
113!     reading in the filter radius
114!
115         if(filteract.eq.1) then
116            read(textpart(1)(1:20),'(f20.0)',iostat=istat) radius
117            if(istat.gt.0) then
118               call inputerror(inpc,ipoinpc,iline,
119     &                       "*FILTER%",ier)
120               return
121            endif
122            if(radius.lt.0.d0) then
123               write(*,*) '*ERROR reading *FILTER'
124               write(*,*) '       Radius of the sensitivity'
125               write(*,*) '       filter cannot be less than 0'
126               write(*,*)
127               call inputerror(inpc,ipoinpc,iline,
128     &                           "*FILTER%",ier)
129               return
130            endif
131            objectset(2,1)(21:40)=textpart(1)(1:20)
132         endif
133!
134!     reading in the radius for boundary weighting
135!
136         if((n.eq.2).and.(boundact.eq.1)) then
137            read(textpart(2)(1:20),'(f20.0)',iostat=istat) radius
138            if(istat.gt.0) then
139               call inputerror(inpc,ipoinpc,iline,
140     &                       "*FILTER%",ier)
141               return
142            endif
143            if(radius.lt.0.d0) then
144               write(*,*) '*ERROR reading *FILTER'
145               write(*,*) '       Radius for the boundary'
146               write(*,*) '       weighting cannot be less'
147               write(*,*) '       than 0'
148               write(*,*)
149               call inputerror(inpc,ipoinpc,iline,
150     &                            "*FILTER%",ier)
151               return
152            endif
153            objectset(1,1)(21:40)=textpart(2)(1:20)
154         elseif((n.eq.1).and.(boundact.eq.1)) then
155            write(*,*) '*WARNING reading *FILTER:'
156            write(*,*) '         boundary weighting activated'
157            write(*,*) '         but no radius defined'
158            write(*,*) '         The radius of the sensitivity'
159            write(*,*) '         filter will be taken'
160            write(*,*)
161            call inputwarning(inpc,ipoinpc,iline,
162     &           "*FILTER%")
163            objectset(1,1)(21:40)=objectset(2,1)(21:40)
164         endif
165!
166         call getnewline(inpc,textpart,istat,n,key,iline,ipol,inl,
167     &        ipoinp,inp,ipoinpc)
168!
169      else
170         call getnewline(inpc,textpart,istat,n,key,iline,ipol,inl,
171     &        ipoinp,inp,ipoinpc)
172      endif
173!
174      return
175      end
176
177
178