submodule_bssn_formulation_io.f90 Source File


This file depends on

sourcefile~~submodule_bssn_formulation_io.f90~~EfferentGraph sourcefile~submodule_bssn_formulation_io.f90 submodule_bssn_formulation_io.f90 sourcefile~module_bssn_formulation.f90 module_bssn_formulation.f90 sourcefile~submodule_bssn_formulation_io.f90->sourcefile~module_bssn_formulation.f90 sourcefile~module_id_base.f90 module_id_base.f90 sourcefile~module_bssn_formulation.f90->sourcefile~module_id_base.f90 sourcefile~module_sph_particles.f90 module_sph_particles.f90 sourcefile~module_bssn_formulation.f90->sourcefile~module_sph_particles.f90 sourcefile~module_standard_tpo_formulation.f90 module_standard_tpo_formulation.f90 sourcefile~module_bssn_formulation.f90->sourcefile~module_standard_tpo_formulation.f90 sourcefile~module_utility.f90 module_utility.f90 sourcefile~module_bssn_formulation.f90->sourcefile~module_utility.f90 sourcefile~module_id_base.f90->sourcefile~module_utility.f90 sourcefile~module_sph_particles.f90->sourcefile~module_id_base.f90 sourcefile~module_sph_particles.f90->sourcefile~module_utility.f90 sourcefile~module_standard_tpo_formulation.f90->sourcefile~module_id_base.f90 sourcefile~module_standard_tpo_formulation.f90->sourcefile~module_sph_particles.f90 sourcefile~module_standard_tpo_formulation.f90->sourcefile~module_utility.f90

Contents


Source Code

! File:         submodule_bssn_formulation_io.f90
! Authors:      Francesco Torsello (FT)
!************************************************************************
! Copyright (C) 2020-2023 Francesco Torsello                            *
!                                                                       *
! This file is part of SPHINCS_ID                                       *
!                                                                       *
! SPHINCS_ID is free software: you can redistribute it and/or modify    *
! it under the terms of the GNU General Public License as published by  *
! the Free Software Foundation, either version 3 of the License, or     *
! (at your option) any later version.                                   *
!                                                                       *
! SPHINCS_ID is distributed in the hope that it will be useful,         *
! but WITHOUT ANY WARRANTY; without even the implied warranty of        *
! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the          *
! GNU General Public License for more details.                          *
!                                                                       *
! You should have received a copy of the GNU General Public License     *
! along with SPHINCS_ID. If not, see <https://www.gnu.org/licenses/>.   *
! The copy of the GNU General Public License should be in the file      *
! 'COPYING'.                                                            *
!************************************************************************

