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 |fuka| |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) == bnsfu )THEN

      ALLOCATE( bnsfuka:: id )
      system= bnsfu
      system_name= "NSNS."

    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 = 3, are:"
      PRINT *
      PRINT *, "   BNSFU: Binary Neutron Stars produced with FUKA"
      PRINT *, "   EJECT: Ejecta data on a uniform Cartesian grid"
      PRINT *
      STOP

    ENDIF

  END SUBROUTINE allocate_idbase