30318764346

Committed 28 Jul 2026 12:55AM UTC coverage: 76.972% (+1.1%) from 75.909%

Build # 30318764346

Build Type

Pull #166

github

Committed by

web-flow

Commit Message

Merge 3346edfd3 into 955f92dca

Pull Request Pull Request #166: Add L2/H1 boundary optimization

Coverage Stats

1631 of 1964 new or added lines in 40 files covered. (83.04%)

48 existing lines in 4 files now uncovered.

9563 of 12424 relevant lines covered (76.97%)

634449.32 hits per line

Source File
Press 'n' to go to next uncovered line, 'b' for previous

60.71

/Source/Curves/DiscreteCurves/MultiSegmentCurve.f90

!
!////////////////////////////////////////////////////////////////////////
!
!      MultiSegmentCurve.f90
!      Created: April 26, 2026 at 11:09 AM 
!      By: David Kopriva  
!
!      The base class for:
!         MultiSegmentCurve
!         MultiSegmentModalCurve
!
!////////////////////////////////////////////////////////////////////////
!
   Module MultiSegmentCurveClass 
   USE SMConstants
   USE SMCurveClass
   USE IntervalSearchModule
   USE GaussQuadratureModule
   IMPLICIT NONE
   
   TYPE, EXTENDS(SMCurve) :: MultiSegmentCurve
      INTEGER                    :: nSegments
      INTEGER                    :: polyOrder
      REAL(KIND=RP), ALLOCATABLE :: cuts(:)
!
!     ========
      CONTAINS
!     ========
!         
      PROCEDURE :: construct => ConstructMultiSegmentCurve
      FINAL     :: DestructMultiSegmentCurve
      PROCEDURE :: positionAt => EvaluateMultiSegmentCurve
      PROCEDURE :: derivativeAt => EvaluateMultiSegmentCurveD 
      PROCEDURE :: derivativeInSegment => baseDerivativeInSegment
      PROCEDURE :: arcLength
      PROCEDURE :: className  => MSCClassName
   END TYPE MultiSegmentCurve
   
!
!  ========
   CONTAINS  
!  ========
!
      SUBROUTINE castObjToMultiSegmentCurve(curve,cast)
!
!     -----------------------------------------------------
!     Cast the base class SMCurve to the FTValue class
!     -----------------------------------------------------
!
         IMPLICIT NONE  
         CLASS(FTObject)          , POINTER :: curve
         CLASS(MultiSegmentCurve) , POINTER :: cast
         
         cast => NULL()
         SELECT TYPE (e => curve)
            CLASS IS(MultiSegmentCurve)
               cast => e
            CLASS DEFAULT
               
         END SELECT
         
      END SUBROUTINE castObjToMultiSegmentCurve
!
!//////////////////////////////////////////////////////////////////////// 
! 
      SUBROUTINE ConstructMultiSegmentCurve(self, cuts, N, curveName, id )  
         IMPLICIT NONE
!
!        ---------
!        Arguments
!        ---------
!
         CLASS(MultiSegmentCurve) :: self
         CLASS(SMCurve), POINTER       :: parentCurve
         REAL(KIND=RP)            :: cuts(0:)
         INTEGER                  :: N
         CHARACTER(LEN=*)         :: curveName
         INTEGER                  :: id
          
         CALL self % SMCurve % initWithNameAndID(curveName,id)
!
!        ----------
!        Set values
!        ----------
!        
         self % cuts      = cuts
         self % polyOrder = N
         self % nSegments = SIZE(cuts)-1
!
      END SUBROUTINE ConstructMultiSegmentCurve
!
!//////////////////////////////////////////////////////////////////////// 
! 
      SUBROUTINE DestructMultiSegmentCurve(self)  
         IMPLICIT NONE  
         TYPE(MultiSegmentCurve) :: self

      END SUBROUTINE DestructMultiSegmentCurve
