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

Go to the source code of this file.

Functions/Subroutines

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

Function/Subroutine Documentation

◆ dfluxs()

subroutine dfluxs ( 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  dflux_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,
integer, dimension(*)  idefload 
)
24 !
25 ! reading the input deck: *DFLUX
26 !
27  implicit none
28 !
29  logical dflux_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,j,l,
40  & key,idefload(*),
41  & iamload(2,*),nam,iamplitude,ipos,ne,iline,ipol,inl,ipoinp(2,*),
42  & inp(3,*),nam_,namtot,namtot_,namta(3,*),idelay,isector,
43  & ipoinpc(0:*)
44 !
45  real*8 xload(2,*),xmagnitude,amta(2,*)
46 !
47  iamplitude=0
48  idelay=0
49  isector=0
50  surface=.false.
51 !
52  if(istep.lt.1) then
53  write(*,*) '*ERROR in dfluxes: *DFLUX should only be used'
54  write(*,*) ' within a STEP'
55  call exit(201)
56  endif
57 !
58  do i=2,n
59  if((textpart(i)(1:6).eq.'OP=NEW').and.(.not.dflux_flag)) then
60  do j=1,nload
61  if((sideload(j)(1:1).eq.'S').or.
62  & (sideload(j)(1:2).eq.'BF')) 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  iamplitude=j
71  exit
72  endif
73  enddo
74  if(j.eq.0) then
75  write(*,*)'*ERROR in dfluxes: nonexistent amplitude'
76  write(*,*) ' '
77  call inputerror(inpc,ipoinpc,iline,
78  &"*DFLUX%")
79  call exit(201)
80  endif
81  iamplitude=j
82  elseif(textpart(i)(1:10).eq.'TIMEDELAY=') THEN
83  if(idelay.ne.0) then
84  write(*,*) '*ERROR in dfluxes: the parameter TIME DELAY'
85  write(*,*) ' is used twice in the same keyword'
86  write(*,*) ' '
87  call inputerror(inpc,ipoinpc,iline,
88  &"*DFLUX%")
89  call exit(201)
90  else
91  idelay=1
92  endif
93  nam=nam+1
94  if(nam.gt.nam_) then
95  write(*,*) '*ERROR in dfluxes: increase nam_'
96  call exit(201)
97  endif
98  amname(nam)='
99  & '
100  if(iamplitude.eq.0) then
101  write(*,*) '*ERROR in dfluxes: time delay must be'
102  write(*,*) ' preceded by the amplitude parameter'
103  call exit(201)
104  endif
105  namta(3,nam)=sign(iamplitude,namta(3,iamplitude))
106  iamplitude=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 dfluxes: 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  &"*DFLUX%")
123  else
124  write(*,*)
125  & '*WARNING in dfluxes: parameter not recognized:'
126  write(*,*) ' ',
127  & textpart(i)(1:index(textpart(i),' ')-1)
128  call inputwarning(inpc,ipoinpc,iline,
129  &"*DFLUX%")
130  endif
131  enddo
132 !
133  do
134  call getnewline(inpc,textpart,istat,n,key,iline,ipol,inl,
135  & ipoinp,inp,ipoinpc)
136  if((istat.lt.0).or.(key.eq.1)) return
137 !
138  read(textpart(2)(1:20),'(a20)',iostat=istat) label
139 !
140 ! compatibility with ABAQUS for shells
141 !
142  if(label(2:4).eq.'NEG') label(2:4)='1 '
143  if(label(2:4).eq.'POS') label(2:4)='2 '
144  if(label(2:2).eq.'N') label(2:2)='5'
145  if(label(2:2).eq.'P') label(2:2)='6'
146 !
147  read(textpart(3)(1:20),'(f20.0)',iostat=istat) xmagnitude
148 !
149  if(istat.gt.0) call inputerror(inpc,ipoinpc,iline,
150  &"*DFLUX%")
151  if(((label(1:2).ne.'S1').and.(label(1:2).ne.'S2').and.
152  & (label(1:2).ne.'S0').and.
153  & (label(1:2).ne.'S3').and.(label(1:2).ne.'S4').and.
154  & (label(1:2).ne.'S5').and.(label(1:2).ne.'S6').and.
155  & (label(1:2).ne.'BF').and.(label(1:2).ne.'S ')).or.
156  & ((label(3:4).ne.' ').and.(label(3:4).ne.'NU'))) then
157  call inputerror(inpc,ipoinpc,iline,
158  &"*DFLUX%")
159  endif
160 !
161  read(textpart(1)(1:10),'(i10)',iostat=istat) l
162  if(istat.eq.0) then
163  if(l.gt.ne) then
164  write(*,*) '*ERROR in dfluxes: element ',l
165  write(*,*) ' is not defined'
166  call exit(201)
167  endif
168 !
169  if((lakon(l)(1:2).eq.'CP').or.
170  & (lakon(l)(2:2).eq.'A').or.
171  & (lakon(l)(7:7).eq.'E').or.
172  & (lakon(l)(7:7).eq.'S').or.
173  & (lakon(l)(7:7).eq.'A')) then
174  if(label(1:2).eq.'S1') then
175  label(1:2)='S3'
176  elseif(label(1:2).eq.'S2') then
177  label(1:2)='S4'
178  elseif(label(1:2).eq.'S3') then
179  label(1:2)='S5'
180  elseif(label(1:2).eq.'S4') then
181  label(1:2)='S6'
182  elseif(label(1:2).eq.'S5') then
183  label(1:2)='S1'
184  elseif(label(1:2).eq.'S6') then
185  label(1:2)='S2'
186  endif
187  elseif((lakon(l)(1:1).eq.'B').or.
188  & (lakon(l)(7:7).eq.'B')) then
189  elseif((lakon(l)(1:1).eq.'S').or.
190  & (lakon(l)(7:7).eq.'L')) then
191  endif
192  call loadadd(l,label,xmagnitude,nelemload,sideload,
193  & xload,nload,nload_,iamload,iamplitude,
194  & nam,isector,idefload)
195  else
196  read(textpart(1)(1:80),'(a80)',iostat=istat) elset
197  elset(81:81)=' '
198  ipos=index(elset,' ')
199  elset(ipos:ipos)='E'
200  do i=1,nset
201  if(set(i).eq.elset) exit
202  enddo
203  if(i.gt.nset) then
204 !
205 ! check for facial surface
206 !
207  surface=.true.
208  elset(ipos:ipos)='T'
209  do i=1,nset
210  if(set(i).eq.elset) exit
211  enddo
212  if(i.gt.nset) then
213  elset(ipos:ipos)=' '
214  write(*,*) '*ERROR in dfluxes: element set '
215  write(*,*) ' or facial surface ',elset
216  write(*,*) ' has not yet been defined. '
217  call inputerror(inpc,ipoinpc,iline,
218  & "*DFLUX%")
219  call exit(201)
220  endif
221  endif
222 !
223  l=ialset(istartset(i))
224  if(surface) then
225  write(label(2:2),'(i1)') l-10*(l/10)
226  l=l/10
227  endif
228  if((lakon(l)(1:2).eq.'CP').or.
229  & (lakon(l)(2:2).eq.'A').or.
230  & (lakon(l)(7:7).eq.'E').or.
231  & (lakon(l)(7:7).eq.'S').or.
232  & (lakon(l)(7:7).eq.'A')) then
233  if(label(1:2).eq.'S1') then
234  label(1:2)='S3'
235  elseif(label(1:2).eq.'S2') then
236  label(1:2)='S4'
237  elseif(label(1:2).eq.'S3') then
238  label(1:2)='S5'
239  elseif(label(1:2).eq.'S4') then
240  label(1:2)='S6'
241  endif
242  elseif((lakon(l)(1:1).eq.'B').or.
243  & (lakon(l)(7:7).eq.'B')) then
244  if(label(1:2).eq.'S2') label(1:2)='S5'
245  elseif((lakon(l)(1:1).eq.'S').or.
246  & (lakon(l)(7:7).eq.'L')) then
247  label(1:2)='S1'
248  endif
249 !
250  do j=istartset(i),iendset(i)
251  if(ialset(j).gt.0) then
252  l=ialset(j)
253  if(surface) then
254  write(label(2:2),'(i1)') l-10*(l/10)
255  l=l/10
256  endif
257  call loadadd(l,label,xmagnitude,nelemload,sideload,
258  & xload,nload,nload_,iamload,iamplitude,
259  & nam,isector,idefload)
260  else
261  l=ialset(j-2)
262  do
263  l=l-ialset(j)
264  if(l.ge.ialset(j-1)) exit
265  call loadadd(l,label,xmagnitude,nelemload,
266  & sideload,xload,nload,nload_,
267  & iamload,iamplitude,nam,isector,idefload)
268  enddo
269  endif
270  enddo
271  endif
272  enddo
273 !
274  return
inputwarning
subroutine inputwarning(inpc, ipoinpc, iline, text)
Definition: inputwarning.f:20
loadadd
subroutine loadadd(nelement, label, value, nelemload, sideload, xload, nload, nload_, iamload, iamplitude, nam, isector, idefload)
Definition: loadadd.f:21
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)