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

84.85

/Source/IO/ControlFileReader.f90

! MIT License
!
! Copyright (c) 2010-present David A. Kopriva and other contributors: AUTHORS.md
!
! Permission is hereby granted, free of charge, to any person obtaining a copy  
! of this software and associated documentation files (the "Software"), to deal  
! in the Software without restriction, including without limitation the rights  
! to use, copy, modify, merge, publish, distribute, sublicense, and/or sell  
! copies of the Software, and to permit persons to whom the Software is  
! furnished to do so, subject to the following conditions:
!
! The above copyright notice and this permission notice shall be included in all  
! copies or substantial portions of the Software.
!
! THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR  
! IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  
! FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE  
! AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER  
! LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,  
! OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE  
! SOFTWARE.
!
! --- End License
!
!////////////////////////////////////////////////////////////////////////
!
!      ControlFileReader.f90
!      Created: May 29, 2018 at 3:42 PM 
!      By: David Kopriva 
!      All Rights Reserved.
!
!      The control file reader parses the control file and returns
!      a Control file dictionary.
!
!      A Control file dictionary contains the keys
!         TYPE
!         CONTROL_INPUT
!         MODEL
!
!      TYPE is a string naming the type (class) of object stored
!
!      The CONTROL_INPUT dictionary contains the keys
!         TYPE
!         RUN_PARAMETERS
!         MESH_PARAMETERS
!         SPRING_SMOOTHER
!         REFINEMENT_REGIONS
!         SCALE_TRANSFORMATION
!         ROTATION_TRANSFORMATION
!         SIMPLE_EXTRUSION
!         SIMPLE_ROTATION
!         SWEEP_ALONG_CURVE
!
!      The MODEL dictionary contains the keys
!         TYPE
!         OUTER_BOUNDARY
!         INNER_BOUNDARIES
!         SWEEP_CURVE
!         SWEEP_SCALE_FACTOR
!         TOPOGRAPHY
!      
!      The OUTER_BOUNDARY dictionary contains the keys
!         TYPE
!         LIST
!           The list contains dictionaries describing
!               PARAMETRIC_EQUATION_CURVE
!               SPLINE_CURVE
!               END_POINTS_LINE
!               CIRCULAR_ARC
!               ELLIPTIC_ARC
!
!      The INNER_BOUNDARIES dictionary contains the keys
!         TYPE
!         LIST
!            The list contains CHAIN dictionaries
!      
!      A CHAIN dictionary contains the keys
!         TYPE
!         LIST
!            The list will contain dictionaries of type
!                PARAMETRIC_EQUATION_CURVE
!                SPLINE_CURVE
!                END_POINTS_LINE
!                CIRCULAR_ARC
!                ELLIPTIC_ARC
!
!      A PARAMETRIC_EQUATION_CURVE dictionary contains the keys
!         TYPE
!         name
!         xEqn
!         yEqn
!         zEqn
!
!      A SPLINE_CURVE block contains the keys
!         TYPE
!         name
!         SPLINE_DATA
!
!      SPLINE_DATA block contains keys and data
!         nKnots
!         t_1 x_1 y_1 z_1
!         t_2 x_2 y_2 z_2
!         ...
!         t_nKnots x_nKnots y_nKnots z_nKnots
!
!      An END_POINTS_LINE has the following keys
!         TYPE
!         name
!         xStart
!         xEnd
!
!      A CIRCULAR_ARC block contains
!
!         TYPE
!         name
!         units
!         center
!         radius
!         start angle
!         end angle
!
!      An ELLIPTIC_ARC block contains
!
!         TYPE
!         name
!         units
!         center
!         xRadius
!         yRadius
!         start angle
!         end angle
!         rotation
!
!      REFINEMENT_REGIONS dictionary contains the keys
!         TYPE
!         LIST
!            LIST is a list of 
!                REFINEMENT_CENTER
!                REFINEMENT_LINE
!
!      A REFINEMENT_CENTER contains the keys
!         TYPE
!         center
!         h
!         w
!
!      A REFINEMENT_LINE contains the keys
!         TYPE
!         xStart
!         xEnd
!         h
!         w
!      
!      A ROTATION_TRANSFORMATION contains the keys
!         TYPE
!         direction
!         rotationPoint
!
!      A SCALE_TRANSFORMATION contains the keys
!         TYPE
!         origin
!         scaleFactor
!      
!      The SWEEP_CURVE dictionary contains the keys
!         TYPE
!         LIST
!           The list contains dictionaries describing
!               PARAMETRIC_EQUATION_CURVE
!               SPLINE_CURVE
!               END_POINTS_LINE
!      
!      The SWEEP_SCALE_FACTOR dictionary contains the keys
!         TYPE
!         LIST
!           The list contains dictionaries describing
!               PARAMETRIC_EQUATION
!
!        But the equation definitions contain only one equation r(t) = ...
!
!      the TOPOGRAPHY dictionary contains the keys
!         TYPE
!         eqn (for equation defined topography)
!         sizing
!         
!      The SIMPLE_EXTRUSION  block is defined in SimpleSweep.f90
!      The SIMPLE_ROTATION   block is defined in SimpleSweep.f90
!      The SWEEP_ALONG_CURVE block is defined in SweeperClass.f90
! 
!////////////////////////////////////////////////////////////////////////
!
      Module ControlFileReaderClass
      
      USE FTValueDictionaryClass
      USE FTLinkedListClass
      USE FTExceptionClass
      USE SharedExceptionManagerModule
      USE FTStackClass
      USE ErrorTypesModule
      USE FTStringSetClass
      
      IMPLICIT NONE 
      
      TYPE ControlFileReader
         TYPE(FTValueDictionary), POINTER :: controlDict
!
!        --------
         CONTAINS
