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

Go to the source code of this file.

Functions/Subroutines

subroutine temperatures (inpc, textpart, set, istartset, iendset, ialset, nset, t0, t1, nk, ithermal, iamt1, amname, nam, inoelfree, nk_, nmethod, temp_flag, istep, istat, n, iline, ipol, inl, ipoinp, inp, nam_, namtot_, namta, amta, ipoinpc, t1g)
 

Function/Subroutine Documentation

◆ temperatures()

subroutine temperatures ( character*1, dimension(*)  inpc,
character*132, dimension(16)  textpart,
character*81, dimension(*)  set,
integer, dimension(*)  istartset,
integer, dimension(*)  iendset,
integer, dimension(*)  ialset,
integer  nset,
real*8, dimension(*)  t0,
real*8, dimension(*)  t1,
integer  nk,
integer  ithermal,
integer, dimension(*)  iamt1,
character*80, dimension(*)  amname,
integer  nam,
integer  inoelfree,
integer  nk_,
integer  nmethod,
logical  temp_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,
real*8, dimension(2,*)  t1g 
)
23 !
24 ! reading the input deck: *TEMPERATURE
25 !
26  implicit none
27 !
28  logical temp_flag,user,submodel
29 !
30  character*1 inpc(*)
31  character*80 amname(*),amplitude
32  character*81 set(*),noset
33  character*132 textpart(16)
34 !
35  integer istartset(*),iendset(*),ialset(*),iamt1(*),nmethod,
36  & nset,nk,ithermal,istep,istat,n,key,i,j,k,l,nam,ipoinpc(0:*),
37  & iamplitude,ipos,inoelfree,nk_,iline,ipol,inl,ipoinp(2,*),
38  & inp(3,*),nam_,namtot,namtot_,namta(3,*),idelay,iglobstep
39 !
40  real*8 t0(*),t1(*),temperature,tempgrad1,tempgrad2,amta(2,*),
41  & t1g(2,*)
42 !
43  iamplitude=0
44  idelay=0
45  user=.false.
46  iglobstep=0
47  submodel=.false.
48 !
49  if(nmethod.eq.3) then
50  write(*,*) '*ERROR reading *TEMPERATURE: temperature'
51  write(*,*) ' loading is not allowed in a linear'
52  write(*,*) ' buckling step; perform a static'
53  write(*,*) ' nonlinear calculation instead'
54  call exit(201)
55  endif
56 !
57  if(istep.lt.1) then
58  write(*,*) '*ERROR reading *TEMPERATURE: *TEMPERATURE'
59  write(*,*) ' should only be used within a STEP'
60  call exit(201)
61  endif
62 !
63  if(ithermal.ne.1) then
64  write(*,*) '*ERROR reading *TEMPERATURE: a *TEMPERATURE'
65  write(*,*) ' card is detected but no thermal'
66  write(*,*) ' *INITIAL CONDITIONS are given'
67  call exit(201)
68  endif
69 !
70  do i=2,n
71  if((textpart(i).eq.'OP=NEW').and.(.not.temp_flag)) then
72  do j=1,nk
73  t1(j)=t0(j)
74  enddo
75  elseif(textpart(i)(1:10).eq.'AMPLITUDE=') then
76  read(textpart(i)(11:90),'(a80)') amplitude
77  do j=nam,1,-1
78  if(amname(j).eq.amplitude) then
79  iamplitude=j
80  exit
81  endif
82  enddo
83  if(j.eq.0) then
84  write(*,*)
85  & '*ERROR reading *TEMPERATURE: nonexistent amplitude'
86  write(*,*) ' '
87  call inputerror(inpc,ipoinpc,iline,
88  &"*TEMPERATURE%")
89  call exit(201)
90  endif
91  iamplitude=j
92  elseif(textpart(i)(1:10).eq.'TIMEDELAY=') THEN
93  if(idelay.ne.0) then
94  write(*,*)
95  & '*ERROR reading *TEMPERATURE: the parameter TIME'
96  write(*,*) ' DELAY is used twice in the same'
97  write(*,*) ' keyword; '
98  call inputerror(inpc,ipoinpc,iline,
99  &"*TEMPERATURE%")
100  call exit(201)
101  else
102  idelay=1
103  endif
104  nam=nam+1
105  if(nam.gt.nam_) then
106  write(*,*) '*ERROR reading *TEMPERATURE: increase nam_'
107  call exit(201)
108  endif
109  amname(nam)='
110  & '
111  if(iamplitude.eq.0) then
112  write(*,*)
113  & '*ERROR reading *TEMPERATURE: time delay must be'
114  write(*,*) ' preceded by the amplitude parameter'
115  call exit(201)
116  endif
117  namta(3,nam)=sign(iamplitude,namta(3,iamplitude))
118  iamplitude=nam
119  if(nam.eq.1) then
120  namtot=0
121  else
122  namtot=namta(2,nam-1)
123  endif
124  namtot=namtot+1
125  if(namtot.gt.namtot_) then
126  write(*,*) '*ERROR temperatures: increase namtot_'
127  call exit(201)
128  endif
129  namta(1,nam)=namtot
130  namta(2,nam)=namtot
131  read(textpart(i)(11:30),'(f20.0)',iostat=istat)
132  & amta(1,namtot)
133  if(istat.gt.0) call inputerror(inpc,ipoinpc,iline,
134  &"*TEMPERATURE%")
135  elseif(textpart(i)(1:4).eq.'USER') then
136  user=.true.
137  elseif(textpart(i)(1:8).eq.'SUBMODEL') then
138  submodel=.true.
139  elseif(textpart(i)(1:5).eq.'STEP=') then
140  read(textpart(i)(6:15),'(i10)',iostat=istat) iglobstep
141  if(istat.gt.0) call inputerror(inpc,ipoinpc,iline,
142  &"*TEMPERATURE%")
143  else
144  write(*,*)
145  & '*WARNING reading *TEMPERATURE: parameter not recognized:'
146  write(*,*) ' ',
147  & textpart(i)(1:index(textpart(i),' ')-1)
148  call inputwarning(inpc,ipoinpc,iline,
149  &"*TEMPERATURE%")
150  endif
151  enddo
152 !
153 ! check whether global step was specified for submodel
154 !
155  if((submodel).and.(iglobstep.eq.0)) then
156  write(*,*) '*ERROR reading *TEMPERATURE: no global step'
157  write(*,*) ' step specified for the submodel'
158  call inputerror(inpc,ipoinpc,iline,
159  &"*TEMPERATURE%")
160  endif
161 !
162 ! storing the step for submodels in iamboun
163 !
164  if(submodel) then
165  if(iamplitude.ne.0) then
166  write(*,*) '*WARNING reading *TEMPERATURE:'
167  write(*,*) ' no amplitude definition is allowed'
168  write(*,*) ' in combination with a submodel'
169  endif
170  iamplitude=iglobstep
171  endif
172 !
173  if(user.and.(iamplitude.ne.0)) then
174  write(*,*)
175  & '*WARNING reading *TEMPERATURE: no amplitude definition is'
176  write(*,*) ' allowed for temperatures defined by a'
177  write(*,*) ' user routine'
178  iamplitude=0
179  endif
180 !
181  do
182  call getnewline(inpc,textpart,istat,n,key,iline,ipol,inl,
183  & ipoinp,inp,ipoinpc)
184  if((istat.lt.0).or.(key.eq.1)) return
185  read(textpart(2)(1:20),'(f20.0)',iostat=istat) temperature
186  if(istat.gt.0) call inputerror(inpc,ipoinpc,iline,
187  &"*TEMPERATURE%")
188 !
189 ! dummy temperature consisting of the first primes
190 !
191  if(user) temperature=1.2357111317d0
192  if(submodel) temperature=1.9232931374d0
193 !
194  if(inoelfree.ne.0) then
195  tempgrad1=0.d0
196  tempgrad2=0.d0
197  if(n.gt.2) then
198  read(textpart(3)(1:20),'(f20.0)',iostat=istat) tempgrad1
199  if(istat.gt.0) call inputerror(inpc,ipoinpc,iline,
200  &"*TEMPERATURE%")
201  endif
202  if(n.gt.3) then
203  read(textpart(4)(1:20),'(f20.0)',iostat=istat) tempgrad2
204  if(istat.gt.0) call inputerror(inpc,ipoinpc,iline,
205  &"*TEMPERATURE%")
206  endif
207  endif
208 !
209  read(textpart(1)(1:10),'(i10)',iostat=istat) l
210  if(istat.eq.0) then
211  if(l.gt.nk) then
212  write(*,*) '*WARNING reading *TEMPERATURE: node ',l
213  write(*,*) ' exceeds the largest defined ',
214  & 'node number'
215  cycle
216  endif
217  t1(l)=temperature
218  if(nam.gt.0) iamt1(l)=iamplitude
219  if(inoelfree.ne.0) then
220  t1g(1,l)=tempgrad1
221  t1g(2,l)=tempgrad2
222  endif
223  else
224  read(textpart(1)(1:80),'(a80)',iostat=istat) noset
225  noset(81:81)=' '
226  ipos=index(noset,' ')
227  noset(ipos:ipos)='N'
228  do i=1,nset
229  if(set(i).eq.noset) exit
230  enddo
231  if(i.gt.nset) then
232  noset(ipos:ipos)=' '
233  write(*,*) '*ERROR reading *TEMPERATURE: node set ',noset
234  write(*,*) ' has not yet been defined. '
235  call inputerror(inpc,ipoinpc,iline,
236  &"*TEMPERATURE%")
237  call exit(201)
238  endif
239  do j=istartset(i),iendset(i)
240  if(ialset(j).gt.0) then
241  t1(ialset(j))=temperature
242  if(nam.gt.0) iamt1(ialset(j))=iamplitude
243  if(inoelfree.ne.0) then
244  t1g(1,ialset(j))=tempgrad1
245  t1g(2,ialset(j))=tempgrad2
246  endif
247  else
248  k=ialset(j-2)
249  do
250  k=k-ialset(j)
251  if(k.ge.ialset(j-1)) exit
252  t1(k)=temperature
253  if(nam.gt.0) iamt1(k)=iamplitude
254  if(inoelfree.ne.0) then
255  t1g(1,k)=tempgrad1
256  t1g(2,k)=tempgrad2
257  endif
258  enddo
259  endif
260  enddo
261  endif
262  enddo
263 !
264  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
Hosted by OpenAircraft.com, (Michigan UAV, LLC)