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

43.82

/Source/Curves/DiscreteCurves/MultiSegmentModalCurve.f90

!
!////////////////////////////////////////////////////////////////////////
!
!      MultiSegmentModalCurve.f90
!      Created: October 18, 2025 at 1:39 PM 
!      By: David Kopriva  
!
!      A curve subclass that is defined in terms of multiple segments
!      of modally defined Legendre polynomials
!
!////////////////////////////////////////////////////////////////////////
!
   Module MultiSegmentModalCurveClass
      USE MultiSegmentCurveClass
      USE LegendreAlgorithms
      IMPLICIT NONE  
   
      TYPE, EXTENDS(MultiSegmentCurve) :: MultiSegmentModalCurve
         REAL(KIND=RP), ALLOCATABLE    :: segmentLengths(:)
         REAL(KIND=RP), ALLOCATABLE    :: segmentPoints(:,:)
         REAL(KIND=RP), ALLOCATABLE    :: coefs(:,:,:)
!
!        ========
         CONTAINS
!        ========
!         
         PROCEDURE :: ConstructMultiSegmentModalCurve
         FINAL     :: DestructMultiSegmentModalCurve
         PROCEDURE :: positionAt => EvaluateMultiSegmentModalCurve
         PROCEDURE :: derivativeAt => EvaluateMultiSegmentModalCurveD
         PROCEDURE :: derivativeInSegment => modalDerivativeInSegment
         PROCEDURE :: valueInSegment
         PROCEDURE :: className  => MSMCClassName
      END TYPE MultiSegmentModalCurve
!
!  ========      
   CONTAINS  
!  ========      
!
      SUBROUTINE castToMultiSegmentModalCurve(curve,cast)
!
!     -----------------------------------------------------
!     Cast the base class SMCurve to the FTValue class
!     -----------------------------------------------------
!
         IMPLICIT NONE  
         CLASS(SMCurve)                , POINTER :: curve
         CLASS(MultiSegmentModalCurve) , POINTER :: cast
         
         cast => NULL()
         SELECT TYPE (e => curve)
            CLASS IS(MultiSegmentModalCurve)
               cast => e
            CLASS DEFAULT
               
         END SELECT
         
      END SUBROUTINE castToMultiSegmentModalCurve
!
!//////////////////////////////////////////////////////////////////////// 
! 
      SUBROUTINE ConstructMultiSegmentModalCurve(self, parentCurve, cuts, coefs, curveName, id )  
         IMPLICIT NONE
!
!        ---------
!        Arguments
!        ---------
!
         CLASS(MultiSegmentModalCurve) :: self
         CLASS(SMCurve), POINTER       :: parentCurve
         REAL(KIND=RP)                 :: cuts(0:)
         REAL(KIND=RP)                 :: coefs(0:,:,:)
         CHARACTER(LEN=*)              :: curveName
         INTEGER                       :: id
!
!        ---------------
!        Local variables
!        ---------------
!
         INTEGER                       :: k, N
         REAL(KIND=RP), ALLOCATABLE    :: nodes(:), weights(:)
         INTEGER                       :: qOrder
         REAL(KIND=RP)                 :: xStart(3), xEnd(3)
         
         N = SIZE(coefs,1) - 1
         CALL self % MultiSegmentCurve % construct(cuts,N,curveName,id)
         self % coefs = coefs
