CalculiX  2.13
A Free Software Three-Dimensional Structural Finite Element Program
Functions/Subroutines
constraints.f File Reference

Go to the source code of this file.

Functions/Subroutines

subroutine constraints (inpc, textpart, istep, istat, n, iline, ipol, inl, ipoinp, inp, ipoinpc, nener, nobject, objectset)
 

Function/Subroutine Documentation

◆ constraints()

subroutine constraints ( character*1, dimension(*)  inpc,
character*132, dimension(16)  textpart,
integer  istep,
integer  istat,
integer  n,
integer  iline,
integer  ipol,
integer  inl,
integer, dimension(2,*)  ipoinp,
integer, dimension(3,*)  inp,
integer, dimension(0:*)  ipoinpc,
integer  nener,
integer  nobject,
character*81, dimension(4,*)  objectset 
)
21 !
22 ! reading the input deck: *CONSTRAINT
23 !
24 ! criteria: DISPLACEMENT
25 ! EIGENFREQUENCY
26 ! MASS
27 ! SHAPE ENERGY
28 ! STRESS
29 ! THICKNESS
30 !
31  implicit none
32 !
33  character*1 inpc(*)
34  character*2 consttype
35  character*132 textpart(16)
36  character*81 objectset(4,*)
37 !
38  integer istep,istat,n,key,i,iline,ipol,inl,ipoinp(2,*),
39  & inp(3,*),ipoinpc(0:*),nener,nobject,k,ipos
40 !
41  real*8 rho,stress,rel,abs
42 !
43  if(istep.lt.1) then
44  write(*,*) '*ERROR reading *CONSTRAINT: *CONSTRAINT
45  &can only be used within a SENSITIVITY STEP'
46  call exit(201)
47  endif
48 !
49 ! at least 1 objective must be defined
50 !
51  if(nobject.eq.0) then
52  write(*,*) '*ERROR reading *CONSTRAINT'
53  write(*,*) ' at least 1 objective function'
54  write(*,*) ' must be defined '
55  call inputerror(inpc,ipoinpc,iline,
56  &"*CONSTRAINT%")
57  endif
58 !
59 ! if more than 1 objective is defined no constraint is allowed
60 !
61  if(nobject.gt.1) then
62  write(*,*) '*ERROR reading *CONSTRAINT'
63  write(*,*) ' more than 1 objective function'
64  write(*,*) ' defined while constraints are '
65  write(*,*) ' present. Reduce the number of '
66  write(*,*) ' objectives to 1 or remove all '
67  write(*,*) ' the constraints '
68  call inputerror(inpc,ipoinpc,iline,
69  &"*CONSTRAINT%")
70  endif
71 !
72 ! reading the constraints
73 !
74  call getnewline(inpc,textpart,istat,n,key,iline,ipol,inl,
75  & ipoinp,inp,ipoinpc)
76 !
77  do
78 !
79 ! DISPLACEMENT
80 !
81  if(textpart(1)(1:12).eq.'DISPLACEMENT') then
82  nobject=nobject+1
83  objectset(1,nobject)(1:12)='DISPLACEMENT'
84  do k=13,81
85  objectset(1,nobject)(k:k)=' '
86  enddo
87 !
88 ! set definition
89 !
90  if(n.ge.2) then
91  read(textpart(2)(1:80),'(a80)',iostat=istat)
92  & objectset(3,nobject)(1:80)
93  objectset(3,nobject)(81:81)=' '
94  ipos=index(objectset(3,nobject),' ')
95  if(ipos.ne.1) objectset(3,nobject)(ipos:ipos)='N'
96  endif
97 !
98 ! LE or GE for constraint
99 !
100  if(n.ge.3) then
101  read(textpart(3)(1:2),'(a2)') consttype
102  if((consttype.ne.'LE').and.
103  & (consttype.ne.'GE')) then
104  write(*,*) '*ERROR reading *CONSTRAINT'
105  write(*,*) ' type of constraint must be'
106  write(*,*) ' LE or GE'
107  call inputerror(inpc,ipoinpc,iline,
108  &"*CONSTRAINT%")
109  endif
110  objectset(1,nobject)(19:20)=textpart(3)(1:2)
111  endif
112 !
113 ! relative constraint value
114 !
115  if(n.ge.4) then
116  read(textpart(4)(1:20),'(f20.0)',iostat=istat) rel
117  if(istat.gt.0) call inputerror(inpc,ipoinpc,iline,
118  &"*CONSTRAINT%")
119  objectset(1,nobject)(41:60)=textpart(4)(1:20)
120  endif
121 !
122 ! absolute constraint value
123 !
124  if(n.ge.5) then
125  read(textpart(5)(1:20),'(f20.0)',iostat=istat) abs
126  if(istat.gt.0) call inputerror(inpc,ipoinpc,iline,
127  &"*CONSTRAINT%")
128  if(istat.le.0) then
129  objectset(1,nobject)(61:80)=textpart(5)(1:20)
130  endif
131  endif
132 !
133 ! EIGENFREQUENCY
134 !
135  elseif(textpart(1)(1:14).eq.'EIGENFREQUENCY') then
136  nobject=nobject+1
137  objectset(1,nobject)(1:14)='EIGENFREQUENCY'
138  do k=15,81
139  objectset(1,nobject)(k:k)=' '
140  enddo
141 !
142 ! LE or GE for constraint
143 !
144  if(n.ge.3) then
145  read(textpart(3)(1:2),'(a2)') consttype
146  if((consttype.ne.'LE').and.
147  & (consttype.ne.'GE')) then
148  write(*,*) '*ERROR reading *CONSTRAINT'
149  write(*,*) ' type of constraint must be'
150  write(*,*) ' LE or GE'
151  call inputerror(inpc,ipoinpc,iline,
152  &"*CONSTRAINT%")
153  endif
154  objectset(1,nobject)(19:20)=textpart(3)(1:2)
155  endif
156 !
157 ! MASS
158 !
159  elseif(textpart(1)(1:4).eq.'MASS') then
160  nobject=nobject+1
161  objectset(1,nobject)(1:4)='MASS'
162  do k=5,81
163  objectset(1,nobject)(k:k)=' '
164  enddo
165 !
166 ! set definition
167 !
168  if(n.ge.2) then
169  read(textpart(2)(1:80),'(a80)',iostat=istat)
170  & objectset(3,nobject)(1:80)
171  objectset(3,nobject)(81:81)=' '
172  ipos=index(objectset(3,nobject),' ')
173  if(ipos.ne.1) objectset(3,nobject)(ipos:ipos)='E'
174  endif
175 !
176 ! LE or GE for constraint
177 !
178  if(n.ge.3) then
179  read(textpart(3)(1:2),'(a2)') consttype
180  if((consttype.ne.'LE').and.
181  & (consttype.ne.'GE')) then
182  write(*,*) '*ERROR reading *CONSTRAINT'
183  write(*,*) ' type of constraint must be'
184  write(*,*) ' LE or GE'
185  call inputerror(inpc,ipoinpc,iline,
186  &"*CONSTRAINT%")
187  endif
188  objectset(1,nobject)(19:20)=textpart(3)(1:2)
189  endif
190 !
191 ! relative constraint value
192 !
193  if(n.ge.4) then
194  read(textpart(4)(1:20),'(f20.0)',iostat=istat) rel
195  if(istat.gt.0) call inputerror(inpc,ipoinpc,iline,
196  &"*CONSTRAINT%")
197  objectset(1,nobject)(41:60)=textpart(4)(1:20)
198  endif
199 !
200 ! absolute constraint value
201 !
202  if(n.ge.5) then
203  read(textpart(5)(1:20),'(f20.0)',iostat=istat) abs
204  if(istat.gt.0) call inputerror(inpc,ipoinpc,iline,
205  &"*CONSTRAINT%")
206  if(istat.le.0) then
207  objectset(1,nobject)(61:80)=textpart(5)(1:20)
208  endif
209  endif
210 !
211 ! SHAPEENERGY
212 !
213  elseif(textpart(1)(1:11).eq.'SHAPEENERGY') then
214  nobject=nobject+1
215  objectset(1,nobject)(1:11)='SHAPEENERGY'
216  do k=12,81
217  objectset(1,nobject)(k:k)=' '
218  enddo
219 !
220 ! set definition
221 !
222  if(n.ge.2) then
223  read(textpart(2)(1:80),'(a80)',iostat=istat)
224  & objectset(3,nobject)(1:80)
225  objectset(3,nobject)(81:81)=' '
226  ipos=index(objectset(3,nobject),' ')
227  if(ipos.ne.1) objectset(3,nobject)(ipos:ipos)='E'
228  endif
229  nener=1
230 !
231 ! LE or GE for constraint
232 !
233  if(n.ge.3) then
234  read(textpart(3)(1:2),'(a2)') consttype
235  if((consttype.ne.'LE').and.
236  & (consttype.ne.'GE')) then
237  write(*,*) '*ERROR reading *CONSTRAINT'
238  write(*,*) ' type of constraint must be'
239  write(*,*) ' LE or GE'
240  call inputerror(inpc,ipoinpc,iline,
241  &"*CONSTRAINT%")
242  endif
243  objectset(1,nobject)(19:20)=textpart(3)(1:2)
244  endif
245 !
246 ! relative constraint value
247 !
248  if(n.ge.4) then
249  read(textpart(4)(1:20),'(f20.0)',iostat=istat) rel
250  if(istat.gt.0) call inputerror(inpc,ipoinpc,iline,
251  &"*CONSTRAINT%")
252  objectset(1,nobject)(41:60)=textpart(4)(1:20)
253  endif
254 !
255 ! absolute constraint value
256 !
257  if(n.ge.5) then
258  read(textpart(5)(1:20),'(f20.0)',iostat=istat) abs
259  if(istat.gt.0) call inputerror(inpc,ipoinpc,iline,
260  &"*CONSTRAINT%")
261  if(istat.le.0) then
262  objectset(1,nobject)(61:80)=textpart(5)(1:20)
263  endif
264  endif
265 !
266 ! STRESS
267 !
268  elseif(textpart(1)(1:6).eq.'STRESS') then
269  nobject=nobject+1
270  objectset(1,nobject)(1:6)='STRESS'
271  do k=7,81
272  objectset(1,nobject)(k:k)=' '
273  enddo
274 !
275 ! set definition
276 !
277  if(n.ge.2) then
278  read(textpart(2)(1:80),'(a80)',iostat=istat)
279  & objectset(3,nobject)(1:80)
280  objectset(3,nobject)(81:81)=' '
281  ipos=index(objectset(3,nobject),' ')
282  if(ipos.ne.1) objectset(3,nobject)(ipos:ipos)='N'
283  endif
284 !
285 ! LE or GE for constraint
286 !
287  if(n.ge.3) then
288  read(textpart(3)(1:2),'(a2)') consttype
289  if((consttype.ne.'LE').and.
290  & (consttype.ne.'GE')) then
291  write(*,*) '*ERROR reading *CONSTRAINT'
292  write(*,*) ' type of constraint must be'
293  write(*,*) ' LE or GE'
294  call inputerror(inpc,ipoinpc,iline,
295  &"*CONSTRAINT%")
296  endif
297  objectset(1,nobject)(19:20)=textpart(3)(1:2)
298  endif
299 !
300 ! relative constraint value
301 !
302  if(n.ge.4) then
303  read(textpart(4)(1:20),'(f20.0)',iostat=istat) rel
304  if(istat.gt.0) call inputerror(inpc,ipoinpc,iline,
305  &"*CONSTRAINT%")
306  objectset(1,nobject)(41:60)=textpart(4)(1:20)
307  endif
308 !
309 ! absolute constraint value
310 !
311  if(n.ge.5) then
312  read(textpart(5)(1:20),'(f20.0)',iostat=istat) abs
313  if(istat.gt.0) call inputerror(inpc,ipoinpc,iline,
314  &"*CONSTRAINT%")
315  if(istat.le.0) then
316  objectset(1,nobject)(61:80)=textpart(5)(1:20)
317  endif
318  endif
319 !
320 ! rho for the Kreisselmeier-Steinhauser function
321 !
322  if(n.ge.6) then
323  read(textpart(6)(1:20),'(f20.0)',iostat=istat) rho
324  if(istat.gt.0) call inputerror(inpc,ipoinpc,iline,
325  &"*CONSTRAINT%")
326  if(rho.lt.1.d0) then
327  write(*,*) '*ERROR reading *OBJECTIVE'
328  write(*,*) ' first Kreisselmeier-Steinhauser'
329  write(*,*) ' parameter rho cannot be less'
330  write(*,*) ' than 1'
331  call inputerror(inpc,ipoinpc,iline,
332  &"*CONSTRAINT%")
333  endif
334  objectset(2,nobject)(41:60)=textpart(6)(1:20)
335  endif
336 !
337 ! the target stress for the Kreisselmeier-Steinhauser function
338 !
339  if(n.ge.7) then
340  read(textpart(7)(1:20),'(f20.0)',iostat=istat) stress
341  if(istat.gt.0) call inputerror(inpc,ipoinpc,iline,
342  &"*CONSTRAINT%")
343  if(stress.le.0.d0) then
344  write(*,*) '*ERROR reading *OBJECTIVE'
345  write(*,*) ' the target stress in the'
346  write(*,*) ' Kreisselmeier-Steinhauser function'
347  write(*,*) ' must be strictly positive'
348  call inputerror(inpc,ipoinpc,iline,
349  &"*CONSTRAINT%")
350  endif
351  objectset(2,nobject)(61:80)=textpart(7)(1:20)
352  endif
353 !
354 ! THICKNESS
355 !
356  elseif(textpart(1)(1:9).eq.'THICKNESS') then
357  nobject=nobject+1
358  objectset(1,nobject)(1:9)='THICKNESS'
359  do k=10,81
360  objectset(1,nobject)(k:k)=' '
361  enddo
362 !
363 ! set definition for the constraint
364 !
365  if(n.ge.2) then
366  read(textpart(2)(1:80),'(a80)',iostat=istat)
367  & objectset(3,nobject)(1:80)
368  objectset(3,nobject)(81:81)=' '
369  ipos=index(objectset(3,nobject),' ')
370  if(ipos.ne.1) objectset(3,nobject)(ipos:ipos)='N'
371  endif
372 !
373 ! LE or GE for constraint
374 !
375  if(n.ge.3) then
376  read(textpart(3)(1:2),'(a2)') consttype
377  if((consttype.ne.'LE').and.
378  & (consttype.ne.'GE')) then
379  write(*,*) '*ERROR reading *CONSTRAINT'
380  write(*,*) ' type of constraint must be'
381  write(*,*) ' LE or GE'
382  call inputerror(inpc,ipoinpc,iline,
383  &"*CONSTRAINT%")
384  endif
385  objectset(1,nobject)(19:20)=textpart(3)(1:2)
386  endif
387 !
388 ! set definition for opposite reference nodes
389 !
390  if(n.ge.4) then
391  read(textpart(4)(1:80),'(a80)',iostat=istat)
392  & objectset(4,nobject)(1:80)
393  objectset(4,nobject)(81:81)=' '
394  ipos=index(objectset(4,nobject),' ')
395  if(ipos.ne.1) objectset(4,nobject)(ipos:ipos)='N'
396  endif
397 !
398 ! wall thickness definition
399 !
400  if(n.ge.5) then
401  read(textpart(5)(1:20),'(f20.0)',iostat=istat) abs
402  if(istat.gt.0) call inputerror(inpc,ipoinpc,iline,
403  &"*CONSTRAINT%")
404  if(abs.le.0.d0) then
405  write(*,*) '*ERROR reading *OBJECTIVE'
406  write(*,*) ' the acceptable wall thickness'
407  write(*,*) ' value must be strictly positive'
408  call inputerror(inpc,ipoinpc,iline,
409  &"*CONSTRAINT%")
410  endif
411  objectset(1,nobject)(61:80)=textpart(5)(1:20)
412  endif
413  else
414  write(*,*) '*ERROR reading *CONSTRAINT'
415  write(*,*) ' constraint function not known'
416  call inputerror(inpc,ipoinpc,iline,
417  &"*CONSTRAINT%")
418  endif
419 !
420  call getnewline(inpc,textpart,istat,n,key,iline,ipol,inl,
421  & ipoinp,inp,ipoinpc)
422  if((istat.lt.0).or.(key.eq.1)) exit
423 !
424  enddo
425 !
426  return
getnewline
subroutine getnewline(inpc, textpart, istat, n, key, iline, ipol, inl, ipoinp, inp, ipoinpc)
Definition: getnewline.f:21
inputerror
subroutine inputerror(inpc, ipoinpc, iline, text)
Definition: inputerror.f:20
Hosted by OpenAircraft.com, (Michigan UAV, LLC)