VerifyUniqueBaseboardName Subroutine

public subroutine VerifyUniqueBaseboardName(TypeToVerify, NameToVerify, ErrorFound, StringToDisplay)

Arguments

Type	Intent		Name
character(len=*),	intent(in)	::	TypeToVerify
character(len=*),	intent(in)	::	NameToVerify
logical,	intent(out)	::	ErrorFound
character(len=*),	intent(in)	::	StringToDisplay

Calls

Help

Source Code

VerifyUniqueBaseboardName

Source Code

SUBROUTINE VerifyUniqueBaseboardName(TypeToVerify,NameToVerify,ErrorFound,StringToDisplay)

          ! SUBROUTINE INFORMATION:
          !       AUTHOR         Linda Lawrie
          !       DATE WRITTEN   July 2008
          !       MODIFIED       na
          !       RE-ENGINEERED  na

          ! PURPOSE OF THIS SUBROUTINE:
          ! This subroutine verifys that a new name will be unique in the list of
          ! Baseboards.  If not found in the list, it is added before returning.

          ! METHODOLOGY EMPLOYED:
          ! na

          ! REFERENCES:
          ! na

          ! USE STATEMENTS:
          ! na

  IMPLICIT NONE    ! Enforce explicit typing of all variables in this routine

          ! SUBROUTINE ARGUMENT DEFINITIONS:
  CHARACTER(len=*), INTENT(IN)               :: TypeToVerify
  CHARACTER(len=*), INTENT(IN)               :: NameToVerify
  LOGICAL, INTENT(OUT)                       :: ErrorFound
  CHARACTER(len=*), INTENT(IN)               :: StringToDisplay

          ! SUBROUTINE PARAMETER DEFINITIONS:
          ! na

          ! INTERFACE BLOCK SPECIFICATIONS
          ! na

          ! DERIVED TYPE DEFINITIONS
          ! na

          ! SUBROUTINE LOCAL VARIABLE DECLARATIONS:
  INTEGER Found
  TYPE (ComponentNameData), ALLOCATABLE, DIMENSION(:) :: TempBaseboardNames

  ErrorFound=.false.
  Found = 0

  IF (NumBaseboards > 0)   &
        Found=FindItemInList(NameToVerify,BaseboardNames%CompName,NumBaseboards)

  IF (Found /= 0) THEN
    CALL ShowSevereError(TRIM(StringToDisplay)//', duplicate name='//TRIM(NameToVerify)//  &
              ', Baseboard Type="'//TRIM(BaseboardNames(Found)%CompType)//'".')
    CALL ShowContinueError('...Current entry is Baseboard Type="'//trim(TypeToVerify)//'".')
    ErrorFound=.true.
  ELSEIF (NumBaseboards == 0) THEN
    CurMaxBaseboards=4
    ALLOCATE(BaseboardNames(CurMaxBaseboards))
    NumBaseboards=NumBaseboards+1
    BaseboardNames(NumBaseboards)%CompType=TypeToVerify
    BaseboardNames(NumBaseboards)%CompName=NameToVerify
  ELSEIF (NumBaseboards == CurMaxBaseboards) THEN
    ALLOCATE(TempBaseboardNames(CurMaxBaseboards+4))
    TempBaseboardNames(1:CurMaxBaseboards)=BaseboardNames(1:CurMaxBaseboards)
    DEALLOCATE(BaseboardNames)
    CurMaxBaseboards=CurMaxBaseboards+4
    ALLOCATE(BaseboardNames(CurMaxBaseboards))
    BaseboardNames=TempBaseboardNames
    DEALLOCATE(TempBaseboardNames)
    NumBaseboards=NumBaseboards+1
    BaseboardNames(NumBaseboards)%CompType=TypeToVerify
    BaseboardNames(NumBaseboards)%CompName=NameToVerify
  ELSE
    NumBaseboards=NumBaseboards+1
    BaseboardNames(NumBaseboards)%CompType=TypeToVerify
    BaseboardNames(NumBaseboards)%CompName=NameToVerify
  ENDIF

  RETURN

END SUBROUTINE VerifyUniqueBaseboardName

All Procedures