!
!        ---------------
!        Computed values
!        ---------------
!
         ALLOCATE(self % segmentLengths(self % nSegments)    , SOURCE = 0.0_RP)
         ALLOCATE(self % segmentPoints (3,0:self % nSegments), SOURCE = 0.0_RP)
         qOrder = 2*self % polyOrder
         ALLOCATE(nodes(0:qOrder), weights(0:qOrder))
         CALL GaussLegendreNodesAndWeights( qOrder, nodes, weights )
         
         self % segmentPoints(:,0) = self % valueInSegment(1, self % cuts(0), which = LA_EVALUATE_FUNCTION)
         DO k = 1, self % nSegments 
            xStart = self % valueInSegment(k, self % cuts(k-1), which = LA_EVALUATE_FUNCTION)
            xEnd   = self % valueInSegment(k, self % cuts(k)  , which = LA_EVALUATE_FUNCTION)
            self % segmentPoints(:,k) = xEnd
            self % segmentLengths(k) = SQRT((xEnd(1) - xStart(1))**2 + (xEnd(2) - xStart(2))**2)
         END DO

      END SUBROUTINE ConstructMultiSegmentModalCurve
!
!//////////////////////////////////////////////////////////////////////// 
! 
      SUBROUTINE DestructMultiSegmentModalCurve(self)  
         IMPLICIT NONE  
         TYPE(MultiSegmentModalCurve) :: self

      END SUBROUTINE DestructMultiSegmentModalCurve
!
!//////////////////////////////////////////////////////////////////////// 
! 
      SUBROUTINE releaseMultiSegmentModalCurve(self)  
         IMPLICIT NONE
         CLASS(MultiSegmentModalCurve), 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 releaseMultiSegmentModalCurve
!
!//////////////////////////////////////////////////////////////////////// 
! 
      FUNCTION EvaluateMultiSegmentModalCurve(self,t)  RESULT(x)
         IMPLICIT NONE  
         CLASS(MultiSegmentModalCurve) :: self
         REAL(KIND=RP)                 :: t
         REAL(KIND=RP)                 :: x(3)
         
         x = MultiSegmentModalCurveValue(self, t, LA_EVALUATE_FUNCTION)
         
      END FUNCTION EvaluateMultiSegmentModalCurve
!
!//////////////////////////////////////////////////////////////////////// 
! 
      FUNCTION EvaluateMultiSegmentModalCurveD(self,t)  RESULT(x)
         IMPLICIT NONE  
         CLASS(MultiSegmentModalCurve) :: self
         REAL(KIND=RP)                 :: t
         REAL(KIND=RP)                 :: x(3)
         
         x = MultiSegmentModalCurveValue(self, t, LA_EVALUATE_DERIVATIVE)
         
      END FUNCTION EvaluateMultiSegmentModalCurveD
!
!//////////////////////////////////////////////////////////////////////// 
! 
      FUNCTION MultiSegmentModalCurveValue(self, t, which)  RESULT(x)
         IMPLICIT NONE
!
!        ---------
!        Arguments
!        ---------
!
         CLASS(MultiSegmentModalCurve) :: self
         REAL(KIND=RP)                 :: t
         REAL(KIND=RP)                 :: x(3)
         INTEGER                       :: which ! = LA_EVALUATE_FUNCTION or LA_EVALUATE_DERIVATIVE
!
!        ---------------
!        Local Variables
!        ---------------
!
         INTEGER       :: k
         
         k = findInterval(self % cuts,t)
         x = valueInSegment(self, k ,t, which)
         
         IF ( which == LA_EVALUATE_DERIVATIVE )     THEN
            x = 2.0_RP*x/(self % cuts(k) - self % cuts(k-1)) 
         END IF 
          
      END FUNCTION MultiSegmentModalCurveValue
!
!//////////////////////////////////////////////////////////////////////// 
! 
      FUNCTION modalDerivativeInSegment(self, t, k)  RESULT(x)
!
!     ---------------------------------------------------------------
!     Returns the derivative in segment k as needed by the superclass
!     procedure to compute the arc length
!     ---------------------------------------------------------------
!
         IMPLICIT NONE
!
!        ---------
!        Arguments
!        ---------
!
         CLASS(MultiSegmentModalCurve) :: self
         REAL(KIND=RP)                 :: t
         REAL(KIND=RP)                 :: x(3)
         INTEGER                       :: k
!
         x = valueInSegment(self, k ,t, LA_EVALUATE_DERIVATIVE)

      END FUNCTION modalDerivativeInSegment
