daily pastebin goal
22%
SHARE
TWEET

Untitled

a guest Feb 22nd, 2019 47 Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  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
RAW Paste Data
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy. OK, I Understand
 
Top