!        --------
!
         PROCEDURE :: init     => initControlFileReader
         PROCEDURE :: destruct => destructControlFileReader
         PROCEDURE :: importFromControlFile
      END TYPE ControlFileReader
      
      INTEGER, PARAMETER :: CFR_STRING_LENGTH = 132
      
      CHARACTER(LEN=CFR_STRING_LENGTH) :: blockStack(5)
      INTEGER                          :: blockStackTop
      TYPE(FTStringSet)                :: blocksWithListsSet
      CHARACTER(LEN=20)                :: blocksWithLists(7) =      &
                                          ["OUTER_BOUNDARY      ",  &
                                           "REFINEMENT_REGIONS  ",  &
                                           "INNER_BOUNDARIES    ",  &
                                           "INTERFACE_BOUNDARIES",  &
                                           "SWEEP_CURVE         ",  &
                                           "SWEEP_SCALE_FACTOR  ",  &
                                           "CHAIN               "]
!
!     ========      
      CONTAINS 
!     ========
!
!
!//////////////////////////////////////////////////////////////////////// 
! 
      SUBROUTINE initControlFileReader(self)  
         IMPLICIT NONE
         CLASS(ControlFileReader) :: self
         
         ALLOCATE(self % controlDict)
         CALL self % controlDict % initWithSize(sze = 32)
         CALL self % controlDict % addValueForKey(s = "root",key = "TYPE")
         CALL initializeFTExceptions
         CALL blocksWithListsSet % initWithStrings(strings = blocksWithLists)
         blockStack    = ""
         blockStackTop = 0
         
      END SUBROUTINE initControlFileReader
!
!//////////////////////////////////////////////////////////////////////// 
! 
      SUBROUTINE destructControlFileReader(self)  
         IMPLICIT NONE  
         CLASS(ControlFileReader) :: self
         
         CALL releaseFTValueDictionary(self % controlDict)
         CALL destructFTStringSet( blocksWithListsSet)
         blockStack    = ""
         blockStackTop = 0
         
      END SUBROUTINE destructControlFileReader
!
!//////////////////////////////////////////////////////////////////////// 
! 
      SUBROUTINE importFromControlFile(self, fileUnit)  
         IMPLICIT NONE
!
!        ---------
!        Arguments
!        ---------
!
         CLASS(ControlFileReader) :: self
         INTEGER                  :: fileUnit
!
!        ---------------
!        Local Variables
!        ---------------
!
         CLASS(FTObject), POINTER           :: obj
         CHARACTER(LEN=CFR_STRING_LENGTH)   :: objectName
         
         obj        => self % controlDict
         objectName = "root"

         CALL performImport(fileUnit   = fileUnit, &
                            collection = obj,      &
                            objectName = objectName)

      END SUBROUTINE importFromControlFile
!
!//////////////////////////////////////////////////////////////////////// 
! 
      RECURSIVE SUBROUTINE performImport(fileUnit, collection, objectName)  
         IMPLICIT NONE
!
!        ---------
!        Arguments
!        ---------
!
         INTEGER, INTENT(IN)       :: fileUnit
         CHARACTER(LEN=*)          :: objectName
         CLASS(FTObject), POINTER  :: collection
!
!        ---------------
!        Local Variables
!        ---------------
!
         CLASS(FTValueDictionary), POINTER :: dict
         CHARACTER(LEN=CFR_STRING_LENGTH)  :: line
         INTEGER                           :: iStat
         TYPE (FTException)      , POINTER :: exception

         IF(catch(FATAL_ERROR_EXCEPTION)) RETURN  
         
         DO
           READ(fileUnit,"(A)", IOSTAT = iStat, END = 1000) line

           IF(iStat /= 0)   EXIT
           CALL replaceTabs(line)
            
            IF ( INDEX(STRING = line, SUBSTRING = "begin{") > 0)     THEN !Start reading a block
               CALL startNewCollectionInCollection(fileUnit,line,collection)
               IF(catch(FATAL_ERROR_EXCEPTION)) EXIT 
               
            ELSE IF (INDEX(STRING = line, SUBSTRING = "end{") > 0)     THEN
               IF(INDEX(STRING = line, SUBSTRING = "end{FILE}") > 0)   RETURN 
               CALL completeBlock(line,objectName)
               RETURN ! Done with this block, one way or another
               
            ELSE IF (TRIM(line) == "" .OR. line(1:1) == "%") THEN   !Skip blank lines 
               CYCLE
            ELSE IF (INDEX(STRING = line, SUBSTRING = "{") > 0 .OR. &
                     INDEX(STRING = line, SUBSTRING = "}") > 0)     THEN 
               ALLOCATE(exception)
               CALL exception % initFatalException( "Syntax error in control file line: "// TRIM(ADJUSTL(line)) // &
                                                     ". Commands are lower case.")
               CALL throw(exception)
               CALL releaseFTException(exception)
               RETURN 
            ELSE 
               dict => valueDictionaryFromObject(collection)
               CALL readBlock(fileUnit  = fileUnit, &
                              blockDict = dict, &
                              firstLine = line,    &
                              blockName = objectName)
               IF(catch(FATAL_ERROR_EXCEPTION)) EXIT 
               RETURN 
            END IF
         END DO
         
1000     CONTINUE

      END SUBROUTINE performImport
!
!//////////////////////////////////////////////////////////////////////// 
! 
      RECURSIVE SUBROUTINE startNewCollectionInCollection(fileUnit, line, collection)  
         IMPLICIT NONE  
!
!        ---------
!        Arguments
!        ---------
!
         INTEGER, INTENT(IN)       :: fileUnit
         CHARACTER(LEN=*)          :: line
         CLASS(FTObject), POINTER  :: collection
!
!        ---------------
!        Local variables
!        ---------------
!
         CHARACTER(LEN=CFR_STRING_LENGTH)  :: objectName
         CLASS(FTObject)         , POINTER :: obj
         TYPE (FTValueDictionary), POINTER :: newDict
         CLASS(FTLinkedList)     , POINTER :: newList