!
!//////////////////////////////////////////////////////////////////////// 
! 
      SUBROUTINE releaseMultiSegmentCurve(self)  
         IMPLICIT NONE
         TYPE (MultiSegmentCurve), POINTER :: self
         CLASS(FTObject)              , POINTER :: obj
         
         IF(.NOT. ASSOCIATED(self)) RETURN
         
         obj => self
         CALL releaseFTObject(self = obj)
         IF ( .NOT. ASSOCIATED(obj) )     THEN
            self => NULL() 
         END IF      
      END SUBROUTINE releaseMultiSegmentCurve
!
!//////////////////////////////////////////////////////////////////////// 
! 
      FUNCTION EvaluateMultiSegmentCurve(self,t)  RESULT(x)
         IMPLICIT NONE  
         CLASS(MultiSegmentCurve) :: self
         REAL(KIND=RP)                 :: t
         REAL(KIND=RP)                 :: x(3)
         
         x = 0.0_RP
         
      END FUNCTION EvaluateMultiSegmentCurve
!
!//////////////////////////////////////////////////////////////////////// 
! 
      FUNCTION EvaluateMultiSegmentCurveD(self,t)  RESULT(x)
         IMPLICIT NONE  
         CLASS(MultiSegmentCurve) :: self
         REAL(KIND=RP)                 :: t
         REAL(KIND=RP)                 :: x(3)

         x = 0.0_RP     
             
      END FUNCTION EvaluateMultiSegmentCurveD
!
!//////////////////////////////////////////////////////////////////////// 
! 
      FUNCTION baseDerivativeInSegment(self, t, k)  RESULT(x)
!
!        ---------------------------------------------------------------
!        Returns the derivative in segment k as needed by the superclass
!        procedure to compute the arc length
!        ---------------------------------------------------------------
!
         IMPLICIT NONE  
         CLASS(MultiSegmentCurve) :: self
         REAL(KIND=RP)            :: t
         REAL(KIND=RP)            :: x(3)
         INTEGER                  :: k
         
         x = 0.0_RP
         
      END FUNCTION baseDerivativeInSegment
!
!//////////////////////////////////////////////////////////////////////// 
! 
   REAL(KIND=RP) FUNCTION arcLength(self, gQuad)
!
!  -------------------------------------------
!  Compute the arc length of a segmented curve
!  -------------------------------------------
!
      IMPLICIT NONE
!
!     ---------
!     Arguments
!     ---------
!
      CLASS(MultiSegmentCurve) :: self
      TYPE(GaussQuadratureType)     :: gQuad
!
!     ----------------
!     Local variables 
!     ----------------
!
      INTEGER                    :: nSegments
      INTEGER                    :: k
      
      nSegments = self % nSegments
      
      arcLength = 0.0_RP
      DO k = 1, nSegments
         arcLength = arcLength + segmentArcLength(self, k, gQuad % nodes, gQuad % weights)
      END DO 
      
   END FUNCTION arcLength
!
!//////////////////////////////////////////////////////////////////////// 
! 
   REAL(KIND=RP) FUNCTION segmentArcLength(self, k, nodes, weights)
!
!  -------------------------------------
!  Compute the arc length of a segmented
!  curve
!  -------------------------------------
!
      IMPLICIT NONE
!
!     ---------
!     Arguments
!     ---------
!
      CLASS(MultiSegmentCurve) :: self
      REAL(KIND=RP)            :: nodes(0:), weights(0:)
      INTEGER                  :: k
!
!     ----------------
!     Local variables 
!     ----------------
!
      INTEGER                    :: N
      INTEGER                    :: qOrder
      INTEGER                    :: nSegments
      INTEGER                    :: j
      REAL(KIND=RP)              :: t, h, e1(3)
      REAL(KIND=RP)              :: dsdt
      
      nSegments = self % nSegments

      N      = self % polyOrder
      qOrder = SIZE(nodes) - 1
            
      segmentArcLength = 0.0_RP
      h    = self % cuts(k) - self % cuts(k-1)
      dsdt = 2.0_RP/h
      DO j = 0, qOrder
         t                = self % cuts(k-1) + h*0.5_RP*(nodes(j) + 1.0_RP)
         e1               = dsdt*self % derivativeInSegment(t,k)
         segmentArcLength = segmentArcLength + 0.5_RP*h*weights(j)*SQRT(e1(1)**2 + e1(2)**2)
      END DO 
      
   END FUNCTION segmentArcLength
