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

Go to the source code of this file.

Functions/Subroutines

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

Function/Subroutine Documentation

◆ cfluxs()

subroutine cfluxs ( 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  cflux_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  iaxial,
integer, dimension(0:*)  ipoinpc,
integer, dimension(*)  idefforc,
integer, dimension(*)  ipompc,
integer, dimension(3,*)  nodempc,
integer  nmpc,
integer, dimension(*)  ikmpc,
integer, dimension(*)  ilmpc,
character*20, dimension(*)  labmpc 
)
25 !
26 ! reading the input deck: *CFLUX
27 !
28  implicit none
29 !
30  logical cflux_flag,user,add
31 !
32  character*1 inpc(*)
33  character*20 labmpc(*)
34  character*80 amplitude,amname(*)
35  character*81 set(*),noset
36  character*132 textpart(16)
37 !
38  integer istartset(*),iendset(*),ialset(*),nodeforc(2,*),
39  & nset,nforc,nforc_,istep,istat,n,i,j,k,l,iforcdir,key,
40  & iamforc(*),nam,iamplitude,ntrans,inotr(2,*),ipos,ikforc(*),
41  & ilforc(*),nk,iline,ipol,inl,ipoinp(2,*),inp(3,*),nam_,namtot,
42  & namtot_,namta(3,*),idelay,ndirforc(*),isector,iaxial,
43  & ipoinpc(0:*),idefforc(*),ipompc(*),
44  & nodempc(3,*),nmpc,ikmpc(*),ilmpc(*)
45 !
46  real*8 xforc(*),forcval,co(3,*),trab(7,*),amta(2,*)
47 !
48  iamplitude=0
49  idelay=0
50  user=.false.
51  add=.false.
52  isector=0
53 !
54  if(istep.lt.1) then
55  write(*,*) '*ERROR in cfluxes: *CFLUX should only be used'
56  write(*,*) ' within a STEP'
57  call exit(201)
58  endif
59 !
60  do i=2,n
61  if((textpart(i)(1:6).eq.'OP=NEW').and.(.not.cflux_flag)) then
62  do j=1,nforc
63  if(ndirforc(j).eq.0) xforc(j)=0.d0
64  enddo
65  elseif(textpart(i)(1:10).eq.'AMPLITUDE=') then
66  read(textpart(i)(11:90),'(a80)') amplitude
67  do j=nam,1,-1
68  if(amname(j).eq.amplitude) then
69  iamplitude=j
70  exit
71  endif
72  enddo
73  if(j.eq.0) then
74  write(*,*)'*ERROR in cfluxes: nonexistent amplitude'
75  write(*,*) ' '
76  call inputerror(inpc,ipoinpc,iline,
77  &"*CFLUX%")
78  call exit(201)
79  endif
80  iamplitude=j
81  elseif(textpart(i)(1:10).eq.'TIMEDELAY=') THEN
82  if(idelay.ne.0) then
83  write(*,*) '*ERROR in cfluxes: the parameter TIME DELAY'
84  write(*,*) ' is used twice in the same keyword'
85  write(*,*) ' '
86  call inputerror(inpc,ipoinpc,iline,
87  &"*CFLUX%")
88  call exit(201)
89  else
90  idelay=1
91  endif
92  nam=nam+1
93  if(nam.gt.nam_) then
94  write(*,*) '*ERROR in cfluxes: increase nam_'
95  call exit(201)
96  endif
97  amname(nam)='
98  & '
99  if(iamplitude.eq.0) then
100  write(*,*) '*ERROR in cfluxes: time delay must be'
101  write(*,*) ' preceded by the amplitude parameter'
102  call exit(201)
103  endif
104  namta(3,nam)=sign(iamplitude,namta(3,iamplitude))
105  iamplitude=nam
106  if(nam.eq.1) then
107  namtot=0
108  else
109  namtot=namta(2,nam-1)
110  endif
111  namtot=namtot+1
112  if(namtot.gt.namtot_) then
113  write(*,*) '*ERROR cfluxes: increase namtot_'
114  call exit(201)
115  endif
116  namta(1,nam)=namtot
117  namta(2,nam)=namtot
118  read(textpart(i)(11:30),'(f20.0)',iostat=istat)
119  & amta(1,namtot)
120  if(istat.gt.0) call inputerror(inpc,ipoinpc,iline,
121  &"*CFLUX%")
122  elseif(textpart(i)(1:4).eq.'USER') then
123  user=.true.
124  elseif(textpart(i)(1:3).eq.'ADD') then
125  add=.true.
126  else
127  write(*,*)
128  & '*WARNING in cfluxes: parameter not recognized:'
129  write(*,*) ' ',
130  & textpart(i)(1:index(textpart(i),' ')-1)
131  call inputwarning(inpc,ipoinpc,iline,
132  &"*CFLUX%")
133  endif
134  enddo
135 !
136  if(user.and.(iamplitude.ne.0)) then
137  write(*,*) '*WARNING: no amplitude definition is allowed'
138  write(*,*) ' for heat fluxes defined by a'
139  write(*,*) ' user routine'
140  iamplitude=0
141  endif
142 !
143  do
144  call getnewline(inpc,textpart,istat,n,key,iline,ipol,inl,
145  & ipoinp,inp,ipoinpc)
146  if((istat.lt.0).or.(key.eq.1)) return
147 !
148  read(textpart(2)(1:10),'(i10)',iostat=istat) iforcdir
149  if(istat.gt.0) call inputerror(inpc,ipoinpc,iline,
150  &"*CFLUX%")
151  if((iforcdir.ne.0).and.(iforcdir.ne.11)) then
152  write(*,*) '*ERROR in cfluxes: nonexistent degree of '
153  write(*,*) ' freedom. '
154  call inputerror(inpc,ipoinpc,iline,
155  &"*CFLUX%")
156  call exit(201)
157  endif
158  iforcdir=0
159 !
160  if(textpart(3)(1:1).eq.' ') then
161  forcval=0.d0
162  else
163  read(textpart(3)(1:20),'(f20.0)',iostat=istat) forcval
164  if(istat.gt.0) call inputerror(inpc,ipoinpc,iline,
165  &"*CFLUX%")
166  if(iaxial.eq.180) forcval=forcval/iaxial
167  endif
168 !
169 ! dummy flux consisting of the first primes
170 !
171  if(user) forcval=1.2357111317d0
172 !
173  read(textpart(1)(1:10),'(i10)',iostat=istat) l
174  if(istat.eq.0) then
175  if(l.gt.nk) then
176  write(*,*) '*ERROR in cfluxes: node ',l
177  write(*,*) ' is not defined'
178  call exit(201)
179  endif
180  call forcadd(l,iforcdir,forcval,
181  & nodeforc,ndirforc,xforc,nforc,nforc_,iamforc,
182  & iamplitude,nam,ntrans,trab,inotr,co,ikforc,ilforc,
183  & isector,add,user,idefforc,ipompc,nodempc,
184  & nmpc,ikmpc,ilmpc,labmpc)
185  else
186  read(textpart(1)(1:80),'(a80)',iostat=istat) noset
187  noset(81:81)=' '
188  ipos=index(noset,' ')
189  noset(ipos:ipos)='N'
190  do i=1,nset
191  if(set(i).eq.noset) exit
192  enddo
193  if(i.gt.nset) then
194  noset(ipos:ipos)=' '
195  write(*,*) '*ERROR in cfluxes: node set ',noset
196  write(*,*) ' has not yet been defined. '
197  call inputerror(inpc,ipoinpc,iline,
198  &"*CFLUX%")
199  call exit(201)
200  endif
201  do j=istartset(i),iendset(i)
202  if(ialset(j).gt.0) then
203  call forcadd(ialset(j),iforcdir,forcval,
204  & nodeforc,ndirforc,xforc,nforc,nforc_,iamforc,
205  & iamplitude,nam,ntrans,trab,inotr,co,ikforc,ilforc,
206  & isector,add,user,idefforc,ipompc,nodempc,
207  & nmpc,ikmpc,ilmpc,labmpc)
208  else
209  k=ialset(j-2)
210  do
211  k=k-ialset(j)
212  if(k.ge.ialset(j-1)) exit
213  call forcadd(k,iforcdir,forcval,
214  & nodeforc,ndirforc,xforc,nforc,nforc_,
215  & iamforc,iamplitude,nam,ntrans,trab,inotr,co,
216  & ikforc,ilforc,isector,add,user,idefforc,
217  & ipompc,nodempc,nmpc,ikmpc,ilmpc,labmpc)
218  enddo
219  endif
220  enddo
221  endif
222  enddo
223 !
224  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)