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

Go to the source code of this file.

Functions/Subroutines

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

Function/Subroutine Documentation

◆ nodes()

subroutine nodes ( character*1, dimension(*)  inpc,
character*132, dimension(16)  textpart,
real*8, dimension(3,*)  co,
integer  nk,
integer  nk_,
character*81, dimension(*)  set,
integer, dimension(*)  istartset,
integer, dimension(*)  iendset,
integer, dimension(*)  ialset,
integer  nset,
integer  nset_,
integer  nalset,
integer  nalset_,
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: *NODE
24 !
25  implicit none
26 !
27  character*1 inpc(*)
28  character*81 set(*),noset
29  character*132 textpart(16)
30 !
31  integer nk,nk_,nset,nset_,nalset,nalset_,istep,istat,n,key,
32  & i,js,k,nn,inoset,ipos,istartset(*),iendset(*),ialset(*),
33  & iline,ipol,inl,ipoinp(2,*),inp(3,*),ipoinpc(0:*)
34 !
35  real*8 co(3,*)
36 !
37  if(istep.gt.0) then
38  write(*,*) '*ERROR in nodes: *NODE should be placed'
39  write(*,*) ' before all step definitions'
40  call exit(201)
41  endif
42 !
43  inoset=0
44 !
45 ! checking for set definition
46 !
47  loop: do i=2,n
48  if(textpart(i)(1:5).eq.'NSET=') then
49  noset=textpart(i)(6:85)
50  if(textpart(i)(86:86).ne.' ') then
51  write(*,*) '*ERROR in nodes: set name too long'
52  write(*,*) ' (more than 80 characters)'
53  write(*,*) ' set name:',textpart(i)(1:132)
54  call exit(201)
55  endif
56  noset(81:81)=' '
57  ipos=index(noset,' ')
58  noset(ipos:ipos)='N'
59  inoset=1
60  do js=1,nset
61  if(set(js).eq.noset) then
62 !
63 ! existent set
64 !
65  if(iendset(js).eq.nalset) then
66  exit loop
67  else
68  nn=iendset(js)-istartset(js)+1
69  if(nalset+nn.gt.nalset_) then
70  write(*,*) '*ERROR in nodes: increase nalset_'
71  call exit(201)
72  endif
73  do k=1,nn
74  ialset(nalset+k)=ialset(istartset(js)+k-1)
75  enddo
76  do k=istartset(js),nalset
77  ialset(k)=ialset(k+nn)
78  enddo
79  do k=1,nset
80  if(istartset(k).gt.iendset(js)) then
81  istartset(k)=istartset(k)-nn
82  iendset(k)=iendset(k)-nn
83  endif
84  enddo
85  istartset(js)=nalset-nn+1
86  iendset(js)=nalset
87  exit loop
88  endif
89  endif
90  enddo
91 !
92 ! new set
93 !
94  nset=nset+1
95  if(nset.gt.nset_) then
96  write(*,*) '*ERROR in nodes: increase nset_'
97  call exit(201)
98  endif
99  js=nset
100  istartset(js)=nalset+1
101  iendset(js)=nalset
102  set(js)=noset
103  exit
104  else
105  write(*,*)
106  & '*WARNING in nodes: parameter not recognized:'
107  write(*,*) ' ',
108  & textpart(i)(1:index(textpart(i),' ')-1)
109  call inputwarning(inpc,ipoinpc,iline,
110  &"*NODE%")
111  endif
112  enddo loop
113 !
114  do
115  call getnewline(inpc,textpart,istat,n,key,iline,ipol,inl,
116  & ipoinp,inp,ipoinpc)
117  if((istat.lt.0).or.(key.eq.1)) return
118  read(textpart(1)(1:10),'(i10)',iostat=istat) i
119  if(istat.gt.0) call inputerror(inpc,ipoinpc,iline,
120  &"*NODE%")
121  if(n.eq.1) then
122  co(1,i)=0.d0
123  else
124  read(textpart(2)(1:20),'(f20.0)',iostat=istat) co(1,i)
125  if(istat.gt.0) call inputerror(inpc,ipoinpc,iline,
126  &"*NODE%")
127  endif
128  if(n.le.2) then
129  co(2,i)=0.d0
130  else
131  read(textpart(3)(1:20),'(f20.0)',iostat=istat) co(2,i)
132  if(istat.gt.0) call inputerror(inpc,ipoinpc,iline,
133  &"*NODE%")
134  endif
135  if(n.le.3) then
136  co(3,i)=0.d0
137  else
138  read(textpart(4)(1:20),'(f20.0)',iostat=istat) co(3,i)
139  if(istat.gt.0) call inputerror(inpc,ipoinpc,iline,
140  &"*NODE%")
141  endif
142  nk=max(nk,i)
143  if(nk.gt.nk_) then
144  write(*,*) '*ERROR in nodes: increase nk_'
145  call exit(201)
146  endif
147 !
148 ! assigning node to set
149 !
150  if(inoset.eq.1) then
151  if(nalset+1.gt.nalset_) then
152  write(*,*) '*ERROR in nodes: increase nalset_'
153  call exit(201)
154  endif
155  nalset=nalset+1
156  ialset(nalset)=i
157  iendset(js)=nalset
158  endif
159 !
160  enddo
161 !
162  return
#define max(a, b)
Definition: cascade.c:32
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)