30206241592

Committed 26 Jul 2026 02:31PM UTC coverage: 92.391% (-2.2%) from 94.58%

Build # 30206241592

Build Type

Pull #79

github

Committed by

web-flow

Commit Message

Merge 79dc9ef6b into 58212d52c

Pull Request Pull Request #79: Type mods2

Coverage Stats

89 of 126 new or added lines in 17 files covered. (70.63%)

33 existing lines in 4 files now uncovered.

2732 of 2957 relevant lines covered (92.39%)

14.8 hits per line

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

94.55

/Source/FTObjects/FTSparseMatrixClass.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.
!
! FTObjectLibrary contains code that, to the best of our knowledge, has been released as
! public domain software:
! * `b3hs_hash_key_jenkins`: originally by Rich Townsend, 
! https://groups.google.com/forum/#!topic/comp.lang.fortran/RWoHZFt39ng, 2005
!
! --- End License

!
!////////////////////////////////////////////////////////////////////////
!
!      SparseMatrixClass.f90
!      Created: July 29, 2013 10:59 AM 
!      By: David Kopriva  
!
!
!////////////////////////////////////////////////////////////////////////
!
!>FTSparseMatrixData is used by the FTSparseMatrix Class. Users will 
!>usually not interact with or use this class directly.
!>
      Module FTSparseMatrixData 
      USE FTObjectClass
      IMPLICIT NONE
!
!     ---------------
!     Type definition
!     ---------------
!
      TYPE, EXTENDS(FTObject) :: MatrixData
         INTEGER                  :: key
         CLASS(FTObject), POINTER :: object
!
!        ========
         CONTAINS
!        ========
!
         PROCEDURE :: initWithObjectAndKey
         FINAL     :: destructMatrixData
         
      END TYPE MatrixData
      
      INTERFACE cast
         MODULE PROCEDURE castObjectToMatrixData
      END INTERFACE cast
      
!
!     ========      
      CONTAINS
!     ========
!
!
!//////////////////////////////////////////////////////////////////////// 
! 
      SUBROUTINE initWithObjectAndKey(self,object,key)
!
!        ----------------------
!        Designated initializer
!        ----------------------
!
         IMPLICIT NONE
         CLASS(MatrixData)        :: self
         CLASS(FTObject), POINTER :: object
         INTEGER                  :: key
         
         CALL self % FTObject % init()
         
         self % key = key
         self % object => object
         CALL self % object % retain()
         
      END SUBROUTINE initWithObjectAndKey
!
!//////////////////////////////////////////////////////////////////////// 
! 
      SUBROUTINE releaseFTMatrixData(self)  
         IMPLICIT NONE
         TYPE(MatrixData), POINTER :: self
         CLASS(FTObject) , POINTER :: obj
          
         IF(.NOT. ASSOCIATED(self)) RETURN
         
         obj => self
         CALL release(obj) 
         IF(.NOT.ASSOCIATED(obj)) self => NULL()
      END SUBROUTINE releaseFTMatrixData
!
!//////////////////////////////////////////////////////////////////////// 
! 
      SUBROUTINE destructMatrixData(self)
         IMPLICIT NONE  
         TYPE(MatrixData) :: self
         
         IF ( ASSOCIATED(self % object) )     THEN
            CALL releaseFTObject(self = self % object)
         END IF 

      END SUBROUTINE destructMatrixData
!
!//////////////////////////////////////////////////////////////////////// 
! 
      SUBROUTINE castObjectToMatrixData(obj,cast)  
         IMPLICIT NONE  
!
!        -----------------------------------------------------
!        Cast the base class FTObject to the MatrixData class
!        -----------------------------------------------------
!
         CLASS(FTObject)  , POINTER :: obj
         CLASS(MatrixData), POINTER :: cast
         
         cast => NULL()
         SELECT TYPE (e => obj)
            TYPE is (MatrixData)
               cast => e
            CLASS DEFAULT
               
         END SELECT
         
      END SUBROUTINE castObjectToMatrixData
!
!//////////////////////////////////////////////////////////////////////// 
! 
      FUNCTION matrixDataCast(obj)  RESULT(cast)
         IMPLICIT NONE  
!
!        -----------------------------------------------------
!        Cast the base class FTObject to the MatrixData class
!        -----------------------------------------------------
!
         CLASS(FTObject)  , POINTER :: obj
         CLASS(MatrixData), POINTER :: cast
         
         cast => NULL()
         SELECT TYPE (e => obj)
            TYPE is (MatrixData)
               cast => e
            CLASS DEFAULT
               
         END SELECT
         
      END FUNCTION matrixDataCast
      
      END Module FTSparseMatrixData
