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

Go to the source code of this file.

Functions/Subroutines

subroutine mpcs (inpc, textpart, set, istartset, iendset, ialset, nset, nset_, nalset, nalset_, ipompc, nodempc, coefmpc, labmpc, nmpc, nmpc_, mpcfree, ikmpc, ilmpc, lakon, ipkon, kon, nk, nk_, nodeboun, ndirboun, ikboun, ilboun, nboun, nboun_, iperturb, ne_, co, xboun, ctrl, typeboun, istep, istat, n, iline, ipol, inl, ipoinp, inp, ipoinpc)
 

Function/Subroutine Documentation

◆ mpcs()

subroutine mpcs ( 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, dimension(*)  ipompc,
integer, dimension(3,*)  nodempc,
real*8, dimension(3,*)  coefmpc,
character*20, dimension(*)  labmpc,
integer  nmpc,
integer  nmpc_,
integer  mpcfree,
integer, dimension(*)  ikmpc,
integer, dimension(*)  ilmpc,
character*8, dimension(*)  lakon,
integer, dimension(*)  ipkon,
integer, dimension(*)  kon,
integer  nk,
integer  nk_,
integer, dimension(*)  nodeboun,
integer, dimension(*)  ndirboun,
integer, dimension(*)  ikboun,
integer, dimension(*)  ilboun,
integer  nboun,
integer  nboun_,
integer, dimension(2)  iperturb,
integer  ne_,
real*8, dimension(3,*)  co,
real*8, dimension(*)  xboun,
real*8, dimension(*)  ctrl,
character*1, dimension(*)  typeboun,
integer  istep,
integer  istat,
integer  n,
integer  iline,
integer  ipol,
integer  inl,
integer, dimension(2,*)  ipoinp,
integer, dimension(3,*)  inp,
integer, dimension(0:*)  ipoinpc 
)
25 !
26 ! reading the input deck: *MPC
27 !
28  implicit none
29 !
30  character*1 typeboun(*),inpc(*)
31  character*8 lakon(*)
32  character*20 labmpc(*),label
33  character*81 set(*),noset
34  character*132 textpart(16)
35 !
36  integer istartset(*),iendset(*),ialset(*),ipompc(*),
37  & nodempc(3,*),idirref,
38  & nset,nset_,nalset,nalset_,nmpc,nmpc_,mpcfree,nk,nk_,ikmpc(*),
39  & ilmpc(*),ipkon(*),kon(*),i,node,ipos,istep,istat,n,ne_,
40  & j,k,nodeboun(*),ndirboun(*),ikboun(*),ilboun(*),ipoinpc(0:*),
41  & nboun,nboun_,key,iperturb(2),istart,inode,m,iline,ipol,inl,
42  & ipoinp(2,*),inp(3,*)
43 !
44  real*8 coefmpc(3,*),co(3,*),xboun(*),ctrl(*)
45 !
46  idirref=0
47 !
48  if(istep.gt.0) then
49  write(*,*)
50  & '*ERROR reading *MPC: *MPC should be placed'
51  write(*,*) ' before all step definitions'
52  call exit(201)
53  endif
54 !
55  if(iperturb(1).eq.1) then
56  write(*,*) '*ERROR reading *MPC: the *MPC option'
57  write(*,*) ' cannot be used in a perturbation step'
58  call exit(201)
59  endif
60 !
61  do i=2,n
62  write(*,*)
63  & '*WARNING reading *MPC: parameter not recognized:'
64  write(*,*) ' ',
65  & textpart(i)(1:index(textpart(i),' ')-1)
66  call inputwarning(inpc,ipoinpc,iline,
67  &"*MPC%")
68  enddo
69 !
70  istart=0
71  inode=0
72  do
73  call getnewline(inpc,textpart,istat,n,key,iline,ipol,inl,
74  & ipoinp,inp,ipoinpc)
75  if((istat.lt.0).or.(key.eq.1)) exit
76 !
77  if(istart.eq.0) then
78  label=textpart(1)(1:20)
79  istart=2
80  else
81  istart=1
82  endif
83 !
84  do i=istart,n
85  read(textpart(i)(1:10),'(i10)',iostat=istat) node
86  if(istat.gt.0) then
87  noset=textpart(i)(1:80)
88  noset(81:81)=' '
89  ipos=index(noset,' ')
90  noset(ipos:ipos)='N'
91  do j=1,nset
92  if(noset.eq.set(j)) then
93  m=iendset(j)-istartset(j)+1
94  do k=1,m
95  node=ialset(istartset(j)+k-1)
96  inode=inode+1
97  if(label(1:8).eq.'STRAIGHT') then
98  call straightmpc(ipompc,nodempc,coefmpc,
99  & labmpc,nmpc,nmpc_,mpcfree,ikmpc,ilmpc,
100  & nk,nk_,nodeboun,ndirboun,ikboun,ilboun,
101  & nboun,nboun_,xboun,inode,node,co,
102  & typeboun)
103  elseif(label(1:5).eq.'PLANE') then
104  call planempc(ipompc,nodempc,coefmpc,
105  & labmpc,nmpc,nmpc_,mpcfree,ikmpc,ilmpc,
106  & nk,nk_,nodeboun,ndirboun,ikboun,ilboun,
107  & nboun,nboun_,xboun,inode,node,co,
108  & typeboun)
109  elseif(label(1:4).eq.'BEAM') then
110  call beammpc(ipompc,nodempc,
111  & labmpc,nmpc,nmpc_,mpcfree,ikmpc,ilmpc,
112  & nk,nk_,nodeboun,ndirboun,ikboun,ilboun,
113  & nboun,nboun_,inode,node,co,
114  & typeboun)
115  else
116  call usermpc(ipompc,nodempc,coefmpc,
117  & labmpc,nmpc,nmpc_,mpcfree,ikmpc,ilmpc,
118  & nk,nk_,nodeboun,ndirboun,ikboun,ilboun,
119  & nboun,nboun_,inode,node,co,label,
120  & typeboun,iperturb,node,idirref,xboun)
121  endif
122  enddo
123  exit
124  endif
125  enddo
126  if(j.gt.nset) then
127  noset(ipos:ipos)=' '
128  write(*,*) '*ERROR in nosets: node set ',
129  & noset
130  write(*,*) ' has not been defined yet'
131  call exit(201)
132  endif
133  else
134  inode=inode+1
135  if(node.eq.0) then
136  inode=inode-1
137  cycle
138  endif
139  if(label(1:8).eq.'STRAIGHT') then
140  call straightmpc(ipompc,nodempc,coefmpc,
141  & labmpc,nmpc,nmpc_,mpcfree,ikmpc,ilmpc,
142  & nk,nk_,nodeboun,ndirboun,ikboun,ilboun,
143  & nboun,nboun_,xboun,inode,node,co,
144  & typeboun)
145  elseif(label(1:5).eq.'PLANE') then
146  call planempc(ipompc,nodempc,coefmpc,
147  & labmpc,nmpc,nmpc_,mpcfree,ikmpc,ilmpc,
148  & nk,nk_,nodeboun,ndirboun,ikboun,ilboun,
149  & nboun,nboun_,xboun,inode,node,co,typeboun)
150  elseif(label(1:4).eq.'BEAM') then
151  call beammpc(ipompc,nodempc,
152  & labmpc,nmpc,nmpc_,mpcfree,ikmpc,ilmpc,
153  & nk,nk_,nodeboun,ndirboun,ikboun,ilboun,
154  & nboun,nboun_,inode,node,co,typeboun)
155  else
156  call usermpc(ipompc,nodempc,coefmpc,
157  & labmpc,nmpc,nmpc_,mpcfree,ikmpc,ilmpc,
158  & nk,nk_,nodeboun,ndirboun,ikboun,ilboun,
159  & nboun,nboun_,inode,node,co,label,
160  & typeboun,iperturb,node,idirref,xboun)
161  endif
162  endif
163  enddo
164 !
165  enddo
166 !
167 ! nonhomogeneous term for user MPC
168 !
169  if((label(1:8).ne.'STRAIGHT').and.(label(1:5).ne.'PLANE').and.
170  & (label(1:4).ne.'BEAM'))
171  & then
172  node=0
173  call usermpc(ipompc,nodempc,coefmpc,
174  & labmpc,nmpc,nmpc_,mpcfree,ikmpc,ilmpc,
175  & nk,nk_,nodeboun,ndirboun,ikboun,ilboun,
176  & nboun,nboun_,inode,node,co,label,typeboun,
177  & iperturb,node,idirref,xboun)
178  else
179 !
180 ! the *MPC option implies a nonlinear geometric
181 ! calculation for all MPC's except MEANROT MPC's
182 !
183  iperturb(2)=1
184  write(*,*) '*INFO reading *MPC: nonlinear geometric'
185  write(*,*) ' effects are turned on'
186  write(*,*)
187  if(iperturb(1).eq.0) iperturb(1)=2
188  endif
189 !
190  return
beammpc
subroutine beammpc(ipompc, nodempc, labmpc, nmpc, nmpc_, mpcfree, ikmpc, ilmpc, nk, nk_, nodeboun, ndirboun, ikboun, ilboun, nboun, nboun_, inode, node, co, typeboun)
Definition: beammpc.f:22
inputwarning
subroutine inputwarning(inpc, ipoinpc, iline, text)
Definition: inputwarning.f:20
planempc
subroutine planempc(ipompc, nodempc, coefmpc, labmpc, nmpc, nmpc_, mpcfree, ikmpc, ilmpc, nk, nk_, nodeboun, ndirboun, ikboun, ilboun, nboun, nboun_, xboun, inode, node, co, typeboun)
Definition: planempc.f:22
getnewline
subroutine getnewline(inpc, textpart, istat, n, key, iline, ipol, inl, ipoinp, inp, ipoinpc)
Definition: getnewline.f:21
straightmpc
subroutine straightmpc(ipompc, nodempc, coefmpc, labmpc, nmpc, nmpc_, mpcfree, ikmpc, ilmpc, nk, nk_, nodeboun, ndirboun, ikboun, ilboun, nboun, nboun_, xboun, inode, node, co, typeboun)
Definition: straightmpc.f:22
usermpc
subroutine usermpc(ipompc, nodempc, coefmpc, labmpc, nmpc, nmpc_, mpcfree, ikmpc, ilmpc, nk, nk_, nodeboun, ndirboun, ikboun, ilboun, nboun, nboun_, nnodes, node, co, label, typeboun, iperturb, noderef, idirref, xboun)
Definition: usermpc.f:23
Hosted by OpenAircraft.com, (Michigan UAV, LLC)