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 extrapolate_d_v_simple(ielfa,xrlfa,adv,advfa,
20     &                  hfa,icyclic,c,ifatie,vel,nef,volume,
21     &                  nfacea,nfaceb,ncfd)
22!
23!     inter/extrapolation of volume/adv at the center of the elements
24!     to the center of the faces
25!
26!     inter/extrapolation of v* at the center of the elements
27!     to the center of the faces;
28!
29      implicit none
30!
31      integer ielfa(4,*),iel1,iel2,iel3,i,j,icyclic,ifatie(*),
32     &  nef,nfacea,nfaceb,ncfd
33!
34      real*8 xrlfa(3,*),xl1,xl2,advfa(*),adv(*),vel(nef,0:7),hfa(3,*),
35     &     c(3,3),volume(*)
36!
37!
38!
39      do i=nfacea,nfaceb
40         iel1=ielfa(1,i)
41         xl1=xrlfa(1,i)
42         iel2=ielfa(2,i)
43         if(iel2.gt.0) then
44!
45!           internal face
46!
47            xl2=xrlfa(2,i)
48            advfa(i)=xl1*volume(iel1)/adv(iel1)
49     &              +xl2*volume(iel2)/adv(iel2)
50            if((icyclic.eq.0).or.(ifatie(i).eq.0)) then
51               do j=1,ncfd
52                  hfa(j,i)=(xl1*vel(iel1,j)
53     &                 +xl2*vel(iel2,j))
54               enddo
55            elseif(ifatie(i).gt.0) then
56               do j=1,ncfd
57                  hfa(j,i)=(xl1*vel(iel1,j)
58     &                 +xl2*(c(j,1)*vel(iel2,1)+
59     &                       c(j,2)*vel(iel2,2)+
60     &                       c(j,3)*vel(iel2,3)))
61               enddo
62            else
63               do j=1,ncfd
64                  hfa(j,i)=(xl1*vel(iel1,j)
65     &                 +xl2*(c(1,j)*vel(iel2,1)+
66     &                       c(2,j)*vel(iel2,2)+
67     &                       c(3,j)*vel(iel2,3)))
68               enddo
69            endif
70         elseif(ielfa(3,i).ne.0) then
71!
72!           external face; linear extrapolation
73!
74            iel3=abs(ielfa(3,i))
75            advfa(i)=xl1*volume(iel1)/adv(iel1)
76     &              +xrlfa(3,i)*volume(iel3)/adv(iel3)
77            do j=1,ncfd
78               hfa(j,i)=(xl1*vel(iel1,j)+xrlfa(3,i)*vel(iel3,j))
79            enddo
80         else
81!
82!           external face: constant extrapolation (only one adjacent
83!           element layer)
84!
85            advfa(i)=volume(iel1)/adv(iel1)
86            do j=1,ncfd
87               hfa(j,i)=vel(iel1,j)
88            enddo
89         endif
90      enddo
91!
92      return
93      end
94