!@mark -
!>The sparse matrix stores an FTObject pointer associated
!>with two keys (i,j) as a hash table.
!>
!>Hash tables are data structures designed to enable storage and fast
!>retrieval of key-value pairs. An example of a key-value pair is
!>a variable name (``gamma'') and its associated value (``1.4'').
!>The table itself is typically an array.
!>The location of the value in a hash table associated with
!>a key, $k$, is specified by way of a hash function, $H(k)$.
!>In the case of a variable name and value, the hash function
!>would convert the name into an integer that tells where to
!>find the associated value in the table.
!>
!>A very simple example of a
!>hash table is, in fact, a singly dimensioned array. The key is 
!>the array index and the value is what is stored at that index.
!>Multiple keys can be used to identify data; a two dimensional
!>array provides an example of where two keys are used to access memory
!>and retrieve the value at that location.
!>If we view a singly dimensioned array as a special case of a hash table,
!>its hash function is just the array index, $H(j)=j$. A doubly dimensioned array
!>could be (and often is) stored columnwise as a singly dimensioned array by creating a hash
!>function that maps the two indices to a single location in the array, e.g.,
!>$H(i,j) = i + j*N$, where $N$ is the range of the first index, $i$. 
!>
!>Two classes are included in FTObjectLibrary. The first, FTSparseMatrix, works with an ordered pair, (i,j), as the
!>keys. The second, FTMultiIndexTable, uses an array of integers as the keys.
!>
!>Both classes include enquiry functions to see of an object exists for the given keys. Otherwise,
!>the function that returns an object for a given key will return an UNASSOCIATED pointer if there
!>is no object for the key. Be sure to retain any object returned by the objectForKeys methods if 
!>you want to keep it beyond the lifespan of the matrix or table. For example,
!>
!>           TYPE(FTObject) :: obj
!>           obj => matrix % objectForKeys(i,j)
!>           IF ( ASSOCIATED(OBJ) ) THEN
!>               CALL obj % retain()
!>                 Cast obj to something useful
!>           ELSE
!>              Perform some kind of error recovery
!>           END IF 
!>The sparse matrix stores an FTObject pointer associated
!>with two keys (i,j) as a hash table. The size, N = the range of i.
!>
!>##Definition (Subclass of FTObject)
!>
!>         TYPE(FTSparseMatrix) :: SparseMatrix
!>#Usage
!>##Initialization
!>
!>         CALL SparseMatrix % initWithSize(N)
!>
!>##Destruction
!>
!>         CALL releaseFTSparseMatrix(SparseMatrix) [Pointers]
!>
!>##Adding an object
!>
!>         CLASS(FTObject), POINTER :: obj
!>         CALL SparseMatrix % addObjectForKeys(obj,i,j)
!>
!>##Retrieving an object
!>
!>         CLASS(FTObject), POINTER :: obj
!>         obj => SparseMatrix % objectForKeys(i,j)
!>
!>Be sure to retain the object if you want it to live
!>      beyond the life of the table.
!>
!>##Testing the presence of keys
!>
!>         LOGICAL :: exists
!>         exists = SparseMatrix % containsKeys(i,j)
!
!////////////////////////////////////////////////////////////////////////
!
      Module FTSparseMatrixClass
      USE FTObjectClass
      USE FTLinkedListClass
      USE FTLinkedListIteratorClass
      USE FTSparseMatrixData
      IMPLICIT NONE
!
!     ----------------------
!     Class type definitions
!     ----------------------
!
      TYPE FTLinkedListPtr
         CLASS(FTLinkedList), POINTER :: list
      END TYPE FTLinkedListPtr
      PRIVATE :: FTLinkedListPtr
      
      TYPE, EXTENDS(FTObject) :: FTSparseMatrix
         TYPE(FTLinkedListPtr)     , DIMENSION(:), ALLOCATABLE :: table
         TYPE(FTLinkedListIterator), PRIVATE                   :: iterator
!
!        ========
         CONTAINS
!        ========
!
         PROCEDURE :: initWithSize     => initSparseMatrixWithSize
         FINAL     :: destructSparseMatrix
         PROCEDURE :: containsKeys     => SparseMatrixContainsKeys
         PROCEDURE :: addObjectForKeys => addObjectToSparseMatrixForKeys
         PROCEDURE :: objectForKeys    => objectInSparseMatrixForKeys
         PROCEDURE :: SparseMatrixSize
         
      END TYPE FTSparseMatrix
!
!     ========
      CONTAINS
!     ========
!
!
!//////////////////////////////////////////////////////////////////////// 
! 
      SUBROUTINE initSparseMatrixWithSize(self,N)  
         IMPLICIT NONE
!
!        ---------
!        Arguments
!        ---------
!
         CLASS(FTSparseMatrix) :: self
         INTEGER            :: N
