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

Go to the source code of this file.

Functions/Subroutines

subroutine elprints (inpc, textpart, set, nset, nprint, nprint_, jout, prlab, prset, nmethod, elprint_flag, nener, ithermal, istep, istat, n, iline, ipol, inl, ipoinp, inp, amname, nam, itpamp, idrct, ipoinpc, cfd)
 

Function/Subroutine Documentation

◆ elprints()

subroutine elprints ( character*1, dimension(*)  inpc,
character*132, dimension(16)  textpart,
character*81, dimension(*)  set,
integer  nset,
integer  nprint,
integer  nprint_,
integer, dimension(2)  jout,
character*6, dimension(*)  prlab,
character*81, dimension(*)  prset,
integer  nmethod,
logical  elprint_flag,
integer  nener,
integer  ithermal,
integer  istep,
integer  istat,
integer  n,
integer  iline,
integer  ipol,
integer  inl,
integer, dimension(2,*)  ipoinp,
integer, dimension(3,*)  inp,
character*80, dimension(*)  amname,
integer  nam,
integer  itpamp,
integer  idrct,
integer, dimension(0:*)  ipoinpc,
integer  cfd 
)
23 !
24 ! reading the *ELEMENT PRINT cards in the input deck
25 !
26  implicit none
27 !
28  logical elprint_flag
29 !
30  character*1 total,elemsys,inpc(*)
31  character*6 prlab(*)
32  character*80 amname(*),timepointsname
33  character*81 set(*),elset,prset(*)
34  character*132 textpart(16)
35 !
36  integer nset,nprint,nprint_,istep,istat,n,i,ii,key,
37  & jout(2),joutl,ipos,nmethod,nener,ithermal,iline,ipol,inl,
38  & ipoinp(2,*),inp(3,*),nam,itpamp,idrct,ipoinpc(0:*),cfd
39 !
40  if(istep.lt.1) then
41  write(*,*) '*ERROR reading *EL PRINT: *EL PRINT should only be'
42  write(*,*) ' used within a *STEP definition'
43  call exit(201)
44  endif
45 !
46  elemsys='L'
47 !
48 ! reset the element print requests
49 !
50  if(.not.elprint_flag) then
51  ii=0
52  do i=1,nprint
53  if((prlab(i)(1:4).eq.'S ').or.
54  & (prlab(i)(1:4).eq.'E ').or.
55  & (prlab(i)(1:4).eq.'ME ').or.
56  & (prlab(i)(1:4).eq.'PEEQ').or.
57  & (prlab(i)(1:4).eq.'ENER').or.
58  & (prlab(i)(1:4).eq.'SDV ').or.
59  & (prlab(i)(1:4).eq.'ELSE').or.
60  & (prlab(i)(1:4).eq.'ELKE').or.
61  & (prlab(i)(1:4).eq.'EVOL').or.
62  & (prlab(i)(1:4).eq.'EBHE').or.
63  & (prlab(i)(1:4).eq.'SVF ').or.
64  & (prlab(i)(1:4).eq.'HFLF').or.
65  & (prlab(i)(1:4).eq.'HFL ')) cycle
66  ii=ii+1
67  prlab(ii)=prlab(i)
68  prset(ii)=prset(i)
69  enddo
70  nprint=ii
71  endif
72 !
73  do ii=1,81
74  elset=' '
75  enddo
76  total=' '
77 !
78  do ii=2,n
79  if(textpart(ii)(1:6).eq.'ELSET=') then
80  elset(1:80)=textpart(ii)(7:86)
81  ipos=index(elset,' ')
82  elset(ipos:ipos)='E'
83  do i=1,nset
84  if(set(i).eq.elset) exit
85  enddo
86  if(i.gt.nset) then
87  write(*,*) '*WARNING reading *EL PRINT: elementset ',
88  & elset(1:ipos-1),' does not exist'
89  call getnewline(inpc,textpart,istat,n,key,iline,ipol,inl,
90  & ipoinp,inp,ipoinpc)
91  return
92  endif
93  elseif(textpart(ii)(1:10).eq.'FREQUENCY=') then
94  read(textpart(ii)(11:20),'(i10)',iostat=istat) joutl
95  if(istat.gt.0) call inputerror(inpc,ipoinpc,iline,
96  &"*EL PRINT%")
97  if(joutl.eq.0) then
98  do
99  call getnewline(inpc,textpart,istat,n,key,iline,ipol,
100  & inl,ipoinp,inp,ipoinpc)
101  if((key.eq.1).or.(istat.lt.0)) return
102  enddo
103  endif
104  if(joutl.gt.0) then
105  jout(1)=joutl
106  itpamp=0
107  endif
108  elseif(textpart(ii)(1:11).eq.'FREQUENCYF=') then
109  read(textpart(ii)(12:21),'(i10)',iostat=istat) joutl
110  if(istat.gt.0) call inputerror(inpc,ipoinpc,iline,
111  &"*EL PRINT%")
112  if(joutl.eq.0) then
113  do
114  call getnewline(inpc,textpart,istat,n,key,iline,ipol,
115  & inl,ipoinp,inp,ipoinpc)
116  if((key.eq.1).or.(istat.lt.0)) return
117  enddo
118  endif
119  if(joutl.gt.0) then
120  jout(2)=joutl
121  itpamp=0
122  endif
123  elseif(textpart(ii)(1:10).eq.'TOTALS=YES') then
124  total='T'
125  elseif(textpart(ii)(1:11).eq.'TOTALS=ONLY') then
126  total='O'
127  elseif(textpart(ii)(1:10).eq.'GLOBAL=YES') then
128  elemsys='G'
129  elseif(textpart(ii)(1:9).eq.'GLOBAL=NO') then
130  elemsys='L'
131  elseif(textpart(ii)(1:11).eq.'TIMEPOINTS=') then
132  timepointsname=textpart(ii)(12:91)
133  do i=1,nam
134  if(amname(i).eq.timepointsname) then
135  itpamp=i
136  exit
137  endif
138  enddo
139  if(i.gt.nam) then
140  write(*,*) '*ERROR elprints: time'
141  write(*,*) ' points definition',
142  & timepointsname,' is unknown'
143  call exit(201)
144  endif
145  if(idrct.eq.1) then
146  write(*,*) '*ERROR reading *EL PRINT: the DIRECT option'
147  write(*,*) ' collides with a TIME POINTS '
148  write(*,*) ' specification'
149  call exit(201)
150  endif
151  jout(1)=1
152  jout(2)=1
153  else
154  write(*,*)
155  & '*WARNING reading *EL PRINT: parameter not recognized:'
156  write(*,*) ' ',
157  & textpart(ii)(1:index(textpart(ii),' ')-1)
158  call inputwarning(inpc,ipoinpc,iline,
159  &"*EL PRINT%")
160  endif
161  enddo
162 !
163 ! check whether a set was defined
164 !
165  if(elset.eq.' ') then
166  write(*,*) '*WARNING reading *EL PRINT: no set was defined'
167  call getnewline(inpc,textpart,istat,n,key,iline,ipol,inl,
168  & ipoinp,inp,ipoinpc)
169  return
170  endif
171 !
172  do
173  call getnewline(inpc,textpart,istat,n,key,iline,ipol,inl,
174  & ipoinp,inp,ipoinpc)
175  if(key.eq.1) exit
176  do ii=1,n
177  if(textpart(ii)(1:4).eq.'PEEQ') then
178  if((nmethod.eq.2).or.(nmethod.eq.3)) then
179  write(*,*)
180  & '*WARNING reading *EL PRINT: selection of PEEQ'
181  write(*,*) ' does not make sense for a'
182  write(*,*) ' frequency or bucking calculation'
183  cycle
184  endif
185  elseif((textpart(ii)(1:4).eq.'CEEQ').or.
186  & (textpart(ii)(1:2).eq.'CE').or.
187  & (textpart(ii)(1:2).eq.'PE')) then
188  if((nmethod.eq.2).or.(nmethod.eq.3)) then
189  write(*,*)
190  & '*WARNING reading *EL PRINT: selection of CEEQ or CE or PE'
191  write(*,*) ' does not make sense for a'
192  write(*,*) ' frequency or bucking calculation'
193  cycle
194  endif
195  textpart(ii)(1:4)='PEEQ'
196  write(*,*)
197  & '*WARNING reading *EL PRINT: selection of CEEQ or CE or PE'
198  write(*,*)
199  & ' is converted into PEEQ; no distinction'
200  write(*,*)
201  & ' is made between PEEQ, CEEQ, CE and PE'
202  elseif(textpart(ii)(1:3).eq.'SDV') then
203  if((nmethod.eq.2).or.(nmethod.eq.3)) then
204  write(*,*)
205  & '*WARNING reading *EL PRINT: selection of SDV'
206  write(*,*) ' does not make sense for a'
207  write(*,*) ' frequency or bucking calculation'
208  cycle
209  endif
210  elseif((textpart(ii)(1:4).eq.'ENER').or.
211  & (textpart(ii)(1:4).eq.'ELSE').or.
212  & (textpart(ii)(1:4).eq.'ELKE')) then
213  nener=1
214  elseif(textpart(ii)(1:4).eq.'HFL ') then
215  if(ithermal.lt.2) then
216  write(*,*)
217  & '*WARNING reading *EL PRINT: HFL only makes '
218  write(*,*) ' sense for heat transfer '
219  write(*,*) ' calculations'
220  cycle
221  endif
222  elseif((textpart(ii)(1:4).eq.'SVF ').or.
223  & (textpart(ii)(1:4).eq.'HFLF')) then
224  if(cfd.eq.0) then
225  write(*,*)
226  & '*WARNING reading *EL PRINT: SVF or HFLF only'
227  write(*,*) ' make sense for 3D fluid'
228  write(*,*) ' calculations; '
229  call inputerror(inpc,ipoinpc,iline,
230  &"*EL PRINT%")
231  cycle
232  endif
233  elseif((textpart(ii)(1:4).ne.'S ').and.
234  & (textpart(ii)(1:4).ne.'E ').and.
235  & (textpart(ii)(1:4).ne.'ME ').and.
236  & (textpart(ii)(1:4).ne.'EVOL').and.
237  & (textpart(ii)(1:4).ne.'EBHE')) then
238  write(*,*)
239  & '*WARNING reading *EL PRINT: label not applicable'
240  write(*,*) ' or unknown; '
241  call inputerror(inpc,ipoinpc,iline,
242  &"*EL PRINT%")
243  cycle
244  endif
245  nprint=nprint+1
246  if(nprint.gt.nprint_) then
247  write(*,*) '*ERROR reading *EL PRINT: increase nprint_'
248  call exit(201)
249  endif
250  prset(nprint)=elset
251  prlab(nprint)(1:4)=textpart(ii)(1:4)
252  prlab(nprint)(5:5)=total
253  prlab(nprint)(6:6)=elemsys
254  enddo
255  enddo
256 !
257  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)