fstr_precheck.f90

Go to the documentation of this file.

!-------------------------------------------------------------------------------
! Copyright (c) 2019 FrontISTR Commons
! This software is released under the MIT License, see LICENSE.txt
!-------------------------------------------------------------------------------
module m_fstr_precheck
 
  use hecmw
  use m_fstr
  use m_precheck_mesh_quality
  use m_precheck_make_result
  use m_hecmw2fstr_mesh_conv
 
  implicit none
 
contains
 
  subroutine fstr_input_precheck(hecMESH, hecMAT, fstrSOLID, fstrPARAM)
    implicit none
    type(hecmwst_local_mesh), intent(inout) :: hecMESH
    type(hecmwst_matrix), intent(in)        :: hecMAT
    type(fstr_solid), intent(in)            :: fstrSOLID
    type(fstr_param), intent(in)            :: fstrPARAM
 
    integer(kind=kint) :: i, cid
    real(kind=kreal), allocatable :: elem_vol(:), elem_asp(:)
    type(hecmwst_result_data) :: fstrresult
 
    ! Density check for eigen/dynamic analysis
    if(fstrparam%solution_type == ksteigen .or. &
       fstrparam%solution_type == kststaticeigen .or. &
       fstrparam%solution_type == kstdynamic) then
      do i = 1, hecmesh%section%n_sect
        if(hecmesh%section%sect_type(i) == 4) cycle
        cid = hecmesh%section%sect_mat_ID_item(i)
        if(fstrsolid%materials(cid)%variables(m_density) == 0.0d0) then
          write(*,*) "*** error: density is not assigned or set to zero"
          call hecmw_abort(hecmw_comm_get_comm())
        endif
      enddo
    endif
 
    if(fstrparam%solution_type == kstprecheck) then
      if(myrank == 0) write(*,*) ' ****   Start Precheck   ****'
 
      ! Allocate element quality arrays
      allocate(elem_vol(hecmesh%n_elem))
      allocate(elem_asp(hecmesh%n_elem))
 
      ! Mesh quality check
      call precheck_mesh_quality(hecmesh, hecmat, elem_vol, elem_asp)
 
      ! Write result file
      if(fstrparam%fg_result == 1) then
        call precheck_write_result(hecmesh, elem_vol, elem_asp)
      endif
 
      ! Build visualization result data and output
      call precheck_make_result(hecmesh, fstrresult, elem_vol, elem_asp)
      if(fstrparam%fg_visual == 1) then
        call fstr2hecmw_mesh_conv(hecmesh)
        call hecmw_visualize_init
        call hecmw_visualize_by_addfname(hecmesh, fstrresult, 0, '_precheck')
        call hecmw_visualize_finalize
        call hecmw2fstr_mesh_conv(hecmesh)
      endif
      call hecmw_result_free(fstrresult)
 
      deallocate(elem_vol)
      deallocate(elem_asp)
 
      if(myrank == 0) write(*,*) ' ****   End Precheck   ****'
    endif
 
    if(fstrparam%solution_type == kstnzprof) then
      call hecmw_nonzero_profile(hecmesh, hecmat)
    endif
  end subroutine fstr_input_precheck
 
  subroutine fstr_get_thickness(hecMESH, mid, thick)
    use hecmw
    use m_fstr
    implicit none
    type(hecmwst_local_mesh) :: hecMESH
    integer(kind=kint) :: mid, ihead
    real(kind=kreal)   :: thick
 
    ihead = hecmesh%section%sect_R_index(mid-1)
    thick = hecmesh%section%sect_R_item(ihead+1)
  end subroutine fstr_get_thickness
 
  subroutine hecmw_nonzero_profile(hecMESH, hecMAT)
    use hecmw_util
    implicit none
    type(hecmwst_local_mesh) :: hecmesh
    type(hecmwst_matrix)     :: hecMAT
 
    integer(kind=kint) :: i, j, in, jS, jE, ftype, n, ndof, nnz, fio
    real(kind=kreal) :: rnum, dens, cond
    character :: fileid*3
 
    fio = 70 + hecmesh%my_rank
    write(fileid,"(i3.3)")hecmesh%my_rank
 
    ftype = 4
 
    n = hecmat%N
    ndof = 3*n
    nnz = 9*n + 9*2*hecmat%indexL(n)
    dens = 100*dble(nnz)/dble(9*n*n)
    rnum = (7.21d0+0.01*dlog10(dble(hecmat%N)))*10.0d0/dble(hecmat%N)
    cond = 1.0d0
 
    open(fio,file='nonzero.dat.'//fileid, status='replace')
    do i= 1, n
      js= hecmat%indexL(i-1) + 1
      je= hecmat%indexL(i  )
      write(fio,"(i0,a,i0)")i,"  ",i
      do j= js, je
        in = hecmat%itemL(j)
        write(fio,"(i0,a,i0)")i, "  ",in
        write(fio,"(i0,a,i0)")in,"  ",i
      enddo
    enddo
    close(fio)
 
    open(fio,file='nonzero.plt.'//fileid, status='replace')
    if(ftype == 4)then
      write(fio,"(a)")'set terminal png size 1500,1500'
    else
      write(fio,"(a)")'set terminal postscript eps enhanced color solid "TimesNewRomanPSMT" 20'
    endif
 
    write(fio,"(a)")'unset key'
    write(fio,"(a)")'unset xtics'
    write(fio,"(a)")'unset ytics'
    write(fio,"(a)")'set size ratio 1.0'
    write(fio,"(a)")'set border lw 1.0'
    write(fio,"(a,i0,a)")'set xrange[0.5:',n,'.5]'
    write(fio,"(a,i0,a)")'set yrange[0.5:',n,'.5] reverse '
 
    if(ftype == 4)then
      write(fio,"(a)")'set out "image.'//fileid//'.png"'
    else
      write(fio,"(a)")'set out "image.'//fileid//'.eps"'
      write(fio,"(a)"     )'set label 1 "Name" at graph 1.1,0.9'
      write(fio,"(a)")'set label 2 "N" at graph 1.1,0.85'
      write(fio,"(a)")'set label 3 "Non-Zero Elem." at graph 1.1,0.8'
      write(fio,"(a)")'set label 4 "Density [%]" at graph 1.1,0.75'
      write(fio,"(a)")'set label 9 "Condition Num." at graph 1.1,0.7'
      write(fio,"(a)"     )'set label 5 ":  matrix" at graph 1.4,0.9'
      write(fio,"(a,i0,a)")'set label 6 ":  ',ndof,'" at graph 1.4,0.85'
      write(fio,"(a,i0,a)")'set label 7 ":  ',nnz,'" at graph 1.4,0.8'
      write(fio,"(a,1pe9.2,a)")'set label 8 ": ',dens,'" at graph 1.4,0.75'
      write(fio,"(a,1pe9.2,a)")'set label 10 ": ',cond,'" at graph 1.4,0.7'
    endif
 
    write(fio,"(a,f12.5,a)")'plot "nonzero.dat.'//fileid//'" pointtype 5 pointsize ',rnum,' linecolor rgb "#F96566"'
    close(fio)
 
    write(*,*)''
    write(*,*)' ### Command recommendation'
    write(*,*)' gnuplot -persist "nonzero.plt"'
  end subroutine hecmw_nonzero_profile
 
end module m_fstr_precheck