!
!//////////////////////////////////////////////////////////////////////// 
! 
      FUNCTION valueInSegment(self, k, t, which)  RESULT(x)
         IMPLICIT NONE
!
!        ---------
!        Arguments
!        ---------
!
         CLASS(MultiSegmentModalCurve) :: self
         REAL(KIND=RP)                 :: t
         REAL(KIND=RP)                 :: x(3)
         INTEGER                       :: which ! = LA_EVALUATE_FUNCTION or LA_EVALUATE_DERIVATIVE
         INTEGER                       :: k
!
!        ---------------
!        Local Variables
!        ---------------
!
         REAL(KIND=RP) :: s
         
         x = 0.0_RP
         s = InvAffineMap(t0 = self % cuts(k-1),t1 = self % cuts(k),t = t)
         x(1) = LegendreSeries(x     = s, N = self % polyOrder, &
                               coefs = self % coefs(:,1,k),     &
                               which = which)      
         x(2) = LegendreSeries(x     = s, N = self % polyOrder, &
                               coefs = self % coefs(:,2,k),     &
                               which = which)      
          
      END FUNCTION valueInSegment
!
!//////////////////////////////////////////////////////////////////////// 
! 
!      -----------------------------------------------------------------
!> Class name returns a string with the name of the type of the object
!>
!>  ### Usage:
!>
!>        PRINT *,  obj % className()
!>        if( obj % className = ="Spline")
!>
      FUNCTION MSMCClassName(self)  RESULT(s)
         IMPLICIT NONE  
         CLASS(MultiSegmentModalCurve)              :: self
         CHARACTER(LEN=CLASS_NAME_CHARACTER_LENGTH) :: s
         
         s = "MultiSegmentModalCurve"
         IF( self % refCount() >= 0 ) CONTINUE 
 
      END FUNCTION MSMCClassName
!
!///////////////////////////////////////////////////////////////////////
!
!                     TESTS
!
!///////////////////////////////////////////////////////////////////////
!
! 
   LOGICAL FUNCTION MultiSegmentModalCurveIsOK()  
      IMPLICIT NONE
      
      CLASS(MultiSegmentModalCurve), POINTER :: self
      CLASS(SMCurve)               , POINTER :: parentCurve => NULL()
!
!     ----------------------------------------------------------
!     Polynomial with three modes and three segments
!     We don't care3 in this test if the segments are continuous
!     ----------------------------------------------------------
!
      REAL(KIND=RP) :: coefs(3,2,3)
      REAL(KIND=RP) :: cuts(0:3) = [0.0_RP, 0.4_RP, 0.7_RP, 1.0_RP]
      REAL(KIND=RP) :: t, tol = 1.0d-9
      INTEGER       :: k
      
      MultiSegmentModalCurveIsOK = .TRUE.
      
      coefs(:,1,1) = [1.0_RP, 0.0_RP, 2.0_RP]
      coefs(:,2,1) = [1.1_RP, 0.1_RP, 2.1_RP]
      coefs(:,1,2) = [0.0_RP, 0.0_RP, 2.0_RP]
      coefs(:,2,2) = [0.1_RP, 0.1_RP, 2.1_RP]
      coefs(:,1,3) = [1.0_RP, 0.0_RP, 0.0_RP]
      coefs(:,2,3) = [1.1_RP, 0.0_RP, 0.1_RP]
      
      ALLOCATE(self)
      CALL self % constructMultiSegmentModalCurve( parentCurve, cuts, coefs,"Test Curve",1)
!
!     ---------------
!     Check intervals
!     ---------------
!
      IF( findInterval(self % cuts, t = 0.25_RP) .NE. 1) MultiSegmentModalCurveIsOK = .FALSE.
      IF( findInterval(self % cuts, t = 0.50_RP) .NE. 2) MultiSegmentModalCurveIsOK = .FALSE.
      IF( findInterval(self % cuts, t = 0.80_RP) .NE. 3) MultiSegmentModalCurveIsOK = .FALSE.
