print_convergence_factor Subroutine

subroutine print_convergence_factor(nx, ny, nz, shared_grid, convergence_factor, unit, filename)

Print the Cauchy convergence factor to a formatted file


Arguments

Type IntentOptional Attributes Name
integer, intent(in) :: nx
integer, intent(in) :: ny
integer, intent(in) :: nz
double precision, intent(in), DIMENSION(nx,ny,nz,3) :: shared_grid
double precision, intent(in), DIMENSION(nx,ny,nz) :: convergence_factor
integer, intent(in) :: unit
character(len=:), ALLOCATABLE :: filename

Called by

proc~~print_convergence_factor~~CalledByGraph proc~print_convergence_factor print_convergence_factor proc~perform_cauchy_convergence_test_known_sol perform_cauchy_convergence_test_known_sol proc~perform_cauchy_convergence_test_known_sol->proc~print_convergence_factor proc~perform_cauchy_convergence_test_unknown_sol perform_cauchy_convergence_test_unknown_sol proc~perform_cauchy_convergence_test_unknown_sol->proc~print_convergence_factor

Contents


Variables

Type Visibility Attributes Name Initial
logical, private :: exist
integer, private :: i
integer, private :: j
integer, private :: k
double precision, private :: min_abs_y
double precision, private :: min_abs_z

Source Code

  SUBROUTINE print_convergence_factor &
    ( nx, ny, nz, shared_grid, convergence_factor, unit, filename )

    !***********************************************************
    !
    !# Print the Cauchy convergence factor to a formatted file
    !
    !***********************************************************

    IMPLICIT NONE

    INTEGER, INTENT(IN):: nx, ny, nz
    DOUBLE PRECISION, DIMENSION(nx,ny,nz,3), INTENT(IN):: shared_grid
    DOUBLE PRECISION, DIMENSION(nx,ny,nz),   INTENT(IN):: convergence_factor
    INTEGER, INTENT(IN):: unit
    LOGICAL:: exist
    CHARACTER( LEN=: ), ALLOCATABLE:: filename

    INTEGER:: i, j, k
    DOUBLE PRECISION:: min_abs_y, min_abs_z

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

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

    WRITE( UNIT = unit, IOSTAT = ios, IOMSG = err_msg, FMT = * ) &
    "# Run ID [ccyymmdd-hhmmss.sss]: " // run_id
    WRITE( UNIT= unit, IOSTAT = ios, &
           IOMSG = err_msg, FMT = * ) &
    "# Cauchy convergence test. "
    WRITE( UNIT = unit, IOSTAT = ios, IOMSG = err_msg, FMT = * ) &
    "# column:      1        2       3       4"
    WRITE( UNIT = unit, IOSTAT = ios, IOMSG = err_msg, FMT = * ) &
    "#      x [km]       y [km]       z [km]       " &
    //"convergence factor [pure number]"

    min_abs_y= HUGE(one)
    min_abs_z= HUGE(one)
    DO j= 1, ny, 1
      IF( ABS( shared_grid(1,j,1,jy) ) < ABS( min_abs_y ) )THEN
        min_abs_y= shared_grid(1,j,1,jy)
      ENDIF
    ENDDO
    DO k= 1, nz, 1
      IF( ABS( shared_grid(1,1,k,jz) ) < ABS( min_abs_z ) )THEN
        min_abs_z= shared_grid(1,1,k,jz)
      ENDIF
    ENDDO

    DO k= 1, nz, 1
      DO j= 1, ny, 1
        DO i= 1, nx, 1

          IF( .FALSE. .AND. export_constraints_xy &
              .AND. &
              ABS(shared_grid(i,j,k,jz) - min_abs_z)/ABS(min_abs_z) > tol &
          )THEN

            CYCLE

          ENDIF
          IF( .FALSE. .AND. export_constraints_x &
              .AND. &
              ( ABS(shared_grid(i,j,k,jz) - min_abs_z)/ABS(min_abs_z) > tol &
              .OR. &
              ABS(shared_grid(i,j,k,jy) - min_abs_y)/ABS(min_abs_y) > tol ) &
          )THEN

            CYCLE

          ENDIF

          WRITE( UNIT = unit, IOSTAT = ios, &
                 IOMSG = err_msg, FMT = * )&
              shared_grid( i, j, k, jx ), &
              shared_grid( i, j, k, jy ), &
              shared_grid( i, j, k, jz ), &
              convergence_factor( i, j, k )

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

        ENDDO
      ENDDO
    ENDDO

    CLOSE( UNIT= unit )

    PRINT *, " * Convergence factor printed to formatted file ", &
             TRIM(filename)
    PRINT *

  END SUBROUTINE print_convergence_factor