!
!//////////////////////////////////////////////////////////////////////// 
! 
      REAL(KIND=RP) FUNCTION affineMap(t0,t1,s)  
         IMPLICIT NONE  
         REAL(KIND=RP) :: t0, t1, s !\in [-1,1]
         
         affineMap = t0 + (t1 - t0)*0.5_RP*(1.0_RP + s)
         
      END FUNCTION affineMap
!
!//////////////////////////////////////////////////////////////////////// 
! 
      REAL(KIND=RP) FUNCTION InvAffineMap(t0,t1,t)  
         IMPLICIT NONE  
         REAL(KIND=RP) :: t0, t1, t !\in [t0,t1]
         
         InvAffineMap = 2.0_RP*(t - t0)/(t1 - t0) - 1.0_RP
         
      END FUNCTION InvAffineMap
!
!//////////////////////////////////////////////////////////////////////// 
! 
!      -----------------------------------------------------------------
!> Class name returns a string with the name of the type of the object
!>
!>  ### Usage:
!>
!>        PRINT *,  obj % className()
!>        if( obj % className =="MultiSegmentCurve")
!>
      FUNCTION MSCClassName(self)  RESULT(s)
         IMPLICIT NONE  
         CLASS(MultiSegmentCurve)              :: self
         CHARACTER(LEN=CLASS_NAME_CHARACTER_LENGTH) :: s
         
         s = "MultiSegmentCurve"
         IF( self % refCount() >= 0 ) CONTINUE 
 
      END FUNCTION MSCClassName

   END Module MultiSegmentCurveClass

