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

Go to the source code of this file.

Functions/Subroutines

subroutine forcadd (node, i, val, nodeforc, ndirforc, xforc, nforc, nforc_, iamforc, iamplitude, nam, ntrans, trab, inotr, co, ikforc, ilforc, isector, add, user, idefforc, ipompc, nodempc, nmpc, ikmpc, ilmpc, labmpc)
 

Function/Subroutine Documentation

◆ forcadd()

subroutine forcadd ( integer  node,
integer  i,
real*8  val,
integer, dimension(2,*)  nodeforc,
integer, dimension(*)  ndirforc,
real*8, dimension(*)  xforc,
integer  nforc,
integer  nforc_,
integer, dimension(*)  iamforc,
integer  iamplitude,
integer  nam,
integer  ntrans,
real*8, dimension(7,*)  trab,
integer, dimension(2,*)  inotr,
real*8, dimension(3,*)  co,
integer, dimension(*)  ikforc,
integer, dimension(*)  ilforc,
integer  isector,
logical  add,
logical  user,
integer, dimension(*)  idefforc,
integer, dimension(*)  ipompc,
integer, dimension(3,*)  nodempc,
integer  nmpc,
integer, dimension(*)  ikmpc,
integer, dimension(*)  ilmpc,
character*20, dimension(*)  labmpc 
)
23 !
24 ! adds a cload condition to the data base
25 !
26  implicit none
27 !
28  logical add,user
29 !
30  character*20 labmpc(*)
31 !
32  integer nodeforc(2,*),ndirforc(*),node,i,nforc,nforc_,j,
33  & iamforc(*),iamplitude,nam,ntrans,inotr(2,*),itr,idf(3),
34  & ikforc(*),ilforc(*),idof,id,k,isector,idefforc(*),ipompc(*),
35  & nodempc(3,*),nmpc,ikmpc(*),ilmpc(*)
36 !
37  real*8 xforc(*),val,trab(7,*),a(3,3),co(3,*)
38 !
39  if(ntrans.eq.0) then
40  itr=0
41  else
42  itr=inotr(1,node)
43  endif
44 !
45 ! checking for boundary conditions on rotational dofs of
46 ! distributing couplings
47 !
48  if((i.ge.5).and.(i.le.7)) then
49 !
50 ! rotational dof
51 !
52  idof=8*(node-1)+i
53  call nident(ikmpc,idof,nmpc,id)
54  if(id.gt.0) then
55  if(ikmpc(id).eq.idof) then
56  if(labmpc(ilmpc(id))(1:14).eq.'ROTTRACOUPLING') then
57  node=nodempc(1,nodempc(3,ipompc(ilmpc(id))))
58  i=nodempc(2,nodempc(3,ipompc(ilmpc(id))))
59  itr=0
60  endif
61  endif
62  endif
63  endif
64 !
65 ! change: transformations on rotations are taken into account
66 ! by the normal of the mean rotation MPC, not by expanding the
67 ! MPC in Carthesian coordinates
68 !
69 c if(itr.eq.0) then
70  if((itr.eq.0).or.(i.eq.0).or.(i.gt.3)) then
71 !
72 ! no transformation applies to the node
73 !
74  idof=8*(node-1)+i
75  call nident(ikforc,idof,nforc,id)
76  if(id.gt.0) then
77  do
78  if(ikforc(id).eq.idof) then
79  k=ilforc(id)
80  if(nodeforc(2,k).eq.isector) then
81  if(add.or.(idefforc(k).eq.1)) then
82  if(nam.gt.0) then
83  if(iamforc(k).ne.iamplitude) then
84  write(*,*) '*ERROR in forcadd:'
85  write(*,*) ' it is not allowed to '
86  write(*,*)' define two concentrated'
87  write(*,*) ' loads/fluxes'
88  write(*,*) ' different amplitudes '
89  write(*,*) ' in one step'
90  write(*,*) 'node: ',node,' dof:',i
91  call exit(201)
92  endif
93  endif
94  xforc(k)=xforc(k)+val
95  else
96  xforc(k)=val
97  if(.not.user) idefforc(k)=1
98  endif
99  if(nam.gt.0) iamforc(k)=iamplitude
100  return
101  endif
102  id=id-1
103  if(id.eq.0) exit
104  else
105  exit
106  endif
107  enddo
108  endif
109 c
110  nforc=nforc+1
111  if(nforc.gt.nforc_) then
112  write(*,*) '*ERROR in forcadd: increase nforc_'
113  call exit(201)
114  endif
115  nodeforc(1,nforc)=node
116  nodeforc(2,nforc)=isector
117  ndirforc(nforc)=i
118  xforc(nforc)=val
119  if(.not.user) idefforc(nforc)=1
120  if(nam.gt.0) iamforc(nforc)=iamplitude
121 !
122 ! updating ikforc and ilforc
123 !
124  do j=nforc,id+2,-1
125  ikforc(j)=ikforc(j-1)
126  ilforc(j)=ilforc(j-1)
127  enddo
128  ikforc(id+1)=idof
129  ilforc(id+1)=nforc
130  else
131 !
132 ! a transformation applies
133 !
134  call transformatrix(trab(1,itr),co(1,node),a)
135 !
136  do j=1,3
137  idf(j)=0
138  idof=8*(node-1)+j
139  call nident(ikforc,idof,nforc,id)
140  if(id.gt.0) then
141  do
142  if(ikforc(id).eq.idof) then
143  k=ilforc(id)
144  if(nodeforc(2,k).eq.isector) then
145  idf(j)=ilforc(id)
146  exit
147  endif
148  id=id-1
149  if(id.eq.0) exit
150  else
151  exit
152  endif
153  enddo
154  endif
155  enddo
156 !
157  if((idf(1).ne.0).and.(.not.user)) then
158 !
159 ! a force was previously applied to this node. The component
160 ! in direction i is filtered out and replaced by the new
161 ! value
162 !
163 ! if an amplitude is selected, it applies to all components
164 ! of the force in the node. No separate amplitudes are allowed.
165 !
166  if((.not.add).and.(idefforc(idf(i)).ne.1))
167  & val=val-xforc(idf(1))*a(1,i)-xforc(idf(2))*a(2,i)
168  & -xforc(idf(3))*a(3,i)
169 !
170  xforc(idf(1))=xforc(idf(1))+val*a(1,i)
171  xforc(idf(2))=xforc(idf(2))+val*a(2,i)
172  xforc(idf(3))=xforc(idf(3))+val*a(3,i)
173 !
174 ! only first entry is tagged
175 !
176  idefforc(idf(i))=1
177 !
178  if(nam.gt.0) then
179  if((iamforc(idf(1)).ne.iamplitude).or.
180  & (iamforc(idf(2)).ne.iamplitude).or.
181  & (iamforc(idf(3)).ne.iamplitude)) then
182  write(*,*) '*ERROR in forcadd:'
183  write(*,*) ' it is not allowed to '
184  write(*,*) ' define two concentrated'
185  write(*,*) ' loads/fluxes with'
186  write(*,*) ' different amplitudes '
187  write(*,*) ' in one step'
188  write(*,*) 'node: ',node,' dof:',i
189  call exit(201)
190  endif
191  do j=1,3
192  iamforc(idf(j))=iamplitude
193  enddo
194  endif
195  else
196  do j=1,3
197  nforc=nforc+1
198  if(nforc.gt.nforc_) then
199  write(*,*) '*ERROR in forcadd: increase nforc_'
200  call exit(201)
201  endif
202  nodeforc(1,nforc)=node
203  nodeforc(2,nforc)=isector
204  ndirforc(nforc)=j
205  if(user) then
206  xforc(nforc)=val
207  else
208  xforc(nforc)=val*a(j,i)
209  endif
210  idefforc(nforc)=1
211  if(nam.gt.0) iamforc(nforc)=iamplitude
212 !
213 ! updating ikforc and ilforc
214 !
215  idof=8*(node-1)+j
216  call nident(ikforc,idof,nforc-1,id)
217  do k=nforc,id+2,-1
218  ikforc(k)=ikforc(k-1)
219  ilforc(k)=ilforc(k-1)
220  enddo
221  ikforc(id+1)=idof
222  ilforc(id+1)=nforc
223  enddo
224  endif
225  endif
226 !
227  return
transformatrix
subroutine transformatrix(xab, p, a)
Definition: transformatrix.f:20
nident
subroutine nident(x, px, n, id)
Definition: nident.f:26
Hosted by OpenAircraft.com, (Michigan UAV, LLC)