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

Go to the source code of this file.

Functions/Subroutines

subroutine multistages (nkon, set, istartset, iendset, ialset, nset, tieset, tietol, co, nk, ipompc, nodempc, coefmpc, nmpc, nmpc_, ikmpc, ilmpc, mpcfree, xind, yind, ics, nx, ny, xind0, yind0, ncs_, cs, labmpc, ntie, mcs, rcscg, rcs0cg, zcscg, zcs0cg, nrcg, nzcg, jcs, kontri, straight, ne, ipkon, kon, lakon, lcs, ifacetet, inodface)
 
subroutine mprod (M, v_in, v_out, size)
 
subroutine invert3d (M, Minv, size)
 

Function/Subroutine Documentation

◆ invert3d()

subroutine invert3d ( real*8, dimension(3,3)  M,
real*8, dimension(3,3)  Minv,
integer  size 
)
623 !
624  implicit none
625 !
626  integer i,j,size
627  real*8 deta,m(3,3),minv(3,3)
628 !
629  deta=m(1,1)*m(2,2)*m(3,3)+m(2,1)*m(3,2)*m(1,3)+
630  & m(3,1)*m(1,2)*m(2,3)-
631  & m(3,1)*m(2,2)*m(1,3)-m(1,1)*m(3,2)*m(2,3)-
632  & m(2,1)*m(1,2)*m(3,3)
633 
634  minv(1,1)=m(2,2)*m(3,3)-m(3,2)*m(2,3)
635  minv(2,1)=m(3,1)*m(2,3)-m(2,1)*m(3,3)
636  minv(3,1)=m(2,1)*m(3,2)-m(3,1)*m(2,2)
637 
638  minv(1,2)=m(3,2)*m(1,3)-m(1,2)*m(3,3)
639  minv(2,2)=m(1,1)*m(3,3)-m(3,1)*m(1,3)
640  minv(3,2)=m(3,1)*m(1,2)-m(1,1)*m(3,2)
641 
642  minv(1,3)=m(1,2)*m(2,3)-m(2,2)*m(1,3)
643  minv(2,3)=m(2,1)*m(1,3)-m(1,1)*m(2,3)
644  minv(3,3)=m(1,1)*m(2,2)-m(2,1)*m(1,2)
645  do i=1,size
646  do j=1,size
647  minv(i,j)=(1/deta)*minv(i,j)
648  enddo
649  enddo
650  return

◆ mprod()

subroutine mprod ( real*8, dimension(size,size)  M,
real*8, dimension(size)  v_in,
real*8, dimension(size)  v_out,
integer  size 
)
605 !
606  implicit none
607 !
608  integer size,i,j
609  real*8 m(size,size),v_in(size),v_out(size),line
610 !
611  do i=1,size
612  line=0
613  do j=1,size
614  line=m(i,j)*v_in(j)+line
615  enddo
616  v_out(i)=line
617  enddo
618 !
619  return

◆ multistages()

