diff --git a/.github/workflows/SpellCheck.yml b/.github/workflows/SpellCheck.yml index 172991d9..7b4c69c1 100644 --- a/.github/workflows/SpellCheck.yml +++ b/.github/workflows/SpellCheck.yml @@ -10,4 +10,4 @@ jobs: - name: Checkout Actions Repository uses: actions/checkout@v5 - name: Check spelling - uses: crate-ci/typos@v1.35.7 + uses: crate-ci/typos@v1.37.0 diff --git a/.typos.toml b/.typos.toml index fb3c37be..7b58891c 100644 --- a/.typos.toml +++ b/.typos.toml @@ -2,4 +2,4 @@ doub = "doub" INOUT = "INOUT" sav = "sav" - +indx = "indx" diff --git a/Source/FTObjects/FTStringSetClass.f90 b/Source/FTObjects/FTStringSetClass.f90 index fede5304..18aeeceb 100644 --- a/Source/FTObjects/FTStringSetClass.f90 +++ b/Source/FTObjects/FTStringSetClass.f90 @@ -2,27 +2,27 @@ ! ! 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 +! 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 +! 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 +! 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, +! * `b3hs_hash_key_jenkins`: originally by Rich Townsend, ! https://groups.google.com/forum/#!topic/comp.lang.fortran/RWoHZFt39ng, 2005 ! ! --- End License @@ -81,7 +81,7 @@ MODULE FTStringSetClass USE FTObjectClass USE FTDictionaryClass IMPLICIT NONE - + TYPE, EXTENDS(FTObject) :: FTStringSet TYPE(FTDictionary), PRIVATE :: dict ! @@ -91,36 +91,36 @@ MODULE FTStringSetClass ! PROCEDURE, PUBLIC :: initFTStringSet PROCEDURE, PUBLIC :: initWithStrings - + FINAL :: destructFTStringSet - + PROCEDURE, PUBLIC :: addString PROCEDURE, PUBLIC :: containsString PROCEDURE, PUBLIC :: strings PROCEDURE, PUBLIC :: unionWithSet PROCEDURE, PUBLIC :: intersectionWithSet ! PROCEDURE, PUBLIC :: setIsCaseSensitive -! PROCEDURE, PUBLIC :: isCaseSensitive +! PROCEDURE, PUBLIC :: isCaseSensitive PROCEDURE, PUBLIC :: setFromDifference PROCEDURE, PUBLIC :: isEmpty PROCEDURE, PUBLIC :: count => stringCount - + PROCEDURE, PUBLIC :: printDescription => printFTStringSet PROCEDURE, PUBLIC :: className => FTStringSetClassName -! - END TYPE - +! + END TYPE + ! INTERFACE cast ! MODULE PROCEDURE castToFTStringSet ! END INTERFACE cast ! -! ======== - CONTAINS -! ======== +! ======== + CONTAINS +! ======== ! ! -!//////////////////////////////////////////////////////////////////////// -! +!//////////////////////////////////////////////////////////////////////// +! !> !> Designated initializer. Initializes the amount of storage, but !> the FTStringSet remains empty. @@ -131,20 +131,20 @@ MODULE FTStringSetClass !> logical :: cs = .true. !> CALL FTStringSet % initFTStringSet(N) !> - SUBROUTINE initFTStringSet( self, FTStringSetSize ) - IMPLICIT NONE + SUBROUTINE initFTStringSet( self, FTStringSetSize ) + IMPLICIT NONE CLASS( FTStringSet) :: self INTEGER :: FTStringSetSize - + CALL self % FTObject % init() - + CALL self % dict % initWithSize(sze = FTStringSetSize) ! self % dict % isCaseSensitive = caseSensitive - + END SUBROUTINE initFTStringSet ! -!//////////////////////////////////////////////////////////////////////// -! +!//////////////////////////////////////////////////////////////////////// +! !> !> initializer. Initializes the amount of storage from the strings passed !> *Usage @@ -152,7 +152,7 @@ END SUBROUTINE initFTStringSet !> CHARACTER(LEN=*) :: strings(:) !> CALL FTStringSet % initWithStrings(strings) !> - SUBROUTINE initWithStrings( self, strings ) + SUBROUTINE initWithStrings( self, strings ) IMPLICIT NONE ! ! --------- @@ -167,25 +167,25 @@ SUBROUTINE initWithStrings( self, strings ) ! --------------- ! INTEGER :: stringCount, i, dictSize - + stringCount = SIZE(strings) dictSize = 2**EXPONENT(REAL(stringCount)) ! Makes it a factor of two - + CALL self % initFTStringSet(FTStringSetSize = dictSize) - - DO i = 1, stringCount - CALL self % addString(str = STRINGs(i)) - END DO - + + DO i = 1, stringCount + CALL self % addString(str = strings(i)) + END DO + END SUBROUTINE initWithStrings ! -!//////////////////////////////////////////////////////////////////////// -! +!//////////////////////////////////////////////////////////////////////// +! !> !> Destructor for the class. This is called automatically when the !> reference count reaches zero. Do not call this yourself on pointers !> - SUBROUTINE destructFTStringSet(self) + SUBROUTINE destructFTStringSet(self) IMPLICIT NONE TYPE( FTStringSet) :: self @@ -195,78 +195,78 @@ END SUBROUTINE destructFTStringSet !> Public, generic name: release(self) !> !> Call release(self) on an object to release control -!> of an object. If its reference count is zero, then +!> of an object. If its reference count is zero, then !> it is deallocated. !------------------------------------------------ ! -!//////////////////////////////////////////////////////////////////////// -! - SUBROUTINE releaseFTStringSet(self) +!//////////////////////////////////////////////////////////////////////// +! + SUBROUTINE releaseFTStringSet(self) IMPLICIT NONE TYPE(FTStringSet) , POINTER :: self CLASS(FTObject) , POINTER :: obj - + obj => self CALL release(self = obj) IF ( .NOT. ASSOCIATED(obj) ) THEN NULLIFY(self) - END IF + END IF END SUBROUTINE releaseFTStringSet ! -!//////////////////////////////////////////////////////////////////////// -! - INTEGER FUNCTION stringCount(self) - IMPLICIT NONE +!//////////////////////////////////////////////////////////////////////// +! + INTEGER FUNCTION stringCount(self) + IMPLICIT NONE CLASS(FTStringSet) :: self stringCount = self % dict % COUNT() END FUNCTION stringCount ! -!//////////////////////////////////////////////////////////////////////// -! +!//////////////////////////////////////////////////////////////////////// +! ! ----------------------------------------------------------------- !> AddString adds a string to the set if it is not already present !> !>### Usage: !> CALL set % addString(str) !> - SUBROUTINE AddString(self,str) + SUBROUTINE AddString(self,str) IMPLICIT NONE CLASS(FTStringSet) :: self CHARACTER(LEN=*) :: str CLASS(FTObject) , POINTER :: obj - - IF(self % dict % containsKey(key = str)) RETURN - + + IF(self % dict % containsKey(key = str)) RETURN + ALLOCATE(obj) CALL obj % init() CALL self % dict % addObjectForKey(object = obj,key = str) CALL release(obj) - + END SUBROUTINE AddString ! -!//////////////////////////////////////////////////////////////////////// -! +!//////////////////////////////////////////////////////////////////////// +! ! ----------------------------------------------------------------- -!> containsString returns .TRUE. if the set contains the string, .FALSE. +!> containsString returns .TRUE. if the set contains the string, .FALSE. !> otherwise. !> !>### Usage: !> if(set % containsString(str)) !> LOGICAL FUNCTION containsString(self,str) - IMPLICIT NONE + IMPLICIT NONE CLASS(FTStringSet) :: self CHARACTER(LEN=*) :: str - + containsString = self % dict % containsKey(key = str) - + END FUNCTION containsString ! -!//////////////////////////////////////////////////////////////////////// -! +!//////////////////////////////////////////////////////////////////////// +! ! ----------------------------------------------------------------- !> strings returns a pointer to an array of strings that are in the set. -!> Deallocate this array when done with it. +!> Deallocate this array when done with it. !> !>### Usage: !> @@ -276,16 +276,16 @@ END FUNCTION containsString !> DEALLOCATE(s) !> FUNCTION strings(self) RESULT(s) - IMPLICIT NONE + IMPLICIT NONE CLASS(FTStringSet) :: self CHARACTER(LEN=FTDICT_KWD_STRING_LENGTH) ,DIMENSION(:), POINTER :: s - + s => self % dict % allKeys() - + END FUNCTION strings ! -!//////////////////////////////////////////////////////////////////////// -! +!//////////////////////////////////////////////////////////////////////// +! !> unionWithSet returns a pointer to a new set that is the union of two sets. !> the new set has reference count of 1. Release when done. !> @@ -296,27 +296,27 @@ END FUNCTION strings !> call releaseFTStringSet(newSet) ! FUNCTION unionWithSet(self,set) RESULT(newSet) - IMPLICIT NONE + IMPLICIT NONE CLASS(FTStringSet) :: self, set CHARACTER(LEN=FTDICT_KWD_STRING_LENGTH) ,DIMENSION(:), POINTER :: s1, s2 INTEGER :: i TYPE(FTStringSet), POINTER :: newSet - + ALLOCATE(newSet) s1 => self % strings() CALL newSet % initWithStrings(strings = s1) DEALLOCATE(s1) - + s2 => set % strings() - DO i = 1, SIZE(s2) - CALL newSet % addString(str = s2(i)) - END DO + DO i = 1, SIZE(s2) + CALL newSet % addString(str = s2(i)) + END DO DEALLOCATE(s2) - + END FUNCTION unionWithSet ! -!//////////////////////////////////////////////////////////////////////// -! +!//////////////////////////////////////////////////////////////////////// +! !> intersectionWithSet returns a pointer to a new set that is the intersection of two sets. !> the new set has reference count of 1. Release when done. !> @@ -327,30 +327,30 @@ END FUNCTION unionWithSet !> call releaseFTStringSet(newSet) ! FUNCTION intersectionWithSet(self, set) RESULT(newSet) - IMPLICIT NONE + IMPLICIT NONE CLASS(FTStringSet) :: self, set CHARACTER(LEN=FTDICT_KWD_STRING_LENGTH) ,DIMENSION(:), POINTER :: strArray INTEGER :: i TYPE(FTStringSet), POINTER :: newSet - - + + ALLOCATE(newSet) CALL newSet % initFTStringSet(FTStringSetSize = 16) - + strArray => self % strings() - IF(.NOT.ASSOCIATED(strArray)) RETURN - - DO i = 1, SIZE(strArray) + IF(.NOT.ASSOCIATED(strArray)) RETURN + + DO i = 1, SIZE(strArray) IF ( set % containsString(str = strArray(i)) ) THEN CALL newSet % addString(str = strArray(i)) - END IF - END DO + END IF + END DO DEALLOCATE(strArray) - + END FUNCTION intersectionWithSet ! -!//////////////////////////////////////////////////////////////////////// -! +!//////////////////////////////////////////////////////////////////////// +! !> setFromDifference returns a pointer to a new set that is the difference of two sets. !> $$A - B = \{x: x \in A \;\rm{ and }\; x\notin B\}$$ !> the new set has reference count of 1. Release when done. @@ -362,58 +362,58 @@ END FUNCTION intersectionWithSet !> call releaseFTStringSet(newSet) ! FUNCTION setFromDifference(self, set) RESULT(newSet) - IMPLICIT NONE + IMPLICIT NONE CLASS(FTStringSet) :: self, set CHARACTER(LEN=FTDICT_KWD_STRING_LENGTH) ,DIMENSION(:), POINTER :: strArray INTEGER :: i TYPE(FTStringSet), POINTER :: newSet - + ALLOCATE(newSet) CALL newSet % initFTStringSet(FTStringSetSize = MAX(self % count(),8)) - + IF(self % count() ==0 ) RETURN strArray => self % strings() - IF(.NOT.ASSOCIATED(strArray)) RETURN - - DO i = 1, SIZE(strArray) + IF(.NOT.ASSOCIATED(strArray)) RETURN + + DO i = 1, SIZE(strArray) IF ( .NOT.set % containsString(str = strArray(i)) ) THEN CALL newSet % addString(str = strArray(i)) - END IF - END DO + END IF + END DO DEALLOCATE(strArray) - + END FUNCTION setFromDifference ! -!//////////////////////////////////////////////////////////////////////// -! - LOGICAL FUNCTION isEmpty(self) - IMPLICIT NONE +!//////////////////////////////////////////////////////////////////////// +! + LOGICAL FUNCTION isEmpty(self) + IMPLICIT NONE CLASS(FTStringSet) :: self isEmpty = .TRUE. - IF(self % count() > 0) isEmpty = .FALSE. + IF(self % count() > 0) isEmpty = .FALSE. END FUNCTION isEmpty ! -!//////////////////////////////////////////////////////////////////////// -! -! SUBROUTINE setIsCaseSensitive(self,sensitive) -! IMPLICIT NONE +!//////////////////////////////////////////////////////////////////////// +! +! SUBROUTINE setIsCaseSensitive(self,sensitive) +! IMPLICIT NONE ! CLASS(FTStringSet) :: self ! LOGICAL :: sensitive ! self % dict % isCaseSensitive = sensitive ! END SUBROUTINE setIsCaseSensitive ! -!//////////////////////////////////////////////////////////////////////// -! -! LOGICAL FUNCTION isCaseSensitive(self) -! IMPLICIT NONE +!//////////////////////////////////////////////////////////////////////// +! +! LOGICAL FUNCTION isCaseSensitive(self) +! IMPLICIT NONE ! CLASS(FTStringSet) :: self ! isCaseSensitive = self % dict % isCaseSensitive ! END FUNCTION isCaseSensitive ! -!//////////////////////////////////////////////////////////////////////// -! - SUBROUTINE printFTStringSet(self,iUnit) +!//////////////////////////////////////////////////////////////////////// +! + SUBROUTINE printFTStringSet(self,iUnit) IMPLICIT NONE ! ! --------- @@ -429,46 +429,46 @@ SUBROUTINE printFTStringSet(self,iUnit) ! INTEGER :: i CHARACTER(LEN=FTDICT_KWD_STRING_LENGTH), POINTER :: keys(:) - + keys => self % dict % allKeys() - DO i = 1, SIZE(keys) - PRINT *, TRIM(keys(i)) - END DO + DO i = 1, SIZE(keys) + PRINT *, TRIM(keys(i)) + END DO DEALLOCATE(keys) - + END SUBROUTINE printFTStringSet ! !--------------------------------------------------------------------------- !> Generic Name: cast -!> -!> Cast a pointer to the base class to an FTStringSet pointer +!> +!> Cast a pointer to the base class to an FTStringSet pointer !--------------------------------------------------------------------------- ! -!//////////////////////////////////////////////////////////////////////// -! +!//////////////////////////////////////////////////////////////////////// +! FUNCTION FTStringSetFromObject(obj) RESULT(cast) ! ! ----------------------------------------------------- ! Cast the base class FTObject to the FTException class ! ----------------------------------------------------- ! - IMPLICIT NONE + IMPLICIT NONE CLASS(FTObject) , POINTER :: obj CLASS(FTStringSet), POINTER :: cast - + cast => NULL() SELECT TYPE (e => obj) TYPE is (FTStringSet) cast => e CLASS DEFAULT - + END SELECT - + END FUNCTION FTStringSetFromObject ! -!//////////////////////////////////////////////////////////////////////// -! +!//////////////////////////////////////////////////////////////////////// +! ! ----------------------------------------------------------------- !> Class name returns a string with the name of the type of the object !> @@ -478,13 +478,13 @@ END FUNCTION FTStringSetFromObject !> if( obj % className = "FTStringSet") !> FUNCTION FTStringSetClassName(self) RESULT(s) - IMPLICIT NONE + IMPLICIT NONE CLASS(FTStringSet) :: self CHARACTER(LEN=CLASS_NAME_CHARACTER_LENGTH) :: s - + s = "FTStringSet" - + END FUNCTION FTStringSetClassName - - END MODULE FTStringSetClass + + END MODULE FTStringSetClass