Rocstar  1.0
Rocstar multiphysics simulation application
 All Classes Namespaces Files Functions Variables Typedefs Enumerations Enumerator Friends Macros Groups Pages
SplitQuadFace.F90
Go to the documentation of this file.
1 ! *********************************************************************
2 ! * Rocstar Simulation Suite *
3 ! * Copyright@2015, Illinois Rocstar LLC. All rights reserved. *
4 ! * *
5 ! * Illinois Rocstar LLC *
6 ! * Champaign, IL *
7 ! * www.illinoisrocstar.com *
8 ! * sales@illinoisrocstar.com *
9 ! * *
10 ! * License: See LICENSE file in top level of distribution package or *
11 ! * http://opensource.org/licenses/NCSA *
12 ! *********************************************************************
13 ! *********************************************************************
14 ! * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, *
15 ! * EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES *
16 ! * OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND *
17 ! * NONINFRINGEMENT. IN NO EVENT SHALL THE CONTRIBUTORS OR *
18 ! * COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER *
19 ! * LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, *
20 ! * Arising FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE *
21 ! * USE OR OTHER DEALINGS WITH THE SOFTWARE. *
22 ! *********************************************************************
23 !******************************************************************************
24 !
25 ! Purpose: Indicate which way quad face should be split into two triangular
26 ! faces.
27 !
28 ! Description: None.
29 !
30 ! Input:
31 ! xyz Coordinates of the four vertices
32 !
33 ! Output:
34 ! splitFlag Flag indicating whether face should be split along diagonal
35 ! 13 or 24. If splitFlag == FACE_SPLIT_13, face should be split
36 ! along diagonal 13, giving the two triangular faces 123 and 134.
37 ! IF splitFlag == FACE_SPLIT_24, face should be split along
38 ! diagonal 24, giving the two triangular faces 124 and 234.
39 !
40 ! Notes: None.
41 !
42 !******************************************************************************
43 !
44 ! $Id: SplitQuadFace.F90,v 1.3 2008/12/06 08:44:10 mtcampbe Exp $
45 !
46 ! Copyright: (c) 2002 by the University of Illinois
47 !
48 !******************************************************************************
49 
50 SUBROUTINE splitquadface( global,xyz1,xyz2,xyz3,xyz4,splitFlag )
51 
52  USE moddatatypes
53  USE modparameters
54  USE moderror
55  USE modglobal, ONLY : t_global
56  USE modinterfaces, ONLY : facevectortria
57 
58  IMPLICIT NONE
59 
60 ! ... parameters
61  TYPE(t_global), POINTER :: global
62 
63  INTEGER, INTENT(OUT) :: splitflag
64 
65  REAL(RFREAL), DIMENSION(3), INTENT(IN) :: xyz1, xyz2, xyz3, xyz4
66 
67 ! ... local variables
68  CHARACTER(CHRLEN) :: rcsidentstring
69 
70  REAL(RFREAL) :: fvecx1, fvecx2, fvecy1, fvecy2, fvecz1, fvecz2, mag1, mag2, &
71  prod1, prod2
72  REAL(RFREAL) :: xyznodes(3,3)
73 
74 !******************************************************************************
75 
76  rcsidentstring = '$RCSfile: SplitQuadFace.F90,v $ $Revision: 1.3 $'
77 
78  CALL registerfunction( global,'SplitQuadFace',&
79  'SplitQuadFace.F90' )
80 
81 ! Start -----------------------------------------------------------------------
82 
83 ! Split along diagonal 13: subdivision 123-134
84 
85  xyznodes(1:3,1) = xyz1(1:3)
86  xyznodes(1:3,2) = xyz2(1:3)
87  xyznodes(1:3,3) = xyz3(1:3)
88 
89  CALL facevectortria( xyznodes,fvecx1,fvecy1,fvecz1 )
90 
91  xyznodes(1:3,1) = xyz1(1:3)
92  xyznodes(1:3,2) = xyz3(1:3)
93  xyznodes(1:3,3) = xyz4(1:3)
94 
95  CALL facevectortria( xyznodes,fvecx2,fvecy2,fvecz2 )
96 
97  mag1 = sqrt(fvecx1*fvecx1 + fvecy1*fvecy1 + fvecz1*fvecz1)
98  mag2 = sqrt(fvecx2*fvecx2 + fvecy2*fvecy2 + fvecz2*fvecz2)
99  prod1 = (fvecx1*fvecx2 + fvecy1*fvecy2 + fvecz1*fvecz2)/(mag1*mag2)
100 
101  IF (prod1 < 0.0_rfreal) THEN
102  CALL errorstop( global,err_face_split,__line__ )
103  ENDIF ! prod1
104 
105 ! Split along diagonal 24: subdivision 124-234
106 
107  xyznodes(1:3,1) = xyz1(1:3)
108  xyznodes(1:3,2) = xyz2(1:3)
109  xyznodes(1:3,3) = xyz4(1:3)
110 
111  CALL facevectortria( xyznodes,fvecx1,fvecy1,fvecz1 )
112 
113  xyznodes(1:3,1) = xyz2(1:3)
114  xyznodes(1:3,2) = xyz3(1:3)
115  xyznodes(1:3,3) = xyz4(1:3)
116 
117  CALL facevectortria( xyznodes,fvecx2,fvecy2,fvecz2 )
118 
119  mag1 = sqrt(fvecx1*fvecx1 + fvecy1*fvecy1 + fvecz1*fvecz1)
120  mag2 = sqrt(fvecx2*fvecx2 + fvecy2*fvecy2 + fvecz2*fvecz2)
121  prod2 = (fvecx1*fvecx2 + fvecy1*fvecy2 + fvecz1*fvecz2)/(mag1*mag2)
122 
123  IF (prod2 < 0.0_rfreal) THEN
124  CALL errorstop( global,err_face_split,__line__ )
125  ENDIF ! prod2
126 
127 ! Better subdivision is that which has smaller dotproduct
128 
129  IF (prod1 < prod2) THEN
130  splitflag = face_split_13
131  ELSE
132  splitflag = face_split_24
133  ENDIF ! prod1<prod2
134 
135 ! finalize --------------------------------------------------------------------
136 
137  CALL deregisterfunction( global )
138 
139 END SUBROUTINE splitquadface
140 
141 !******************************************************************************
142 !
143 ! RCS Revision history:
144 !
145 ! $Log: SplitQuadFace.F90,v $
146 ! Revision 1.3 2008/12/06 08:44:10 mtcampbe
147 ! Updated license.
148 !
149 ! Revision 1.2 2008/11/19 22:17:23 mtcampbe
150 ! Added Illinois Open Source License/Copyright
151 !
152 ! Revision 1.1 2004/12/01 16:51:33 haselbac
153 ! Initial revision after changing case
154 !
155 ! Revision 1.3 2002/10/27 18:48:59 haselbac
156 ! Removed tabs
157 !
158 ! Revision 1.2 2002/09/05 17:40:20 jblazek
159 ! Variable global moved into regions().
160 !
161 ! Revision 1.1 2002/03/01 17:07:13 haselbac
162 ! Initial revision
163 !
164 !******************************************************************************
165 
166 
167 
168 
169 
170 
171 
subroutine splitquadface(global, xyz1, xyz2, xyz3, xyz4, splitFlag)
subroutine facevectortria(xyzNodes, fVecX, fVecY, fVecZ)
Definition: FaceVector.F90:49
subroutine registerfunction(global, funName, fileName)
Definition: ModError.F90:449
double sqrt(double d)
Definition: double.h:73
double mag2() const
subroutine errorstop(global, errorCode, errorLine, addMessage)
Definition: ModError.F90:483
subroutine deregisterfunction(global)
Definition: ModError.F90:469