subroutine multistages ( integer  nkon,
character*81, dimension(*)  set,
integer, dimension(*)  istartset,
integer, dimension(*)  iendset,
integer, dimension(*)  ialset,
integer  nset,
character*81, dimension(3,*)  tieset,
real*8, dimension(3,*)  tietol,
real*8, dimension(3,* )  co,
integer  nk,
integer, dimension(*)  ipompc,
integer, dimension(3,*)  nodempc,
real*8, dimension(*)  coefmpc,
integer  nmpc,
integer  nmpc_,
integer, dimension(*)  ikmpc,
integer, dimension(*)  ilmpc,
integer  mpcfree,
real*8, dimension(*)  xind,
real*8, dimension(*)  yind,
integer, dimension(*)  ics,
integer, dimension(*)  nx,
integer, dimension(*)  ny,
real*8, dimension(*)  xind0,
real*8, dimension(*)  yind0,
integer  ncs_,
real*8, dimension(17,*)  cs,
character*20, dimension(*)  labmpc,
integer  ntie,
integer  mcs,
real*8, dimension(*)  rcscg,
real*8, dimension(*)  rcs0cg,
real*8, dimension(*)  zcscg,
real*8, dimension(*)  zcs0cg,
integer, dimension(*)  nrcg,
integer, dimension(*)  nzcg,
integer, dimension(*)  jcs,
integer, dimension(3,*)  kontri,
real*8, dimension(9,*)  straight,
integer  ne,
integer, dimension(*)  ipkon,
integer, dimension(*)  kon,
character*8, dimension(*)  lakon,
integer, dimension(*)  lcs,
integer, dimension(*)  ifacetet,
integer, dimension(*)  inodface 
)
25 !
26  implicit none
27 !
28  logical nodesonaxis,cylindrical,replace,left,right,multistage
29 !
30  character*8 lakon(*)
31  character*20 labmpc(*)
32  character*81 set(*),leftset,rightset,tieset(3,*),temp,indepties,
33  & indeptiet
34 !
35  integer istartset(*),iendset(*),ialset(*),ipompc(*),nodempc(3,*),
36  & nset,i,j,k,nk,nmpc,nmpc_,mpcfree,ics(*),l,ikmpc(*),ilmpc(*),
37  & lcs(*),kflag,ncsnodes,ncs_,mcs,ntie,nrcg(*),nzcg(*),jcs(*),
38  & kontri(3,*),ne,ipkon(*),kon(*),ifacetet(*),inodface(*),
39  & nodel(5),noder(5),nkon,indexe,nope,ipos,nelem,
40  & indcs, node_cycle,itemp(5),nx(*),ny(*),netri,noder0,
41  & nodef(8),nterms,kseg,k2,ndir,idof,number,id,mpcfreeold,
42  & lathyp(3,6),inum,ier
43 !
44 ! creates multistage MPC's: connection of dissimilar cyclic
45 ! symmetric segments
46 !
47 ! author: Konrad Mottl
48 !
49  real*8 tolloc,co(3,* ),coefmpc(*),xind(*),yind(*),xind0(*),
50  & yind0(*),dd,xap,yap,zap,tietol(3,*),cs(17,*),xp,yp,
51  & phi,rcscg(*),rcs0cg(*),zcscg(*),zcs0cg(*),zp,rp,
52  & straight(9,*),t(3,3),csab(7),ratio(8),tinv(3,3),
53  & coord(3),node(3),t2d(3,3),phi0,al(3,3),ar(3,3),
54  & rind, dxmax, dxmin, drmax, drmin, pi,phi_min
55 !
56  data lathyp /1,2,3,1,3,2,2,1,3,2,3,1,3,1,2,3,2,1/
57 !
58  pi=4.*atan(1.)
59  multistage=.true.
60 !
61 ! Find the TIE numbers which describe multistage connections
62 !
63  do i=1,ntie
64  if (tieset(1,i)(81:81).eq.'M') then
65  tieset(1,i)(81:81)=' '
66 
67 !
68 ! **********Starting the main loop over all multistage ties*********
69 ! Creating of the fields nodel and noder with specific
70 ! information for each node
71 ! node(l,r)(1)=nodenumber
72 ! node(l,r)(2)=setnumber
73 ! node(l,r)(3)=elementnumber
74 ! node(l,r)(4)=segments of cyclic symmetry part
75 ! node(l,r)(5)=cyclic symmetry parts number
76 !
77  replace=.true.
78 !
79 ! Defining the left and right node sets
80 !
81  leftset=tieset(2,i)
82  rightset=tieset(3,i)
83 !
84  if (tietol(1,i).eq.-1.d0) then
85  tolloc=0.1d0
86  write(*,*)
87  & '*INFO in multistages: no tolerance was defined'
88  write(*,*) ' in the *TIE option; a tolerance of ',
89  & tolloc
90  write(*,*) ' will be used'
91  write(*,*)
92  else
93  tolloc=tietol(1,i)
94  endif
95 !
96 ! Copying the nodes of each Set of the Tie
97 !
98  do j=1,nset
99  if(leftset.eq.set(j)) then
100  nodel(1)=ialset(istartset(j))
101  nodel(2)=j
102  elseif(rightset.eq.set(j)) then
103  noder(1)=ialset(istartset(j))
104  noder(2)=j
105  endif
106  enddo
107 !
108 ! identifying an element on either side of the
109 ! multistage connection
110 !
111  left=.false.
112  right=.false.
113  loop: do k=1,ne
114  indexe=ipkon(k)
115  if(indexe.lt.0) cycle
116 !
117 ! number of nodes belonging to the element
118 !
119  if(lakon(k)(1:5).eq.'C3D8I') then
120  nope=11
121  elseif(lakon(k)(4:4).eq.'2') then
122  nope=20
123  elseif(lakon(k)(4:4).eq.'8') then
124  nope=8
125  elseif(lakon(k)(4:5).eq.'10') then
126  nope=10
127  elseif(lakon(k)(4:4).eq.'4') then
128  nope=4
129  elseif(lakon(k)(4:5).eq.'15') then
130  nope=15
131  elseif(lakon(k)(4:4).eq.'6') then
132  nope=6
133  elseif(lakon(k)(1:2).eq.'ES') then
134  read(lakon(k)(8:8),'(i1)') nope
135  nope=nope+1
136  endif
137 !
138  do l=indexe+1,indexe+nope
139  if(.not.left) then
140  if(nodel(1).eq.kon(l))then
141  nodel(3)=k
142  left=.true.
143  endif
144  endif
145  if(.not.right) then
146  if(noder(1).eq.kon(l))then
147  noder(3)=k
148  right=.true.
149  endif
150  endif
151  if(left.and.right) exit loop
152  enddo
153  enddo loop
154 c !
155 c ! Looking for the cyclic symmetry the nodes belong to
156 c!
157 c!
158 c do k=1,ne-1
159 c write(*,*) 'multistages ',k,ipkon(k),ipkon(k+1)
160 c do l=ipkon(k)+1,ipkon(k+1)
161 c if (nodel(1).eq.kon(l)) then
162 c nodel(3)=k
163 c elseif (noder(1).eq.kon(l)) then
164 c noder(3)=k
165 c endif
166 c enddo
167 c enddo
168 c!
169 c! For the last element a different loop is needed
170 c!
171 c do l=ipkon(ne),nkon
172 c if (nodel(1).eq.kon(l)) then
173 c nodel(3)=k
174 c!
175 c elseif (noder(1).eq.kon(l)) then
176 c noder(3)=k
177 c endif
178 c enddo
179 !
180  do j=1,mcs
181  do l=istartset(int(cs(13,j))),iendset(int(cs(13,j)))
182  if (ialset(l).eq.nodel(3)) then
183  nodel(4)=cs(1,j)
184  nodel(5)=j
185  elseif (ialset(l).eq.noder(3)) then
186  noder(4)=cs(1,j)
187  noder(5)=j
188  endif
189  enddo
190  csab(1)=cs(6,j)
191  csab(2)=cs(7,j)
192  csab(3)=cs(8,j)
193  csab(4)=cs(9,j)
194  csab(5)=cs(10,j)
195  csab(6)=cs(11,j)
196  csab(7)=-1.d0
197  enddo
198 !
199 ! Sorting such that rightset is independent with lesser angle
200 ! and noder is in the independent set
201 !
202  if (nodel(4).ge.noder(4)) then
203  indcs=nodel(5)
204  phi0=(2.d0*pi)/nodel(4)
205  temp=rightset;
206  rightset=leftset
207  leftset=temp
208  do j=1,5
209  itemp(j)=noder(j)
210  noder(j)=nodel(j)
211  nodel(j)=itemp(j)
212  enddo
213  else
214  indcs=noder(5)
215  phi0=(2.d0*pi)/noder(4)
216  endif
217 !
218 ! Looking for a node on the independent cyclic symmetry side
219 !
220  indepties=tieset(3,int(cs(17,indcs)))
221  indeptiet=indepties
222  ipos=index(indepties,' ')
223  indepties(ipos:ipos)='S'
224  indeptiet(ipos:ipos)='T'
225  do j=1,nset
226  if(indepties.eq.set(j)) then
227 !
228 ! nodal independent surface
229 !
230  node_cycle=ialset(istartset(j))
231  exit
232  elseif(indeptiet.eq.set(j)) then
233 !
234 ! facial independent surface
235 !
236  nelem=int(ialset(istartset(j))/10)
237  node_cycle=kon(ipkon(nelem)+1)
238  exit
239  endif
240  enddo
241 !
242 c do j=1,nset
243 c if(tieset(3,int(cs(17,indcs))).eq.set(j)) then
244 c node_cycle=ialset(istartset(j))
245 c endif
246 c enddo
247 !
248 ! Defining the rotary matrix for the tie level
249 !
250  t(1,1)=csab(4)-csab(1)
251  t(1,2)=csab(5)-csab(2)
252  t(1,3)=csab(6)-csab(3)
253  dd=dsqrt(t(1,1)*t(1,1)+t(1,2)*t(1,2)+t(1,3)*t(1,3))
254  t(1,1)=t(1,1)/dd
255  t(1,2)=t(1,2)/dd
256  t(1,3)=t(1,3)/dd
257 !
258 ! Defining the Position of the Leftnode, which contains the angle boundary
259 ! for the second parameter for the tie level
260 !
261  xap=co(1,node_cycle)-csab(1)
262  yap=co(2,node_cycle)-csab(2)
263  zap=co(3,node_cycle)-csab(3)
264 !
265  zp=xap*t(1,1)+yap*t(1,2)+zap*t(1,3)
266  rp=((xap-t(1,1)*zp)**2+(yap-zp*t(1,2))**2+
267  & (zap-zp*t(1,3))**2)
268  rp=dsqrt(rp)
269 !
270 ! Performing the vector product for the third axis of the rotary matrix
271 !
272  if(rp.gt.1.d-10) then
273  t(2,1)=(xap-zp*t(1,1))/rp
274  t(2,2)=(yap-zp*t(1,2))/rp
275  t(2,3)=(zap-zp*t(1,3))/rp
276  t(3,1)=t(1,2)*t(2,3)-t(2,2)*t(1,3)
277  t(3,2)=t(2,1)*t(1,3)-t(1,1)*t(2,3)
278  t(3,3)=t(1,1)*t(2,2)-t(2,1)*t(1,2)
279  endif
280 !
281 ! Inverting the rotary matrix to rotate the node back afterwards
282 !
283  call invert3d(t,tinv,3)
284 !
285 ! Writing a secondary rotary matrix which rotates the nodes on
286 ! the tie level with the angle phi
287 !
288  l=0
289  do j=istartset(noder(2)),iendset(noder(2))
290  l=l+1
291  node(1)=co(1,ialset(j))-csab(1)
292  node(2)=co(2,ialset(j))-csab(2)
293  node(3)=co(3,ialset(j))-csab(3)
294  call mprod(t,node,coord,3)
295  xind(l)=coord(2)
296  yind(l)=coord(3)
297  nx(l)=l
298  ny(l)=l
299  ics(l)=ialset(j)
300  xind0(l)=xind(l)
301  yind0(l)=yind(l)
302  rind=dsqrt(coord(2)**2+coord(3)**2)
303  phi=datan2(-coord(3),coord(2))
304  if (l.gt.1.d0) then
305  dxmax=max(dxmax,dabs(coord(1)))
306  drmax=max(drmax,dabs(rind))
307 
308  dxmin=min(dxmin,dabs(coord(1)))
309  drmin=min(drmin,dabs(rind))
310  phi_min=min(phi_min,phi)
311  else
312  dxmax=dabs(coord(1))
313  phi_min=phi
314  drmax=rind
315  dxmin=dabs(coord(1))
316  drmin=rind
317  endif
318  enddo
319 !
320  cylindrical=.false.
321  if ((dxmax-dxmin).ge.(drmax-drmin)) then
322  l=0.d0
323  do j=istartset(noder(2)),iendset(noder(2))
324  l=l+1
325  node(1)=co(1,ialset(j))-csab(1)
326  node(2)=co(2,ialset(j))-csab(2)
327  node(3)=co(3,ialset(j))-csab(3)
328  call mprod(t,node,coord,3)
329  xind(l)=coord(2)
330  yind(l)=datan2(-coord(3),coord(2))
331  nx(l)=l
332  ny(l)=l
333  ics(l)=ialset(j)
334  xind0(l)=xind(l)
335  yind0(l)=yind(l)
336  enddo
337  cylindrical=.true.
338 c write(*,*) 'Multistage Tie',tieset(1,i)(1:80),
339 c & 'is horizontally triangulated'
340  else
341 c write(*,*) 'Multistage Tie',tieset(1,i)(1:80),
342 c & 'is vertically triangulated'
343  endif
344 c
345 c Sorting the coordinates for the further consideration
346 c
347  ncsnodes=l
348  kflag=2
349  call dsort(xind,nx,ncsnodes,kflag)
350  call dsort(yind,ny,ncsnodes,kflag)
351 !
352  call triangulate(ics,xind0,yind0,ncsnodes,
353  & rcscg,rcs0cg,zcscg,zcs0cg,nrcg,nzcg,jcs,kontri,
354  & straight,ne,ipkon,kon,lakon,lcs,netri,ifacetet,
355  & inodface)
356 !
357  do j=istartset(nodel(2)),iendset(nodel(2))
358  node(1)=co(1,ialset(j))-csab(1)
359  node(2)=co(2,ialset(j))-csab(2)
360  node(3)=co(3,ialset(j))-csab(3)
361 !
362 ! Rotating into local coordinates "coord"
363 !
364  call mprod(t,node,coord,3)
365 !
366 ! Determining the number of segments for the rotation
367 !
368  phi=datan2(-coord(3),coord(2))
369  if (phi.gt.(-1.d-5+phi_min)) then
370  kseg=int(noder(4)*0.5d0*(phi-phi_min)/pi)
371  else
372  kseg=int(noder(4)*0.5d0*(2.d0*pi+(phi-phi_min))/pi)
373  endif
374 !
375  t2d(1,1)=1.d0
376  t2d(1,2)=0.d0
377  t2d(1,3)=0.d0
378  t2d(2,1)=0.d0
379  t2d(2,2)=dcos(-kseg*phi0)
380  t2d(2,3)=dsin(-kseg*phi0)
381  t2d(3,1)=0.d0
382  t2d(3,2)=-dsin(-kseg*phi0)
383  t2d(3,3)=dcos(-kseg*phi0)
384 !
385 ! Rotating the dependent nodes by the number of
386 ! segments to "node" in local coordinates
387 !
388  call mprod(t2d,coord,node,3)
389 !
390 ! Copying the local coordinates to the local variables
391 !
392  if (cylindrical) then
393  yp=node(1)
394  zp=phi
395  else
396  xp=node(1)
397  yp=node(2)
398  zp=node(3)
399  endif
400  noder0=nk+1
401 !
402 ! Rotating back to global coordinates to "coord"
403 !
404  call mprod(tinv,node,coord,3)
405  co(1,noder0)=coord(1)
406  co(2,noder0)=coord(2)
407  co(3,noder0)=coord(3)
408 !
409  ier=0
410  call linkdissimilar(co,csab,
411  & rcscg,rcs0cg,zcscg,zcs0cg,nrcg,nzcg,
412  & straight,nodef,ratio,nterms,yp,zp,netri,
413  & noder0,ifacetet,inodface,ialset(j),
414  & t(1,1),t(1,2),t(1,3),ier,multistage)
415 !
416  if ((kseg.eq.(noder(4))-1.d0).and.(replace)) then
417  cs(1,mcs+1)=-noder(4)
418  do k=2,17
419  cs(k,mcs+1)=cs(k,noder(5))
420  enddo
421  cs(13,mcs+1)=0.5d0
422  mcs=mcs+1
423  replace=.false.
424  endif
425 !
426 !
427  call transformatrix(csab,co(1,ialset(j)),al)
428  call transformatrix(csab,co(1,noder0),ar)
429 !
430 ! checking for latin hypercube positions in matrix al none of
431 ! which are zero
432 !
433  do inum=1,6
434  if((dabs(al(lathyp(1,inum),1)).gt.1.d-3).and.
435  & (dabs(al(lathyp(2,inum),2)).gt.1.d-3).and.
436  & (dabs(al(lathyp(3,inum),3)).gt.1.d-3)) exit
437  enddo
438 !
439  do ndir=1,3
440  nmpc=nmpc+1
441  ipompc(nmpc)=mpcfree
442  if((kseg.ne.0).or.(kseg.eq.(noder(4))-1.d0)) then
443  labmpc(nmpc)='CYCLIC '
444  if (kseg.eq.1) then
445  if (noder(5).lt.10) then
446  write(labmpc(nmpc)(7:7),'(i1)') noder(5)
447  else
448  write(labmpc(nmpc)(7:8),'(i2)') noder(5)
449  endif
450  endif
451  if (kseg.eq.(noder(4))-1.d0) then
452  if (mcs.lt.10) then
453  write(labmpc(nmpc)(7:7),'(i1)') mcs
454  elseif (mcs.lt.100) then
455  write(labmpc(nmpc)(7:8),'(i2)') mcs
456  else
457  write(*,*)
458  & '*ERROR in multistages: no more than 49'
459  write(*,*)
460  & ' cyclic symmetry definitions allowed'
461  call exit(201)
462  endif
463  endif
464  number=ndir-1
465  number=lathyp(ndir,inum)
466 !
467 ! determining which direction to use for the
468 ! dependent side: should not occur on the dependent
469 ! side in another MPC and should have a nonzero
470 ! coefficient
471 !
472  idof=8*(ialset(j)-1)+number
473  call nident(ikmpc,idof,nmpc-1,id)
474  if(id.gt.0) then
475  if(ikmpc(id).eq.idof) then
476  write(*,*)
477  & '*WARNING in multistages: cyclic MPC in node'
478  write(*,*) ' ',ialset(j),
479  & ' and direction',ndir
480  write(*,*) ' cannot be created: the'
481  write(*,*)
482  & ' DOF in this node is already used'
483  cycle
484  endif
485  endif
486 !
487  number=number-1
488 !
489 ! updating ikmpc and ilmpc
490 !
491  do k=nmpc,id+2,-1
492  ikmpc(k)=ikmpc(k-1)
493  ilmpc(k)=ilmpc(k-1)
494  enddo
495  ikmpc(id+1)=idof
496  ilmpc(id+1)=nmpc
497  do k=1,3
498  number=number+1
499  if(number.gt.3) number=1
500  if(dabs(al(number,ndir)).lt.1.d-5) cycle
501  nodempc(1,mpcfree)=ialset(j)
502  nodempc(2,mpcfree)=number
503  coefmpc(mpcfree)=al(number,ndir)
504  mpcfree=nodempc(3,mpcfree)
505  if(mpcfree.eq.0) then
506  write(*,*)
507  & '*ERROR in multistages: increase memmpc_'
508  call exit(201)
509  endif
510  enddo
511  do k=1,3
512  number=number+1
513  if(number.gt.3) number=1
514  if(dabs(ar(number,ndir)).lt.1.d-5) cycle
515  do k2=1,nterms
516  if (dabs(ratio(k2)).gt.1.d-10) then
517  nodempc(1,mpcfree)=nodef(k2)
518  nodempc(2,mpcfree)=number
519  coefmpc(mpcfree)=
520  % -ar(number,ndir)*ratio(k2)
521  mpcfreeold=mpcfree
522  mpcfree=nodempc(3,mpcfree)
523  endif
524  if(mpcfree.eq.0) then
525  write(*,*)
526  & '*ERROR in multistages: increase memmpc_'
527  call exit(201)
528  endif
529  enddo
530  enddo
531  nodempc(3,mpcfreeold)=0
532  phi=0.d0
533  else
534 !
535 ! Starting the creation of the standard MPC
536 !
537 ! determining which direction to use for the
538 ! dependent side: should not occur on the dependent
539 ! side in another MPC and should have a nonzero
540 ! coefficient
541 !
542  labmpc(nmpc)=' '
543  idof=8*(ialset(j)-1)+ndir
544  call nident(ikmpc,idof,nmpc-1,id)
545  if(id.gt.0) then
546  if(ikmpc(id).eq.idof) then
547  write(*,*)
548  & '*WARNING in multistages: cyclic MPC in node'
549  write(*,*) ' ',ialset(j),
550  & ' and direction',ndir
551  write(*,*) ' cannot be created: the'
552  write(*,*)
553  & ' DOF in this node is already used'
554  cycle
555  endif
556  endif
557 !
558 ! updating ikmpc and ilmpc
559 !
560  do k=nmpc,id+2,-1
561  ikmpc(k)=ikmpc(k-1)
562  ilmpc(k)=ilmpc(k-1)
563  enddo
564  ikmpc(id+1)=idof
565  ilmpc(id+1)=nmpc
566 
567  nodempc(1,mpcfree)=ialset(j)
568  nodempc(2,mpcfree)=ndir
569  coefmpc(mpcfree)=-1
570  mpcfree=nodempc(3,mpcfree)
571  if(mpcfree.eq.0) then
572  write(*,*)
573  & '*ERROR in multistages: increase memmpc_'
574  call exit(201)
575  endif
576 
577  do k2=1,nterms
578  if (dabs(ratio(k2)).gt.1.d-6) then
579  nodempc(1,mpcfree)=nodef(k2)
580  nodempc(2,mpcfree)=ndir
581  coefmpc(mpcfree)=ratio(k2)
582  mpcfreeold=mpcfree
583  mpcfree=nodempc(3,mpcfree)
584  endif
585  if(mpcfree.eq.0) then
586  write(*,*)
587  & '*ERROR in multistages: increase memmpc_'
588  call exit(201)
589  endif
590  enddo
591  endif
592  nodempc(3,mpcfreeold)=0
593  enddo
594 !
595  enddo !Loop over nodes on dependent side
596  endif
597  enddo !Loop over ties
598 !
599 ! *********Ending the main loop over all multistage ties***********
600 !
601  return
max
#define max(a, b)
Definition: cascade.c:32
triangulate
subroutine triangulate(ics, rcs0, zcs0, ncsnodes, rcscg, rcs0cg, zcscg, zcs0cg, nrcg, nzcg, jcs, kontri, straight, ne, ipkon, kon, lakon, lcs, netri, ifacetet, inodface)
Definition: triangulate.f:22
min
#define min(a, b)
Definition: cascade.c:31
mprod
subroutine mprod(M, v_in, v_out, size)
Definition: multistages.f:605
invert3d
subroutine invert3d(M, Minv, size)
Definition: multistages.f:623
transformatrix
subroutine transformatrix(xab, p, a)
Definition: transformatrix.f:20
nident
subroutine nident(x, px, n, id)
Definition: nident.f:26
linkdissimilar
subroutine linkdissimilar(co, csab, rcscg, rcs0cg, zcscg, zcs0cg, nrcg, nzcg, straight, nodef, ratio, nterms, rp, zp, netri, nodei, ifacetet, inodface, noded, xn, yn, zn, ier, multistage)
Definition: linkdissimilar.f:23
dsort
subroutine dsort(dx, iy, n, kflag)
Definition: dsort.f:6
Hosted by OpenAircraft.com, (Michigan UAV, LLC)