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

Go to the source code of this file.

Functions/Subroutines

subroutine modaldynamics (inpc, textpart, nmethod, tinc, tper, iexpl, istep, istat, n, iline, ipol, inl, ipoinp, inp, iperturb, isolver, cs, mcs, ipoinpc, idrct, ctrl, tmin, tmax, nforc, nload, nbody, iprestr, t0, t1, ithermal, nk, vold, veold, xmodal, set, nset, mi, cyclicsymmetry)
 

Function/Subroutine Documentation

◆ modaldynamics()

subroutine modaldynamics ( character*1, dimension(*)  inpc,
character*132, dimension(16)  textpart,
integer  nmethod,
real*8  tinc,
real*8  tper,
integer  iexpl,
integer  istep,
integer  istat,
integer  n,
integer  iline,
integer  ipol,
integer  inl,
integer, dimension(2,*)  ipoinp,
integer, dimension(3,*)  inp,
integer, dimension(2)  iperturb,
integer  isolver,
real*8, dimension(17,*)  cs,
integer  mcs,
integer, dimension(0:*)  ipoinpc,
integer  idrct,
real*8, dimension(*)  ctrl,
real*8  tmin,
real*8  tmax,
integer  nforc,
integer  nload,
integer  nbody,
integer  iprestr,
real*8, dimension(*)  t0,
real*8, dimension(*)  t1,
integer  ithermal,
integer  nk,
real*8, dimension(0:mi(2),*)  vold,
real*8, dimension(0:mi(2),*)  veold,
real*8, dimension(*)  xmodal,
character*81, dimension(*)  set,
integer  nset,
integer, dimension(*)  mi,
integer  cyclicsymmetry 
)
23 !
24 ! reading the input deck: *MODAL DYNAMIC
25 !
26  implicit none
27 !
28  logical steadystate,nodalset
29 !
30  character*1 inpc(*)
31  character*20 solver
32  character*81 set(*),noset
33  character*132 textpart(16)
34 !
35  integer nmethod,istep,istat,n,key,iexpl,iline,ipol,inl,
36  & ipoinp(2,*),inp(3,*),iperturb(2),isolver,i,mcs,ipoinpc(0:*),
37  & idrct,nforc,nload,nbody,iprestr,ithermal,j,nk,ipos,nset,mi(*),
38  & cyclicsymmetry
39 !
40  real*8 tinc,tper,cs(17,*),ctrl(*),tmin,tmax,t0(*),t1(*),
41  & vold(0:mi(2),*),veold(0:mi(2),*),xmodal(*)
42 !
43  iexpl=0
44  iperturb(1)=0
45  iperturb(2)=0
46  idrct=1
47  tmin=0.d0
48  tmax=0.d0
49  steadystate=.false.
50  if((mcs.ne.0).and.(cs(2,1).ge.0.d0)) then
51  cyclicsymmetry=1
52 c else
53 c cyclicsymmetry=0
54  endif
55  nodalset=.false.
56 !
57  if(istep.lt.1) then
58  write(*,*) '*ERROR in modaldynamics: *MODAL DYNAMIC can only'
59  write(*,*) ' be used within a STEP'
60  call exit(201)
61  endif
62 !
63 ! default solver
64 !
65  solver=' '
66  if(isolver.eq.0) then
67  solver(1:7)='SPOOLES'
68  elseif(isolver.eq.2) then
69  solver(1:16)='ITERATIVESCALING'
70  elseif(isolver.eq.3) then
71  solver(1:17)='ITERATIVECHOLESKY'
72  elseif(isolver.eq.4) then
73  solver(1:3)='SGI'
74  elseif(isolver.eq.5) then
75  solver(1:5)='TAUCS'
76  elseif(isolver.eq.7) then
77  solver(1:7)='PARDISO'
78  endif
79 !
80  do i=2,n
81  if(textpart(i)(1:7).eq.'SOLVER=') then
82  read(textpart(i)(8:27),'(a20)') solver
83  elseif(textpart(i)(1:9).eq.'DIRECT=NO') then
84  idrct=0
85  elseif(textpart(i)(1:7).eq.'DELTMX=') then
86  read(textpart(i)(8:27),'(f20.0)',iostat=istat) ctrl(27)
87  elseif(textpart(i)(1:11).eq.'STEADYSTATE') then
88  steadystate=.true.
89 c elseif(textpart(i)(1:14).eq.'CYCLICSYMMETRY') then
90 c cyclicsymmetry=.true.
91 c elseif(textpart(i)(1:5).eq.'NSET=') then
92 c nodalset=.true.
93 c noset=textpart(i)(6:85)
94 c noset(81:81)=' '
95 c ipos=index(noset,' ')
96 c noset(ipos:ipos)='N'
97  else
98  write(*,*)
99  & '*WARNING in modaldynamics: parameter not recognized:'
100  write(*,*) ' ',
101  & textpart(i)(1:index(textpart(i),' ')-1)
102  call inputwarning(inpc,ipoinpc,iline,
103  &"*MODAL DYNAMIC%")
104  endif
105  enddo
106 !
107  if(solver(1:7).eq.'SPOOLES') then
108  isolver=0
109  elseif(solver(1:16).eq.'ITERATIVESCALING') then
110  write(*,*) '*WARNING in modaldynamics: the iterative scaling'
111  write(*,*) ' procedure is not available for modal'
112  write(*,*) ' dynamic calculations; the default solver'
113  write(*,*) ' is used'
114  elseif(solver(1:17).eq.'ITERATIVECHOLESKY') then
115  write(*,*) '*WARNING in modaldynamics: the iterative scaling'
116  write(*,*) ' procedure is not available for modal'
117  write(*,*) ' dynamic calculations; the default solver'
118  write(*,*) ' is used'
119  elseif(solver(1:3).eq.'SGI') then
120  isolver=4
121  elseif(solver(1:5).eq.'TAUCS') then
122  isolver=5
123 c elseif(solver(1:13).eq.'MATRIXSTORAGE') then
124 c isolver=6
125  elseif(solver(1:7).eq.'PARDISO') then
126  isolver=7
127  else
128  write(*,*) '*WARNING in modaldynamics: unknown solver;'
129  write(*,*) ' the default solver is used'
130  endif
131 !
132  if((isolver.eq.2).or.(isolver.eq.3)) then
133  write(*,*) '*ERROR in modaldynamics: the default solver ',
134  & solver
135  write(*,*) ' cannot be used for modal dynamic'
136  write(*,*) ' calculations '
137  call exit(201)
138  endif
139 !
140 c if(nodalset) then
141 c do i=1,nset
142 c if(set(i).eq.noset) exit
143 c enddo
144 c if(i.gt.nset) then
145 c noset(ipos:ipos)=' '
146 c write(*,*) '*ERROR in modaldynamics: node set ',noset
147 c write(*,*) ' has not yet been defined.'
148 c call exit(201)
149 c endif
150 c xmodal(10)=i+0.5d0
151 c else
152 c if(cyclicsymmetry) then
153 c write(*,*) '*ERROR in modaldynamics: cyclic symmetric'
154 c write(*,*) ' structure, yet no node set defined'
155 c call exit(201)
156 c endif
157 c endif
158 !
159  call getnewline(inpc,textpart,istat,n,key,iline,ipol,inl,
160  & ipoinp,inp,ipoinpc)
161  if((istat.lt.0).or.(key.eq.1)) then
162  write(*,*) '*ERROR in modaldynamics: definition not complete'
163  write(*,*) ' '
164  call inputerror(inpc,ipoinpc,iline,
165  &"*MODAL DYNAMIC%")
166  call exit(201)
167  endif
168  read(textpart(1)(1:20),'(f20.0)',iostat=istat)tinc
169  if(istat.gt.0) call inputerror(inpc,ipoinpc,iline,
170  &"*MODAL DYNAMIC%")
171  read(textpart(2)(1:20),'(f20.0)',iostat=istat)tper
172  if(istat.gt.0) call inputerror(inpc,ipoinpc,iline,
173  &"*MODAL DYNAMIC%")
174  read(textpart(3)(1:20),'(f20.0)',iostat=istat) tmin
175  if(istat.gt.0) call inputerror(inpc,ipoinpc,iline,
176  &"*MODAL DYNAMIC%")
177  read(textpart(4)(1:20),'(f20.0)',iostat=istat) tmax
178  if(istat.gt.0) call inputerror(inpc,ipoinpc,iline,
179  &"*MODAL DYNAMIC%")
180 !
181  if(steadystate) then
182 !
183 ! modal dynamics calculation till steady state
184 !
185  if(tper.le.0.d0) then
186  write(*,*) '*ERROR in modaldynamics: relative error'
187  write(*,*) ' is nonpositive'
188  call exit(201)
189  endif
190  tper=-tper
191  if(tinc.le.0.d0) then
192  write(*,*) '*ERROR in modaldynamics: initial increment'
193  write(*,*) ' size is nonpositive'
194  call exit(201)
195  endif
196  if(tmin.lt.0.d0) then
197  tmin=1.d-10
198  endif
199  if(tmax.lt.1.d-10) then
200  tmax=1.d+30
201  endif
202  else
203 !
204 ! transient modal dynamics calculation
205 !
206  if(tper.lt.0.d0) then
207  write(*,*) '*ERROR in modaldynamics: step size is negative'
208  call exit(201)
209  elseif(tper.le.0.d0) then
210  tper=1.d0
211  endif
212  if(tinc.lt.0.d0) then
213  write(*,*) '*ERROR in modaldynamics: initial increment size
214  &is negative'
215  call exit(201)
216  elseif(tinc.le.0.d0) then
217  tinc=tper
218  endif
219  if(tinc.gt.tper) then
220  write(*,*) '*ERROR in modaldynamics: initial increment size
221  &exceeds step size'
222  call exit(201)
223  endif
224 !
225  if(idrct.ne.1) then
226  if(tmin.lt.1.d-10*tper) then
227  tmin=min(tinc,1.d-10*tper)
228  endif
229  if(tmax.lt.1.d-10) then
230  tmax=1.d+30
231  endif
232  endif
233  endif
234 !
235 ! removing the present loading
236 !
237  nforc=0
238  nload=0
239  nbody=0
240  iprestr=0
241  if((ithermal.eq.1).or.(ithermal.eq.3)) then
242  do j=1,nk
243  t1(j)=t0(j)
244  enddo
245  endif
246 !
247 ! resetting fields vold and veold after a frequency or
248 ! buckling step
249 !
250  if((nmethod.eq.2).or.(nmethod.eq.3)) then
251  do i=1,nk
252  do j=1,3
253  vold(j,i)=0.d0
254  veold(j,i)=0.d0
255  enddo
256  enddo
257  endif
258 !
259  nmethod=4
260 !
261 ! correction for cyclic symmetric structures:
262 ! if the present step was not preceded by a frequency step
263 ! no nodal diameter has been selected. To make sure that
264 ! mastructcs is called instead of mastruct a fictitious
265 ! minimum nodal diameter is stored
266 !
267  if((cyclicsymmetry.eq.1).and.(mcs.ne.0).and.(cs(2,1)<0.d0))
268  & cs(2,1)=0.d0
269 !
270  call getnewline(inpc,textpart,istat,n,key,iline,ipol,inl,
271  & ipoinp,inp,ipoinpc)
272 !
273  return
inputwarning
subroutine inputwarning(inpc, ipoinpc, iline, text)
Definition: inputwarning.f:20
min
#define min(a, b)
Definition: cascade.c:31
steadystate
void steadystate(double **co, ITG *nk, ITG **kon, ITG **ipkon, char **lakon, ITG *ne, ITG **nodeboun, ITG **ndirboun, double **xboun, ITG *nboun, ITG **ipompcp, ITG **nodempcp, double **coefmpcp, char **labmpcp, ITG *nmpc, ITG *nodeforc, ITG *ndirforc, double *xforc, ITG *nforc, ITG *nelemload, char *sideload, double *xload, ITG *nload, ITG **nactdof, ITG *neq, ITG *nzl, ITG *icol, ITG *irow, ITG *nmethod, ITG **ikmpcp, ITG **ilmpcp, ITG **ikboun, ITG **ilboun, double *elcon, ITG *nelcon, double *rhcon, ITG *nrhcon, double *cocon, ITG *ncocon, double *alcon, ITG *nalcon, double *alzero, ITG **ielmat, ITG **ielorien, ITG *norien, double *orab, ITG *ntmat_, double **t0, double **t1, ITG *ithermal, double *prestr, ITG *iprestr, double **voldp, ITG *iperturb, double *sti, ITG *nzs, double *timepar, double *xmodal, double **veoldp, char *amname, double *amta, ITG *namta, ITG *nam, ITG *iamforc, ITG *iamload, ITG **iamt1, ITG *jout, ITG *kode, char *filab, double **emep, double *xforcold, double *xloadold, double **t1old, ITG **iamboun, double **xbounold, ITG *iexpl, double *plicon, ITG *nplicon, double *plkcon, ITG *nplkcon, double *xstate, ITG *npmat_, char *matname, ITG *mi, ITG *ncmat_, ITG *nstate_, double **enerp, char *jobnamec, double *ttime, char *set, ITG *nset, ITG *istartset, ITG *iendset, ITG *ialset, ITG *nprint, char *prlab, char *prset, ITG *nener, double *trab, ITG **inotr, ITG *ntrans, double **fmpcp, char *cbody, ITG *ibody, double *xbody, ITG *nbody, double *xbodyold, ITG *istep, ITG *isolver, ITG *jq, char *output, ITG *mcs, ITG *nkon, ITG *ics, double *cs, ITG *mpcend, double *ctrl, ITG *ikforc, ITG *ilforc, double *thicke, ITG *nmat, char *typeboun, ITG *ielprop, double *prop, char *orname)
Definition: steadystate.c:37
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)