SUBMODULE (bssn_formulation) io

  !********************************************
  !
  !# This submodule contains the implementation
  !  of the methods of TYPE [[bssn]] that
  !  handle I/O (input/output)
  !
  !  FT 05.07.2022
  !
  !********************************************


  IMPLICIT NONE


  CONTAINS


  !-------------------!
  !--  SUBROUTINES  --!
  !-------------------!


  MODULE PROCEDURE read_bssn_dump_print_formatted

    !************************************************
    !
    !# Read the |bssn| |id| from the binary file output
    !  by write_BSSN_dump, and print it to a
    !  formatted file
    !
    !  FT 08.02.2021
    !
    !************************************************

    USE mesh_refinement,  ONLY: levels, nlevels
    USE tensor,           ONLY: jxx, jxy, jxz, jyy, jyz, jzz, jx, jy, jz
    USE ADM_refine,       ONLY: lapse, shift_u, &
                                allocate_ADM, deallocate_ADM
    USE BSSN_refine,  ONLY: allocate_BSSN, deallocate_BSSN, &
                            Gamma_u,        & ! Conformal connection
                            phi,            & ! Conformal factor
                            trK,            & ! Trace of extrinsic curvature
                            A_BSSN3_ll,     & ! Conformal traceless
                                              ! extrinsic curvature
                            g_BSSN3_ll,     & ! Conformal metric
                            !Theta_Z4,       & ! Vector in the CCZ4 formulation.
                                              ! Loaded here because ADM_TO_BSSN
                                              ! calls SUBROUTINES that need it
                                              ! as input; however, it is not
                                              ! evolved in BSSN
                            !lapse_A_BSSN,   & ! Time derivative of lapse
                            !shift_B_BSSN_u, & ! Time derivativeof shift
                            read_BSSN_dump

    IMPLICIT NONE

    INTEGER:: i, j, k, l, min_ix_y, min_iy_y, min_iz_y, &
              min_ix_z, min_iy_z, min_iz_z

    DOUBLE PRECISION:: min_abs_y, min_abs_z

    LOGICAL:: exist

    CHARACTER(LEN= :), ALLOCATABLE:: finalnamefile

    PRINT *, "** Executing the read_bssn_dump_print_formatted subroutine..."

    levels = this% levels
    nlevels= this% nlevels

    CALL allocate_ADM()
    CALL allocate_BSSN()

    CALL read_BSSN_dump( 00000, namefile_bin )

    IF( this% call_flag == 0 )THEN
      PRINT *, "** The SUBROUTINE print_formatted_id_bssn_variables ", &
        " must be called after compute_and_print_bssn_variables, otherwise", &
        " there are no bssn fields to export to the formatted file."
      PRINT *, "   Aborting."
      PRINT *
      STOP
    ENDIF

    IF( PRESENT(namefile) )THEN
      finalnamefile= namefile
    ELSE
      finalnamefile= "bssn_vars.dat"
    ENDIF

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

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

    WRITE( UNIT = 20, IOSTAT = ios, IOMSG = err_msg, FMT = * ) &
    "# Run ID [ccyymmdd-hhmmss.sss]: " // run_id
    WRITE( UNIT = 20, IOSTAT = ios, IOMSG = err_msg, FMT = * ) &
    "# Values of the fields (including coordinates) exported by LORENE "&
    // "on each grid point"
    IF( ios > 0 )THEN
      PRINT *, "...error when writing line 1 in ", TRIM(finalnamefile), &
               ". The error message is", err_msg
      STOP
    ENDIF
    !CALL test_status( ios, err_msg, "...error when writing line 1 in "&
    !         // TRIM(finalnamefile) )
    WRITE( UNIT = 20, IOSTAT = ios, IOMSG = err_msg, FMT = * ) &
    "# column:      1        2       3       4       5", &
    "       6       7       8", &
    "       9       10      11", &
    "       12      13      14", &
    "       15      16      17      18      19", &
    "       20      21      22", &
    "       23      24      25"
    IF( ios > 0 )THEN
      PRINT *, "...error when writing line 2 in ", TRIM(finalnamefile), &
               ". The error message is", err_msg
      STOP
    ENDIF
    !CALL test_status( ios, err_msg, "...error when writing line 2 in "&
    !        // TRIM(finalnamefile) )
    WRITE( UNIT = 20, IOSTAT = ios, IOMSG = err_msg, FMT = * ) &
    "#      refinement level    ", &
    "       x [Msun_geo]       y [Msun_geo]       z [Msun_geo]       lapse", &
    "       shift_x [c]    shift_y [c]    shift_z [c]", &
    "       conformal factor phi        trace of extr. curv. trK", &
    "       g_BSSN_xx       g_BSSN_xy      g_BSSN_xz", &
    "       g_BSSN_yy       g_BSSN_yz      g_BSSN_zz", &
    "       A_BSSN_xx       A_BSSN_xy      A_BSSN_xz", &
    "       A_BSSN_yy       A_BSSN_yz      A_BSSN_zz", &
    "       Gamma_u_x       Gamma_u_y      Gamma_u_z"
    IF( ios > 0 )THEN
      PRINT *, "...error when writing line 3 in ", TRIM(finalnamefile), &
               ". The error message is", err_msg
      STOP
    ENDIF
    !CALL test_status( ios, err_msg, "...error when writing line 3 in "&
    !        // TRIM(finalnamefile) )

    DO l= 1, this% nlevels, 1

      ASSOCIATE( lapse      => lapse% levels(l)% var, &
                 shift_u    => shift_u% levels(l)% var, &
                 g_BSSN3_ll => g_BSSN3_ll% levels(l)% var, &
                 A_BSSN3_ll => A_BSSN3_ll% levels(l)% var, &
                 phi        => phi% levels(l)% var, &
                 trK        => trK% levels(l)% var, &
                 Gamma_u    => Gamma_u% levels(l)% var &
      )

        min_abs_y= 1D+20
        min_abs_z= 1D+20
        DO k= 1, this% get_ngrid_z(l), 1
          DO j= 1, this% get_ngrid_y(l), 1
            DO i= 1, this% get_ngrid_x(l), 1

              IF( ABS( this% coords% levels(l)% var( i, j, k, jy ) ) &
                  < min_abs_y )THEN
                min_abs_y= ABS( this% coords% levels(l)% var( i, j, k, jy ) )
                min_ix_y= i
                min_iy_y= j
                min_iz_y= k
              ENDIF

              IF( ABS( this% coords% levels(l)% var( i, j, k, jz ) ) &
                  < min_abs_z )THEN
                min_abs_z= ABS( this% coords% levels(l)% var( i, j, k, jz ) )
                min_ix_z= i
                min_iy_z= j
                min_iz_z= k
              ENDIF

            ENDDO
          ENDDO
        ENDDO

        DO k= 1, this% get_ngrid_z(l), 1

          DO j= 1, this% get_ngrid_y(l), 1

            DO i= 1, this% get_ngrid_x(l), 1

              IF( this% export_form_xy .AND. &
                  ( this% coords% levels(l)% var( i, j, k, jz ) /= &
                    this% coords% levels(l)% var( min_ix_z, min_iy_z, &
                                                  min_iz_z, jz ) ) )THEN
                CYCLE
              ENDIF
              IF( this% export_form_x .AND. &
                  ( this% coords% levels(l)% var( i, j, k, jz ) /= &
                    this% coords% levels(l)% var( min_ix_z, min_iy_z, &
                                                  min_iz_z, jz ) &
                    .OR. &
                    this% coords% levels(l)% var( i, j, k, jy ) /= &
                    this% coords% levels(l)% var( min_ix_y, min_iy_y, &
                                                  min_iz_y, jy ) ) )THEN
                CYCLE
              ENDIF

              WRITE( UNIT = 20, IOSTAT = ios, IOMSG = err_msg, FMT = * )&
                  l, &                                              ! 1
                  this% coords% levels(l)% var( i, j, k, jx ), &    ! 2
                  this% coords% levels(l)% var( i, j, k, jy ), &    ! 3
                  this% coords% levels(l)% var( i, j, k, jz ), &    ! 4
                  lapse( i, j, k ), &                               ! 5
                  shift_u( i, j, k, jx ), &                         ! 6
                  shift_u( i, j, k, jy ), &                         ! 7
                  shift_u( i, j, k, jz ), &                         ! 8
                  phi( i, j, k ), &                                 ! 9
                  trK( i, j, k ), &                                 ! 10
                  g_BSSN3_ll( i, j, k, jxx ), &                     ! 11
                  g_BSSN3_ll( i, j, k, jxy ), &                     ! 12
                  g_BSSN3_ll( i, j, k, jxz ), &                     ! 13
                  g_BSSN3_ll( i, j, k, jyy ), &                     ! 14
                  g_BSSN3_ll( i, j, k, jyz ), &                     ! 15
                  g_BSSN3_ll( i, j, k, jzz ), &                     ! 16
                  A_BSSN3_ll( i, j, k, jxx ), &                     ! 17
                  A_BSSN3_ll( i, j, k, jxy ), &                     ! 18
                  A_BSSN3_ll( i, j, k, jxz ), &                     ! 19
                  A_BSSN3_ll( i, j, k, jyy ), &                     ! 20
                  A_BSSN3_ll( i, j, k, jyz ), &                     ! 21
                  A_BSSN3_ll( i, j, k, jzz ), &                     ! 22
                  Gamma_u( i, j, k, jx ), &                         ! 23
                  Gamma_u( i, j, k, jy ), &                         ! 24
                  Gamma_u( i, j, k, jz )                            ! 25

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

            ENDDO
          ENDDO
        ENDDO
      END ASSOCIATE
    ENDDO

    CLOSE( UNIT= 20 )

    !
    !-- Deallocate MODULE variables
    !
    CALL deallocate_ADM()
    CALL deallocate_BSSN()

    PRINT *, " * BSSN ID on the refined mesh, to be supplied to ", &
             "SPHINCS_BSSN, printed to formatted file ", TRIM(namefile)

    PRINT *, "** Subroutine read_bssn_dump_print_formatted " &
             // "executed."
    PRINT *

  END PROCEDURE read_bssn_dump_print_formatted


  MODULE PROCEDURE print_formatted_id_bssn_variables

    !************************************************
    !
    !# Print the |bssn| |id|, computed on the gravity
    !  grid, to a formatted file
    !
    !  FT 26.10.2020
    !
    !************************************************

    USE tensor,              ONLY: jxx, jxy, jxz, jyy, jyz, jzz, jx, jy, jz

    IMPLICIT NONE

    INTEGER:: i, j, k, l, min_ix_y, min_iy_y, min_iz_y, &
              min_ix_z, min_iy_z, min_iz_z

    DOUBLE PRECISION:: min_abs_y, min_abs_z

    LOGICAL:: exist

    CHARACTER(LEN= :), ALLOCATABLE:: finalnamefile

    ! Being abs_grid a local array, it is good practice to allocate it on the
    ! heap, otherwise it will be stored on the stack which has a very limited
    ! size. This results in a segmentation fault.
    !ALLOCATE( abs_grid( 3, this% ngrid_x, this% ngrid_y, this% ngrid_z ) )

    PRINT *, "** Executing the print_formatted_id_BSSN_variables " &
             // "subroutine..."

    IF( this% call_flag == 0 )THEN
      PRINT *, "** The SUBROUTINE print_formatted_id_bssn_variables ", &
        " must be called after compute_and_print_bssn_variables, otherwise", &
        " there are no bssn fields to export to the formatted file."
      PRINT *, "   Aborting."
      PRINT *
      STOP
    ENDIF

    IF( PRESENT(namefile) )THEN
      finalnamefile= namefile
    ELSE
      finalnamefile= "bssn-id.dat"
    ENDIF

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

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

    WRITE( UNIT = 20, IOSTAT = ios, IOMSG = err_msg, FMT = * ) &
    "# Run ID [ccyymmdd-hhmmss.sss]: " // run_id
    WRITE( UNIT = 20, IOSTAT = ios, IOMSG = err_msg, FMT = * ) &
    "# Values of the fields (including coordinates) exported by LORENE "&
    // "on each grid point"
    IF( ios > 0 )THEN
      PRINT *, "...error when writing line 1 in ", TRIM(finalnamefile), &
               ". The error message is", err_msg
      STOP
    ENDIF
    !CALL test_status( ios, err_msg, "...error when writing line 1 in "&
    !         // TRIM(finalnamefile) )
    WRITE( UNIT = 20, IOSTAT = ios, IOMSG = err_msg, FMT = * ) &
    "# column:      1        2       3       4       5", &
    "       6       7       8", &
    "       9       10      11", &
    "       12      13      14", &
    "       15      16      17      18      19", &
    "       20      21      22", &
    "       23      24      25"
    IF( ios > 0 )THEN
      PRINT *, "...error when writing line 2 in ", TRIM(finalnamefile), &
               ". The error message is", err_msg
      STOP
    ENDIF
    !CALL test_status( ios, err_msg, "...error when writing line 2 in "&
    !        // TRIM(finalnamefile) )
    WRITE( UNIT = 20, IOSTAT = ios, IOMSG = err_msg, FMT = * ) &
    "#      refinement level    ", &
    "       x [Msun_geo]       y [Msun_geo]       z [Msun_geo]       lapse", &
    "       shift_x [c]    shift_y [c]    shift_z [c]", &
    "       conformal factor phi        trace of extr. curv. trK", &
    "       g_BSSN_xx       g_BSSN_xy      g_BSSN_xz", &
    "       g_BSSN_yy       g_BSSN_yz      g_BSSN_zz", &
    "       A_BSSN_xx       A_BSSN_xy      A_BSSN_xz    ", &
    "       A_BSSN_yy       A_BSSN_yz      A_BSSN_zz", &
    "       Gamma_u_x       Gamma_u_y      Gamma_u_z"
    IF( ios > 0 )THEN
      PRINT *, "...error when writing line 3 in ", TRIM(finalnamefile), &
               ". The error message is", err_msg
      STOP
    ENDIF
    !CALL test_status( ios, err_msg, "...error when writing line 3 in "&
    !        // TRIM(finalnamefile) )

    DO l= 1, this% nlevels, 1

      ASSOCIATE( lapse           => this% lapse% levels(l)% var, &
                 shift_u         => this% shift_u% levels(l)% var, &
                 phi             => this% phi% levels(l)% var, &
                 trK             => this% trK% levels(l)% var, &
                 g_BSSN3_ll      => this% g_BSSN3_ll% levels(l)% var, &
                 A_BSSN3_ll      => this% A_BSSN3_ll% levels(l)% var, &
                 Gamma_u         => this% Gamma_u% levels(l)% var &
      )


        !DO iz= 1, this% ngrid_z, 1
        !  DO iy= 1, this% ngrid_y, 1
        !    DO ix= 1, this% ngrid_x, 1
        !      abs_grid( 1, ix, iy, iz )= ABS( this% grid( 1, ix, iy, iz ) )
        !      abs_grid( 2, ix, iy, iz )= ABS( this% grid( 2, ix, iy, iz ) )
        !      abs_grid( 3, ix, iy, iz )= ABS( this% grid( 3, ix, iy, iz ) )
        !    ENDDO
        !  ENDDO
        !ENDDO

        min_abs_y= HUGE(1.0D0)
        min_abs_z= HUGE(1.0D0)
        DO k= 1, this% get_ngrid_z(l), 1
          DO j= 1, this% get_ngrid_y(l), 1
            DO i= 1, this% get_ngrid_x(l), 1

              IF( ABS( this% coords% levels(l)% var( i, j, k, jy ) ) &
                  < min_abs_y )THEN
                min_abs_y= ABS( this% coords% levels(l)% var( i, j, k, jy ) )
                min_ix_y= i
                min_iy_y= j
                min_iz_y= k
              ENDIF

              IF( ABS( this% coords% levels(l)% var( i, j, k, jz ) ) &
                  < min_abs_z )THEN
                min_abs_z= ABS( this% coords% levels(l)% var( i, j, k, jz ) )
                min_ix_z= i
                min_iy_z= j
                min_iz_z= k
              ENDIF

            ENDDO
          ENDDO
        ENDDO

        DO k= 1, this% get_ngrid_z(l), 1

          DO j= 1, this% get_ngrid_y(l), 1

            DO i= 1, this% get_ngrid_x(l), 1

              IF( this% export_form_xy .AND. &
                  ( this% coords% levels(l)% var( i, j, k, jz ) /= &
                    this% coords% levels(l)% var( min_ix_z, min_iy_z, &
                                                  min_iz_z, jz ) ) )THEN
                CYCLE
              ENDIF
              IF( this% export_form_x .AND. &
                  ( this% coords% levels(l)% var( i, j, k, jz ) /= &
                    this% coords% levels(l)% var( min_ix_z, min_iy_z, &
                                                  min_iz_z, jz ) &
                    .OR. &
                    this% coords% levels(l)% var( i, j, k, jy ) /= &
                    this% coords% levels(l)% var( min_ix_y, min_iy_y, &
                                                  min_iz_y, jy ) ) )THEN
                CYCLE
              ENDIF

              WRITE( UNIT = 20, IOSTAT = ios, IOMSG = err_msg, FMT = * )&
                l, &                                              ! 1 !
                this% coords% levels(l)% var( i, j, k, jx ), &    ! 2 !
                this% coords% levels(l)% var( i, j, k, jy ), &    ! 3
                this% coords% levels(l)% var( i, j, k, jz ), &    ! 4
                lapse( i, j, k ), &                               ! 5
                shift_u( i, j, k, jx ), &                         ! 6
                shift_u( i, j, k, jy ), &                         ! 7
                shift_u( i, j, k, jz ), &                         ! 8
                phi( i, j, k ), &                                 ! 9
                trK( i, j, k ), &                                 ! 10
                g_BSSN3_ll( i, j, k, jxx ), &                     ! 11
                g_BSSN3_ll( i, j, k, jxy ), &                     ! 12
                g_BSSN3_ll( i, j, k, jxz ), &                     ! 13
                g_BSSN3_ll( i, j, k, jyy ), &                     ! 14
                g_BSSN3_ll( i, j, k, jyz ), &                     ! 15
                g_BSSN3_ll( i, j, k, jzz ), &                     ! 16
                A_BSSN3_ll( i, j, k, jxx ), &                     ! 17
                A_BSSN3_ll( i, j, k, jxy ), &                     ! 18
                A_BSSN3_ll( i, j, k, jxz ), &                     ! 19
                A_BSSN3_ll( i, j, k, jyy ), &                     ! 20
                A_BSSN3_ll( i, j, k, jyz ), &                     ! 21
                A_BSSN3_ll( i, j, k, jzz ), &                     ! 22
                Gamma_u( i, j, k, jx ), &                         ! 23
                Gamma_u( i, j, k, jy ), &                         ! 24
                Gamma_u( i, j, k, jz )                            ! 25

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

            ENDDO
          ENDDO
        ENDDO
      END ASSOCIATE
    ENDDO

    CLOSE( UNIT= 20 )

    PRINT *, " * BSSN ID on the gravity grid saved to formatted " &
             // "file ", TRIM(finalnamefile)

    PRINT *, "** Subroutine print_formatted_id_BSSN_variables " &
             // "executed."
    PRINT *

  END PROCEDURE print_formatted_id_bssn_variables


END SUBMODULE io