1!
2!     CalculiX - A 3-dimensional finite element program
3!     Copyright (C) 1998-2021 Guido Dhondt
4!
5!     This program is free software; you can redistribute it and/or
6!     modify it under the terms of the GNU General Public License as
7!     published by the Free Software Foundation(version 2);
8!
9!
10!     This program is distributed in the hope that it will be useful,
11!     but WITHOUT ANY WARRANTY; without even the implied warranty of
12!     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
13!     GNU General Public License for more details.
14!
15!     You should have received a copy of the GNU General Public License
16!     along with this program; if not, write to the Free Software
17!     Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
18!
19      subroutine allocation_rfn(nk_,ne_,nkon_,ipoinp,ipoinpc,inpc,inp)
20!
21!     calculates a conservative estimate of the size of to be allocated
22!
23      implicit none
24!
25      character*1 inpc(*)
26      character*8 label
27      character*132 textpart(16)
28!
29      integer nk_,ne_,nkon_,ipoinp(2,*),ipoinpc(0:*),inp(3,*),ier,i,
30     &     nteller,nopeexp,nope,nentries,n,key,istat,ipol,inl,iline
31!
32      parameter(nentries=18)
33!
34      ier=0
35!
36!     initialisation of ipoinp
37!
38      do i=1,nentries
39        if(ipoinp(1,i).ne.0) then
40          ipol=i
41          inl=ipoinp(1,i)
42          iline=inp(1,inl)-1
43          exit
44        endif
45      enddo
46!
47      istat=0
48!
49      call getnewline(inpc,textpart,istat,n,key,iline,ipol,inl,
50     &     ipoinp,inp,ipoinpc)
51      loop: do
52        if(istat.lt.0) then
53          exit
54        endif
55!
56        if(textpart(1)(1:8).eq.'*ELEMENT') then
57!
58          loop1: do i=2,n
59            if(textpart(i)(1:5).eq.'TYPE=') then
60              read(textpart(i)(6:13),'(a8)') label
61              if(label.eq.'        ') then
62                write(*,*)
63     &               '*ERROR in allocation: element type is lacking'
64                write(*,*) '       '
65                call inputerror(inpc,ipoinpc,iline,
66     &               "*ELEMENT or *ELEMENT OUTPUT%",ier)
67                exit
68              endif
69!
70              nopeexp=0
71!
72              if(label.eq.'C3D10   ') then
73                nope=10
74                nopeexp=10
75              elseif(label.eq.'C3D4    ') then
76                nope=4
77                nopeexp=4
78              endif
79            endif
80          enddo loop1
81!
82          loop2:do
83            call getnewline(inpc,textpart,istat,n,key,iline,ipol,inl,
84     &         ipoinp,inp,ipoinpc)
85            if((istat.lt.0).or.(key.eq.1)) exit
86            read(textpart(1)(1:10),'(i10)',iostat=istat) i
87            if(istat.gt.0) then
88              call inputerror(inpc,ipoinpc,iline,
89     &             "*ELEMENT%",ier)
90              exit
91            endif
92            nteller=n-1
93            if(nteller.lt.nope) then
94              do
95                call getnewline(inpc,textpart,istat,n,key,iline,
96     &               ipol,inl,ipoinp,inp,ipoinpc)
97                if((istat.lt.0).or.(key.eq.1)) exit loop2
98                if(nteller+n.gt.nope) n=nope-nteller
99                nteller=nteller+n
100                if(nteller.eq.nope) exit
101              enddo
102            endif
103            ne_=max(ne_,i)
104            nkon_=nkon_+nopeexp
105          enddo loop2
106        elseif(textpart(1)(1:5).eq.'*NODE') then
107!
108          do
109            call getnewline(inpc,textpart,istat,n,key,iline,ipol,inl,
110     &           ipoinp,inp,ipoinpc)
111            if((istat.lt.0).or.(key.eq.1)) exit
112            read(textpart(1)(1:10),'(i10)',iostat=istat) i
113            if(istat.gt.0) then
114              call inputerror(inpc,ipoinpc,iline,
115     &             "*NODE%",ier)
116              exit
117            endif
118            nk_=max(nk_,i)
119          enddo
120        else
121!
122          call getnewline(inpc,textpart,istat,n,key,iline,ipol,inl,
123     &         ipoinp,inp,ipoinpc)
124        endif
125      enddo loop
126!
127      if(ier.eq.1) then
128        write(*,*) '*ERROR in allocation: at least one fatal'
129        write(*,*) '       error message while reading the'
130        write(*,*) '       input deck: CalculiX stops.'
131        write(*,*)
132        call exit(201)
133      endif
134!
135      return
136      end
137