Advertisement
Guest User

Untitled

a guest
Feb 22nd, 2019
81
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 2.69 KB | None | 0 0
  1. program gaussian
  2.  
  3. implicit none
  4. integer i, j, k
  5. character(1) c
  6.  
  7. open(unit=100, file='energyDensity.vtk',
  8. 1 form="unformatted",access="stream")
  9. write(100) '# vtk DataFile Version 3.0', new_line(c)
  10. write(100) 'First time trying vtk import n', new_line(c)
  11. write(100) 'BINARY', new_line(c)
  12. write(100) 'DATASET STRUCTURED_POINTS', new_line(c)
  13. write(100) 'DIMENSIONS 101 101 101', new_line(c)
  14. write(100) 'ORIGIN 0 0 0', new_line(c)
  15. write(100) 'SPACING 1 1 1', new_line(c)
  16. write(100) 'POINT_DATA 1030301', new_line(c)
  17. write(100) 'SCALARS volume_scalars double 1', new_line(c)
  18. write(100) 'LOOKUP_TABLE default', new_line(c)
  19.  
  20.  
  21. do k = -50,50
  22. do j = -50,50
  23. do i = -50,50
  24.  
  25. write(100) 50.*exp(float((-(i*i+j*j+k*k))/25))
  26.  
  27. enddo
  28. enddo
  29. enddo
  30. close(100)
  31.  
  32. endprogram
  33.  
  34. vtkNew<vtkStructuredPointsReader> reader;
  35. reader->SetFileName (argv[1]);
  36. reader->Update();
  37.  
  38. program gaussian
  39.  
  40. use iso_fortran_env
  41.  
  42. implicit none
  43. integer i, j, k
  44. character(1) c
  45.  
  46. open(unit=100, file='energyDensity.vtk', &
  47. form="unformatted",access="stream")
  48. write(100) '# vtk DataFile Version 3.0', new_line(c)
  49. write(100) 'First time trying vtk import n', new_line(c)
  50. write(100) 'BINARY', new_line(c)
  51. write(100) 'DATASET STRUCTURED_POINTS', new_line(c)
  52. write(100) 'DIMENSIONS 101 101 101', new_line(c)
  53. write(100) 'ORIGIN 0 0 0', new_line(c)
  54. write(100) 'SPACING 1 1 1', new_line(c)
  55. write(100) 'POINT_DATA 1030301', new_line(c)
  56. write(100) 'SCALARS volume_scalars double 1', new_line(c)
  57. write(100) 'LOOKUP_TABLE default', new_line(c)
  58.  
  59.  
  60. do k = -50,50
  61. do j = -50,50
  62. do i = -50,50
  63.  
  64. write(100) SwapB64(exp(real((-(i*i+j*j+k*k)), real64) / 25))
  65.  
  66. enddo
  67. enddo
  68. enddo
  69. close(100)
  70. contains
  71.  
  72. elemental function SwapB64(x) result(res)
  73. real(real64) :: res
  74. real(real64),intent(in) :: x
  75. character(8) :: bytes
  76. integer(int64) :: t
  77. real(real64) :: rbytes, rt
  78. equivalence (rbytes, bytes)
  79. equivalence (t, rt)
  80.  
  81. rbytes = x
  82.  
  83. t = ichar(bytes(8:8),int64)
  84.  
  85. t = ior( ishftc(ichar(bytes(7:7),int64),8), t )
  86.  
  87. t = ior( ishftc(ichar(bytes(6:6),int64),16), t )
  88.  
  89. t = ior( ishftc(ichar(bytes(5:5),int64),24), t )
  90.  
  91. t = ior( ishftc(ichar(bytes(4:4),int64),32), t )
  92.  
  93. t = ior( ishftc(ichar(bytes(3:3),int64),40), t )
  94.  
  95. t = ior( ishftc(ichar(bytes(2:2),int64),48), t )
  96.  
  97. t = ior( ishftc(ichar(bytes(1:1),int64),56), t )
  98.  
  99. res = rt
  100.  
  101. end function
  102. endprogram
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement