Loads markers from a binary STL. This is a serial routine.
| Type | Intent | Optional | Attributes | Name | ||
|---|---|---|---|---|---|---|
| class(marker_set), | intent(inout) | :: | this |
A collection of tessellation elements |
||
| character(len=*), | intent(in) | :: | STL_file |
Variable to compute |
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