!
!        ---------------
!        Local variables
!        ---------------
!
         INTEGER :: j
         
         CALL self % FTObject % init()
         
         ALLOCATE(self % table(N))
         DO j = 1, N
            ALLOCATE(self % table(j) % list)
            CALL self % table(j) % list % init()
         END DO
         
         CALL self % iterator % init()
         
      END SUBROUTINE initSparseMatrixWithSize
!
!//////////////////////////////////////////////////////////////////////// 
! 
      SUBROUTINE addObjectToSparseMatrixForKeys(self,obj,i,j)
         IMPLICIT NONE  
!
!        ---------
!        Arguments
!        ---------
!
         CLASS(FTSparseMatrix)    :: self
         CLASS(FTObject), POINTER :: obj
!
!        ---------------
!        Local variables
!        ---------------
!
         CLASS(MatrixData), POINTER :: mData
         CLASS(FTObject)  , POINTER :: ptr
         INTEGER                    :: i,j
         
         IF ( .NOT.self % containsKeys(i,j) )     THEN
            ALLOCATE(mData)
            CALL mData % initWithObjectAndKey(obj,j)
            ptr => mData
            CALL self % table(i) % list % add(ptr)
            CALL releaseFTObject(ptr)
         END IF 
         
      END SUBROUTINE addObjectToSparseMatrixForKeys
!
!//////////////////////////////////////////////////////////////////////// 
! 
      FUNCTION objectInSparseMatrixForKeys(self,i,j) RESULT(r)
!
!     ---------------------------------------------------------------
!     Returns the stored FTObject for the keys (i,j). Returns NULL()
!     if the object isn't in the table. Retain the object if it needs
!     a strong reference by the caller.
!     ---------------------------------------------------------------
!
         IMPLICIT NONE  
!
!        ---------
!        Arguments
!        ---------
!
         CLASS(FTSparseMatrix)    :: self
         INTEGER                  :: i,j
         CLASS(FTObject), POINTER :: r
!
!        ---------------
!        Local variables
!        ---------------
!
         CLASS(MatrixData)  , POINTER :: mData
         CLASS(FTObject)    , POINTER :: obj
         CLASS(FTLinkedList), POINTER :: list
         
         r    => NULL()
         IF(.NOT.ALLOCATED(self % table))     RETURN 
         list => self % table(i) % list
         IF(.NOT.ASSOCIATED(list))    RETURN 
         IF (  list % COUNT() == 0 )  RETURN
!
!        ----------------------------
!        Step through the linked list
!        ----------------------------
!
         r => NULL()
         
         CALL self % iterator % setLinkedListClass(self % table(i) % list)
         DO WHILE (.NOT.self % iterator % isAtEnd())
         
            obj => self % iterator % object()
            CALL cast(obj,mData)
            IF ( mData % key == j )     THEN
               r => mData % object
               EXIT 
            END IF 
            
            CALL self % iterator % moveToNext()
         END DO

      END FUNCTION objectInSparseMatrixForKeys
!
!//////////////////////////////////////////////////////////////////////// 
! 
      FUNCTION SparseMatrixContainsKeys(self,i,j)  RESULT(r)
         IMPLICIT NONE
!
!        ---------
!        Arguments
!        ---------
!
         CLASS(FTSparseMatrix) :: self
         INTEGER                :: i, j
         LOGICAL                :: r
!
!        ---------------
!        Local variables
!        ---------------
!
         CLASS(FTObject)    , POINTER :: obj
         CLASS(MatrixData)  , POINTER :: mData
         CLASS(FTLinkedList), POINTER :: list
         
         r = .FALSE.
         IF(.NOT.ALLOCATED(self % table))                RETURN 
         IF(.NOT.ASSOCIATED(self % table(i) % list))     RETURN
         IF ( self % table(i) % list % COUNT() == 0 )    RETURN 
!
!        ----------------------------
!        Step through the linked list
!        ----------------------------
!
         list => self % table(i) % list
         CALL self % iterator % setLinkedListClass(list)
         CALL self % iterator % setToStart()
         DO WHILE (.NOT.self % iterator % isAtEnd())
         
            obj => self % iterator % object()
            CALL cast(obj,mData)
            IF ( mData % key == j )     THEN
               r = .TRUE.
               RETURN  
            END IF 
            
            CALL self % iterator % moveToNext()
         END DO
         
      END FUNCTION SparseMatrixContainsKeys
