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

Go to the source code of this file.

Functions/Subroutines

subroutine cloads (inpc, textpart, set, istartset, iendset, ialset, nset, nodeforc, ndirforc, xforc, nforc, nforc_, iamforc, amname, nam, ntrans, trab, inotr, co, ikforc, ilforc, nk, cload_flag, istep, istat, n, iline, ipol, inl, ipoinp, inp, nam_, namtot_, namta, amta, nmethod, iaxial, iperturb, ipoinpc, maxsectors, idefforc, ipompc, nodempc, nmpc, ikmpc, ilmpc, labmpc)
 

Function/Subroutine Documentation

◆ cloads()

subroutine cloads ( character*1, dimension(*)  inpc,
character*132, dimension(16)  textpart,
character*81, dimension(*)  set,
integer, dimension(*)  istartset,
integer, dimension(*)  iendset,
integer, dimension(*)  ialset,
integer  nset,
integer, dimension(2,*)  nodeforc,
integer, dimension(*)  ndirforc,
real*8, dimension(*)  xforc,
integer  nforc,
integer  nforc_,
integer, dimension(*)  iamforc,
character*80, dimension(*)  amname,
integer  nam,
integer  ntrans,
real*8, dimension(7,*)  trab,
integer, dimension(2,*)  inotr,
real*8, dimension(3,*)  co,
integer, dimension(*)  ikforc,
integer, dimension(*)  ilforc,
integer  nk,
logical  cload_flag,
integer  istep,
integer  istat,
integer  n,
integer  iline,
integer  ipol,
integer  inl,
integer, dimension(2,*)  ipoinp,
integer, dimension(3,*)  inp,
integer  nam_,
integer  namtot_,
integer, dimension(3,*)  namta,
real*8, dimension(2,*)  amta,
integer  nmethod,
integer  iaxial,
integer  iperturb,
integer, dimension(0:*)  ipoinpc,
integer  maxsectors,
integer, dimension(*)  idefforc,
integer, dimension(*)  ipompc,
integer, dimension(3,*)  nodempc,
integer  nmpc,
integer, dimension(*)  ikmpc,
integer, dimension(*)  ilmpc,
character*20, dimension(*)  labmpc 
)
26 !
27 ! reading the input deck: *CLOADS
28 !
29  implicit none
30 !
31  logical cload_flag,add,user,submodel,green
32 !
33  character*1 inpc(*)
34  character*20 labmpc(*)
35  character*80 amplitude,amname(*)
36  character*81 set(*),noset
37  character*132 textpart(16)
38 !
39  integer istartset(*),iendset(*),ialset(*),nodeforc(2,*),
40  & nset,nforc,nforc_,istep,istat,n,i,j,k,l,iforcdir,key,
41  & iamforc(*),nam,iamplitude,ntrans,inotr(2,*),ipos,ikforc(*),
42  & ilforc(*),nk,iline,ipol,inl,ipoinp(2,*),inp(3,*),nam_,namtot,
43  & namtot_,namta(3,*),idelay,lc,nmethod,ndirforc(*),isector,
44  & iperturb,iaxial,ipoinpc(0:*),maxsectors,jsector,idefforc(*),
45  & iglobstep,ipompc(*),nodempc(3,*),nmpc,ikmpc(*),ilmpc(*)
46 !
47  real*8 xforc(*),forcval,co(3,*),trab(7,*),amta(2,*),omega0
48 !
49  iamplitude=0
50  idelay=0
51  lc=1
52  isector=0
53  user=.false.
54  add=.false.
55  iglobstep=0
56  submodel=.false.
57  green=.false.
58 !
59  if(istep.lt.1) then
60  write(*,*) '*ERROR in cloads: *CLOAD should only be used'
61  write(*,*) ' within a STEP'
62  call exit(201)
63  endif
64 !
65  do i=2,n
66  if((textpart(i)(1:6).eq.'OP=NEW').and.(.not.cload_flag)) then
67  do j=1,nforc
68  xforc(j)=0.d0
69  enddo
70  elseif(textpart(i)(1:10).eq.'AMPLITUDE=') then
71  read(textpart(i)(11:90),'(a80)') amplitude
72  do j=1,nam
73  if(amname(j).eq.amplitude) then
74  iamplitude=j
75  exit
76  endif
77  enddo
78  if(j.gt.nam) then
79  write(*,*)'*ERROR in cloads: nonexistent amplitude'
80  write(*,*) ' '
81  call inputerror(inpc,ipoinpc,iline,
82  &"*CLOAD%")
83  call exit(201)
84  endif
85  iamplitude=j
86  elseif(textpart(i)(1:10).eq.'TIMEDELAY=') THEN
87  if(idelay.ne.0) then
88  write(*,*) '*ERROR in cloads: the parameter TIME DELAY'
89  write(*,*) ' is used twice in the same keyword'
90  write(*,*) ' '
91  call inputerror(inpc,ipoinpc,iline,
92  &"*CLOAD%")
93  call exit(201)
94  else
95  idelay=1
96  endif
97  nam=nam+1
98  if(nam.gt.nam_) then
99  write(*,*) '*ERROR in cloads: increase nam_'
100  call exit(201)
101  endif
102  amname(nam)='
103  & '
104  if(iamplitude.eq.0) then
105  write(*,*) '*ERROR in cloads: time delay must be'
106  write(*,*) ' preceded by the amplitude parameter'
107  call exit(201)
108  endif
109  namta(3,nam)=sign(iamplitude,namta(3,iamplitude))
110  iamplitude=nam
111  if(nam.eq.1) then
112  namtot=0
113  else
114  namtot=namta(2,nam-1)
115  endif
116  namtot=namtot+1
117  if(namtot.gt.namtot_) then
118  write(*,*) '*ERROR cloads: increase namtot_'
119  call exit(201)
120  endif
121  namta(1,nam)=namtot
122  namta(2,nam)=namtot
123  read(textpart(i)(11:30),'(f20.0)',iostat=istat)
124  & amta(1,namtot)
125  if(istat.gt.0) call inputerror(inpc,ipoinpc,iline,
126  &"*CLOAD%")
127  elseif(textpart(i)(1:9).eq.'LOADCASE=') then
128  read(textpart(i)(10:19),'(i10)',iostat=istat) lc
129  if(istat.gt.0) call inputerror(inpc,ipoinpc,iline,
130  &"*CLOAD%")
131  if(nmethod.ne.5) then
132  write(*,*) '*ERROR in cloads: the parameter LOAD CASE'
133  write(*,*) ' is only allowed in STEADY STATE'
134  write(*,*) ' DYNAMICS calculations'
135  call exit(201)
136  endif
137  elseif(textpart(i)(1:7).eq.'SECTOR=') then
138  read(textpart(i)(8:17),'(i10)',iostat=istat) isector
139  if(istat.gt.0) call inputerror(inpc,ipoinpc,iline,
140  &"*CLOAD%")
141  if((nmethod.le.3).or.(iperturb.gt.1)) then
142  write(*,*) '*ERROR in cloads: the parameter SECTOR'
143  write(*,*) ' is only allowed in MODAL DYNAMICS or'
144  write(*,*) ' STEADY STATE DYNAMICS calculations'
145  call exit(201)
146  endif
147  if(isector.gt.maxsectors) then
148  write(*,*) '*ERROR in cloads: sector ',isector
149  write(*,*) ' exceeds number of sectors'
150  call exit(201)
151  endif
152  isector=isector-1
153  elseif(textpart(i)(1:4).eq.'USER') then
154  user=.true.
155  elseif(textpart(i)(1:8).eq.'SUBMODEL') then
156  submodel=.true.
157  elseif(textpart(i)(1:5).eq.'STEP=') then
158  read(textpart(i)(6:15),'(i10)',iostat=istat) iglobstep
159  if(istat.gt.0) call inputerror(inpc,ipoinpc,iline,
160  &"*CLOAD%")
161  elseif(textpart(i)(1:7).eq.'OMEGA0=') then
162  green=.true.
163  read(textpart(i)(8:27),'(f20.0)',iostat=istat) omega0
164  if(istat.gt.0) call inputerror(inpc,ipoinpc,iline,
165  &"*CLOAD%")
166  omega0=omega0**2
167  else
168  write(*,*)
169  & '*WARNING in cloads: parameter not recognized:'
170  write(*,*) ' ',
171  & textpart(i)(1:index(textpart(i),' ')-1)
172  call inputwarning(inpc,ipoinpc,iline,
173  &"*CLOAD%")
174  endif
175  enddo
176 !
177 ! check whether global step was specified for submodel
178 !
179  if((submodel).and.(iglobstep.eq.0)) then
180  write(*,*) '*ERROR reading *CLOAD: no global step'
181  write(*,*) ' step specified for the submodel'
182  call inputerror(inpc,ipoinpc,iline,
183  &"*CLOAD%")
184  endif
185 !
186 ! storing the step for submodels in iamboun
187 !
188  if(submodel) then
189  if(iamplitude.ne.0) then
190  write(*,*) '*WARNING reading *CLOAD:'
191  write(*,*) ' no amplitude definition is allowed'
192  write(*,*) ' in combination with a submodel'
193  endif
194  iamplitude=iglobstep
195  endif
196 !
197  if(user.and.(iamplitude.ne.0)) then
198  write(*,*) '*WARNING: no amplitude definition is allowed'
199  write(*,*) ' for concentrated loads defined by a'
200  write(*,*) ' user routine'
201  iamplitude=0
202  endif
203 !
204  do
205  call getnewline(inpc,textpart,istat,n,key,iline,ipol,inl,
206  & ipoinp,inp,ipoinpc)
207  if((istat.lt.0).or.(key.eq.1)) return
208 !
209  read(textpart(2)(1:10),'(i10)',iostat=istat) iforcdir
210  if(istat.gt.0) call inputerror(inpc,ipoinpc,iline,
211  &"*CLOAD%")
212  if((iforcdir.lt.1).or.(iforcdir.gt.6)) then
213  write(*,*) '*ERROR in cloads: nonexistent degree of freedom'
214  write(*,*) ' '
215  call inputerror(inpc,ipoinpc,iline,
216  &"*CLOAD%")
217  call exit(201)
218  endif
219 c if(iforcdir.gt.3) iforcdir=iforcdir+1
220 !
221 ! for Green function applications the value of omega_0^2 is stored as
222 ! force value
223 !
224  if(green) then
225  forcval=omega0
226  elseif(textpart(3)(1:1).eq.' ') then
227  forcval=0.d0
228  else
229  read(textpart(3)(1:20),'(f20.0)',iostat=istat) forcval
230  if(istat.gt.0) call inputerror(inpc,ipoinpc,iline,
231  &"*CLOAD%")
232  if(iaxial.eq.180) forcval=forcval/iaxial
233  endif
234 !
235 ! dummy flux consisting of the first primes
236 !
237  if(user) forcval=1.2357111317d0
238  if(submodel) forcval=1.9232931374d0
239 !
240  read(textpart(1)(1:10),'(i10)',iostat=istat) l
241  if(istat.eq.0) then
242  if(l.gt.nk) then
243  write(*,*) '*ERROR in cloads: node ',l
244  write(*,*) ' is not defined'
245  call exit(201)
246  endif
247  if(submodel) then
248  if(ntrans.gt.0) then
249  if(inotr(1,l).gt.0) then
250  write(*,*) '*ERROR reading *CLOAD: in submodel'
251  write(*,*) ' node',l,' a local coordinate'
252  write(*,*) ' system was defined. This is not'
253  write(*,*) ' allowed'
254  call exit(201)
255  endif
256  endif
257  endif
258  if(lc.ne.1) then
259  jsector=isector+maxsectors
260  else
261  jsector=isector
262  endif
263  call forcadd(l,iforcdir,forcval,nodeforc,ndirforc,xforc,
264  & nforc,nforc_,iamforc,iamplitude,nam,ntrans,trab,inotr,co,
265  & ikforc,ilforc,jsector,add,user,idefforc,ipompc,nodempc,
266  & nmpc,ikmpc,ilmpc,labmpc)
267  else
268  read(textpart(1)(1:80),'(a80)',iostat=istat) noset
269  noset(81:81)=' '
270  ipos=index(noset,' ')
271  noset(ipos:ipos)='N'
272  do i=1,nset
273  if(set(i).eq.noset) exit
274  enddo
275  if(i.gt.nset) then
276  noset(ipos:ipos)=' '
277  write(*,*) '*ERROR in cloads: node set ',noset
278  write(*,*) ' has not yet been defined. '
279  call inputerror(inpc,ipoinpc,iline,
280  &"*CLOAD%")
281  call exit(201)
282  endif
283  do j=istartset(i),iendset(i)
284  if(ialset(j).gt.0) then
285  k=ialset(j)
286  if(submodel) then
287  if(ntrans.gt.0) then
288  if(inotr(1,k).gt.0) then
289  write(*,*)
290  & '*ERROR reading *CLOAD: in submodel'
291  write(*,*) ' node',k,
292  & ' a local coordinate'
293  write(*,*)
294  & ' system was defined. This is not'
295  write(*,*) ' allowed'
296  call exit(201)
297  endif
298  endif
299  endif
300  if(lc.ne.1) then
301  jsector=isector+maxsectors
302  else
303  jsector=isector
304  endif
305  call forcadd(k,iforcdir,forcval,
306  & nodeforc,ndirforc,xforc,nforc,nforc_,iamforc,
307  & iamplitude,nam,ntrans,trab,inotr,co,ikforc,ilforc,
308  & jsector,add,user,idefforc,ipompc,nodempc,
309  & nmpc,ikmpc,ilmpc,labmpc)
310  else
311  k=ialset(j-2)
312  do
313  k=k-ialset(j)
314  if(k.ge.ialset(j-1)) exit
315  if(submodel) then
316  if(ntrans.gt.0) then
317  if(inotr(1,k).gt.0) then
318  write(*,*)
319  & '*ERROR reading *CLOAD: in submodel'
320  write(*,*) ' node',k,
321  & ' a local coordinate'
322  write(*,*)
323  & ' system was defined. This is not'
324  write(*,*) ' allowed'
325  call exit(201)
326  endif
327  endif
328  endif
329  if(lc.ne.1) then
330  jsector=isector+maxsectors
331  else
332  jsector=isector
333  endif
334  call forcadd(k,iforcdir,forcval,
335  & nodeforc,ndirforc,xforc,nforc,nforc_,
336  & iamforc,iamplitude,nam,ntrans,trab,inotr,co,
337  & ikforc,ilforc,jsector,add,user,idefforc,
338  & ipompc,nodempc,nmpc,ikmpc,ilmpc,labmpc)
339  enddo
340  endif
341  enddo
342  endif
343  enddo
344 !
345  return
inputwarning
subroutine inputwarning(inpc, ipoinpc, iline, text)
Definition: inputwarning.f:20
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
forcadd
subroutine forcadd(node, i, val, nodeforc, ndirforc, xforc, nforc, nforc_, iamforc, iamplitude, nam, ntrans, trab, inotr, co, ikforc, ilforc, isector, add, user, idefforc, ipompc, nodempc, nmpc, ikmpc, ilmpc, labmpc)
Definition: forcadd.f:23
Hosted by OpenAircraft.com, (Michigan UAV, LLC)