!
!        ---------------------------------------
!        New block to add to current collection 
!        ---------------------------------------
!
         objectName                = parseObjectName(line)
         blockStackTop             = blockStackTop + 1
         blockStack(blockStackTop) = objectName

         ALLOCATE(newDict)
         CALL newDict % initWithSize(sze = 32)
         CALL newDict % addValueForKey(s = objectName,key = "TYPE")
         obj => newDict
         CALL addObjectToCollection(obj, collection, objectName)
!
!        --------------------------------------------
!        Certain blocks have lists of objects in them
!        --------------------------------------------
!
          IF( blocksWithListsSet % containsString(objectName))     THEN 
              ALLOCATE(newList)
              CALL newList % init()
              obj => newList
              CALL newDict % addObjectForKey(obj,"LIST")
              CALL releaseFTLinkedListClass(self = newList)
              
              IF(objectName == "CHAIN" .OR. objectName == "OUTER_BOUNDARY")     THEN ! Read (possible) chain parameters
                 DO 
                    READ(fileUnit,"(A)", END = 1000) line
                    CALL replaceTabs(line)
                    line = ADJUSTL(line)
                    IF ( line(1:1) == "\" )     THEN
                       BACKSPACE(fileUnit)
                       EXIT
                    END IF 
                    CALL addKeyAndValueFromLineToDict(blockDict = newDict,line = line)
                 END DO 
              END IF
              obj => newList
         END IF
         
         CALL releaseFTValueDictionary(self = newDict)
         CALL performImport(fileUnit, obj, objectName)
1000     CONTINUE
         
      END SUBROUTINE startNewCollectionInCollection
!
!//////////////////////////////////////////////////////////////////////// 
! 
      SUBROUTINE completeBlock(line, objectName)
         IMPLICIT NONE  
!
!        ---------
!        Arguments
!        ---------
!
         CHARACTER(LEN=*) :: line, objectName
!
!        ---------------
!        Local Variables
!        ---------------
!
         TYPE (FTException)      , POINTER :: exception
         CHARACTER(LEN=CFR_STRING_LENGTH)  :: foundName
         CHARACTER(LEN=132)                :: msg
         
         foundName = parseObjectName(line)
         IF(foundName /= blockStack(blockStackTop))     THEN
            msg = "Block termination error. Expected: "//TRIM(objectName)//"; Found: "//TRIM(foundName)
            PRINT *, msg
            ALLOCATE(exception)
            CALL exception % initFatalException(msg)
            CALL throw(exception)
            CALL releaseFTException(exception)
            RETURN 
         END IF 
         blockStack(blockStackTop) = ""
         blockStackTop = blockStackTop - 1
      END SUBROUTINE completeBlock
!
!//////////////////////////////////////////////////////////////////////// 
! 
      SUBROUTINE addObjectToCollection(obj, collection, objectName)  
          IMPLICIT NONE
          CHARACTER(LEN=*)         :: objectName
          CLASS(FTObject), POINTER :: collection, obj
          
          SELECT TYPE (c => collection) 
            TYPE IS (FTValueDictionary)
              CALL c % addObjectForKey(obj, objectName)
            TYPE IS (FTLinkedList)
               CALL c % add(obj)
            CLASS DEFAULT 
            
         END SELECT 

      END SUBROUTINE addObjectToCollection
!
!//////////////////////////////////////////////////////////////////////// 
! 
      SUBROUTINE keyAndValueOnLine(line, key, lValue)  
         IMPLICIT NONE
!
!        ---------
!        Arguments
!        ---------
!
         CHARACTER(LEN = CFR_STRING_LENGTH) :: key, lValue, line
!
!        ---------------
!        Local Variables
!        ---------------
!
         INTEGER :: indxOfEqual
         
         indxOfEqual = INDEX(STRING = line, SUBSTRING = "=")
         IF ( indxOfEqual <= 1 )     THEN
            lValue = ""
            key    = "" 
         ELSE 
            key    = TRIM(ADJUSTL(line(1:indxOfEqual-1))) 
            lValue = TRIM(ADJUSTL(line(indxOfEqual+1:)))
         END IF 
         
      END SUBROUTINE keyAndValueOnLine
!
!//////////////////////////////////////////////////////////////////////// 
! 
      SUBROUTINE readBlock(fileUnit, blockDict, firstLine, blockName)  
         IMPLICIT NONE
!
!        ---------
!        Arguments
!        ---------
!
         INTEGER                           :: fileUnit
         CLASS(FTValueDictionary), POINTER :: blockDict
         CHARACTER(LEN=*)                  :: firstLine,blockName
         CHARACTER(LEN=132)                :: errMsg
!
!        ---------------
!        Local Variables
!        ---------------
!
         INTEGER                          :: s, e
         CHARACTER(LEN=CFR_STRING_LENGTH) :: line
         TYPE (FTException)     , POINTER :: exception
         
         errMsg = ""
         CALL addKeyAndValueFromLineToDict(blockDict = blockDict, &
                             line      = firstLine)
         DO
           READ(fileUnit,"(A)", END = 1000) line
           CALL replaceTabs(line)
!
!           -------------
!           Check for end
!           -------------
!
            s = INDEX(STRING = line, SUBSTRING = "end{")
            IF ( s > 0 )     THEN
               s = s + 3
               e =  INDEX(STRING = line, SUBSTRING = "}")
               IF(line(s+1:e-1) /= TRIM(blockName))     THEN
                  errMsg = "Improper block termination. Expected "// TRIM(blockName)// "; found "// line(s+1:e-1)
                  PRINT *, errMsg
                  ALLOCATE(exception)
                  CALL exception % initFatalException(errMsg)
                  CALL throw(exception)
                  CALL releaseFTException(exception)
               END IF 
               blockStack(blockStackTop) = ""
               blockStackTop = blockStackTop - 1
               RETURN 
            END IF
!
!           -----------------------------------------------
!           Spline curve definitions contain the nodes and 
!           values
!           -----------------------------------------------
!
            s = INDEX(STRING = line, SUBSTRING = "\begin{SPLINE_DATA}")
            IF ( s > 0 )     THEN
               CALL readSplineData(fileUnit, blockDict)
               CYCLE 
            END IF 
!
!           ------------------
!           Otherwise carry on
!           ------------------
!
            CALL addKeyAndValueFromLineToDict(blockDict = blockDict, &
                                              line      = line)
         END DO 
         
1000     CONTINUE 
         
      END SUBROUTINE readBlock
!
!//////////////////////////////////////////////////////////////////////// 
! 
      SUBROUTINE addKeyAndValueFromLineToDict(blockDict,line)  
         IMPLICIT NONE
!
!        ---------
!        Arguments
!        ---------
!
         TYPE(FTValueDictionary) :: blockDict
         CHARACTER(LEN=*)        :: line
!
!        ---------------
!        Local variables
!        ---------------
!
         CHARACTER(LEN=CFR_STRING_LENGTH) :: key, lValue
         
         CALL keyAndValueOnLine(line   = line, &
                                key    = key,  &
                                lValue = lValue)
         CALL blockDict % addValueForKey(lValue, key)
         
      END SUBROUTINE addKeyAndValueFromLineToDict
!
!//////////////////////////////////////////////////////////////////////// 
! 
      FUNCTION parseObjectName(line) RESULT(objName)
         IMPLICIT NONE  
!
!        ---------
!        Arguments
!        ---------
!
         CHARACTER(LEN=*)                 :: line
         CHARACTER(LEN=CFR_STRING_LENGTH) :: objName
         INTEGER                          :: l, r
         
         l = INDEX(STRING = line, SUBSTRING = "{")
         r = INDEX(STRING = line, SUBSTRING = "}")
         
         objName = line(l+1:r-1)
         
      END FUNCTION parseObjectName
!
!//////////////////////////////////////////////////////////////////////// 
! 
      SUBROUTINE replaceTabs(line)  
         IMPLICIT NONE
         CHARACTER(LEN=*) :: line
         CHARACTER(LEN=1) :: tab = CHAR(9), space = CHAR(32)
         INTEGER          :: i
         DO i = 1, LEN_TRIM(line)
            IF(line(i:i) == tab)   line(i:i) = space
         END DO 
      END SUBROUTINE replaceTabs
!
!//////////////////////////////////////////////////////////////////////// 
! 
      SUBROUTINE readSplineData(fileUnit, dict) 
         USE EncoderModule
         USE FTDataClass
         IMPLICIT NONE
!
!        ---------
!        Arguments
!        ---------
!
         INTEGER                           :: fileUnit
         CLASS(FTValueDictionary), POINTER :: dict
!
!        ---------------
!        Local Variables
!        ---------------
!
         INTEGER                          :: j, k, N
         CHARACTER(LEN=CFR_STRING_LENGTH) :: line
         REAL(KIND(1.0d0)), ALLOCATABLE   :: array(:,:)
         CHARACTER(LEN=1), ALLOCATABLE    :: enc(:)
         TYPE (FTData)   , POINTER        :: dta
         CLASS(FTObject) , POINTER        :: obj
         TYPE (FTException)     , POINTER :: exception
!
!        ----------------
!        Number of points
!        ----------------
!                                           
         N = dict % integerValueForKey("nKnots")
         IF ( N < HUGE(N) )     THEN
         
            ALLOCATE(array(4,N))
            DO j = 1, N
                READ(fileUnit, *) (array(k,j), k = 1,4)
            END DO
            
            CALL encode(arrayIn = array, enc = enc)
            
            ALLOCATE(dta)
            CALL dta % initWithDataOfType(genericData = enc,&
                                          dataType    = "Array2DReal")
            
            obj => dta
            CALL dict % addObjectForKey(object = obj, key = "data")
            CALL releaseFTData(self = dta)
!
!           ----------------------------------------
!           Data is followed by an \end{SPLINE_DATA}
!           ----------------------------------------
!
            READ(fileUnit,"(A)", END = 1000) line
            j = INDEX(STRING = line, SUBSTRING = "\end{SPLINE_DATA}")
            IF ( j <= 0 )     THEN
               ALLOCATE(exception)
               CALL exception % initFatalException( "No \end{SPLINE_DATA} marker for spline data" )
               CALL throw(exception)
               CALL releaseFTException(exception)
            END IF 
            
         ELSE 
            ALLOCATE(exception)
            CALL exception % initFatalException( "Malformed Spline data. No nKnots" )
            CALL throw(exception)
            CALL releaseFTException(exception)
         END IF 
          
1000  CONTINUE 
         
      END SUBROUTINE readSplineData
      END MODULE ControlFileReaderClass

1	! MIT License
2	!
3	! Copyright (c) 2010-present David A. Kopriva and other contributors: AUTHORS.md
4	!
5	! Permission is hereby granted, free of charge, to any person obtaining a copy
6	! of this software and associated documentation files (the "Software"), to deal
7	! in the Software without restriction, including without limitation the rights
8	! to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
9	! copies of the Software, and to permit persons to whom the Software is
10	! furnished to do so, subject to the following conditions:
11	!
12	! The above copyright notice and this permission notice shall be included in all
13	! copies or substantial portions of the Software.
14	!
15	! THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
16	! IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
17	! FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
18	! AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
19	! LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
20	! OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
21	! SOFTWARE.
22	!
23	! --- End License
24	!
25	!////////////////////////////////////////////////////////////////////////
26	!
27	! ControlFileReader.f90
28	! Created: May 29, 2018 at 3:42 PM
29	! By: David Kopriva
30	! All Rights Reserved.
31	!
32	! The control file reader parses the control file and returns
33	! a Control file dictionary.
34	!
35	! A Control file dictionary contains the keys
36	! TYPE
37	! CONTROL_INPUT
38	! MODEL
39	!
40	! TYPE is a string naming the type (class) of object stored
41	!
42	! The CONTROL_INPUT dictionary contains the keys
43	! TYPE
44	! RUN_PARAMETERS
45	! MESH_PARAMETERS
46	! SPRING_SMOOTHER
47	! REFINEMENT_REGIONS
48	! SCALE_TRANSFORMATION
49	! ROTATION_TRANSFORMATION
50	! SIMPLE_EXTRUSION
51	! SIMPLE_ROTATION
52	! SWEEP_ALONG_CURVE
53	!
54	! The MODEL dictionary contains the keys
55	! TYPE
56	! OUTER_BOUNDARY
57	! INNER_BOUNDARIES
58	! SWEEP_CURVE
59	! SWEEP_SCALE_FACTOR
60	! TOPOGRAPHY
61	!
62	! The OUTER_BOUNDARY dictionary contains the keys
63	! TYPE
64	! LIST
65	! The list contains dictionaries describing
66	! PARAMETRIC_EQUATION_CURVE
67	! SPLINE_CURVE
68	! END_POINTS_LINE
69	! CIRCULAR_ARC
70	! ELLIPTIC_ARC
71	!
72	! The INNER_BOUNDARIES dictionary contains the keys
73	! TYPE
74	! LIST
75	! The list contains CHAIN dictionaries
76	!
77	! A CHAIN dictionary contains the keys
78	! TYPE
79	! LIST
80	! The list will contain dictionaries of type
81	! PARAMETRIC_EQUATION_CURVE
82	! SPLINE_CURVE
83	! END_POINTS_LINE
84	! CIRCULAR_ARC
85	! ELLIPTIC_ARC
86	!
87	! A PARAMETRIC_EQUATION_CURVE dictionary contains the keys
88	! TYPE
89	! name
90	! xEqn
91	! yEqn
92	! zEqn
93	!
94	! A SPLINE_CURVE block contains the keys
95	! TYPE
96	! name
97	! SPLINE_DATA
98	!
99	! SPLINE_DATA block contains keys and data
100	! nKnots
101	! t_1 x_1 y_1 z_1
102	! t_2 x_2 y_2 z_2
103	! ...
104	! t_nKnots x_nKnots y_nKnots z_nKnots
105	!
106	! An END_POINTS_LINE has the following keys
107	! TYPE
108	! name
109	! xStart
110	! xEnd
111	!
112	! A CIRCULAR_ARC block contains
113	!
114	! TYPE
115	! name
116	! units
117	! center
118	! radius
119	! start angle
120	! end angle
121	!
122	! An ELLIPTIC_ARC block contains
123	!
124	! TYPE
125	! name
126	! units
127	! center
128	! xRadius
129	! yRadius
130	! start angle
131	! end angle
132	! rotation
133	!
134	! REFINEMENT_REGIONS dictionary contains the keys
135	! TYPE
136	! LIST
137	! LIST is a list of
138	! REFINEMENT_CENTER
139	! REFINEMENT_LINE
140	!
141	! A REFINEMENT_CENTER contains the keys
142	! TYPE
143	! center
144	! h
145	! w
146	!
147	! A REFINEMENT_LINE contains the keys
148	! TYPE
149	! xStart
150	! xEnd
151	! h
152	! w
153	!
154	! A ROTATION_TRANSFORMATION contains the keys
155	! TYPE
156	! direction
157	! rotationPoint
158	!
159	! A SCALE_TRANSFORMATION contains the keys
160	! TYPE
161	! origin
162	! scaleFactor
163	!
164	! The SWEEP_CURVE dictionary contains the keys
165	! TYPE
166	! LIST
167	! The list contains dictionaries describing
168	! PARAMETRIC_EQUATION_CURVE
169	! SPLINE_CURVE
170	! END_POINTS_LINE
171	!
172	! The SWEEP_SCALE_FACTOR dictionary contains the keys
173	! TYPE
174	! LIST
175	! The list contains dictionaries describing
176	! PARAMETRIC_EQUATION
177	!
178	! But the equation definitions contain only one equation r(t) = ...
179	!
180	! the TOPOGRAPHY dictionary contains the keys
181	! TYPE
182	! eqn (for equation defined topography)
183	! sizing
184	!
185	! The SIMPLE_EXTRUSION block is defined in SimpleSweep.f90
186	! The SIMPLE_ROTATION block is defined in SimpleSweep.f90
187	! The SWEEP_ALONG_CURVE block is defined in SweeperClass.f90
188	!
189	!////////////////////////////////////////////////////////////////////////
190	!
191	Module ControlFileReaderClass
192
193	USE FTValueDictionaryClass
194	USE FTLinkedListClass
195	USE FTExceptionClass
196	USE SharedExceptionManagerModule
197	USE FTStackClass
198	USE ErrorTypesModule
199	USE FTStringSetClass
200
201	IMPLICIT NONE
202
203	TYPE ControlFileReader
204	TYPE(FTValueDictionary), POINTER :: controlDict
205	!
206	! --------
207	CONTAINS
208	! --------
209	!
210	PROCEDURE :: init => initControlFileReader
211	PROCEDURE :: destruct => destructControlFileReader
212	PROCEDURE :: importFromControlFile
213	END TYPE ControlFileReader
214
215	INTEGER, PARAMETER :: CFR_STRING_LENGTH = 132
216
217	CHARACTER(LEN=CFR_STRING_LENGTH) :: blockStack(5)
218	INTEGER :: blockStackTop
219	TYPE(FTStringSet) :: blocksWithListsSet
220	CHARACTER(LEN=20) :: blocksWithLists(7) = &
221	["OUTER_BOUNDARY ", &
222	"REFINEMENT_REGIONS ", &
223	"INNER_BOUNDARIES ", &
224	"INTERFACE_BOUNDARIES", &
225	"SWEEP_CURVE ", &
226	"SWEEP_SCALE_FACTOR ", &
227	"CHAIN "]
228	!
229	! ========
230	CONTAINS
231	! ========
232	!
233	!
234	!////////////////////////////////////////////////////////////////////////
235	!
236	SUBROUTINE initControlFileReader(self)	24✔
237	IMPLICIT NONE
238	CLASS(ControlFileReader) :: self
239
240	ALLOCATE(self % controlDict)	24✔
241	CALL self % controlDict % initWithSize(sze = 32)	24✔
242	CALL self % controlDict % addValueForKey(s = "root",key = "TYPE")	24✔
243	CALL initializeFTExceptions	24✔
244	CALL blocksWithListsSet % initWithStrings(strings = blocksWithLists)	24✔
245	blockStack = ""	144✔
246	blockStackTop = 0	24✔
247
248	END SUBROUTINE initControlFileReader	24✔
249	!
250	!////////////////////////////////////////////////////////////////////////
251	!
252	SUBROUTINE destructControlFileReader(self)	24✔
253	IMPLICIT NONE
254	CLASS(ControlFileReader) :: self
255
256	CALL releaseFTValueDictionary(self % controlDict)	24✔
257	CALL destructFTStringSet( blocksWithListsSet)	24✔
258	blockStack = ""	144✔
259	blockStackTop = 0	24✔
260
261	END SUBROUTINE destructControlFileReader	24✔
262	!
263	!////////////////////////////////////////////////////////////////////////
264	!
265	SUBROUTINE importFromControlFile(self, fileUnit)	24✔
266	IMPLICIT NONE
267	!
268	! ---------
269	! Arguments
270	! ---------
271	!
272	CLASS(ControlFileReader) :: self
273	INTEGER :: fileUnit
274	!
275	! ---------------
276	! Local Variables
277	! ---------------
278	!
279	CLASS(FTObject), POINTER :: obj
280	CHARACTER(LEN=CFR_STRING_LENGTH) :: objectName
281
282	obj => self % controlDict	24✔
283	objectName = "root"	24✔
284
285	CALL performImport(fileUnit = fileUnit, &
286	collection = obj, &
287	objectName = objectName)	24✔
288
289	END SUBROUTINE importFromControlFile	24✔
290	!
291	!////////////////////////////////////////////////////////////////////////
292	!
293	RECURSIVE SUBROUTINE performImport(fileUnit, collection, objectName)	329✔
294	IMPLICIT NONE
295	!
296	! ---------
297	! Arguments
298	! ---------
299	!
300	INTEGER, INTENT(IN) :: fileUnit
301	CHARACTER(LEN=*) :: objectName
302	CLASS(FTObject), POINTER :: collection
303	!
304	! ---------------
305	! Local Variables
306	! ---------------
307	!
308	CLASS(FTValueDictionary), POINTER :: dict
309	CHARACTER(LEN=CFR_STRING_LENGTH) :: line
310	INTEGER :: iStat
311	TYPE (FTException) , POINTER :: exception
312
313	IF(catch(FATAL_ERROR_EXCEPTION)) RETURN	658✔
314
315	DO	663✔
316	READ(fileUnit,"(A)", IOSTAT = iStat, END = 1000) line	992✔
317
318	IF(iStat /= 0) EXIT	992✔
319	CALL replaceTabs(line)	992✔
320
321	IF ( INDEX(STRING = line, SUBSTRING = "begin{") > 0) THEN !Start reading a block	992✔
322	CALL startNewCollectionInCollection(fileUnit,line,collection)	305✔
323	IF(catch(FATAL_ERROR_EXCEPTION)) EXIT	305✔
324
325	ELSE IF (INDEX(STRING = line, SUBSTRING = "end{") > 0) THEN	687✔
326	IF(INDEX(STRING = line, SUBSTRING = "end{FILE}") > 0) RETURN	139✔
327	CALL completeBlock(line,objectName)	115✔
328	RETURN ! Done with this block, one way or another	115✔
329
330	ELSE IF (TRIM(line) == "" .OR. line(1:1) == "%") THEN !Skip blank lines	548✔
331	CYCLE	358✔
332	ELSE IF (INDEX(STRING = line, SUBSTRING = "{") > 0 .OR. &	190✔
333	INDEX(STRING = line, SUBSTRING = "}") > 0) THEN
334	ALLOCATE(exception)	×
335	CALL exception % initFatalException( "Syntax error in control file line: "// TRIM(ADJUSTL(line)) // &
336	". Commands are lower case.")	×
NEW 337	CALL throw(exception)	×
338	CALL releaseFTException(exception)	×
339	RETURN	190✔
340	ELSE
341	dict => valueDictionaryFromObject(collection)	190✔
342	CALL readBlock(fileUnit = fileUnit, &
343	blockDict = dict, &
344	firstLine = line, &
345	blockName = objectName)	190✔
346	IF(catch(FATAL_ERROR_EXCEPTION)) EXIT	190✔
347	RETURN	190✔
348	END IF
349	END DO
350
351	1000 CONTINUE
352
353	END SUBROUTINE performImport	329✔
354	!
355	!////////////////////////////////////////////////////////////////////////
356	!
357	RECURSIVE SUBROUTINE startNewCollectionInCollection(fileUnit, line, collection)	305✔
358	IMPLICIT NONE
359	!
360	! ---------
361	! Arguments
362	! ---------
363	!
364	INTEGER, INTENT(IN) :: fileUnit
365	CHARACTER(LEN=*) :: line
366	CLASS(FTObject), POINTER :: collection
367	!
368	! ---------------
369	! Local variables
370	! ---------------
371	!
372	CHARACTER(LEN=CFR_STRING_LENGTH) :: objectName
373	CLASS(FTObject) , POINTER :: obj
374	TYPE (FTValueDictionary), POINTER :: newDict
375	CLASS(FTLinkedList) , POINTER :: newList
376	!
377	! ---------------------------------------
378	! New block to add to current collection
379	! ---------------------------------------
380	!
381	objectName = parseObjectName(line)	610✔
382	blockStackTop = blockStackTop + 1	305✔
383	blockStack(blockStackTop) = objectName	305✔
384
385	ALLOCATE(newDict)	305✔
386	CALL newDict % initWithSize(sze = 32)	305✔
387	CALL newDict % addValueForKey(s = objectName,key = "TYPE")	305✔
388	obj => newDict	305✔
389	CALL addObjectToCollection(obj, collection, objectName)	305✔
390	!
391	! --------------------------------------------
392	! Certain blocks have lists of objects in them
393	! --------------------------------------------
394	!
395	IF( blocksWithListsSet % containsString(objectName)) THEN	305✔
396	ALLOCATE(newList)	69✔
397	CALL newList % init()	69✔
398	obj => newList	69✔
399	CALL newDict % addObjectForKey(obj,"LIST")	69✔
400	CALL releaseFTLinkedListClass(self = newList)	69✔
401
402	IF(objectName == "CHAIN" .OR. objectName == "OUTER_BOUNDARY") THEN ! Read (possible) chain parameters	69✔
403	DO	36✔
404	READ(fileUnit,"(A)", END = 1000) line	90✔
405	CALL replaceTabs(line)	90✔
406	line = ADJUSTL(line)	90✔
407	IF ( line(1:1) == "\" ) THEN	90✔
408	BACKSPACE(fileUnit)	54✔
409	EXIT	54✔
410	END IF
411	CALL addKeyAndValueFromLineToDict(blockDict = newDict,line = line)	36✔
412	END DO
413	END IF
414	obj => newList	69✔
415	END IF
416
417	CALL releaseFTValueDictionary(self = newDict)	305✔
418	CALL performImport(fileUnit, obj, objectName)	305✔
419	1000 CONTINUE
420
421	END SUBROUTINE startNewCollectionInCollection	305✔
422	!
423	!////////////////////////////////////////////////////////////////////////
424	!
425	SUBROUTINE completeBlock(line, objectName)	115✔
426	IMPLICIT NONE
427	!
428	! ---------
429	! Arguments
430	! ---------
431	!
432	CHARACTER(LEN=*) :: line, objectName
433	!
434	! ---------------
435	! Local Variables
436	! ---------------
437	!
438	TYPE (FTException) , POINTER :: exception
439	CHARACTER(LEN=CFR_STRING_LENGTH) :: foundName
440	CHARACTER(LEN=132) :: msg
441
442	foundName = parseObjectName(line)	230✔
443	IF(foundName /= blockStack(blockStackTop)) THEN	115✔
444	msg = "Block termination error. Expected: "//TRIM(objectName)//"; Found: "//TRIM(foundName)	×
445	PRINT *, msg	×
446	ALLOCATE(exception)	×
447	CALL exception % initFatalException(msg)	×
NEW 448	CALL throw(exception)	×
NEW 449	CALL releaseFTException(exception)	×
UNCOV 450	RETURN	×
451	END IF
452	blockStack(blockStackTop) = ""	115✔
453	blockStackTop = blockStackTop - 1	115✔
454	END SUBROUTINE completeBlock	115✔
455	!
456	!////////////////////////////////////////////////////////////////////////
457	!
458	SUBROUTINE addObjectToCollection(obj, collection, objectName)	305✔
459	IMPLICIT NONE
460	CHARACTER(LEN=*) :: objectName
461	CLASS(FTObject), POINTER :: collection, obj
462
463	SELECT TYPE (c => collection)
464	TYPE IS (FTValueDictionary)
465	CALL c % addObjectForKey(obj, objectName)	175✔
466	TYPE IS (FTLinkedList)
467	CALL c % add(obj)	130✔
468	CLASS DEFAULT
469
470	END SELECT
471
472	END SUBROUTINE addObjectToCollection	610✔
473	!
474	!////////////////////////////////////////////////////////////////////////
475	!
476	SUBROUTINE keyAndValueOnLine(line, key, lValue)	761✔
477	IMPLICIT NONE
478	!
479	! ---------
480	! Arguments
481	! ---------
482	!
483	CHARACTER(LEN = CFR_STRING_LENGTH) :: key, lValue, line
484	!
485	! ---------------
486	! Local Variables
487	! ---------------
488	!
489	INTEGER :: indxOfEqual
490
491	indxOfEqual = INDEX(STRING = line, SUBSTRING = "=")	761✔
492	IF ( indxOfEqual <= 1 ) THEN	761✔
493	lValue = ""	2✔
494	key = ""	2✔
495	ELSE
496	key = TRIM(ADJUSTL(line(1:indxOfEqual-1)))	759✔
497	lValue = TRIM(ADJUSTL(line(indxOfEqual+1:)))	759✔
498	END IF
499
500	END SUBROUTINE keyAndValueOnLine	761✔
501	!
502	!////////////////////////////////////////////////////////////////////////
503	!
504	SUBROUTINE readBlock(fileUnit, blockDict, firstLine, blockName)	190✔
505	IMPLICIT NONE
506	!
507	! ---------
508	! Arguments
509	! ---------
510	!
511	INTEGER :: fileUnit
512	CLASS(FTValueDictionary), POINTER :: blockDict
513	CHARACTER(LEN=*) :: firstLine,blockName
514	CHARACTER(LEN=132) :: errMsg
515	!
516	! ---------------
517	! Local Variables
518	! ---------------
519	!
520	INTEGER :: s, e
521	CHARACTER(LEN=CFR_STRING_LENGTH) :: line
522	TYPE (FTException) , POINTER :: exception
523
524	errMsg = ""	190✔
525	CALL addKeyAndValueFromLineToDict(blockDict = blockDict, &
526	line = firstLine)	190✔
527	DO	543✔
528	READ(fileUnit,"(A)", END = 1000) line	733✔
529	CALL replaceTabs(line)	733✔
530	!
531	! -------------
532	! Check for end
533	! -------------
534	!
535	s = INDEX(STRING = line, SUBSTRING = "end{")	733✔
536	IF ( s > 0 ) THEN	733✔
537	s = s + 3	190✔
538	e = INDEX(STRING = line, SUBSTRING = "}")	190✔
539	IF(line(s+1:e-1) /= TRIM(blockName)) THEN	190✔
540	errMsg = "Improper block termination. Expected "// TRIM(blockName)// "; found "// line(s+1:e-1)	×
541	PRINT *, errMsg	×
542	ALLOCATE(exception)	×
543	CALL exception % initFatalException(errMsg)	×
NEW 544	CALL throw(exception)	×
NEW 545	CALL releaseFTException(exception)	×
546	END IF
547	blockStack(blockStackTop) = ""	190✔
548	blockStackTop = blockStackTop - 1	190✔
549	RETURN	190✔
550	END IF
551	!
552	! -----------------------------------------------
553	! Spline curve definitions contain the nodes and
554	! values
555	! -----------------------------------------------
556	!
557	s = INDEX(STRING = line, SUBSTRING = "\begin{SPLINE_DATA}")	543✔
558	IF ( s > 0 ) THEN	543✔
559	CALL readSplineData(fileUnit, blockDict)	8✔
560	CYCLE	8✔
561	END IF
562	!
563	! ------------------
564	! Otherwise carry on
565	! ------------------
566	!
567	CALL addKeyAndValueFromLineToDict(blockDict = blockDict, &
568	line = line)	535✔
569	END DO
570
571	1000 CONTINUE
572
573	END SUBROUTINE readBlock	190✔
574	!
575	!////////////////////////////////////////////////////////////////////////
576	!
577	SUBROUTINE addKeyAndValueFromLineToDict(blockDict,line)	761✔
578	IMPLICIT NONE
579	!
580	! ---------
581	! Arguments
582	! ---------
583	!
584	TYPE(FTValueDictionary) :: blockDict
585	CHARACTER(LEN=*) :: line
586	!
587	! ---------------
588	! Local variables
589	! ---------------
590	!
591	CHARACTER(LEN=CFR_STRING_LENGTH) :: key, lValue
592
593	CALL keyAndValueOnLine(line = line, &
594	key = key, &
595	lValue = lValue)	761✔
596	CALL blockDict % addValueForKey(lValue, key)	761✔
597
598	END SUBROUTINE addKeyAndValueFromLineToDict	761✔
599	!
600	!////////////////////////////////////////////////////////////////////////
601	!
602	FUNCTION parseObjectName(line) RESULT(objName)	420✔
603	IMPLICIT NONE
604	!
605	! ---------
606	! Arguments
607	! ---------
608	!
609	CHARACTER(LEN=*) :: line
610	CHARACTER(LEN=CFR_STRING_LENGTH) :: objName
611	INTEGER :: l, r
612
613	l = INDEX(STRING = line, SUBSTRING = "{")	420✔
614	r = INDEX(STRING = line, SUBSTRING = "}")	420✔
615
616	objName = line(l+1:r-1)	420✔
617
618	END FUNCTION parseObjectName	420✔
619	!
620	!////////////////////////////////////////////////////////////////////////
621	!
622	SUBROUTINE replaceTabs(line)	1,815✔
623	IMPLICIT NONE
624	CHARACTER(LEN=*) :: line
625	CHARACTER(LEN=1) :: tab = CHAR(9), space = CHAR(32)
626	INTEGER :: i
627	DO i = 1, LEN_TRIM(line)	48,176✔
628	IF(line(i:i) == tab) line(i:i) = space	48,176✔
629	END DO
630	END SUBROUTINE replaceTabs	1,815✔
631	!
632	!////////////////////////////////////////////////////////////////////////
633	!
634	SUBROUTINE readSplineData(fileUnit, dict)	8✔
635	USE EncoderModule
636	USE FTDataClass
637	IMPLICIT NONE
638	!
639	! ---------
640	! Arguments
641	! ---------
642	!
643	INTEGER :: fileUnit
644	CLASS(FTValueDictionary), POINTER :: dict
645	!
646	! ---------------
647	! Local Variables
648	! ---------------
649	!
650	INTEGER :: j, k, N
651	CHARACTER(LEN=CFR_STRING_LENGTH) :: line
652	REAL(KIND(1.0d0)), ALLOCATABLE :: array(:,:)	8✔
653	CHARACTER(LEN=1), ALLOCATABLE :: enc(:)	8✔
654	TYPE (FTData) , POINTER :: dta
655	CLASS(FTObject) , POINTER :: obj
656	TYPE (FTException) , POINTER :: exception
657	!
658	! ----------------
659	! Number of points
660	! ----------------
661	!
662	N = dict % integerValueForKey("nKnots")	8✔
663	IF ( N < HUGE(N) ) THEN	8✔
664
665	ALLOCATE(array(4,N))	8✔
666	DO j = 1, N	826✔
667	READ(fileUnit, *) (array(k,j), k = 1,4)	4,098✔
668	END DO
669
670	CALL encode(arrayIn = array, enc = enc)	8✔
671
672	ALLOCATE(dta)	8✔
673	CALL dta % initWithDataOfType(genericData = enc,&
674	dataType = "Array2DReal")	8✔
675
676	obj => dta	8✔
677	CALL dict % addObjectForKey(object = obj, key = "data")	8✔
678	CALL releaseFTData(self = dta)	8✔
679	!
680	! ----------------------------------------
681	! Data is followed by an \end{SPLINE_DATA}
682	! ----------------------------------------
683	!
684	READ(fileUnit,"(A)", END = 1000) line	8✔
685	j = INDEX(STRING = line, SUBSTRING = "\end{SPLINE_DATA}")	8✔
686	IF ( j <= 0 ) THEN	8✔
687	ALLOCATE(exception)	×
688	CALL exception % initFatalException( "No \end{SPLINE_DATA} marker for spline data" )	×
NEW 689	CALL throw(exception)	×
690	CALL releaseFTException(exception)	×
691	END IF
692
693	ELSE
694	ALLOCATE(exception)	×
695	CALL exception % initFatalException( "Malformed Spline data. No nKnots" )	×
NEW 696	CALL throw(exception)	×
697	CALL releaseFTException(exception)	×
698	END IF
699
700	1000 CONTINUE
701
702	END SUBROUTINE readSplineData	8✔
703	END MODULE ControlFileReaderClass	305✔

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