Print star's radial mass profile and radii of surfaces to different ASCII files
FT 23.07.2021
Type | Intent | Optional | 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 |
Type | Visibility | Attributes | Name | Initial | |||
---|---|---|---|---|---|---|---|
logical, | private | :: | exist |
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