!
!     ------------
!     Check values
!     ------------
!
      MultiSegmentModalCurveIsOK = .TRUE.
      DO k = 0, 5 
         t = cuts(0) + k*(cuts(3) - cuts(0))/5.0_RP
         MultiSegmentModalCurveIsOK = MAXVAL(ABS(self % positionAt(t) - testPolynomialAt(self,t))) < tol
         MultiSegmentModalCurveIsOK = MultiSegmentModalCurveIsOK .AND. MAXVAL(ABS(self % derivativeAt(t) - &   
                                      testPolynomialDerivAt(self,t))) < tol
      END DO 

      CALL releaseMultiSegmentModalCurve(self)
      
   END FUNCTION MultiSegmentModalCurveIsOK
!
!//////////////////////////////////////////////////////////////////////// 
! 
   FUNCTION testPolynomialAt(self, t)  RESULT(p)
      IMPLICIT NONE  
      TYPE(MultiSegmentModalCurve) :: self
      REAL(KIND=RP)                :: t
      INTEGER                      :: k
      REAL(KIND=RP)                :: p(3), s
      
      p = 0.0_RP
      k = findInterval(self % cuts, t)
      s = InvAffineMap(t0 = self % cuts(k-1),t1 = self % cuts(k),t = t)
      
      p(1) = self % coefs(0,1,k)*P0(s) + self % coefs(1,1,k)*P1(s) + self % coefs(2,1,k)*P2(s)
      p(2) = self % coefs(0,2,k)*P0(s) + self % coefs(1,2,k)*P1(s) + self % coefs(2,2,k)*P2(s)

   END FUNCTION testPolynomialAt
!
!//////////////////////////////////////////////////////////////////////// 
! 
   FUNCTION testPolynomialDerivAt(self, t)  RESULT(p)
      IMPLICIT NONE  
      TYPE(MultiSegmentModalCurve) :: self
      REAL(KIND=RP)                :: t
      INTEGER                      :: k
      REAL(KIND=RP)                :: p(3), s
      
      p = 0.0_RP
      k = findInterval(self % cuts, t)
      s = InvAffineMap(t0 = self % cuts(k-1),t1 = self % cuts(k),t = t)
      
      p(1) = self % coefs(0,1,k)*P0Prime(s) + self % coefs(1,1,k)*P1Prime(s) + &
             self % coefs(2,1,k)*P2Prime(s)
      p(2) = self % coefs(0,2,k)*P0Prime(s) + self % coefs(1,2,k)*P1Prime(s) + &
             self % coefs(2,2,k)*P2Prime(s)

   END FUNCTION testPolynomialDerivAt
   
   END Module MultiSegmentModalCurveClass

