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

Go to the source code of this file.

Functions/Subroutines

subroutine films (inpc, textpart, set, istartset, iendset, ialset, nset, nelemload, sideload, xload, nload, nload_, ielmat, ntmat_, iamload, amname, nam, lakon, ne, flow_flag, istep, istat, n, iline, ipol, inl, ipoinp, inp, nam_, namtot_, namta, amta, ipoinpc, mi)
 

Function/Subroutine Documentation

◆ films()

subroutine films ( 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,*)  nelemload,
character*20, dimension(*)  sideload,
real*8, dimension(2,*)  xload,
integer  nload,
integer  nload_,
integer, dimension(mi(3),*)  ielmat,
integer  ntmat_,
integer, dimension(2,*)  iamload,
character*80, dimension(*)  amname,
integer  nam,
character*8, dimension(*)  lakon,
integer  ne,
logical  flow_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, dimension(0:*)  ipoinpc,
integer, dimension(*)  mi 
)
24 !
25 ! reading the input deck: *FILM
26 !
27  implicit none
28 !
29  logical flow_flag,surface
30 !
31  character*1 inpc(*)
32  character*8 lakon(*)
33  character*20 sideload(*),label
34  character*80 amname(*),amplitude
35  character*81 set(*),elset
36  character*132 textpart(16)
37 !
38  integer istartset(*),iendset(*),ialset(*),nelemload(2,*),mi(*),
39  & ielmat(mi(3),*),nset,nload,nload_,ntmat_,istep,istat,n,i,
40  & j,l,key,iload,
41  & iamload(2,*),nam,iamptemp,ipos,ne,node,iampfilm,iline,ipol,inl,
42  & ipoinp(2,*),inp(3,*),nam_,namtot,namtot_,namta(3,*),idelay1,
43  & idelay2,ipoinpc(0:*)
44 !
45  real*8 xload(2,*),xmagfilm,xmagtemp,amta(2,*)
46 !
47  iamptemp=0
48  iampfilm=0
49  idelay1=0
50  idelay2=0
51  surface=.false.
52 !
53  if(istep.lt.1) then
54  write(*,*) '*ERROR in films: *FILM should only be used'
55  write(*,*) ' within a STEP'
56  call exit(201)
57  endif
58 !
59  do i=2,n
60  if((textpart(i)(1:6).eq.'OP=NEW').and.(.not.flow_flag)) then
61  do j=1,nload
62  if(sideload(j)(1:1).eq.'F') then
63  xload(1,j)=0.d0
64  endif
65  enddo
66  elseif(textpart(i)(1:10).eq.'AMPLITUDE=') then
67  read(textpart(i)(11:90),'(a80)') amplitude
68  do j=nam,1,-1
69  if(amname(j).eq.amplitude) then
70  iamptemp=j
71  exit
72  endif
73  enddo
74  if(j.eq.0) then
75  write(*,*)'*ERROR in films: nonexistent amplitude'
76  write(*,*) ' '
77  call inputerror(inpc,ipoinpc,iline,
78  &"*FILM%")
79  call exit(201)
80  endif
81  iamptemp=j
82  elseif(textpart(i)(1:10).eq.'TIMEDELAY=') THEN
83  if(idelay1.ne.0) then
84  write(*,*) '*ERROR in films: the parameter TIME DELAY'
85  write(*,*) ' is used twice in the same keyword'
86  write(*,*) ' '
87  call inputerror(inpc,ipoinpc,iline,
88  &"*FILM%")
89  call exit(201)
90  else
91  idelay1=1
92  endif
93  nam=nam+1
94  if(nam.gt.nam_) then
95  write(*,*) '*ERROR in films: increase nam_'
96  call exit(201)
97  endif
98  amname(nam)='
99  & '
100  if(iamptemp.eq.0) then
101  write(*,*) '*ERROR in films: time delay must be'
102  write(*,*) ' preceded by the amplitude parameter'
103  call exit(201)
104  endif
105  namta(3,nam)=sign(iamptemp,namta(3,iamptemp))
106  iamptemp=nam
107  if(nam.eq.1) then
108  namtot=0
109  else
110  namtot=namta(2,nam-1)
111  endif
112  namtot=namtot+1
113  if(namtot.gt.namtot_) then
114  write(*,*) '*ERROR films: increase namtot_'
115  call exit(201)
116  endif
117  namta(1,nam)=namtot
118  namta(2,nam)=namtot
119  read(textpart(i)(11:30),'(f20.0)',iostat=istat)
120  & amta(1,namtot)
121  if(istat.gt.0) call inputerror(inpc,ipoinpc,iline,
122  &"*FILM%")
123  elseif(textpart(i)(1:14).eq.'FILMAMPLITUDE=') then
124  read(textpart(i)(15:94),'(a80)') amplitude
125  do j=nam,1,-1
126  if(amname(j).eq.amplitude) then
127  iampfilm=j
128  exit
129  endif
130  enddo
131  if(j.eq.0) then
132  write(*,*)'*ERROR in films: nonexistent amplitude'
133  write(*,*) ' '
134  call inputerror(inpc,ipoinpc,iline,
135  &"*FILM%")
136  call exit(201)
137  endif
138  iampfilm=j
139  elseif(textpart(i)(1:14).eq.'FILMTIMEDELAY=') THEN
140  if(idelay2.ne.0) then
141  write(*,*) '*ERROR in films: the parameter FILM TIME'
142  write(*,*) ' DELAY is used twice in the same'
143  write(*,*) ' keyword; '
144  call inputerror(inpc,ipoinpc,iline,
145  &"*FILM%")
146  call exit(201)
147  else
148  idelay2=1
149  endif
150  nam=nam+1
151  if(nam.gt.nam_) then
152  write(*,*) '*ERROR in films: increase nam_'
153  call exit(201)
154  endif
155  amname(nam)='
156  & '
157  if(iampfilm.eq.0) then
158  write(*,*) '*ERROR in films: film time delay must be'
159  write(*,*) ' preceded by the film amplitude'
160  write(*,*) ' parameter'
161  call exit(201)
162  endif
163  namta(3,nam)=sign(iampfilm,namta(3,iampfilm))
164  iampfilm=nam
165  if(nam.eq.1) then
166  namtot=0
167  else
168  namtot=namta(2,nam-1)
169  endif
170  namtot=namtot+1
171  if(namtot.gt.namtot_) then
172  write(*,*) '*ERROR films: increase namtot_'
173  call exit(201)
174  endif
175  namta(1,nam)=namtot
176  namta(2,nam)=namtot
177  read(textpart(i)(15:34),'(f20.0)',iostat=istat)
178  & amta(1,namtot)
179  if(istat.gt.0) call inputerror(inpc,ipoinpc,iline,
180  &"*FILM%")
181  else
182  write(*,*)
183  & '*WARNING in films: parameter not recognized:'
184  write(*,*) ' ',
185  & textpart(i)(1:index(textpart(i),' ')-1)
186  call inputwarning(inpc,ipoinpc,iline,
187  &"*FILM%")
188  endif
189  enddo
190 !
191  do
192  call getnewline(inpc,textpart,istat,n,key,iline,ipol,inl,
193  & ipoinp,inp,ipoinpc)
194  if((istat.lt.0).or.(key.eq.1)) return
195 !
196  read(textpart(2)(1:20),'(a20)',iostat=istat) label
197 !
198 ! compatibility with ABAQUS for shells
199 !
200  if(label(2:4).eq.'NEG') label(2:4)='1 '
201  if(label(2:4).eq.'POS') label(2:4)='2 '
202  if(label(2:2).eq.'N') label(2:2)='5'
203  if(label(2:2).eq.'P') label(2:2)='6'
204 !
205 ! reference temperature and film coefficient
206 ! (for non uniform loading: use user routine film.f)
207 !
208  if((label(3:4).ne.'NU').and.(label(3:4).ne.'FC')) then
209  read(textpart(3)(1:20),'(f20.0)',iostat=istat) xmagtemp
210  if(istat.gt.0) call inputerror(inpc,ipoinpc,iline,
211  &"*FILM%")
212  read(textpart(4)(1:20),'(f20.0)',iostat=istat) xmagfilm
213  if(istat.gt.0) call inputerror(inpc,ipoinpc,iline,
214  &"*FILM%")
215  node=0
216 !
217 ! for forced convection: reference node and, optionally,
218 ! a film coefficient (else use user routine film.f)
219 !
220  elseif(label(3:4).eq.'FC') then
221  read(textpart(3)(1:10),'(i10)',iostat=istat) node
222  if(istat.gt.0) call inputerror(inpc,ipoinpc,iline,
223  &"*FILM%")
224  xmagtemp=0.d0
225  read(textpart(4)(1:20),'(f20.0)',iostat=istat) xmagfilm
226  if(istat.gt.0) xmagfilm=-1.d0
227  endif
228  if(((label(1:2).ne.'F1').and.(label(1:2).ne.'F2').and.
229  & (label(1:2).ne.'F0').and.
230  & (label(1:2).ne.'F3').and.(label(1:2).ne.'F4').and.
231  & (label(1:2).ne.'F5').and.(label(1:2).ne.'F6')).or.
232  & ((label(3:4).ne.' ').and.(label(3:4).ne.'NU').and.
233  & (label(3:4).ne.'FC'))) then
234  call inputerror(inpc,ipoinpc,iline,
235  &"*FILM%")
236  endif
237 !
238  read(textpart(1)(1:10),'(i10)',iostat=istat) l
239  if(istat.eq.0) then
240  if(l.gt.ne) then
241  write(*,*) '*ERROR in films: element ',l
242  write(*,*) ' is not defined'
243  call exit(201)
244  endif
245 !
246  if((lakon(l)(1:2).eq.'CP').or.
247  & (lakon(l)(2:2).eq.'A').or.
248  & (lakon(l)(7:7).eq.'E').or.
249  & (lakon(l)(7:7).eq.'S').or.
250  & (lakon(l)(7:7).eq.'A')) then
251  if(label(1:2).eq.'F1') then
252  label(1:2)='F3'
253  elseif(label(1:2).eq.'F2') then
254  label(1:2)='F4'
255  elseif(label(1:2).eq.'F3') then
256  label(1:2)='F5'
257  elseif(label(1:2).eq.'F4') then
258  label(1:2)='F6'
259  elseif(label(1:2).eq.'F5') then
260  label(1:2)='F1'
261  elseif(label(1:2).eq.'F6') then
262  label(1:2)='F2'
263  endif
264  endif
265  call loadaddt(l,label,xmagfilm,xmagtemp,nelemload,sideload,
266  & xload,nload,nload_,iamload,
267  & iamptemp,iampfilm,nam,node,iload)
268  else
269  read(textpart(1)(1:80),'(a80)',iostat=istat) elset
270  elset(81:81)=' '
271  ipos=index(elset,' ')
272  elset(ipos:ipos)='E'
273  do i=1,nset
274  if(set(i).eq.elset) exit
275  enddo
276  if(i.gt.nset) then
277 !
278 ! check for facial surface
279 !
280  surface=.true.
281  elset(ipos:ipos)='T'
282  do i=1,nset
283  if(set(i).eq.elset) exit
284  enddo
285  if(i.gt.nset) then
286  elset(ipos:ipos)=' '
287  write(*,*) '*ERROR in films: element set '
288  write(*,*) ' or facial surface ',elset
289  write(*,*) ' has not yet been defined. '
290  call inputerror(inpc,ipoinpc,iline,
291  & "*FILM%")
292  call exit(201)
293  endif
294  endif
295 !
296  l=ialset(istartset(i))
297  if(surface) then
298  write(label(2:2),'(i1)') l-10*(l/10)
299  l=l/10
300  endif
301  if((lakon(l)(1:2).eq.'CP').or.
302  & (lakon(l)(2:2).eq.'A').or.
303  & (lakon(l)(7:7).eq.'E').or.
304  & (lakon(l)(7:7).eq.'S').or.
305  & (lakon(l)(7:7).eq.'A')) then
306  if(label(1:2).eq.'F1') then
307  label(1:2)='F3'
308  elseif(label(1:2).eq.'F2') then
309  label(1:2)='F4'
310  elseif(label(1:2).eq.'F3') then
311  label(1:2)='F5'
312  elseif(label(1:2).eq.'F4') then
313  label(1:2)='F6'
314  elseif(label(1:2).eq.'F5') then
315  label(1:2)='F1'
316  elseif(label(1:2).eq.'F6') then
317  label(1:2)='F2'
318  endif
319  endif
320 !
321  do j=istartset(i),iendset(i)
322  if(ialset(j).gt.0) then
323  l=ialset(j)
324  if(surface) then
325  write(label(2:2),'(i1)') l-10*(l/10)
326  l=l/10
327  endif
328  call loadaddt(l,label,xmagfilm,xmagtemp,nelemload,
329  & sideload,xload,nload,nload_,iamload,
330  & iamptemp,iampfilm,nam,node,iload)
331  else
332  l=ialset(j-2)
333  do
334  l=l-ialset(j)
335  if(l.ge.ialset(j-1)) exit
336  call loadaddt(l,label,xmagfilm,xmagtemp,nelemload,
337  & sideload,xload,nload,nload_,iamload,
338  & iamptemp,iampfilm,nam,node,iload)
339  enddo
340  endif
341  enddo
342  endif
343  enddo
344 !
345  return
inputwarning
subroutine inputwarning(inpc, ipoinpc, iline, text)
Definition: inputwarning.f:20
loadaddt
subroutine loadaddt(nelement, label, valfilm, valtemp, nelemload, sideload, xload, nload, nload_, iamload, iamptemp, iampfilm, nam, node, iload)
Definition: loadaddt.f:22
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)