marker_set_LoadSTL Subroutine

private impure subroutine marker_set_LoadSTL(this, STL_file)

Loads markers from a binary STL. This is a serial routine.

Type Bound

marker_set

Arguments

Type IntentOptional Attributes Name
class(marker_set), intent(inout) :: this

A collection of tessellation elements

character(len=*), intent(in) :: STL_file

Variable to compute


Calls

proc~~marker_set_loadstl~~CallsGraph proc~marker_set_loadstl marker_set%marker_set_LoadSTL markers markers proc~marker_set_loadstl->markers proc~lagrangian_set_recycle lagrangian_set%lagrangian_set_Recycle proc~marker_set_loadstl->proc~lagrangian_set_recycle proc~lagrangian_set_resize lagrangian_set%lagrangian_set_Resize proc~marker_set_loadstl->proc~lagrangian_set_resize proc~parallel_obj_rankisroot parallel_obj%parallel_obj_RankIsRoot proc~marker_set_loadstl->proc~parallel_obj_rankisroot proc~lagrangian_set_recycle->proc~lagrangian_set_resize

Source Code

    impure subroutine marker_set_LoadSTL(this,STL_file)
      !> Loads markers from a binary STL. This is a serial routine.
      implicit none
      class(marker_set), intent(inout) :: this                                 !! A collection of tessellation elements
      character(len=*),  intent(in)    :: STL_file                             !! Variable to compute
      ! Work variables
      integer          :: facets_count                                         !! Number of facets in the STL file
      real(leapSP)     :: v1(3),v2(3),v3(3),a(3),b(3)                          !! verticies of the facet
      character(len=80):: cbuf                                                 !! Character buffer
      character(len=2) :: padd                                                 !! Padding in STL file
      integer :: n
      integer :: fid,ierr
      logical :: ok


      ! Update the global count of markers
      call this%Recycle
      associate (mpi => this%parallel)
        if (mpi%RankIsRoot()) then
          ! Check file is there and open it
          inquire(file=trim(adjustl(STL_file)),exist=ok)
          if (.not.ok) call mpi%stop('Unable to find the STL file: '//trim(adjustl(STL_file)))

          open(newunit = fid, file   = trim(adjustl(STL_file)),&
                              status = 'old',                  &
                              action = 'read',                 &
                              access = 'stream',               &
                              form   = 'unformatted',          &
                              iostat = ierr)
          if (ierr.ne.0) call mpi%Stop('Unable to open the STL file: '//trim(adjustl(STL_file)))

          ! Read header record
          ! -------------------------- !
          read (fid) cbuf
          read (fid) facets_count

          ! Add new ib markers
          ! -------------------------- !
          call this%Resize(this%count_+facets_count)

          ! Re-read and store the facets
          ! -------------------------- !
          select type(markers=>this%p)
          type is (marker_obj)
            do n =this%count_-facets_count+1,this%count_
              ! Assign ID to markers
              ! -------------------------- !
               markers(n)%id = this%count + n - (this%count_-facets_count)
              ! Read normal
              ! -------------------------- !
              read (fid) a
              markers(n)%n=real(a,WP)
              ! Read vertecies
              ! -------------------------- !
              read (fid) v1
              read (fid) v2
              read (fid) v3

              ! Place a marker at the centroid
              markers(n)%p = reaL((v1+v2+v3)/3.0_wp,WP)

              ! Assign the surface area of the facet to the marker
              a = v2-v1
              b = v3-v1
              markers(n)%SA= real(0.5_WP * sqrt(          &
                            (a(2)*b(3)-a(3)*b(2))**2     &
                          + (a(3)*b(1)-a(1)*b(3))**2     &
                          + (a(1)*b(2)-a(2)*b(1))**2),WP)

              ! Read padding
              read (fid) padd
            end do
          end select

          close(fid)
        end if
      end associate

      call this%Recycle

      return
    end subroutine marker_set_LoadSTL