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

Go to the source code of this file.

Functions/Subroutines

subroutine noelsets (inpc, textpart, set, istartset, iendset, ialset, nset, nset_, nalset, nalset_, nk, ne, irstrt, istep, istat, n, iline, ipol, inl, ipoinp, inp, ipoinpc)
 

Function/Subroutine Documentation

◆ noelsets()

subroutine noelsets ( 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  nset_,
integer  nalset,
integer  nalset_,
integer  nk,
integer  ne,
integer  irstrt,
integer  istep,
integer  istat,
integer  n,
integer  iline,
integer  ipol,
integer  inl,
integer, dimension(2,*)  ipoinp,
integer, dimension(3,*)  inp,
integer, dimension(0:*)  ipoinpc 
)
22 !
23 ! reading the input deck: *NSET and *ELSET
24 !
25  implicit none
26 !
27  logical igen
28 !
29  character*1 inpc(*)
30  character*81 set(*),noelset
31  character*132 textpart(16)
32 !
33  integer nset,nset_,nalset,nalset_,istep,istat,n,key,i,nk,ne,
34  & kode,ipos,j,k,m,iset,nn,irstrt,istartset(*),iendset(*),
35  & ialset(*),iline,ipol,inl,ipoinp(2,*),inp(3,*),ipoinpc(0:*)
36 !
37  if((istep.gt.0).and.(irstrt.ge.0)) then
38  write(*,*) '*ERROR in noelsets: *NSET/*ELSET should be placed'
39  write(*,*) ' before all step definitions'
40  call exit(201)
41  endif
42 !
43  igen=.false.
44 !
45 ! reading the name of the set
46 !
47  if(textpart(1)(1:5).eq.'*NSET') then
48  do i=2,n
49  if(textpart(i)(1:5).eq.'NSET=') then
50  noelset(1:80)=textpart(i)(6:85)
51  if(textpart(i)(86:86).ne.' ') then
52  write(*,*) '*ERROR in noelsets: set name too long'
53  write(*,*) ' (more than 80 characters)'
54  write(*,*) ' set name:',textpart(2)(1:132)
55  call exit(201)
56  endif
57  noelset(81:81)=' '
58  ipos=index(noelset,' ')
59  noelset(ipos:ipos)='N'
60  kode=0
61  elseif(textpart(i)(1:8).eq.'GENERATE') then
62  igen=.true.
63  else
64  write(*,*)
65  & '*WARNING in noelsets: parameter not recognized:'
66  write(*,*) ' ',
67  & textpart(i)(1:index(textpart(i),' ')-1)
68  call inputwarning(inpc,ipoinpc,iline,
69  &"*NSET or *ELSET%")
70  endif
71  enddo
72  else
73  do i=2,n
74  if(textpart(i)(1:6).eq.'ELSET=') then
75  noelset(1:80)=textpart(i)(7:86)
76  if(textpart(i)(87:87).ne.' ') then
77  write(*,*) '*ERROR in noelsets: set name too long'
78  write(*,*) ' (more than 80 characters)'
79  write(*,*) ' set name',textpart(2)(1:132)
80  call exit(201)
81  endif
82  noelset(81:81)=' '
83  ipos=index(noelset,' ')
84  noelset(ipos:ipos)='E'
85  kode=1
86  elseif(textpart(i)(1:8).eq.'GENERATE') then
87  igen=.true.
88  else
89  write(*,*)
90  & '*WARNING in noelsets: parameter not recognized:'
91  write(*,*) ' ',
92  & textpart(i)(1:index(textpart(i),' ')-1)
93  call inputwarning(inpc,ipoinpc,iline,
94  &"*NSET or *ELSET%")
95  endif
96  enddo
97  endif
98 !
99 ! check whether new set or old set
100 !
101  do iset=1,nset
102  if(set(iset).eq.noelset) then
103 !
104 ! existent set
105 !
106  if(iendset(iset).eq.nalset) then
107  exit
108  else
109 !
110 ! rearranging set information towards the end
111 !
112  nn=iendset(iset)-istartset(iset)+1
113  if(nalset+nn.gt.nalset_) then
114  write(*,*)'*ERROR in noelsets: increase nalset_'
115  call exit(201)
116  endif
117  do k=1,nn
118  ialset(nalset+k)=ialset(istartset(iset)+k-1)
119  enddo
120  do k=istartset(iset),nalset
121  ialset(k)=ialset(k+nn)
122  enddo
123  do k=1,nset
124  if(istartset(k).gt.iendset(iset)) then
125  istartset(k)=istartset(k)-nn
126  iendset(k)=iendset(k)-nn
127  endif
128  enddo
129  istartset(iset)=nalset-nn+1
130  iendset(iset)=nalset
131  exit
132  endif
133  endif
134  enddo
135  if(iset.gt.nset) then
136  nset=nset+1
137  if(nset.gt.nset_) then
138  write(*,*) '*ERROR in noelsets: increase nset_'
139  call exit(201)
140  endif
141  set(nset)=noelset
142  istartset(nset)=nalset+1
143  iendset(nset)=0
144  iset=nset
145  endif
146 !
147  do
148  call getnewline(inpc,textpart,istat,n,key,iline,ipol,inl,
149  & ipoinp,inp,ipoinpc)
150  if((istat.lt.0).or.(key.eq.1)) then
151  if(iendset(nset).eq.0) then
152  nset=nset-1
153  endif
154  return
155  endif
156  if(igen) n=3
157  if(nalset+n.gt.nalset_) then
158  write(*,*) '*ERROR in noelsets: increase nalset_'
159  call exit(201)
160  endif
161 !
162  if(igen) then
163  if(textpart(3)(1:1).eq.' ') then
164  textpart(3)='1
165  &
166  & '
167  endif
168  do i=1,3
169  read(textpart(i)(1:10),'(i10)',iostat=istat)
170  & ialset(nalset+i)
171  if(istat.gt.0) call inputerror(inpc,ipoinpc,iline,
172  &"*NSET or *ELSET%")
173  enddo
174  if(kode.eq.0) then
175  if(ialset(nalset+1).gt.nk) then
176  write(*,*) '*ERROR in noelsets: starting value in'
177  write(*,*) ' set ',set(iset),' > nk'
178  call exit(201)
179  elseif(ialset(nalset+2).gt.nk) then
180  write(*,*) '*WARNING in noelsets: end value in'
181  write(*,*) ' set ',set(iset),' > nk;'
182  write(*,*) ' replaced by nk'
183  ialset(nalset+2)=nk
184  elseif(ialset(nalset+3).le.0) then
185  write(*,*) '*ERROR in noelsets: increment in'
186  write(*,*) ' set ',set(iset),' <=0'
187  call exit(201)
188  endif
189  else
190  if(ialset(nalset+1).gt.ne) then
191  write(*,*) '*ERROR in noelsets: starting value in'
192  write(*,*) ' set ',set(iset),' > ne'
193  call exit(201)
194  elseif(ialset(nalset+2).gt.ne) then
195  write(*,*) '*WARNING in noelsets: end value in'
196  write(*,*) ' set ',set(iset),' > ne;'
197  write(*,*) ' replaced by ne'
198  ialset(nalset+2)=nk
199  elseif(ialset(nalset+3).le.0) then
200  write(*,*) '*ERROR in noelsets: increment in'
201  write(*,*) ' set ',set(iset),' <=0'
202  call exit(201)
203  endif
204  endif
205  if(ialset(nalset+1).eq.ialset(nalset+2)) then
206  ialset(nalset+2)=0
207  ialset(nalset+3)=0
208  nalset=nalset+1
209  else
210  ialset(nalset+3)=-ialset(nalset+3)
211  nalset=nalset+3
212  endif
213  iendset(iset)=nalset
214  else
215  do i=1,n
216  read(textpart(i)(1:10),'(i10)',iostat=istat)
217  & ialset(nalset+1)
218  if(istat.gt.0) then
219 !
220 ! set name
221 !
222  noelset=textpart(i)(1:80)
223  noelset(81:81)=' '
224  ipos=index(noelset,' ')
225  if(kode.eq.0) then
226  noelset(ipos:ipos)='N'
227  else
228  noelset(ipos:ipos)='E'
229  endif
230  do j=1,nset
231  if(j.eq.iset)cycle
232  if(noelset.eq.set(j)) then
233  m=iendset(j)-istartset(j)+1
234  do k=1,m
235  ialset(nalset+k)=ialset(istartset(j)+k-1)
236  enddo
237  nalset=nalset+m
238  exit
239  endif
240  enddo
241  if(noelset.ne.set(j)) then
242  noelset(ipos:ipos)=' '
243  if(kode.eq.0) then
244  write(*,*) '*ERROR in noelsets: node set ',
245  & noelset
246  else
247  write(*,*) '*ERROR in noelsets: element set ',
248  & noelset
249  endif
250  write(*,*) ' has not been defined yet'
251  call exit(201)
252  endif
253  else
254 !
255 ! node or element number
256 !
257  if(kode.eq.0) then
258  if(ialset(nalset+1).gt.nk) then
259  write(*,*) '*WARNING in noelsets: value ',
260  & ialset(nalset+1)
261  write(*,*) ' in set ',set(iset),' > nk'
262  else
263  nalset=nalset+1
264  endif
265  else
266  if(ialset(nalset+1).gt.ne) then
267  write(*,*) '*WARNING in noelsets: value ',
268  & ialset(nalset+1)
269  write(*,*) ' in set ',set(iset),' > ne;'
270  write(*,*) ' This is only allowed for'
271  write(*,*)
272  & ' global elsets in combination'
273  write(*,*) ' with submodels'
274 c else
275 c nalset=nalset+1
276  endif
277  nalset=nalset+1
278  endif
279  endif
280  enddo
281  iendset(iset)=nalset
282  endif
283  enddo
284 !
285  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)