!
!//////////////////////////////////////////////////////////////////////// 
! 
      SUBROUTINE releaseFTSparseMatrix(self)  
         IMPLICIT NONE
         TYPE(FTSparseMatrix), POINTER :: self
         CLASS(FTObject)     , POINTER :: obj
           
         IF(.NOT. ASSOCIATED(self)) RETURN
        
         obj => self
         CALL release(obj) 
         IF(.NOT.ASSOCIATED(obj)) self => NULL()
      END SUBROUTINE releaseFTSparseMatrix
!
!//////////////////////////////////////////////////////////////////////// 
! 
      SUBROUTINE releaseFTSparseMatrixClass(self)  
         IMPLICIT NONE
         CLASS(FTSparseMatrix), POINTER :: self
         CLASS(FTObject)      , POINTER :: obj
           
         IF(.NOT. ASSOCIATED(self)) RETURN
        
         obj => self
         CALL release(obj) 
         IF(.NOT.ASSOCIATED(obj)) self => NULL()
      END SUBROUTINE releaseFTSparseMatrixClass
!
!//////////////////////////////////////////////////////////////////////// 
! 
      SUBROUTINE destructSparseMatrix(self)
         IMPLICIT NONE  
!
!        ---------
!        Arguments
!        ---------
!
         TYPE(FTSparseMatrix) :: self
!
!        ---------------
!        Local variables
!        ---------------
!
         INTEGER :: j

         IF(ALLOCATED(self % table))     THEN 
            DO j = 1, SIZE(self % table)
               IF ( ASSOCIATED(self % table(j) % list) )     THEN
                  CALL releaseSMMemberList(list = self % table(j) % list)
               END IF 
            END DO
         END IF 

         IF(ALLOCATED(self % table))   DEALLOCATE(self % table)
         
      END SUBROUTINE destructSparseMatrix
!
!//////////////////////////////////////////////////////////////////////// 
! 
      SUBROUTINE releaseSMMemberList(list)  
          IMPLICIT NONE  
          CLASS(FTLinkedList), POINTER :: list
          CLASS(FTObject)    , POINTER :: obj

          obj => list
          CALL releaseFTObject(self = obj)
          IF(.NOT. ASSOCIATED(obj)) list => NULL()
      END SUBROUTINE releaseSMMemberList
!
!//////////////////////////////////////////////////////////////////////// 
! 
      INTEGER FUNCTION SparseMatrixSize(self)  
         IMPLICIT NONE  
         CLASS(FTSparseMatrix) :: self
         IF ( ALLOCATED(self % table) )     THEN
            SparseMatrixSize =  SIZE(self % table)
         ELSE
            SparseMatrixSize = 0
         END IF 
      END FUNCTION SparseMatrixSize
!
!//////////////////////////////////////////////////////////////////////// 
! 
      FUNCTION SparseMatrixFromObject(obj) RESULT(cast)
!
!     --------------------------------------------------------
!     Cast the base class FTObject to the FTSparseMatrix class
!     --------------------------------------------------------
!
         IMPLICIT NONE  
         CLASS(FTObject)   , POINTER :: obj
         CLASS(FTSparseMatrix), POINTER :: cast
         
         cast => NULL()
         SELECT TYPE (e => obj)
            TYPE is (FTSparseMatrix)
               cast => e
            CLASS DEFAULT
               
         END SELECT
         
      END FUNCTION SparseMatrixFromObject
!
!////////////////////////////////////////////////////////////////////////
!
      INTEGER FUNCTION Hash1( idPair )
         INTEGER, DIMENSION(2) :: idPair
         Hash1 = MAXVAL(idPair)
      END FUNCTION Hash1
