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

Go to the source code of this file.

Functions/Subroutines

subroutine equations (inpc, textpart, ipompc, nodempc, coefmpc, nmpc, nmpc_, mpcfree, nk, co, trab, inotr, ntrans, ikmpc, ilmpc, labmpc, istep, istat, n, iline, ipol, inl, ipoinp, inp, ipoinpc, set, istartset, iendset, ialset, nset, nodempcref, coefmpcref, ikmpcref, memmpcref_, mpcfreeref, maxlenmpcref, memmpc_, maxlenmpc)
 

Function/Subroutine Documentation

◆ equations()

subroutine equations ( character*1, dimension(*)  inpc,
character*132, dimension(16)  textpart,
integer, dimension(*)  ipompc,
integer, dimension(3,*)  nodempc,
real*8, dimension(*)  coefmpc,
integer  nmpc,
integer  nmpc_,
integer  mpcfree,
integer  nk,
real*8, dimension(3,*)  co,
real*8, dimension(7,*)  trab,
integer, dimension(2,*)  inotr,
integer  ntrans,
integer, dimension(*)  ikmpc,
integer, dimension(*)  ilmpc,
character*20, dimension(*)  labmpc,
integer  istep,
integer  istat,
integer  n,
integer  iline,
integer  ipol,
integer  inl,
integer, dimension(2,*)  ipoinp,
integer, dimension(3,*)  inp,
integer, dimension(0:*)  ipoinpc,
character*81, dimension(*)  set,
integer, dimension(*)  istartset,
integer, dimension(*)  iendset,
integer, dimension(*)  ialset,
integer  nset,
integer, dimension(3,*)  nodempcref,
real*8, dimension(*)  coefmpcref,
integer, dimension(*)  ikmpcref,
integer  memmpcref_,
integer  mpcfreeref,
integer  maxlenmpcref,
integer  memmpc_,
integer  maxlenmpc 
)
25 !
26 ! reading the input deck: *EQUATION
27 !
28  implicit none
29 !
30  character*1 inpc(*)
31  character*20 labmpc(*)
32  character*81 set(*),noset
33  character*132 textpart(16)
34 !
35  integer ipompc(*),nodempc(3,*),nmpc,nmpc_,mpcfree,istep,istat,
36  & n,i,j,ii,key,nterm,number,nk,inotr(2,*),ntrans,node,ndir,
37  & mpcfreeold,ikmpc(*),ilmpc(*),id,idof,itr,iline,ipol,inl,
38  & ipoinp(2,*),inp(3,*),ipoinpc(0:*),impcstart,impcend,i1,
39  & istartset(*),iendset(*),ialset(*),nset,k,l,m,index1,ipos,
40  & impc,nodempcref(3,*),ikmpcref(*),memmpcref_,mpcfreeref,
41  & maxlenmpcref,memmpc_,maxlenmpc
42 !
43  real*8 coefmpc(*),co(3,*),trab(7,*),a(3,3),x,coefmpcref(*)
44 !
45  do m=2,n
46  if(textpart(m)(1:9).eq.'REMOVEALL') then
47 !
48  if(istep.eq.1) then
49  write(*,*) '*ERROR reading *EQUATION'
50  write(*,*) ' removing equations is not allowed'
51  write(*,*) ' in the first step'
52  call exit(201)
53  endif
54 !
55  do j=1,nmpc
56  index1=ipompc(j)
57  if(index1.eq.0) cycle
58  do
59  if(nodempc(3,index1).eq.0) then
60  nodempc(3,index1)=mpcfree
61  mpcfree=ipompc(j)
62  exit
63  endif
64  index1=nodempc(3,index1)
65  enddo
66  ipompc(j)=0
67  ikmpc(j)=0
68  ilmpc(j)=0
69  enddo
70  nmpc=0
71  call getnewline(inpc,textpart,istat,n,key,iline,ipol,inl,
72  & ipoinp,inp,ipoinpc)
73  return
74  elseif(textpart(m)(1:6).eq.'REMOVE') then
75 !
76  if(istep.eq.1) then
77  write(*,*) '*ERROR reading *EQUATION'
78  write(*,*) ' removing equations is not allowed'
79  write(*,*) ' in the first step'
80  call exit(201)
81  endif
82 !
83  do i=1,nmpc
84  if(ikmpcref(i).ne.ikmpc(i)) then
85  write(*,*) '*ERROR reading *EQUATION'
86  write(*,*) ' The dependent terms in some'
87  write(*,*) ' of the nonlinear equations have'
88  write(*,*) ' changed since the start of the'
89  write(*,*) ' calculation. Removing equations'
90  write(*,*) ' does not work'
91  call exit(201)
92  endif
93  enddo
94 !
95 ! restoring the original equations (before the first call to
96 ! cascade)
97 !
98  memmpc_=memmpcref_
99  mpcfree=mpcfreeref
100  maxlenmpc=maxlenmpcref
101  mpcfreeref=-1
102 !
103  do i=1,memmpc_
104  do j=1,3
105  nodempc(j,i)=nodempcref(j,i)
106  enddo
107  coefmpc(i)=coefmpcref(i)
108  enddo
109 !
110  do
111  call getnewline(inpc,textpart,istat,n,key,iline,ipol,inl,
112  & ipoinp,inp,ipoinpc)
113  if((istat.lt.0).or.(key.eq.1)) return
114 !
115  read(textpart(2)(1:10),'(i10)',iostat=istat) impcstart
116  if(istat.gt.0) call inputerror(inpc,ipoinpc,iline,
117  &"*EQUATION%")
118 !
119  if(textpart(3)(1:1).eq.' ') then
120  impcend=impcstart
121  else
122  read(textpart(3)(1:10),'(i10)',iostat=istat) impcend
123  if(istat.gt.0) call inputerror(inpc,ipoinpc,iline,
124  &"*EQUATION%")
125  endif
126 !
127  read(textpart(1)(1:10),'(i10)',iostat=istat) l
128  if(istat.eq.0) then
129  if((l.gt.nk).or.(l.le.0)) then
130  write(*,*) '*ERROR reading *BOUNDARY:'
131  write(*,*) ' node ',l,' is not defined'
132  call exit(201)
133  endif
134  do i1=impcstart,impcend
135  idof=8*(l-1)+i1
136  call nident(ikmpc,idof,nmpc,id)
137  if(id.gt.0) then
138  if(ikmpc(id).eq.idof) then
139  impc=ilmpc(id)
140  call mpcrem(impc,mpcfree,nodempc,nmpc,
141  & ikmpc,ilmpc,labmpc,coefmpc,ipompc)
142  cycle
143  endif
144  endif
145  write(*,*)
146  & '*WARNING reading *EQUATION: MPC to remove'
147  write(*,*) ' is not defined; node:',l
148  write(*,*) ' degree of freedom:',i1
149  enddo
150  else
151  read(textpart(1)(1:80),'(a80)',iostat=istat) noset
152  noset(81:81)=' '
153  ipos=index(noset,' ')
154  noset(ipos:ipos)='N'
155  do i=1,nset
156  if(set(i).eq.noset) exit
157  enddo
158  if(i.gt.nset) then
159  noset(ipos:ipos)=' '
160  write(*,*) '*ERROR reading *BOUNDARY: node set ',
161  & noset
162  write(*,*) ' has not yet been defined. '
163  call inputerror(inpc,ipoinpc,iline,
164  &"*EQUATION%")
165  call exit(201)
166  endif
167  do j=istartset(i),iendset(i)
168  if(ialset(j).gt.0) then
169  k=ialset(j)
170  do i1=impcstart,impcend
171  idof=8*(k-1)+i1
172  call nident(ikmpc,idof,nmpc,id)
173  if(id.gt.0) then
174  if(ikmpc(id).eq.idof) then
175  impc=ilmpc(id)
176  call mpcrem(impc,mpcfree,nodempc,
177  & nmpc,ikmpc,ilmpc,labmpc,coefmpc,
178  & ipompc)
179  cycle
180  endif
181  endif
182  write(*,*)
183  & '*WARNING reading *EQUATION: MPC to remove'
184  write(*,*) ' is not defined; node:',k
185  write(*,*) ' degree of freedom:',i1
186  enddo
187  else
188  k=ialset(j-2)
189  do
190  k=k-ialset(j)
191  if(k.ge.ialset(j-1)) exit
192  do i1=impcstart,impcend
193  idof=8*(k-1)+i1
194  call nident(ikmpc,idof,nmpc,id)
195  if(id.gt.0) then
196  if(ikmpc(id).eq.idof) then
197  impc=ilmpc(id)
198  call mpcrem(impc,mpcfree,
199  & nodempc,nmpc,ikmpc,ilmpc,labmpc,
200  & coefmpc,ipompc)
201  cycle
202  endif
203  endif
204  write(*,*)
205  & '*WARNING reading *EQUATION: MPC to remove'
206  write(*,*)
207  & ' is not defined; node:',k
208  write(*,*)' degree of freedom:',i1
209  enddo
210  enddo
211  endif
212  enddo
213  endif
214  enddo
215  return
216  else
217  write(*,*)
218  & '*WARNING reading *EQUATION: parameter not recognized:'
219  write(*,*) ' ',
220  & textpart(m)(1:index(textpart(m),' ')-1)
221  call inputwarning(inpc,ipoinpc,iline,
222  &"*EQUATION%")
223  endif
224  enddo
225 !
226  if(istep.gt.0) then
227  write(*,*)
228  & '*ERROR reading *EQUATION: *EQUATION should be placed'
229  write(*,*) ' before all step definitions'
230  call exit(201)
231  endif
232 !
233  do
234  call getnewline(inpc,textpart,istat,n,key,iline,ipol,inl,
235  & ipoinp,inp,ipoinpc)
236  if((istat.lt.0).or.(key.eq.1)) return
237  read(textpart(1)(1:10),'(i10)',iostat=istat) nterm
238 !
239  nmpc=nmpc+1
240  if(nmpc.gt.nmpc_) then
241  write(*,*) '*ERROR reading *EQUATION: increase nmpc_'
242  call exit(201)
243  endif
244 !
245  labmpc(nmpc)=' '
246  ipompc(nmpc)=mpcfree
247  ii=0
248 !
249  do
250  call getnewline(inpc,textpart,istat,n,key,iline,ipol,inl,
251  & ipoinp,inp,ipoinpc)
252  if((istat.lt.0).or.(key.eq.1)) then
253  write(*,*) '*ERROR reading *EQUATION: mpc definition ',
254  & nmpc
255  write(*,*) ' is not complete. '
256  call inputerror(inpc,ipoinpc,iline,
257  &"*EQUATION%")
258  call exit(201)
259  endif
260 !
261  do i=1,n/3
262 !
263  read(textpart((i-1)*3+1)(1:10),'(i10)',iostat=istat) node
264  if(istat.gt.0) call inputerror(inpc,ipoinpc,iline,
265  &"*EQUATION%")
266  if((node.gt.nk).or.(node.le.0)) then
267  write(*,*) '*ERROR reading *EQUATION:'
268  write(*,*) ' node ',node,' is not defined'
269  call exit(201)
270  endif
271 !
272  read(textpart((i-1)*3+2)(1:10),'(i10)',iostat=istat) ndir
273  if(istat.gt.0) call inputerror(inpc,ipoinpc,iline,
274  &"*EQUATION%")
275  if(ndir.le.6) then
276 c elseif(ndir.eq.4) then
277 c ndir=5
278 c elseif(ndir.eq.5) then
279 c ndir=6
280 c elseif(ndir.eq.6) then
281 c ndir=7
282  elseif(ndir.eq.8) then
283  ndir=4
284  elseif(ndir.eq.11) then
285  ndir=0
286  else
287  write(*,*) '*ERROR reading *EQUATION:'
288  write(*,*) ' direction',ndir,' is not defined'
289  call exit(201)
290  endif
291 !
292  read(textpart((i-1)*3+3)(1:20),'(f20.0)',iostat=istat) x
293  if(istat.gt.0) call inputerror(inpc,ipoinpc,iline,
294  &"*EQUATION%")
295 !
296 ! check whether the node is transformed
297 !
298  if(ntrans.le.0) then
299  itr=0
300  elseif(inotr(1,node).eq.0) then
301  itr=0
302  else
303  itr=inotr(1,node)
304  endif
305 !
306  if((itr.eq.0).or.(ndir.eq.0).or.(ndir.eq.4)) then
307  nodempc(1,mpcfree)=node
308  nodempc(2,mpcfree)=ndir
309  coefmpc(mpcfree)=x
310 !
311 ! updating ikmpc and ilmpc
312 !
313  if(ii.eq.0) then
314  idof=8*(node-1)+ndir
315  call nident(ikmpc,idof,nmpc-1,id)
316  if(id.gt.0) then
317  if(ikmpc(id).eq.idof) then
318  write(*,100)
319  & (ikmpc(id))/8+1,ikmpc(id)-8*((ikmpc(id))/8)
320  call exit(201)
321  endif
322  endif
323  do j=nmpc,id+2,-1
324  ikmpc(j)=ikmpc(j-1)
325  ilmpc(j)=ilmpc(j-1)
326  enddo
327  ikmpc(id+1)=idof
328  ilmpc(id+1)=nmpc
329  endif
330 !
331  mpcfreeold=mpcfree
332  mpcfree=nodempc(3,mpcfree)
333  if(mpcfree.eq.0) then
334  write(*,*)
335  & '*ERROR reading *EQUATION: increase memmpc_'
336  call exit(201)
337  endif
338  else
339  call transformatrix(trab(1,inotr(1,node)),
340  & co(1,node),a)
341 !
342  number=ndir-1
343  if(ii.eq.0) then
344 !
345 ! determining which direction to use for the
346 ! dependent side: should not occur on the dependent
347 ! side in another MPC and should have a nonzero
348 ! coefficient
349 !
350  do j=1,3
351  number=number+1
352  if(number.gt.3) number=1
353  idof=8*(node-1)+number
354  call nident(ikmpc,idof,nmpc-1,id)
355  if(id.gt.0) then
356  if(ikmpc(id).eq.idof) then
357  cycle
358  endif
359  endif
360  if(dabs(a(number,ndir)).lt.1.d-5) cycle
361  exit
362  enddo
363  if(j.gt.3) then
364  write(*,*)
365  & '*ERROR reading *EQUATION: SPC in node'
366  write(*,*) node,' in transformed coordinates'
367  write(*,*) ' cannot be converted in MPC: all'
368  write(*,*) ' DOFs in the node are used as'
369  write(*,*) ' dependent nodes in other MPCs'
370  call exit(201)
371  endif
372  number=number-1
373 !
374 ! updating ikmpc and ilmpc
375 !
376  do j=nmpc,id+2,-1
377  ikmpc(j)=ikmpc(j-1)
378  ilmpc(j)=ilmpc(j-1)
379  enddo
380  ikmpc(id+1)=idof
381  ilmpc(id+1)=nmpc
382  endif
383 !
384  do j=1,3
385  number=number+1
386  if(number.gt.3) number=1
387  if(dabs(a(number,ndir)).lt.1.d-5) cycle
388  nodempc(1,mpcfree)=node
389  nodempc(2,mpcfree)=number
390  coefmpc(mpcfree)=x*a(number,ndir)
391  mpcfreeold=mpcfree
392  mpcfree=nodempc(3,mpcfree)
393  if(mpcfree.eq.0) then
394  write(*,*)
395  & '*ERROR reading *EQUATION: increase memmpc_'
396  call exit(201)
397  endif
398  enddo
399  endif
400 !
401  ii=ii+1
402  enddo
403 !
404  if(ii.eq.nterm) then
405  nodempc(3,mpcfreeold)=0
406  exit
407  endif
408  enddo
409  enddo
410 !
411  100 format(/,'*ERROR reading *EQUATION: the DOF corresponding to',
412  & /,'node ',i10,' in direction',i1,' is detected on',
413  & /,'the dependent side of two different MPC''s')
414  return
inputwarning
subroutine inputwarning(inpc, ipoinpc, iline, text)
Definition: inputwarning.f:20
transformatrix
subroutine transformatrix(xab, p, a)
Definition: transformatrix.f:20
mpcrem
subroutine mpcrem(i, mpcfree, nodempc, nmpc, ikmpc, ilmpc, labmpc, coefmpc, ipompc)
Definition: mpcrem.f:21
getnewline
subroutine getnewline(inpc, textpart, istat, n, key, iline, ipol, inl, ipoinp, inp, ipoinpc)
Definition: getnewline.f:21
nident
subroutine nident(x, px, n, id)
Definition: nident.f:26
inputerror
subroutine inputerror(inpc, ipoinpc, iline, text)
Definition: inputerror.f:20
Hosted by OpenAircraft.com, (Michigan UAV, LLC)