1	!
2	!////////////////////////////////////////////////////////////////////////
3	!
4	! MultiSegmentCurve.f90
5	! Created: April 26, 2026 at 11:09 AM
6	! By: David Kopriva
7	!
8	! The base class for:
9	! MultiSegmentCurve
10	! MultiSegmentModalCurve
11	!
12	!////////////////////////////////////////////////////////////////////////
13	!
14	Module MultiSegmentCurveClass
15	USE SMConstants
16	USE SMCurveClass
17	USE IntervalSearchModule
18	USE GaussQuadratureModule
19	IMPLICIT NONE
20
21	TYPE, EXTENDS(SMCurve) :: MultiSegmentCurve
22	INTEGER :: nSegments
23	INTEGER :: polyOrder
24	REAL(KIND=RP), ALLOCATABLE :: cuts(:)
25	!
26	! ========
27	CONTAINS
28	! ========
29	!
30	PROCEDURE :: construct => ConstructMultiSegmentCurve
31	FINAL :: DestructMultiSegmentCurve
32	PROCEDURE :: positionAt => EvaluateMultiSegmentCurve
33	PROCEDURE :: derivativeAt => EvaluateMultiSegmentCurveD
34	PROCEDURE :: derivativeInSegment => baseDerivativeInSegment
35	PROCEDURE :: arcLength
36	PROCEDURE :: className => MSCClassName
37	END TYPE MultiSegmentCurve
38
39	!
40	! ========
41	CONTAINS
42	! ========
43	!
44	SUBROUTINE castObjToMultiSegmentCurve(curve,cast)	5,931✔
45	!
46	! -----------------------------------------------------
47	! Cast the base class SMCurve to the FTValue class
48	! -----------------------------------------------------
49	!
50	IMPLICIT NONE
51	CLASS(FTObject) , POINTER :: curve
52	CLASS(MultiSegmentCurve) , POINTER :: cast
53
54	cast => NULL()	5,931✔
55	SELECT TYPE (e => curve)
56	CLASS IS(MultiSegmentCurve)
57	cast => e	5,931✔
58	CLASS DEFAULT
59
60	END SELECT
61
62	END SUBROUTINE castObjToMultiSegmentCurve	5,931✔
63	!
64	!////////////////////////////////////////////////////////////////////////
65	!
66	SUBROUTINE ConstructMultiSegmentCurve(self, cuts, N, curveName, id )	626✔
67	IMPLICIT NONE
68	!
69	! ---------
70	! Arguments
71	! ---------
72	!
73	CLASS(MultiSegmentCurve) :: self
74	CLASS(SMCurve), POINTER :: parentCurve
75	REAL(KIND=RP) :: cuts(0:)
76	INTEGER :: N
77	CHARACTER(LEN=*) :: curveName
78	INTEGER :: id
79
80	CALL self % SMCurve % initWithNameAndID(curveName,id)	626✔
81	!
82	! ----------
83	! Set values
84	! ----------
85	!
86	self % cuts = cuts	7,562✔
87	self % polyOrder = N	626✔
88	self % nSegments = SIZE(cuts)-1	626✔
89	!
90	END SUBROUTINE ConstructMultiSegmentCurve	626✔
91	!
92	!////////////////////////////////////////////////////////////////////////
93	!
94	SUBROUTINE DestructMultiSegmentCurve(self)	516✔
95	IMPLICIT NONE
96	TYPE(MultiSegmentCurve) :: self
97
98	END SUBROUTINE DestructMultiSegmentCurve	516✔
99	!
100	!////////////////////////////////////////////////////////////////////////
101	!
NEW 102	SUBROUTINE releaseMultiSegmentCurve(self)	×
103	IMPLICIT NONE
104	TYPE (MultiSegmentCurve), POINTER :: self
105	CLASS(FTObject) , POINTER :: obj
106
NEW 107	IF(.NOT. ASSOCIATED(self)) RETURN	×
108
NEW 109	obj => self	×
NEW 110	CALL releaseFTObject(self = obj)	×
NEW 111	IF ( .NOT. ASSOCIATED(obj) ) THEN	×
NEW 112	self => NULL()	×
113	END IF
114	END SUBROUTINE releaseMultiSegmentCurve
115	!
116	!////////////////////////////////////////////////////////////////////////
117	!
NEW 118	FUNCTION EvaluateMultiSegmentCurve(self,t) RESULT(x)	×
119	IMPLICIT NONE
120	CLASS(MultiSegmentCurve) :: self
121	REAL(KIND=RP) :: t
122	REAL(KIND=RP) :: x(3)
123
NEW 124	x = 0.0_RP	×
125
NEW 126	END FUNCTION EvaluateMultiSegmentCurve	×
127	!
128	!////////////////////////////////////////////////////////////////////////
129	!
NEW 130	FUNCTION EvaluateMultiSegmentCurveD(self,t) RESULT(x)	×
131	IMPLICIT NONE
132	CLASS(MultiSegmentCurve) :: self
133	REAL(KIND=RP) :: t
134	REAL(KIND=RP) :: x(3)
135
NEW 136	x = 0.0_RP	×
137
NEW 138	END FUNCTION EvaluateMultiSegmentCurveD	×
139	!
140	!////////////////////////////////////////////////////////////////////////
141	!
NEW 142	FUNCTION baseDerivativeInSegment(self, t, k) RESULT(x)	×
143	!
144	! ---------------------------------------------------------------
145	! Returns the derivative in segment k as needed by the superclass
146	! procedure to compute the arc length
147	! ---------------------------------------------------------------
148	!
149	IMPLICIT NONE
150	CLASS(MultiSegmentCurve) :: self
151	REAL(KIND=RP) :: t
152	REAL(KIND=RP) :: x(3)
153	INTEGER :: k
154
NEW 155	x = 0.0_RP	×
156
NEW 157	END FUNCTION baseDerivativeInSegment	×
158	!
159	!////////////////////////////////////////////////////////////////////////
160	!
161	REAL(KIND=RP) FUNCTION arcLength(self, gQuad)	2✔
162	!
163	! -------------------------------------------
164	! Compute the arc length of a segmented curve
165	! -------------------------------------------
166	!
167	IMPLICIT NONE
168	!
169	! ---------
170	! Arguments
171	! ---------
172	!
173	CLASS(MultiSegmentCurve) :: self
174	TYPE(GaussQuadratureType) :: gQuad
175	!
176	! ----------------
177	! Local variables
178	! ----------------
179	!
180	INTEGER :: nSegments
181	INTEGER :: k
182
183	nSegments = self % nSegments	2✔
184
185	arcLength = 0.0_RP	2✔
186	DO k = 1, nSegments	7✔
187	arcLength = arcLength + segmentArcLength(self, k, gQuad % nodes, gQuad % weights)	7✔
188	END DO
189
190	END FUNCTION arcLength	2✔
191	!
192	!////////////////////////////////////////////////////////////////////////
193	!
194	REAL(KIND=RP) FUNCTION segmentArcLength(self, k, nodes, weights)	2,883✔
195	!
196	! -------------------------------------
197	! Compute the arc length of a segmented
198	! curve
199	! -------------------------------------
200	!
201	IMPLICIT NONE
202	!
203	! ---------
204	! Arguments
205	! ---------
206	!
207	CLASS(MultiSegmentCurve) :: self
208	REAL(KIND=RP) :: nodes(0:), weights(0:)
209	INTEGER :: k
210	!
211	! ----------------
212	! Local variables
213	! ----------------
214	!
215	INTEGER :: N
216	INTEGER :: qOrder
217	INTEGER :: nSegments
218	INTEGER :: j
219	REAL(KIND=RP) :: t, h, e1(3)
220	REAL(KIND=RP) :: dsdt
221
222	nSegments = self % nSegments	2,883✔
223
224	N = self % polyOrder	2,883✔
225	qOrder = SIZE(nodes) - 1	2,883✔
226
227	segmentArcLength = 0.0_RP	2,883✔
228	h = self % cuts(k) - self % cuts(k-1)	2,883✔
229	dsdt = 2.0_RP/h	2,883✔
230	DO j = 0, qOrder	20,336✔
231	t = self % cuts(k-1) + h0.5_RP(nodes(j) + 1.0_RP)	17,453✔
232	e1 = dsdt*self % derivativeInSegment(t,k)	69,812✔
233	segmentArcLength = segmentArcLength + 0.5_RPhweights(j)SQRT(e1(1)2 + e1(2)*2)	20,336✔
234	END DO
235
236	END FUNCTION segmentArcLength	2,883✔
237	!
238	!////////////////////////////////////////////////////////////////////////
239	!
NEW 240	REAL(KIND=RP) FUNCTION affineMap(t0,t1,s)	×
241	IMPLICIT NONE
242	REAL(KIND=RP) :: t0, t1, s !\in [-1,1]
243
NEW 244	affineMap = t0 + (t1 - t0)0.5_RP(1.0_RP + s)	×
245
NEW 246	END FUNCTION affineMap	×
247	!
248	!////////////////////////////////////////////////////////////////////////
249	!
250	REAL(KIND=RP) FUNCTION InvAffineMap(t0,t1,t)	28,358✔
251	IMPLICIT NONE
252	REAL(KIND=RP) :: t0, t1, t !\in [t0,t1]
253
254	InvAffineMap = 2.0_RP*(t - t0)/(t1 - t0) - 1.0_RP	28,358✔
255
256	END FUNCTION InvAffineMap	28,358✔
257	!
258	!////////////////////////////////////////////////////////////////////////
259	!
260	! -----------------------------------------------------------------
261	!> Class name returns a string with the name of the type of the object
262	!>
263	!> ### Usage:
264	!>
265	!> PRINT *, obj % className()
266	!> if( obj % className =="MultiSegmentCurve")
267	!>
NEW 268	FUNCTION MSCClassName(self) RESULT(s)	×
269	IMPLICIT NONE
270	CLASS(MultiSegmentCurve) :: self
271	CHARACTER(LEN=CLASS_NAME_CHARACTER_LENGTH) :: s
272
NEW 273	s = "MultiSegmentCurve"	×
NEW 274	IF( self % refCount() >= 0 ) CONTINUE	×
275
NEW 276	END FUNCTION MSCClassName	×
277
278	END Module MultiSegmentCurveClass	6,963✔

trixi-framework / HOHQMesh / 30318764346

Source File Press 'n' to go to next uncovered line, 'b' for previous

Source File
Press 'n' to go to next uncovered line, 'b' for previous