Advertisement
Guest User

Untitled

a guest
Oct 14th, 2019
125
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 1.74 KB | None | 0 0
  1. subroutine grid_output(this, filename, other)
  2.  
  3. class(mesh) :: this
  4. class(cell), optional, intent(in) :: other
  5. character(len=20), intent(in) :: filename
  6. integer :: tag, ip, L(3), nodes, s(3), icom(3), ip_new, gcom(3), lp(3), i
  7.  
  8. tag = 33423
  9. L = this%L
  10. nodes = this%nodes
  11. if(present(other)) then
  12. gcom = (/ int(anint( other%gcom(1) - other%L(1)/2)), int(anint( other%gcom(2) - other%L(2)/2)), int(anint(other%gcom(3) - other%L(3)/2)) /)
  13. call check_boundary(gcom(1),this%L(1),this%b)
  14. call check_boundary(gcom(2),this%L(2),this%b)
  15. call check_boundary(gcom(3),this%L(3),this%b)
  16. end if
  17.  
  18. OPEN(UNIT=tag, FILE=trim(filename)//".vti" )
  19. write(tag,'(A)')'<?xml version="1.0"?>'
  20. write(tag,'(A)')'<VTKFile type="ImageData" version="0.1" byte_order="LittleEndian">'
  21. write(tag,'(A,I1,A,I3,A,I1,A,I3,A,I1,A,I3,A)')' <ImageData WholeExtent="',0,' ',L(1),&
  22. ' ',0,' ',L(2),' ',0,' ',L(3),'" Origin="0 0 0" Spacing="1 1 1">'
  23. write(tag,'(A,I1,A,I3,A,I1,A,I3,A,I1,A,I3,A)')' <Piece Extent="',0,' ',L(1),' ',0,' ',L(2),' ',0,' ',L(3),'">'
  24. write(tag,*)' <CellData> '
  25. write(tag,*)' <DataArray Name="scalar_data" type="Float64" format="ascii">'
  26. do ip=0, nodes-1
  27. if(present(other)) then
  28. call vec_global2local(s, this%position(ip), gcom, this%L)
  29. ip_new = other%ip(s)
  30. write(tag,'(F10.2)', ADVANCE='no') other%gt(ip_new)
  31. else
  32. write(tag,'(F10.2)', ADVANCE='no') this%gt(ip)
  33. end if
  34. end do
  35. write(tag,'(A)') ""
  36. write(tag,'(A)')" </DataArray>"
  37. write(tag,'(A)')" </CellData>"
  38. write(tag,'(A)')" </Piece>"
  39. write(tag,'(A)')"</ImageData>"
  40. write(tag,'(A)')"</VTKFile>"
  41. CLOSE(tag)
  42. end subroutine grid_output
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement