print_mass_profile_surface_radii Subroutine

subroutine print_mass_profile_surface_radii(mass_profile, mass_profile_idx, surface_radii, radius, dr, n_surfaces, filename_mass_profile, filename_shells_radii)

Print star's radial mass profile and radii of surfaces to different ASCII files

FT 23.07.2021


Arguments

Type IntentOptional Attributes Name
double precision, intent(in), DIMENSION( :, : ) :: mass_profile
integer, intent(in), DIMENSION( : ) :: mass_profile_idx
double precision, intent(in), DIMENSION( n_surfaces ) :: surface_radii
double precision, intent(in) :: radius
double precision, intent(in) :: dr
integer, intent(in) :: n_surfaces
character(len=*), intent(in) :: filename_mass_profile
character(len=*), intent(in) :: filename_shells_radii

Called by

proc~~print_mass_profile_surface_radii~~CalledByGraph proc~print_mass_profile_surface_radii print_mass_profile_surface_radii proc~place_particles_ellipsoidal_surfaces place_particles_ellipsoidal_surfaces proc~place_particles_ellipsoidal_surfaces->proc~print_mass_profile_surface_radii interface~place_particles_ellipsoidal_surfaces place_particles_ellipsoidal_surfaces interface~place_particles_ellipsoidal_surfaces->proc~place_particles_ellipsoidal_surfaces

Contents


Variables

Type Visibility Attributes Name Initial
logical, private :: exist

Source Code

  SUBROUTINE print_mass_profile_surface_radii( mass_profile, mass_profile_idx, &
                                               surface_radii, radius, dr, &
                                               n_surfaces, &
                                               filename_mass_profile, &
                                               filename_shells_radii )

    !*************************************************
    !
    !# Print star's radial mass profile and radii of
    !  surfaces to different ASCII files
    !
    !  FT 23.07.2021
    !
    !*************************************************

    !USE constants,  ONLY: third

    IMPLICIT NONE

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

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

    CHARACTER( LEN= * ), INTENT( IN ):: filename_mass_profile, &
                                        filename_shells_radii

    LOGICAL:: exist

    PRINT *, " * Print mass profile to file..."
    PRINT *

    INQUIRE( FILE= TRIM(filename_mass_profile), EXIST= exist )

    IF( exist )THEN
      OPEN( UNIT= 2, FILE= TRIM(filename_mass_profile), STATUS= "REPLACE", &
            FORM= "FORMATTED", &
            POSITION= "REWIND", ACTION= "WRITE", IOSTAT= ios, &
            IOMSG= err_msg )
    ELSE
      OPEN( UNIT= 2, FILE= TRIM(filename_mass_profile), STATUS= "NEW", &
            FORM= "FORMATTED", &
            ACTION= "WRITE", IOSTAT= ios, IOMSG= err_msg )
    ENDIF
    IF( ios > 0 )THEN
      PRINT *, "...error when opening " // TRIM(filename_mass_profile), &
               ". The error message is", err_msg
      STOP
    ENDIF

    write_data_loop: DO itr = 1, NINT(radius/dr) - 1, 1

      WRITE( UNIT = 2, IOSTAT = ios, IOMSG = err_msg, FMT = * ) &
        mass_profile( 1, mass_profile_idx(itr) ), &
        mass_profile( 2, mass_profile_idx(itr) ), &
        mass_profile( 3, mass_profile_idx(itr) )

      IF( ios > 0 )THEN
        PRINT *, "...error when writing the arrays in " &
                 // TRIM(filename_mass_profile), ". The error message is", &
                 err_msg
        STOP
      ENDIF

    ENDDO write_data_loop

    CLOSE( UNIT= 2 )

    PRINT *, " * Print surfaces' radii to file..."
    PRINT *

    INQUIRE( FILE= TRIM(filename_shells_radii), EXIST= exist )

    IF( exist )THEN
      OPEN( UNIT= 2, FILE= TRIM(filename_shells_radii), STATUS= "REPLACE", &
            FORM= "FORMATTED", &
            POSITION= "REWIND", ACTION= "WRITE", IOSTAT= ios, &
            IOMSG= err_msg )
    ELSE
      OPEN( UNIT= 2, FILE= TRIM(filename_shells_radii), STATUS= "NEW", &
            FORM= "FORMATTED", &
            ACTION= "WRITE", IOSTAT= ios, IOMSG= err_msg )
    ENDIF
    IF( ios > 0 )THEN
      PRINT *, "...error when opening " // TRIM(filename_shells_radii), &
              ". The error message is", err_msg
      STOP
    ENDIF

    DO itr = 1, n_surfaces, 1

      WRITE( UNIT = 2, IOSTAT = ios, IOMSG = err_msg, FMT = * ) &
        surface_radii( itr )

      IF( ios > 0 )THEN
        PRINT *, "...error when writing the arrays in " &
                 // TRIM(filename_shells_radii), ". The error message is", &
                 err_msg
        STOP
      ENDIF

    ENDDO

    CLOSE( UNIT= 2 )

  END SUBROUTINE print_mass_profile_surface_radii