!
!////////////////////////////////////////////////////////////////////////
!
      INTEGER FUNCTION Hash2( idPair )
         INTEGER, DIMENSION(2) :: idPair
         Hash2 = MINVAL(idPair)
      END FUNCTION Hash2

      END Module FTSparseMatrixClass

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	! FTObjectLibrary contains code that, to the best of our knowledge, has been released as
24	! public domain software:
25	! * `b3hs_hash_key_jenkins`: originally by Rich Townsend,
26	! https://groups.google.com/forum/#!topic/comp.lang.fortran/RWoHZFt39ng, 2005
27	!
28	! --- End License
29
30	!
31	!////////////////////////////////////////////////////////////////////////
32	!
33	! SparseMatrixClass.f90
34	! Created: July 29, 2013 10:59 AM
35	! By: David Kopriva
36	!
37	!
38	!////////////////////////////////////////////////////////////////////////
39	!
40	!>FTSparseMatrixData is used by the FTSparseMatrix Class. Users will
41	!>usually not interact with or use this class directly.
42	!>
43	Module FTSparseMatrixData
44	USE FTObjectClass
45	IMPLICIT NONE
46	!
47	! ---------------
48	! Type definition
49	! ---------------
50	!
51	TYPE, EXTENDS(FTObject) :: MatrixData
52	INTEGER :: key
53	CLASS(FTObject), POINTER :: object
54	!
55	! ========
56	CONTAINS
57	! ========
58	!
59	PROCEDURE :: initWithObjectAndKey
60	FINAL :: destructMatrixData
61
62	END TYPE MatrixData
63
64	INTERFACE cast
65	MODULE PROCEDURE castObjectToMatrixData
66	END INTERFACE cast
67
68	!
69	! ========
70	CONTAINS
71	! ========
72	!
73	!
74	!////////////////////////////////////////////////////////////////////////
75	!
76	SUBROUTINE initWithObjectAndKey(self,object,key)	12✔
77	!
78	! ----------------------
79	! Designated initializer
80	! ----------------------
81	!
82	IMPLICIT NONE
83	CLASS(MatrixData) :: self
84	CLASS(FTObject), POINTER :: object
85	INTEGER :: key
86
87	CALL self % FTObject % init()	12✔
88
89	self % key = key	12✔
90	self % object => object	12✔
91	CALL self % object % retain()	12✔
92
93	END SUBROUTINE initWithObjectAndKey	12✔
94	!
95	!////////////////////////////////////////////////////////////////////////
96	!
97	SUBROUTINE releaseFTMatrixData(self)	1✔
98	IMPLICIT NONE
99	TYPE(MatrixData), POINTER :: self
100	CLASS(FTObject) , POINTER :: obj
101
102	IF(.NOT. ASSOCIATED(self)) RETURN	1✔
103
104	obj => self	1✔
105	CALL release(obj)	1✔
106	IF(.NOT.ASSOCIATED(obj)) self => NULL()	1✔
107	END SUBROUTINE releaseFTMatrixData
108	!
109	!////////////////////////////////////////////////////////////////////////
110	!
111	SUBROUTINE destructMatrixData(self)	12✔
112	IMPLICIT NONE
113	TYPE(MatrixData) :: self
114
115	IF ( ASSOCIATED(self % object) ) THEN	12✔
116	CALL releaseFTObject(self = self % object)	12✔
117	END IF
118
119	END SUBROUTINE destructMatrixData	12✔
120	!
121	!////////////////////////////////////////////////////////////////////////
122	!
123	SUBROUTINE castObjectToMatrixData(obj,cast)	52✔
124	IMPLICIT NONE
125	!
126	! -----------------------------------------------------
127	! Cast the base class FTObject to the MatrixData class
128	! -----------------------------------------------------
129	!
130	CLASS(FTObject) , POINTER :: obj
131	CLASS(MatrixData), POINTER :: cast
132
133	cast => NULL()	52✔
134	SELECT TYPE (e => obj)
135	TYPE is (MatrixData)
136	cast => e	52✔
137	CLASS DEFAULT
138
139	END SELECT
140
141	END SUBROUTINE castObjectToMatrixData	52✔
142	!
143	!////////////////////////////////////////////////////////////////////////
144	!
145	FUNCTION matrixDataCast(obj) RESULT(cast)	1✔
146	IMPLICIT NONE
147	!
148	! -----------------------------------------------------
149	! Cast the base class FTObject to the MatrixData class
150	! -----------------------------------------------------
151	!
152	CLASS(FTObject) , POINTER :: obj
153	CLASS(MatrixData), POINTER :: cast
154
155	cast => NULL()	1✔
156	SELECT TYPE (e => obj)
157	TYPE is (MatrixData)
158	cast => e	1✔
159	CLASS DEFAULT
160
161	END SELECT
162
163	END FUNCTION matrixDataCast	1✔
164
165	END Module FTSparseMatrixData	65✔
166	!@mark -
167	!>The sparse matrix stores an FTObject pointer associated
168	!>with two keys (i,j) as a hash table.
169	!>
170	!>Hash tables are data structures designed to enable storage and fast
171	!>retrieval of key-value pairs. An example of a key-value pair is
172	!>a variable name (``gamma'') and its associated value (``1.4'').
173	!>The table itself is typically an array.
174	!>The location of the value in a hash table associated with
175	!>a key, $k$, is specified by way of a hash function, $H(k)$.
176	!>In the case of a variable name and value, the hash function
177	!>would convert the name into an integer that tells where to
178	!>find the associated value in the table.
179	!>
180	!>A very simple example of a
181	!>hash table is, in fact, a singly dimensioned array. The key is
182	!>the array index and the value is what is stored at that index.
183	!>Multiple keys can be used to identify data; a two dimensional
184	!>array provides an example of where two keys are used to access memory
185	!>and retrieve the value at that location.
186	!>If we view a singly dimensioned array as a special case of a hash table,
187	!>its hash function is just the array index, $H(j)=j$. A doubly dimensioned array
188	!>could be (and often is) stored columnwise as a singly dimensioned array by creating a hash
189	!>function that maps the two indices to a single location in the array, e.g.,
190	!>$H(i,j) = i + j*N$, where $N$ is the range of the first index, $i$.
191	!>
192	!>Two classes are included in FTObjectLibrary. The first, FTSparseMatrix, works with an ordered pair, (i,j), as the
193	!>keys. The second, FTMultiIndexTable, uses an array of integers as the keys.
194	!>
195	!>Both classes include enquiry functions to see of an object exists for the given keys. Otherwise,
196	!>the function that returns an object for a given key will return an UNASSOCIATED pointer if there
197	!>is no object for the key. Be sure to retain any object returned by the objectForKeys methods if
198	!>you want to keep it beyond the lifespan of the matrix or table. For example,
199	!>
200	!> TYPE(FTObject) :: obj
201	!> obj => matrix % objectForKeys(i,j)
202	!> IF ( ASSOCIATED(OBJ) ) THEN
203	!> CALL obj % retain()
204	!> Cast obj to something useful
205	!> ELSE
206	!> Perform some kind of error recovery
207	!> END IF
208	!>The sparse matrix stores an FTObject pointer associated
209	!>with two keys (i,j) as a hash table. The size, N = the range of i.
210	!>
211	!>##Definition (Subclass of FTObject)
212	!>
213	!> TYPE(FTSparseMatrix) :: SparseMatrix
214	!>#Usage
215	!>##Initialization
216	!>
217	!> CALL SparseMatrix % initWithSize(N)
218	!>
219	!>##Destruction
220	!>
221	!> CALL releaseFTSparseMatrix(SparseMatrix) [Pointers]
222	!>
223	!>##Adding an object
224	!>
225	!> CLASS(FTObject), POINTER :: obj
226	!> CALL SparseMatrix % addObjectForKeys(obj,i,j)
227	!>
228	!>##Retrieving an object
229	!>
230	!> CLASS(FTObject), POINTER :: obj
231	!> obj => SparseMatrix % objectForKeys(i,j)
232	!>
233	!>Be sure to retain the object if you want it to live
234	!> beyond the life of the table.
235	!>
236	!>##Testing the presence of keys
237	!>
238	!> LOGICAL :: exists
239	!> exists = SparseMatrix % containsKeys(i,j)
240	!
241	!////////////////////////////////////////////////////////////////////////
242	!
243	Module FTSparseMatrixClass
244	USE FTObjectClass
245	USE FTLinkedListClass
246	USE FTLinkedListIteratorClass
247	USE FTSparseMatrixData
248	IMPLICIT NONE
249	!
250	! ----------------------
251	! Class type definitions
252	! ----------------------
253	!
254	TYPE FTLinkedListPtr
255	CLASS(FTLinkedList), POINTER :: list
256	END TYPE FTLinkedListPtr
257	PRIVATE :: FTLinkedListPtr
258
259	TYPE, EXTENDS(FTObject) :: FTSparseMatrix
260	TYPE(FTLinkedListPtr) , DIMENSION(:), ALLOCATABLE :: table
261	TYPE(FTLinkedListIterator), PRIVATE :: iterator
262	!
263	! ========
264	CONTAINS
265	! ========
266	!
267	PROCEDURE :: initWithSize => initSparseMatrixWithSize
268	FINAL :: destructSparseMatrix
269	PROCEDURE :: containsKeys => SparseMatrixContainsKeys
270	PROCEDURE :: addObjectForKeys => addObjectToSparseMatrixForKeys
271	PROCEDURE :: objectForKeys => objectInSparseMatrixForKeys
272	PROCEDURE :: SparseMatrixSize
273
274	END TYPE FTSparseMatrix
275	!
276	! ========
277	CONTAINS
278	! ========
279	!
280	!
281	!////////////////////////////////////////////////////////////////////////
282	!
283	SUBROUTINE initSparseMatrixWithSize(self,N)	2✔
284	IMPLICIT NONE
285	!
286	! ---------
287	! Arguments
288	! ---------
289	!
290	CLASS(FTSparseMatrix) :: self
291	INTEGER :: N
292	!
293	! ---------------
294	! Local variables
295	! ---------------
296	!
297	INTEGER :: j
298
299	CALL self % FTObject % init()	2✔
300
301	ALLOCATE(self % table(N))	2✔
302	DO j = 1, N	10✔
303	ALLOCATE(self % table(j) % list)	8✔
304	CALL self % table(j) % list % init()	10✔
305	END DO
306
307	CALL self % iterator % init()	2✔
308
309	END SUBROUTINE initSparseMatrixWithSize	2✔
310	!
311	!////////////////////////////////////////////////////////////////////////
312	!
313	SUBROUTINE addObjectToSparseMatrixForKeys(self,obj,i,j)	17✔
314	IMPLICIT NONE
315	!
316	! ---------
317	! Arguments
318	! ---------
319	!
320	CLASS(FTSparseMatrix) :: self
321	CLASS(FTObject), POINTER :: obj
322	!
323	! ---------------
324	! Local variables
325	! ---------------
326	!
327	CLASS(MatrixData), POINTER :: mData
328	CLASS(FTObject) , POINTER :: ptr
329	INTEGER :: i,j
330
331	IF ( .NOT.self % containsKeys(i,j) ) THEN	17✔
332	ALLOCATE(mData)	11✔
333	CALL mData % initWithObjectAndKey(obj,j)	11✔
334	ptr => mData	11✔
335	CALL self % table(i) % list % add(ptr)	11✔
336	CALL releaseFTObject(ptr)	11✔
337	END IF
338
339	END SUBROUTINE addObjectToSparseMatrixForKeys	17✔
340	!
341	!////////////////////////////////////////////////////////////////////////
342	!
343	FUNCTION objectInSparseMatrixForKeys(self,i,j) RESULT(r)	18✔
344	!
345	! ---------------------------------------------------------------
346	! Returns the stored FTObject for the keys (i,j). Returns NULL()
347	! if the object isn't in the table. Retain the object if it needs
348	! a strong reference by the caller.
349	! ---------------------------------------------------------------
350	!
351	IMPLICIT NONE
352	!
353	! ---------
354	! Arguments
355	! ---------
356	!
357	CLASS(FTSparseMatrix) :: self
358	INTEGER :: i,j
359	CLASS(FTObject), POINTER :: r
360	!
361	! ---------------
362	! Local variables
363	! ---------------
364	!
365	CLASS(MatrixData) , POINTER :: mData
366	CLASS(FTObject) , POINTER :: obj
367	CLASS(FTLinkedList), POINTER :: list
368
369	r => NULL()	18✔
370	IF(.NOT.ALLOCATED(self % table)) RETURN	18✔
371	list => self % table(i) % list	18✔
372	IF(.NOT.ASSOCIATED(list)) RETURN	18✔
373	IF ( list % COUNT() == 0 ) RETURN	18✔
374	!
375	! ----------------------------
376	! Step through the linked list
377	! ----------------------------
378	!
379	r => NULL()	17✔
380
381	CALL self % iterator % setLinkedListClass(self % table(i) % list)	17✔
382	DO WHILE (.NOT.self % iterator % isAtEnd())	31✔
383
384	obj => self % iterator % object()	31✔
385	CALL cast(obj,mData)	31✔
386	IF ( mData % key == j ) THEN	31✔
387	r => mData % object	17✔
388	EXIT	17✔
389	END IF
390
391	CALL self % iterator % moveToNext()	14✔
392	END DO
393
394	END FUNCTION objectInSparseMatrixForKeys	17✔
395	!
396	!////////////////////////////////////////////////////////////////////////
397	!
398	FUNCTION SparseMatrixContainsKeys(self,i,j) RESULT(r)	18✔
399	IMPLICIT NONE
400	!
401	! ---------
402	! Arguments
403	! ---------
404	!
405	CLASS(FTSparseMatrix) :: self
406	INTEGER :: i, j
407	LOGICAL :: r
408	!
409	! ---------------
410	! Local variables
411	! ---------------
412	!
413	CLASS(FTObject) , POINTER :: obj
414	CLASS(MatrixData) , POINTER :: mData
415	CLASS(FTLinkedList), POINTER :: list
416
417	r = .FALSE.	18✔
418	IF(.NOT.ALLOCATED(self % table)) RETURN	18✔
419	IF(.NOT.ASSOCIATED(self % table(i) % list)) RETURN	18✔
420	IF ( self % table(i) % list % COUNT() == 0 ) RETURN	18✔
421	!
422	! ----------------------------
423	! Step through the linked list
424	! ----------------------------
425	!
426	list => self % table(i) % list	13✔
427	CALL self % iterator % setLinkedListClass(list)	13✔
428	CALL self % iterator % setToStart()	13✔
429	DO WHILE (.NOT.self % iterator % isAtEnd())	27✔
430
431	obj => self % iterator % object()	21✔
432	CALL cast(obj,mData)	21✔
433	IF ( mData % key == j ) THEN	21✔
434	r = .TRUE.	7✔
435	RETURN	7✔
436	END IF
437
438	CALL self % iterator % moveToNext()	14✔
439	END DO
440
441	END FUNCTION SparseMatrixContainsKeys	6✔
442	!
443	!////////////////////////////////////////////////////////////////////////
444	!
445	SUBROUTINE releaseFTSparseMatrix(self)	2✔
446	IMPLICIT NONE
447	TYPE(FTSparseMatrix), POINTER :: self
448	CLASS(FTObject) , POINTER :: obj
449
450	IF(.NOT. ASSOCIATED(self)) RETURN	2✔
451
452	obj => self	2✔
453	CALL release(obj)	2✔
454	IF(.NOT.ASSOCIATED(obj)) self => NULL()	2✔
455	END SUBROUTINE releaseFTSparseMatrix
456	!
457	!////////////////////////////////////////////////////////////////////////
458	!
NEW 459	SUBROUTINE releaseFTSparseMatrixClass(self)	×
460	IMPLICIT NONE
461	CLASS(FTSparseMatrix), POINTER :: self
462	CLASS(FTObject) , POINTER :: obj
463
NEW 464	IF(.NOT. ASSOCIATED(self)) RETURN	×
465
NEW 466	obj => self	×
NEW 467	CALL release(obj)	×
NEW 468	IF(.NOT.ASSOCIATED(obj)) self => NULL()	×
469	END SUBROUTINE releaseFTSparseMatrixClass
470	!
471	!////////////////////////////////////////////////////////////////////////
472	!
473	SUBROUTINE destructSparseMatrix(self)	2✔
474	IMPLICIT NONE
475	!
476	! ---------
477	! Arguments
478	! ---------
479	!
480	TYPE(FTSparseMatrix) :: self
481	!
482	! ---------------
483	! Local variables
484	! ---------------
485	!
486	INTEGER :: j
487
488	IF(ALLOCATED(self % table)) THEN	2✔
489	DO j = 1, SIZE(self % table)	10✔
490	IF ( ASSOCIATED(self % table(j) % list) ) THEN	10✔
491	CALL releaseSMMemberList(list = self % table(j) % list)	8✔
492	END IF
493	END DO
494	END IF
495
496	IF(ALLOCATED(self % table)) DEALLOCATE(self % table)	2✔
497
498	END SUBROUTINE destructSparseMatrix	2✔
499	!
500	!////////////////////////////////////////////////////////////////////////
501	!
502	SUBROUTINE releaseSMMemberList(list)	8✔
503	IMPLICIT NONE
504	CLASS(FTLinkedList), POINTER :: list
505	CLASS(FTObject) , POINTER :: obj
506
507	obj => list	8✔
508	CALL releaseFTObject(self = obj)	8✔
509	IF(.NOT. ASSOCIATED(obj)) list => NULL()	8✔
510	END SUBROUTINE releaseSMMemberList	8✔
511	!
512	!////////////////////////////////////////////////////////////////////////
513	!
514	INTEGER FUNCTION SparseMatrixSize(self)	1✔
515	IMPLICIT NONE
516	CLASS(FTSparseMatrix) :: self
517	IF ( ALLOCATED(self % table) ) THEN	1✔
518	SparseMatrixSize = SIZE(self % table)	1✔
519	ELSE
520	SparseMatrixSize = 0	×
521	END IF
522	END FUNCTION SparseMatrixSize	1✔
523	!
524	!////////////////////////////////////////////////////////////////////////
525	!
526	FUNCTION SparseMatrixFromObject(obj) RESULT(cast)	1✔
527	!
528	! --------------------------------------------------------
529	! Cast the base class FTObject to the FTSparseMatrix class
530	! --------------------------------------------------------
531	!
532	IMPLICIT NONE
533	CLASS(FTObject) , POINTER :: obj
534	CLASS(FTSparseMatrix), POINTER :: cast
535
536	cast => NULL()	1✔
537	SELECT TYPE (e => obj)
538	TYPE is (FTSparseMatrix)
539	cast => e	1✔
540	CLASS DEFAULT
541
542	END SELECT
543
544	END FUNCTION SparseMatrixFromObject	1✔
545	!
546	!////////////////////////////////////////////////////////////////////////
547	!
548	INTEGER FUNCTION Hash1( idPair )	32✔
549	INTEGER, DIMENSION(2) :: idPair
550	Hash1 = MAXVAL(idPair)	96✔
551	END FUNCTION Hash1	32✔
552	!
553	!////////////////////////////////////////////////////////////////////////
554	!
555	INTEGER FUNCTION Hash2( idPair )	32✔
556	INTEGER, DIMENSION(2) :: idPair
557	Hash2 = MINVAL(idPair)	96✔
558	END FUNCTION Hash2	32✔
559
560	END Module FTSparseMatrixClass	5✔

trixi-framework / FTObjectLibrary / 30206241592

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