CalculiX  2.13
A Free Software Three-Dimensional Structural Finite Element Program
ties.f File Reference

Go to the source code of this file.

Functions/Subroutines

subroutine ties (inpc, textpart, tieset, tietol, istep, istat, n, iline, ipol, inl, ipoinp, inp, ntie, ntie_, ipoinpc)
 

Function/Subroutine Documentation

◆ ties()

subroutine ties ( character*1, dimension(*)  inpc,
character*132, dimension(16)  textpart,
character*81, dimension(3,*)  tieset,
real*8, dimension(3,*)  tietol,
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(0:*)  ipoinpc 
)
21 !
22 ! reading the input deck: *TIE
23 !
24  implicit none
25 !
26  logical multistage,tied,fluidperiodic,fluidcyclic
27 !
28  character*1 inpc(*)
29  character*81 tieset(3,*)
30  character*132 textpart(16)
31 !
32  integer istep,istat,n,i,key,ipos,iline,ipol,inl,ipoinp(2,*),
33  & inp(3,*),ntie,ntie_,ipoinpc(0:*)
34 !
35  real*8 tietol(3,*)
36 !
37  multistage=.false.
38  tied=.true.
39  fluidperiodic=.false.
40  fluidcyclic=.false.
41 !
42  if(istep.gt.0) then
43  write(*,*) '*ERROR in ties: *TIE should'
44  write(*,*) ' be placed before all step definitions'
45  call exit(201)
46  endif
47 !
48  ntie=ntie+1
49  if(ntie.gt.ntie_) then
50  write(*,*) '*ERROR in ties: increase ntie_'
51  call exit(201)
52  endif
53 !
54  tietol(1,ntie)=-1.d0
55  tietol(2,ntie)=1.d0
56  tieset(1,ntie)(1:1)=' '
57 !
58  do i=2,n
59  if(textpart(i)(1:18).eq.'POSITIONTOLERANCE=') then
60  read(textpart(i)(19:38),'(f20.0)',iostat=istat)
61  & tietol(1,ntie)
62  if(istat.gt.0) call inputerror(inpc,ipoinpc,iline,
63  &"*TIE%")
64  elseif(textpart(i)(1:5).eq.'NAME=') then
65  read(textpart(i)(6:85),'(a80)',iostat=istat)
66  & tieset(1,ntie)(1:80)
67  if(istat.gt.0) call inputerror(inpc,ipoinpc,iline,
68  &"*TIE%")
69  elseif(textpart(i)(1:14).eq.'CYCLICSYMMETRY') then
70  tied=.false.
71  elseif(textpart(i)(1:10).eq.'MULTISTAGE') then
72  multistage=.true.
73  tied=.false.
74  elseif(textpart(i)(1:13).eq.'FLUIDPERIODIC') then
75  fluidperiodic=.true.
76  tied=.false.
77  elseif(textpart(i)(1:11).eq.'FLUIDCYCLIC') then
78  fluidcyclic=.true.
79  tied=.false.
80  elseif(textpart(i)(1:9).eq.'ADJUST=NO') then
81  tietol(2,ntie)=-1.d0
82  else
83  write(*,*)
84  & '*WARNING in ties: parameter not recognized:'
85  write(*,*) ' ',
86  & textpart(i)(1:index(textpart(i),' ')-1)
87  call inputwarning(inpc,ipoinpc,iline,
88  &"*TIE%")
89  endif
90  enddo
91  if(tieset(1,ntie)(1:1).eq.' ') then
92  write(*,*) '*ERROR in ties: tie name is lacking'
93  call inputerror(inpc,ipoinpc,iline,
94  &"*TIE%")
95  call exit(201)
96  endif
97 !
98  call getnewline(inpc,textpart,istat,n,key,iline,ipol,inl,
99  & ipoinp,inp,ipoinpc)
100  if((istat.lt.0).or.(key.eq.1)) then
101  write(*,*)'*ERROR in ties: definition of the tie'
102  write(*,*) ' is not complete.'
103  call exit(201)
104  endif
105 !
106  if(multistage) then
107  tieset(1,ntie)(81:81)='M'
108  elseif(tied) then
109  tieset(1,ntie)(81:81)='T'
110  elseif(fluidperiodic) then
111  tieset(1,ntie)(81:81)='P'
112  elseif(fluidcyclic) then
113  tieset(1,ntie)(81:81)='Z'
114  else
115  tieset(1,ntie)(81:81)=' '
116  endif
117 !
118  if(tied) then
119 !
120 ! slave surface can be nodal or facial
121 !
122  tieset(2,ntie)(1:80)=textpart(1)(1:80)
123  tieset(2,ntie)(81:81)=' '
124 !
125 ! master surface must be facial
126 !
127  tieset(3,ntie)(1:80)=textpart(2)(1:80)
128  tieset(3,ntie)(81:81)=' '
129  ipos=index(tieset(3,ntie),' ')
130  tieset(3,ntie)(ipos:ipos)='T'
131  elseif(multistage) then
132 !
133 ! slave and master surface must be nodal
134 !
135  tieset(2,ntie)(1:80)=textpart(1)(1:80)
136  tieset(2,ntie)(81:81)=' '
137  ipos=index(tieset(2,ntie),' ')
138  tieset(2,ntie)(ipos:ipos)='S'
139 !
140  tieset(3,ntie)(1:80)=textpart(2)(1:80)
141  tieset(3,ntie)(81:81)=' '
142  ipos=index(tieset(3,ntie),' ')
143  tieset(3,ntie)(ipos:ipos)='S'
144  elseif((fluidperiodic).or.(fluidcyclic)) then
145 !
146 ! slave and master surface must be facial
147 !
148  tieset(2,ntie)(1:80)=textpart(1)(1:80)
149  tieset(2,ntie)(81:81)=' '
150  ipos=index(tieset(2,ntie),' ')
151  tieset(2,ntie)(ipos:ipos)='T'
152 !
153  tieset(3,ntie)(1:80)=textpart(2)(1:80)
154  tieset(3,ntie)(81:81)=' '
155  ipos=index(tieset(3,ntie),' ')
156  tieset(3,ntie)(ipos:ipos)='T'
157  else
158 !
159 ! cyclic symmetry tie
160 ! slave and master surface may be nodal or facial
161 !
162  tieset(2,ntie)(1:80)=textpart(1)(1:80)
163  tieset(2,ntie)(81:81)=' '
164 !
165  tieset(3,ntie)(1:80)=textpart(2)(1:80)
166  tieset(3,ntie)(81:81)=' '
167  endif
168 !
169  call getnewline(inpc,textpart,istat,n,key,iline,ipol,inl,
170  & ipoinp,inp,ipoinpc)
171 !
172  return
subroutine inputwarning(inpc, ipoinpc, iline, text)
Definition: inputwarning.f:20
subroutine getnewline(inpc, textpart, istat, n, key, iline, ipol, inl, ipoinp, inp, ipoinpc)
Definition: getnewline.f:21
subroutine inputerror(inpc, ipoinpc, iline, text)
Definition: inputerror.f:20
Hosted by OpenAircraft.com, (Michigan UAV, LLC)