allocate_idbase Subroutine

  SUBROUTINE allocate_idbase( id, filename, system, system_name )

    !*********************************************
    !
    !# This SUBROUTINE allocates a polymorphic
    !  object of class idbase to its dynamic type.
    !  The dynamic type is one among those that
    !  use the |lorene| |id|
    !
    !  FT 09.02.2022
    !
    !*********************************************

    IMPLICIT NONE

    CLASS(idbase),    ALLOCATABLE, INTENT(INOUT):: id
    CHARACTER(LEN=*),              INTENT(IN)   :: filename
    CHARACTER(LEN=5),              INTENT(INOUT):: system
    CHARACTER(LEN=5),              INTENT(INOUT):: system_name

    IF( ALLOCATED(id) )THEN

      PRINT *, "** ERROR in allocate_idbase! ", &
               " The polymorphic allocatable argument 'id' ",&
               " is already allocated. This SUBROUTINE allocates and", &
               " initializes a polymorphic object of CLASS idbase, hence ", &
               " its argument of CLASS idbase should not be already allocated."
      PRINT *, "   Stopping..."
      PRINT *
      STOP

    ENDIF

    IF( filename(1:5) == bnslo )THEN

      ALLOCATE( bnslorene:: id )
      system= bnslo
      system_name= "NSNS."

    ELSEIF( filename(1:5) == drslo )THEN

      ALLOCATE( diffstarlorene:: id )
      system= drslo
      system_name= "DRSx."

    ELSEIF( filename(1:5) == ejecta_grid )THEN

      ALLOCATE( ejecta:: id )
      system= ejecta_grid
      system_name= "EJEC."

    ELSE

      PRINT *, "** ERROR! Unrecognized physical system ", system
      PRINT *
      PRINT *, "   Please specify the type of physical system in the first 5",&
               " characters of the name of the file containing the initial", &
               " data."
      PRINT *
      PRINT *, "   The 5-character names, and associated physical systems,", &
              " supported by this version of SPHINCS_ID, with flavour = 2, are:"
      PRINT *
      PRINT *, "   BNSLO: Binary Neutron Stars produced with LORENE"
      PRINT *, "   DRSLO: Differentially Rotating Star produced with LORENE"
      PRINT *, "   EJECT: Ejecta data on a uniform Cartesian grid"
      PRINT *
      STOP

    ENDIF

  END SUBROUTINE allocate_idbase