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

Go to the source code of this file.

Functions/Subroutines

subroutine contactpairs (inpc, textpart, tieset, istep, istat, n, iline, ipol, inl, ipoinp, inp, ntie, ntie_, iperturb, matname, nmat, ipoinpc, tietol, set, nset, mortar, ncmat_, ntmat_, elcon)
 

Function/Subroutine Documentation

◆ contactpairs()

subroutine contactpairs ( character*1, dimension(*)  inpc,
character*132, dimension(16)  textpart,
character*81, dimension(3,*)  tieset,
integer  istep,
integer  istat,
integer  n,
integer  iline,
integer  ipol,
integer  inl,
integer, dimension(2,*)  ipoinp,
integer, dimension(3,*)  inp,
integer  ntie,
integer  ntie_,
integer, dimension(2)  iperturb,
character*80, dimension(*)  matname,
integer  nmat,
integer, dimension(0:*)  ipoinpc,
real*8, dimension(3,*)  tietol,
character*81, dimension(*)  set,
integer  nset,
integer  mortar,
integer  ncmat_,
integer  ntmat_,
real*8, dimension(0:ncmat_,ntmat_,*)  elcon 
)
23 !
24 ! reading the input deck: *CONTACT PAIR
25 !
26  implicit none
27 !
28  logical linear
29 !
30  character*1 inpc(*)
31  character*80 matname(*),material
32  character*81 tieset(3,*),noset,set(*)
33  character*132 textpart(16)
34 !
35  integer istep,istat,n,i,key,ipos,iline,ipol,inl,ipoinp(2,*),
36  & inp(3,*),ntie,ntie_,iperturb(2),nmat,ipoinpc(0:*),nset,j,
37  & mortar,ncmat_,ntmat_
38 !
39  real*8 tietol(3,*),adjust,elcon(0:ncmat_,ntmat_,*)
40 !
41 ! tietol contains information on:
42 ! - small (tietol<0) or large (tietol>0) sliding
43 ! - the adjust value (only if dabs(tietol)>=2,
44 ! adjust=dabs(tietol)-2
45 !
46  if(istep.gt.0) then
47  write(*,*) '*ERROR reading *CONTACT PAIR: *CONTACT PAIR should'
48  write(*,*) ' be placed before all step definitions'
49  call exit(201)
50  endif
51 !
52  mortar=-1
53  linear=.false.
54 !
55  ntie=ntie+1
56  if(ntie.gt.ntie_) then
57  write(*,*) '*ERROR reading *CONTACT PAIR: increase ntie_'
58  call exit(201)
59  endif
60  tietol(1,ntie)=1.d0
61 !
62 ! default for "no clearance"
63 !
64  tietol(3,ntie)=1.2357111317d0
65  do j=1,80
66  tieset(1,ntie)(j:j)=' '
67  enddo
68 !
69  do i=2,n
70  if(textpart(i)(1:12).eq.'INTERACTION=') then
71  material=textpart(i)(13:92)
72  elseif(textpart(i)(1:12).eq.'SMALLSLIDING') then
73  tietol(1,ntie)=-tietol(1,ntie)
74  elseif(textpart(i)(1:6).eq.'LINEAR') then
75  linear=.true.
76  elseif(textpart(i)(1:7).eq.'ADJUST=') then
77  read(textpart(i)(8:25),'(f20.0)',iostat=istat) adjust
78  if(istat.gt.0) then
79  noset(1:80)=textpart(i)(8:87)
80  noset(81:81)=' '
81  ipos=index(noset,' ')
82  noset(ipos:ipos)='N'
83  do j=1,nset
84  if(set(j).eq.noset) exit
85  enddo
86  if(j.gt.nset) then
87  noset(ipos:ipos)=' '
88  write(*,*)
89  & '*ERROR reading *CONTACT PAIR: adjust node set',
90  & noset
91  write(*,*) ' has not been defined'
92  call inputerror(inpc,ipoinpc,iline,
93  &"*CONTACT PAIR%")
94  call exit(201)
95  endif
96  do j=1,ipos-1
97  tieset(1,ntie)(j:j)=noset(j:j)
98  enddo
99  do j=ipos,80
100  tieset(1,ntie)(j:j)=' '
101  enddo
102  else
103  tietol(1,ntie)=dsign(1.d0,tietol(1,ntie))*(2.d0+adjust)
104  endif
105  elseif(textpart(i)(1:18).eq.'TYPE=NODETOSURFACE') then
106  mortar=0
107  elseif(textpart(i)(1:21).eq.'TYPE=SURFACETOSURFACE') then
108  mortar=1
109  elseif(textpart(i)(1:11).eq.'TYPE=MORTAR') then
110  mortar=2
111  elseif(textpart(i)(1:13).eq.'TYPE=PGMORTAR') then
112  mortar=5
113  elseif(textpart(i)(1:14).eq.'TYPE=LINMORTAR') then
114  mortar=3
115  elseif(textpart(i)(1:16).eq.'TYPE=PGLINMORTAR') then
116  mortar=4
117  else
118  write(*,*)
119  & '*WARNING reading *CONTACT PAIR: parameter not recognized:'
120  write(*,*) ' ',
121  & textpart(i)(1:index(textpart(i),' ')-1)
122  call inputwarning(inpc,ipoinpc,iline,
123  &"*CONTACT PAIR%")
124  endif
125  enddo
126 !
127  if(mortar.lt.0) then
128  write(*,*) '*ERROR reading *CONTACT PAIR'
129  write(*,*) ' no TYPE specified'
130  call inputerror(inpc,ipoinpc,iline,
131  &"*CONTACT PAIR%")
132  endif
133 !
134 ! SMALL SLIDING significates that the number of contact elements
135 ! within one increment is frozen. This is not allowed for
136 ! SURFACE TO SURFACE contact.
137 !
138  if((tietol(1,ntie).lt.0.d0).and.(mortar.eq.1)) then
139  write(*,*) '*WARNING reading *CONTACT PAIR'
140  write(*,*) ' The option SMALL SLIDING cannot be'
141  write(*,*) ' used with SURFACE TO SURFACE contact'
142  tietol(1,ntie)=-tietol(1,ntie)
143  endif
144 !
145 ! check for the existence of the surface interaction
146 !
147  do i=1,nmat
148  if(matname(i).eq.material) exit
149  enddo
150  if(i.gt.nmat) then
151  write(*,*) '*ERROR reading *CONTACT PAIR: nonexistent surface'
152  write(*,*) ' interaction; '
153  call inputerror(inpc,ipoinpc,iline,
154  &"*CONTACT PAIR%")
155  call exit(201)
156  endif
157  tietol(2,ntie)=i+0.5d0
158 !
159 ! check whether sigma_at_infinity is given for node-to-face penalty
160 ! contact with a linear pressure-overclosure relationship
161 !
162  if(ncmat_<2) then
163  write(*,*)
164  & '*ERROR reading *CONTACT PAIR: no PRESSURE-OVERCLOSURE'
165  write(*,*)
166  & ' has been defined for at least one *CONTACT INTERACTION'
167  call exit(201)
168  elseif(int(elcon(3,1,i)).le.0) then
169  write(*,*)
170  & '*ERROR reading *CONTACT PAIR: no PRESSURE-OVERCLOSURE'
171  write(*,*)
172  & ' has been defined for at least one *CONTACT INTERACTION'
173  call exit(201)
174  endif
175 !
176  if(int(elcon(3,1,i)).eq.2) then
177  if(mortar.eq.0) then
178  if(elcon(1,1,i).lt.1.d-30) then
179  write(*,*) '*ERROR reading *CONTACT PAIR:'
180  write(*,*) ' for node-to-face penalty contact'
181  write(*,*) ' with linear pressure-overclosure'
182  write(*,*) ' relationship, the'
183  write(*,*) ' tension at large clearances'
184  write(*,*) ' must exceed 1.e-30'
185  call inputerror(inpc,ipoinpc,iline,
186  &"*CONTACT PAIR%")
187  call exit(201)
188  endif
189  endif
190  endif
191 !
192  tieset(1,ntie)(81:81)='C'
193 !
194  call getnewline(inpc,textpart,istat,n,key,iline,ipol,inl,
195  & ipoinp,inp,ipoinpc)
196  if((istat.lt.0).or.(key.eq.1)) then
197  write(*,*)'*ERROR reading *CONTACT PAIR: definition of the '
198  write(*,*) ' contact pair is not complete.'
199  call exit(201)
200  endif
201 !
202 ! storing the slave surface
203 !
204  if(mortar.eq.1) then
205  tieset(2,ntie)(1:80)=textpart(1)(1:80)
206  tieset(2,ntie)(81:81)=' '
207  ipos=index(tieset(2,ntie),' ')
208  tieset(2,ntie)(ipos:ipos)='T'
209  elseif(mortar.eq.2) then
210  tieset(2,ntie)(1:80)=textpart(1)(1:80)
211  tieset(2,ntie)(81:81)=' '
212  ipos=index(tieset(2,ntie),' ')
213  tieset(2,ntie)(ipos:ipos)='M'
214  elseif(mortar.eq.3) then
215  tieset(2,ntie)(1:80)=textpart(1)(1:80)
216  tieset(2,ntie)(81:81)=' '
217  ipos=index(tieset(2,ntie),' ')
218  tieset(2,ntie)(ipos:ipos)='O'
219  elseif(mortar.eq.4) then
220  tieset(2,ntie)(1:80)=textpart(1)(1:80)
221  tieset(2,ntie)(81:81)=' '
222  ipos=index(tieset(2,ntie),' ')
223  tieset(2,ntie)(ipos:ipos)='P'
224  elseif(mortar.eq.5) then
225  tieset(2,ntie)(1:80)=textpart(1)(1:80)
226  tieset(2,ntie)(81:81)=' '
227  ipos=index(tieset(2,ntie),' ')
228  tieset(2,ntie)(ipos:ipos)='G'
229  else
230  tieset(2,ntie)(1:80)=textpart(1)(1:80)
231  tieset(2,ntie)(81:81)=' '
232  ipos=index(tieset(2,ntie),' ')
233  tieset(2,ntie)(ipos:ipos)='S'
234  endif
235 !
236  tieset(3,ntie)(1:80)=textpart(2)(1:80)
237  tieset(3,ntie)(81:81)=' '
238  ipos=index(tieset(3,ntie),' ')
239  tieset(3,ntie)(ipos:ipos)='T'
240 !
241 ! the definition of a contact pair triggers a call to
242 ! nonlingeo (for static calculations) but not automatically
243 ! to the nonlinear calculation of strains (i.e.
244 ! iperturb(2) should be zero unless NLGEOM is activated)
245 !
246  if((iperturb(1).eq.0).and.(.not.linear)) then
247  iperturb(1)=2
248  endif
249 !
250 ! check for further contact pairs
251 !
252  do
253  call getnewline(inpc,textpart,istat,n,key,iline,ipol,inl,
254  & ipoinp,inp,ipoinpc)
255  if((istat.lt.0).or.(key.eq.1)) exit
256 !
257  ntie=ntie+1
258 !
259 ! copying the information from the previous tie
260 !
261  do i=1,3
262  tietol(i,ntie)=tietol(i,ntie-1)
263  enddo
264  tieset(1,ntie)=tieset(1,ntie-1)
265 !
266 ! storing slave and master surface
267 !
268  if(mortar.eq.1) then
269  tieset(2,ntie)(1:80)=textpart(1)(1:80)
270  tieset(2,ntie)(81:81)=' '
271  ipos=index(tieset(2,ntie),' ')
272  tieset(2,ntie)(ipos:ipos)='T'
273  elseif(mortar.eq.2) then
274  tieset(2,ntie)(1:80)=textpart(1)(1:80)
275  tieset(2,ntie)(81:81)=' '
276  ipos=index(tieset(2,ntie),' ')
277  tieset(2,ntie)(ipos:ipos)='M'
278  elseif(mortar.eq.3) then
279  tieset(2,ntie)(1:80)=textpart(1)(1:80)
280  tieset(2,ntie)(81:81)=' '
281  ipos=index(tieset(2,ntie),' ')
282  tieset(2,ntie)(ipos:ipos)='O'
283  elseif(mortar.eq.4) then
284  tieset(2,ntie)(1:80)=textpart(1)(1:80)
285  tieset(2,ntie)(81:81)=' '
286  ipos=index(tieset(2,ntie),' ')
287  tieset(2,ntie)(ipos:ipos)='P'
288  elseif(mortar.eq.5) then
289  tieset(2,ntie)(1:80)=textpart(1)(1:80)
290  tieset(2,ntie)(81:81)=' '
291  ipos=index(tieset(2,ntie),' ')
292  tieset(2,ntie)(ipos:ipos)='G'
293  else
294  tieset(2,ntie)(1:80)=textpart(1)(1:80)
295  tieset(2,ntie)(81:81)=' '
296  ipos=index(tieset(2,ntie),' ')
297  tieset(2,ntie)(ipos:ipos)='S'
298  endif
299 !
300  tieset(3,ntie)(1:80)=textpart(2)(1:80)
301  tieset(3,ntie)(81:81)=' '
302  ipos=index(tieset(3,ntie),' ')
303  tieset(3,ntie)(ipos:ipos)='T'
304  enddo
305 !
306  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)