assign_surfaces_mass Subroutine

subroutine assign_surfaces_mass(surface_masses, surface_radii, radius, dr, n_surfaces, mass_profile_idx, mass_profile, mass_star)

Uses

  • proc~~assign_surfaces_mass~~UsesGraph proc~assign_surfaces_mass assign_surfaces_mass module~utility utility proc~assign_surfaces_mass->module~utility constants constants module~utility->constants matrix matrix module~utility->matrix

Assign a mass to each surface, based on the radial mass profile of the star (computed along the larger equatorial radius)

FT 23.07.2021

Arguments

Type IntentOptional Attributes Name
double precision, intent(inout), DIMENSION( n_surfaces ) :: surface_masses
double precision, intent(in), DIMENSION( n_surfaces ) :: surface_radii
double precision, intent(in) :: radius
double precision, intent(in) :: dr
integer, intent(in) :: n_surfaces
integer, intent(in), DIMENSION( : ) :: mass_profile_idx
double precision, intent(in), DIMENSION( :, : ) :: mass_profile
double precision, intent(in) :: mass_star

Called by

proc~~assign_surfaces_mass~~CalledByGraph proc~assign_surfaces_mass assign_surfaces_mass proc~place_particles_ellipsoidal_surfaces place_particles_ellipsoidal_surfaces proc~place_particles_ellipsoidal_surfaces->proc~assign_surfaces_mass interface~place_particles_ellipsoidal_surfaces place_particles_ellipsoidal_surfaces interface~place_particles_ellipsoidal_surfaces->proc~place_particles_ellipsoidal_surfaces

Contents

Variables

Source Code

assign_surfaces_mass

Variables

Type Visibility Attributes Name Initial
integer, private :: itr2
integer, private :: shell_index

Source Code

  SUBROUTINE assign_surfaces_mass( surface_masses, surface_radii, radius, dr, &
                                   n_surfaces, mass_profile_idx, mass_profile, &
                                   mass_star )

    !*************************************************
    !
    !# Assign a mass to each surface,
    !  based on the radial mass profile of the star
    !  (computed along the larger equatorial radius)
    !
    !  FT 23.07.2021
    !
    !*************************************************

    USE utility,  ONLY: zero

    IMPLICIT NONE

    INTEGER,          INTENT( IN ):: n_surfaces
    DOUBLE PRECISION, INTENT( IN ):: radius, dr, mass_star

    INTEGER, DIMENSION( : ),                 INTENT( IN ):: mass_profile_idx
    DOUBLE PRECISION, DIMENSION( n_surfaces ), INTENT( IN ):: surface_radii
    DOUBLE PRECISION, DIMENSION( :, : ),     INTENT( IN ):: mass_profile
    DOUBLE PRECISION, DIMENSION( n_surfaces ), INTENT( IN OUT ):: surface_masses

    INTEGER shell_index, itr2

    shell_index= 1
    itr2= 1
    surface_masses= zero
    assign_masses_to_surfaces: DO itr= 1, NINT(radius/dr), 1

      IF( shell_index == n_surfaces )THEN

        surface_masses( shell_index )= SUM( mass_profile( 2, &
         mass_profile_idx(itr2):mass_profile_idx(NINT(radius/dr)-1) ), DIM= 1 )

        EXIT

      ENDIF

      IF( mass_profile( 1, mass_profile_idx(itr) ) &
          >= surface_radii( shell_index ) &!+ radius/DBLE(2*n_surfaces)
      )THEN

       surface_masses( shell_index )= SUM( mass_profile( 2, &
                     mass_profile_idx(itr2):mass_profile_idx(itr) ), DIM= 1 )

       itr2= itr + 1
       shell_index= shell_index + 1

      ENDIF

    ENDDO assign_masses_to_surfaces

    ! Safety check
    IF( ABS( SUM( surface_masses, DIM= 1 ) - mass_star )/mass_star > 5.0D-3 )THEN
      PRINT *, " ** The masses of the shells do not add up to the ", &
               "mass of the star. Stopping..."
      PRINT *, " * SUM( surface_masses )= ", SUM( surface_masses, DIM=1 )
      PRINT *, " * Baryon mass of the star= ", mass_star
      PRINT *, " * Array surface_masses=", surface_masses
      PRINT *
      STOP
    ENDIF

  END SUBROUTINE assign_surfaces_mass