1	!
2	!////////////////////////////////////////////////////////////////////////
3	!
4	! MultiSegmentModalCurve.f90
5	! Created: October 18, 2025 at 1:39 PM
6	! By: David Kopriva
7	!
8	! A curve subclass that is defined in terms of multiple segments
9	! of modally defined Legendre polynomials
10	!
11	!////////////////////////////////////////////////////////////////////////
12	!
13	Module MultiSegmentModalCurveClass
14	USE MultiSegmentCurveClass
15	USE LegendreAlgorithms
16	IMPLICIT NONE
17
18	TYPE, EXTENDS(MultiSegmentCurve) :: MultiSegmentModalCurve
19	REAL(KIND=RP), ALLOCATABLE :: segmentLengths(:)
20	REAL(KIND=RP), ALLOCATABLE :: segmentPoints(:,:)
21	REAL(KIND=RP), ALLOCATABLE :: coefs(:,:,:)
22	!
23	! ========
24	CONTAINS
25	! ========
26	!
27	PROCEDURE :: ConstructMultiSegmentModalCurve
28	FINAL :: DestructMultiSegmentModalCurve
29	PROCEDURE :: positionAt => EvaluateMultiSegmentModalCurve
30	PROCEDURE :: derivativeAt => EvaluateMultiSegmentModalCurveD
31	PROCEDURE :: derivativeInSegment => modalDerivativeInSegment
32	PROCEDURE :: valueInSegment
33	PROCEDURE :: className => MSMCClassName
34	END TYPE MultiSegmentModalCurve
35	!
36	! ========
37	CONTAINS
38	! ========
39	!
40	SUBROUTINE castToMultiSegmentModalCurve(curve,cast)	516✔
41	!
42	! -----------------------------------------------------
43	! Cast the base class SMCurve to the FTValue class
44	! -----------------------------------------------------
45	!
46	IMPLICIT NONE
47	CLASS(SMCurve) , POINTER :: curve
48	CLASS(MultiSegmentModalCurve) , POINTER :: cast
49
50	cast => NULL()	516✔
51	SELECT TYPE (e => curve)
52	CLASS IS(MultiSegmentModalCurve)
53	cast => e	516✔
54	CLASS DEFAULT
55
56	END SELECT
57
58	END SUBROUTINE castToMultiSegmentModalCurve	516✔
59	!
60	!////////////////////////////////////////////////////////////////////////
61	!
62	SUBROUTINE ConstructMultiSegmentModalCurve(self, parentCurve, cuts, coefs, curveName, id )	514✔
63	IMPLICIT NONE
64	!
65	! ---------
66	! Arguments
67	! ---------
68	!
69	CLASS(MultiSegmentModalCurve) :: self
70	CLASS(SMCurve), POINTER :: parentCurve
71	REAL(KIND=RP) :: cuts(0:)
72	REAL(KIND=RP) :: coefs(0:,:,:)
73	CHARACTER(LEN=*) :: curveName
74	INTEGER :: id
75	!
76	! ---------------
77	! Local variables
78	! ---------------
79	!
80	INTEGER :: k, N
81	REAL(KIND=RP), ALLOCATABLE :: nodes(:), weights(:)	514✔
82	INTEGER :: qOrder
83	REAL(KIND=RP) :: xStart(3), xEnd(3)
84
85	N = SIZE(coefs,1) - 1	514✔
86	CALL self % MultiSegmentCurve % construct(cuts,N,curveName,id)	514✔
87	self % coefs = coefs	9,604✔
88	!
89	! ---------------
90	! Computed values
91	! ---------------
92	!
93	ALLOCATE(self % segmentLengths(self % nSegments) , SOURCE = 0.0_RP)	1,066✔
94	ALLOCATE(self % segmentPoints (3,0:self % nSegments), SOURCE = 0.0_RP)	4,778✔
95	qOrder = 2*self % polyOrder	514✔
96	ALLOCATE(nodes(0:qOrder), weights(0:qOrder))	514✔
97	CALL GaussLegendreNodesAndWeights( qOrder, nodes, weights )	514✔
98
99	self % segmentPoints(:,0) = self % valueInSegment(1, self % cuts(0), which = LA_EVALUATE_FUNCTION)	2,056✔
100	DO k = 1, self % nSegments	1,066✔
101	xStart = self % valueInSegment(k, self % cuts(k-1), which = LA_EVALUATE_FUNCTION)	2,208✔
102	xEnd = self % valueInSegment(k, self % cuts(k) , which = LA_EVALUATE_FUNCTION)	2,208✔
103	self % segmentPoints(:,k) = xEnd	2,208✔
104	self % segmentLengths(k) = SQRT((xEnd(1) - xStart(1))2 + (xEnd(2) - xStart(2))2)	1,066✔
105	END DO
106
107	END SUBROUTINE ConstructMultiSegmentModalCurve	1,028✔
108	!
109	!////////////////////////////////////////////////////////////////////////
110	!
111	SUBROUTINE DestructMultiSegmentModalCurve(self)	514✔
112	IMPLICIT NONE
113	TYPE(MultiSegmentModalCurve) :: self
114
115	END SUBROUTINE DestructMultiSegmentModalCurve	514✔
116	!
117	!////////////////////////////////////////////////////////////////////////
118	!
119	SUBROUTINE releaseMultiSegmentModalCurve(self)	2✔
120	IMPLICIT NONE
121	CLASS(MultiSegmentModalCurve), POINTER :: self
122	CLASS(FTObject) , POINTER :: obj
123
124	IF(.NOT. ASSOCIATED(self)) RETURN	2✔
125
126	obj => self	2✔
127	CALL releaseFTObject(self = obj)	2✔
128	IF ( .NOT. ASSOCIATED(obj) ) THEN	2✔
129	self => NULL()	2✔
130	END IF
131	END SUBROUTINE releaseMultiSegmentModalCurve
132	!
133	!////////////////////////////////////////////////////////////////////////
134	!
NEW 135	FUNCTION EvaluateMultiSegmentModalCurve(self,t) RESULT(x)	×
136	IMPLICIT NONE
137	CLASS(MultiSegmentModalCurve) :: self
138	REAL(KIND=RP) :: t
139	REAL(KIND=RP) :: x(3)
140
NEW 141	x = MultiSegmentModalCurveValue(self, t, LA_EVALUATE_FUNCTION)	×
142
NEW 143	END FUNCTION EvaluateMultiSegmentModalCurve	×
144	!
145	!////////////////////////////////////////////////////////////////////////
146	!
NEW 147	FUNCTION EvaluateMultiSegmentModalCurveD(self,t) RESULT(x)	×
148	IMPLICIT NONE
149	CLASS(MultiSegmentModalCurve) :: self
150	REAL(KIND=RP) :: t
151	REAL(KIND=RP) :: x(3)
152
NEW 153	x = MultiSegmentModalCurveValue(self, t, LA_EVALUATE_DERIVATIVE)	×
154
NEW 155	END FUNCTION EvaluateMultiSegmentModalCurveD	×
156	!
157	!////////////////////////////////////////////////////////////////////////
158	!
NEW 159	FUNCTION MultiSegmentModalCurveValue(self, t, which) RESULT(x)	×
160	IMPLICIT NONE
161	!
162	! ---------
163	! Arguments
164	! ---------
165	!
166	CLASS(MultiSegmentModalCurve) :: self
167	REAL(KIND=RP) :: t
168	REAL(KIND=RP) :: x(3)
169	INTEGER :: which ! = LA_EVALUATE_FUNCTION or LA_EVALUATE_DERIVATIVE
170	!
171	! ---------------
172	! Local Variables
173	! ---------------
174	!
175	INTEGER :: k
176
NEW 177	k = findInterval(self % cuts,t)	×
NEW 178	x = valueInSegment(self, k ,t, which)	×
179
NEW 180	IF ( which == LA_EVALUATE_DERIVATIVE ) THEN	×
NEW 181	x = 2.0_RP*x/(self % cuts(k) - self % cuts(k-1))	×
182	END IF
183
NEW 184	END FUNCTION MultiSegmentModalCurveValue	×
185	!
186	!////////////////////////////////////////////////////////////////////////
187	!
188	FUNCTION modalDerivativeInSegment(self, t, k) RESULT(x)	100✔
189	!
190	! ---------------------------------------------------------------
191	! Returns the derivative in segment k as needed by the superclass
192	! procedure to compute the arc length
193	! ---------------------------------------------------------------
194	!
195	IMPLICIT NONE
196	!
197	! ---------
198	! Arguments
199	! ---------
200	!
201	CLASS(MultiSegmentModalCurve) :: self
202	REAL(KIND=RP) :: t
203	REAL(KIND=RP) :: x(3)
204	INTEGER :: k
205	!
206	x = valueInSegment(self, k ,t, LA_EVALUATE_DERIVATIVE)	100✔
207
208	END FUNCTION modalDerivativeInSegment	100✔
209	!
210	!////////////////////////////////////////////////////////////////////////
211	!
212	FUNCTION valueInSegment(self, k, t, which) RESULT(x)	28,358✔
213	IMPLICIT NONE
214	!
215	! ---------
216	! Arguments
217	! ---------
218	!
219	CLASS(MultiSegmentModalCurve) :: self
220	REAL(KIND=RP) :: t
221	REAL(KIND=RP) :: x(3)
222	INTEGER :: which ! = LA_EVALUATE_FUNCTION or LA_EVALUATE_DERIVATIVE
223	INTEGER :: k
224	!
225	! ---------------
226	! Local Variables
227	! ---------------
228	!
229	REAL(KIND=RP) :: s
230
231	x = 0.0_RP	113,432✔
232	s = InvAffineMap(t0 = self % cuts(k-1),t1 = self % cuts(k),t = t)	28,358✔
233	x(1) = LegendreSeries(x = s, N = self % polyOrder, &
234	coefs = self % coefs(:,1,k), &
235	which = which)	28,358✔
236	x(2) = LegendreSeries(x = s, N = self % polyOrder, &
237	coefs = self % coefs(:,2,k), &
238	which = which)	28,358✔
239
240	END FUNCTION valueInSegment	28,358✔
241	!
242	!////////////////////////////////////////////////////////////////////////
243	!
244	! -----------------------------------------------------------------
245	!> Class name returns a string with the name of the type of the object
246	!>
247	!> ### Usage:
248	!>
249	!> PRINT *, obj % className()
250	!> if( obj % className = ="Spline")
251	!>
NEW 252	FUNCTION MSMCClassName(self) RESULT(s)	×
253	IMPLICIT NONE
254	CLASS(MultiSegmentModalCurve) :: self
255	CHARACTER(LEN=CLASS_NAME_CHARACTER_LENGTH) :: s
256
NEW 257	s = "MultiSegmentModalCurve"	×
NEW 258	IF( self % refCount() >= 0 ) CONTINUE	×
259
NEW 260	END FUNCTION MSMCClassName	×
261	!
262	!///////////////////////////////////////////////////////////////////////
263	!
264	! TESTS
265	!
266	!///////////////////////////////////////////////////////////////////////
267	!
268	!
NEW 269	LOGICAL FUNCTION MultiSegmentModalCurveIsOK()	×
270	IMPLICIT NONE
271
272	CLASS(MultiSegmentModalCurve), POINTER :: self
273	CLASS(SMCurve) , POINTER :: parentCurve => NULL()
274	!
275	! ----------------------------------------------------------
276	! Polynomial with three modes and three segments
277	! We don't care3 in this test if the segments are continuous
278	! ----------------------------------------------------------
279	!
280	REAL(KIND=RP) :: coefs(3,2,3)
281	REAL(KIND=RP) :: cuts(0:3) = [0.0_RP, 0.4_RP, 0.7_RP, 1.0_RP]
282	REAL(KIND=RP) :: t, tol = 1.0d-9
283	INTEGER :: k
284
NEW 285	MultiSegmentModalCurveIsOK = .TRUE.	×
286
NEW 287	coefs(:,1,1) = [1.0_RP, 0.0_RP, 2.0_RP]	×
NEW 288	coefs(:,2,1) = [1.1_RP, 0.1_RP, 2.1_RP]	×
NEW 289	coefs(:,1,2) = [0.0_RP, 0.0_RP, 2.0_RP]	×
NEW 290	coefs(:,2,2) = [0.1_RP, 0.1_RP, 2.1_RP]	×
NEW 291	coefs(:,1,3) = [1.0_RP, 0.0_RP, 0.0_RP]	×
NEW 292	coefs(:,2,3) = [1.1_RP, 0.0_RP, 0.1_RP]	×
293
NEW 294	ALLOCATE(self)	×
NEW 295	CALL self % constructMultiSegmentModalCurve( parentCurve, cuts, coefs,"Test Curve",1)	×
296	!
297	! ---------------
298	! Check intervals
299	! ---------------
300	!
NEW 301	IF( findInterval(self % cuts, t = 0.25_RP) .NE. 1) MultiSegmentModalCurveIsOK = .FALSE.	×
NEW 302	IF( findInterval(self % cuts, t = 0.50_RP) .NE. 2) MultiSegmentModalCurveIsOK = .FALSE.	×
NEW 303	IF( findInterval(self % cuts, t = 0.80_RP) .NE. 3) MultiSegmentModalCurveIsOK = .FALSE.	×
304	!
305	! ------------
306	! Check values
307	! ------------
308	!
NEW 309	MultiSegmentModalCurveIsOK = .TRUE.	×
NEW 310	DO k = 0, 5	×
NEW 311	t = cuts(0) + k*(cuts(3) - cuts(0))/5.0_RP	×
NEW 312	MultiSegmentModalCurveIsOK = MAXVAL(ABS(self % positionAt(t) - testPolynomialAt(self,t))) < tol	×
313	MultiSegmentModalCurveIsOK = MultiSegmentModalCurveIsOK .AND. MAXVAL(ABS(self % derivativeAt(t) - &
NEW 314	testPolynomialDerivAt(self,t))) < tol	×
315	END DO
316
NEW 317	CALL releaseMultiSegmentModalCurve(self)	×
318
NEW 319	END FUNCTION MultiSegmentModalCurveIsOK	×
320	!
321	!////////////////////////////////////////////////////////////////////////
322	!
NEW 323	FUNCTION testPolynomialAt(self, t) RESULT(p)	×
324	IMPLICIT NONE
325	TYPE(MultiSegmentModalCurve) :: self
326	REAL(KIND=RP) :: t
327	INTEGER :: k
328	REAL(KIND=RP) :: p(3), s
329
NEW 330	p = 0.0_RP	×
NEW 331	k = findInterval(self % cuts, t)	×
NEW 332	s = InvAffineMap(t0 = self % cuts(k-1),t1 = self % cuts(k),t = t)	×
333
NEW 334	p(1) = self % coefs(0,1,k)P0(s) + self % coefs(1,1,k)P1(s) + self % coefs(2,1,k)*P2(s)	×
NEW 335	p(2) = self % coefs(0,2,k)P0(s) + self % coefs(1,2,k)P1(s) + self % coefs(2,2,k)*P2(s)	×
336
NEW 337	END FUNCTION testPolynomialAt	×
338	!
339	!////////////////////////////////////////////////////////////////////////
340	!
NEW 341	FUNCTION testPolynomialDerivAt(self, t) RESULT(p)	×
342	IMPLICIT NONE
343	TYPE(MultiSegmentModalCurve) :: self
344	REAL(KIND=RP) :: t
345	INTEGER :: k
346	REAL(KIND=RP) :: p(3), s
347
NEW 348	p = 0.0_RP	×
NEW 349	k = findInterval(self % cuts, t)	×
NEW 350	s = InvAffineMap(t0 = self % cuts(k-1),t1 = self % cuts(k),t = t)	×
351
352	p(1) = self % coefs(0,1,k)P0Prime(s) + self % coefs(1,1,k)P1Prime(s) + &
NEW 353	self % coefs(2,1,k)*P2Prime(s)	×
354	p(2) = self % coefs(0,2,k)P0Prime(s) + self % coefs(1,2,k)P1Prime(s) + &
NEW 355	self % coefs(2,2,k)*P2Prime(s)	×
356
NEW 357	END FUNCTION testPolynomialDerivAt	×
358
359	END Module MultiSegmentModalCurveClass	1,544✔

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