← Back to branch summary

~gabriel1984sibiu/calculix/ccx

« back to all changes in this revision

Viewing changes to CalculiX/ccx_2.11/src/extrapolate_ad_h_comp.f

  • Committer: Grevutiu Gabriel
  • Date: 2016-12-30 12:06:41 UTC
  • Revision ID: gabriel1984sibiu@gmail.com-20161230120641-kzmhfy8mn00w3mhg
New upstream version

Show diffs side-by-side

added added

removed removed

Lines of Context:
CalculiX/ccx_2.11/src/extrapolate_ad_h_comp.f
 
1
!
 
2
!     CalculiX - A 3-dimensional finite element program
 
3
!              Copyright (C) 1998-2015 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_ad_h_comp(nface,ielfa,xrlfa,adv,advfa,
 
20
     &                  hel,hfa,icyclic,c,ifatie)
 
21
!
 
22
!     inter/extrapolation of adv at the center of the elements
 
23
!     to the center of the faces
 
24
!
 
25
!     inter/extrapolation of h at the center of the elements 
 
26
!     to the center of the faces; division through advfa to obtain
 
27
!     the face velocity
 
28
!
 
29
      implicit none
 
30
!
 
31
      integer nface,ielfa(4,*),ipo1,iel2,ipo3,i,j,icyclic,ifatie(*)
 
32
!
 
33
      real*8 xrlfa(3,*),xl1,xl2,advfa(*),adv(*),hel(3,*),hfa(3,*),c(3,3)
 
34
!     
 
35
c$omp parallel default(none)
 
36
c$omp& shared(nface,ielfa,xrlfa,advfa,adv,hfa,hel,icyclic,c,ifatie)
 
37
c$omp& private(i,ipo1,xl1,iel2,j,ipo3,xl2)
 
38
c$omp do
 
39
      do i=1,nface
 
40
         ipo1=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)=1.d0/(xl1/adv(ipo1)+xl2/adv(iel2))
 
49
            if((icyclic.eq.0).or.(ifatie(i).eq.0)) then
 
50
               do j=1,3
 
51
                  hfa(j,i)=(xl1*hel(j,ipo1)/adv(ipo1)
 
52
     &                 +xl2*hel(j,iel2)/adv(iel2))
 
53
               enddo
 
54
            elseif(ifatie(i).gt.0) then
 
55
               do j=1,3
 
56
                  hfa(j,i)=(xl1*hel(j,ipo1)/adv(ipo1)
 
57
     &                 +xl2*(c(j,1)*hel(1,iel2)+
 
58
     &                       c(j,2)*hel(2,iel2)+
 
59
     &                       c(j,3)*hel(3,iel2))/adv(iel2))
 
60
               enddo
 
61
            else
 
62
               do j=1,3
 
63
                  hfa(j,i)=(xl1*hel(j,ipo1)/adv(ipo1)
 
64
     &                 +xl2*(c(1,j)*hel(1,iel2)+
 
65
     &                       c(2,j)*hel(2,iel2)+
 
66
     &                       c(3,j)*hel(3,iel2))/adv(iel2))
 
67
               enddo
 
68
            endif
 
69
         elseif(ielfa(3,i).gt.0) then
 
70
!
 
71
!           external face; linear extrapolation
 
72
!
 
73
            ipo3=ielfa(3,i)
 
74
            advfa(i)=1.d0/(xl1/adv(ipo1)+xrlfa(3,i)/adv(ipo3))
 
75
            do j=1,3
 
76
               hfa(j,i)=(xl1*hel(j,ipo1)/adv(ipo1)+
 
77
     &                   xrlfa(3,i)*hel(j,ipo3)/adv(ipo3))
 
78
            enddo
 
79
         else
 
80
!
 
81
!           external face: constant extrapolation (only one adjacent
 
82
!           element layer)
 
83
!
 
84
            advfa(i)=adv(ipo1)
 
85
            do j=1,3
 
86
               hfa(j,i)=hel(j,ipo1)/adv(ipo1)
 
87
            enddo
 
88
         endif
 
89
      enddo
 
90
c$omp end do
 
91
c$omp end parallel
 
92
!            
 
93
      return
 
94
      end