Implements ImageData

src/legacy/VTK_datasets.f90

@@ -48,7 +48,11 @@ MODULE VTK_datasets
     CONTAINS
         PROCEDURE :: read  => struct_pts_read
         PROCEDURE :: write => struct_pts_write
-        PROCEDURE, PRIVATE :: setup => struct_pts_setup
+        PROCEDURE :: struct_pts_get_origin
+        PROCEDURE :: struct_pts_get_spacing
+        GENERIC, PUBLIC :: get_origin => struct_pts_get_origin
+        GENERIC, PUBLIC :: get_spacing => struct_pts_get_spacing
+        PROCEDURE :: setup => struct_pts_setup
         PROCEDURE :: check_for_diffs => struct_pts_check_for_diffs
     END TYPE struct_pts
 
@@ -209,6 +213,22 @@ MODULE SUBROUTINE struct_pts_write (me, unit)
 
         END SUBROUTINE struct_pts_write
 
+        PURE MODULE FUNCTION struct_pts_get_origin (me) RESULT (origin)
+        IMPLICIT NONE
+        !! Gets the private DT data for origin
+        CLASS (struct_pts), INTENT(IN) :: me
+        REAL(r8k), DIMENSION(3)        :: origin
+
+        END FUNCTION struct_pts_get_origin
+
+        PURE MODULE FUNCTION struct_pts_get_spacing (me) RESULT (spacing)
+        IMPLICIT NONE
+        !! Gets the private DT data for spacing
+        CLASS (struct_pts), INTENT(IN) :: me
+        REAL(r8k), DIMENSION(3)        :: spacing
+
+        END FUNCTION struct_pts_get_spacing
+
         MODULE SUBROUTINE struct_pts_setup (me, dims, origin, spacing)
         IMPLICIT NONE
         !! Sets up the structured points dataset with information

src/legacy/VTK_datasets_procedures.f90

@@ -149,6 +149,22 @@
 
         END PROCEDURE struct_pts_write
 
+        MODULE PROCEDURE struct_pts_get_origin
+        IMPLICIT NONE
+        !! Gets the private DT data for origin
+
+        origin = me%origin
+
+        END PROCEDURE struct_pts_get_origin
+
+        MODULE PROCEDURE struct_pts_get_spacing
+        IMPLICIT NONE
+        !! Gets the private DT data for spacing
+
+        spacing = me%spacing
+
+        END PROCEDURE struct_pts_get_spacing
+
         MODULE PROCEDURE struct_pts_setup
         IMPLICIT NONE
         !! Sets up the structured points dataset with information

src/legacy/VTK_io_procedures.f90

@@ -297,7 +297,8 @@
         MODULE PROCEDURE vtk_serial_full_write
         USE vtk_datasets,    ONLY : struct_pts, struct_grid, rectlnr_grid, polygonal_data, unstruct_grid
         USE VTK_serial_file, ONLY : serial_file
-        USE VTK_serial_Grid, ONLY : VTK_serial_RectilinearGrid_dt, VTK_serial_StructuredGrid_dt, VTK_serial_UnstructuredGrid_dt
+        USE VTK_serial_Grid, ONLY : VTK_serial_RectilinearGrid_dt, VTK_serial_StructuredGrid_dt, &
+          &                         VTK_serial_UnstructuredGrid_dt, VTK_serial_ImageData_dt
         USE XML,             ONLY : file_format, file_format_text, convert_format_to_string, ascii, format_ascii
         IMPLICIT NONE
         !! author: Ian Porter
@@ -342,7 +343,7 @@
 
         SELECT TYPE (geometry)
         CLASS IS (struct_pts)
-            ERROR STOP 'Procedure not yet implemented for: STRUCTURED POINTS. Termination in subroutine: vtk_serial_full_write'
+            ALLOCATE(VTK_serial_ImageData_dt::serial_file%vtk_dataset)
         CLASS IS (struct_grid)
             ALLOCATE(VTK_serial_StructuredGrid_dt::serial_file%vtk_dataset)
         CLASS IS (rectlnr_grid)

src/modern/VTK_piece_element_procedures.f90

@@ -294,7 +294,7 @@
 
         SELECT TYPE (geometry)
         CLASS IS (struct_pts)
-            ERROR STOP 'Error: struct_pts is not yet implemented in piece_set_grid'
+            CALL me%setup(name="Piece",string="Extent=" // '"' // range_string // '"')
         CLASS IS (struct_grid)
             !! For now, don't allow "pieces" but instead force the piece to be the whole extent
             CALL me%setup(name="Piece",string="Extent=" // '"' // range_string // '"')

src/modern/VTK_serial_Grid.f90

@@ -15,11 +15,13 @@ MODULE VTK_serial_Grid
     PUBLIC :: VTK_serial_RectilinearGrid_dt
     PUBLIC :: VTK_serial_StructuredGrid_dt
     PUBLIC :: VTK_serial_UnstructuredGrid_dt
+    PUBLIC :: VTK_serial_ImageData_dt
 
     TYPE, EXTENDS(VTK_element_dt), ABSTRACT :: VTK_dataset_dt
         !! VTK dataset derived type
         CHARACTER(LEN=:), ALLOCATABLE :: WholeExtent  !! String for the whole extent of the range
         CHARACTER(LEN=:), ALLOCATABLE :: grid_type    !! Name of the grid type
+        CHARACTER(LEN=:), ALLOCATABLE :: extra_string !! Additional data needed to be written
         TYPE(piece_dt),   ALLOCATABLE :: piece        !! Piece DT (Currently only supporting one piece)
     CONTAINS
         PROCEDURE(abs_set_grid), DEFERRED :: set_grid

src/modern/VTK_serial_Grid_procedures.f90

@@ -1,5 +1,5 @@
 SUBMODULE (VTK_serial_Grid) VTK_serial_Grid_procedures
-    USE Precision, ONLY : i4k
+    USE Precision, ONLY : i4k, r8k
     !! author: Ian Porter
     !! date: 05/06/2019
     !!
@@ -21,6 +21,7 @@
             ELSE
                 CALL grid%setup(name=me%grid_type)
             END IF
+            IF (ALLOCATED(me%extra_string)) CALL grid%add(me%extra_string, quotes=.FALSE.)
             CALL grid%add(me%piece)
             CALL me%add(grid)
             CALL grid%me_deallocate()
@@ -39,22 +40,23 @@
         END PROCEDURE vtk_dataset_deallocate
 
         MODULE PROCEDURE ImageData_set_grid
+        USE VTK_datasets, ONLY : struct_pts
+        USE Misc,         ONLY : convert_to_string
         IMPLICIT NONE
         !! author: Ian Porter
         !! date: 08/08/2019
         !!
         !! This writes the grid information for an image data grid
         !!
         CHARACTER(LEN=10) :: tmp_string = '          '
-        CHARACTER(LEN=:), ALLOCATABLE :: range_string
+        CHARACTER(LEN=:), ALLOCATABLE :: range_string, origin_string, spacing_string
         INTEGER(i4k) :: i, j
         INTEGER(i4k), DIMENSION(2,3)  :: range
         CHARACTER(LEN=*), PARAMETER :: file_extension = ".vti"
         CHARACTER(LEN=*), PARAMETER :: grid_type = "ImageData"
 
-ERROR STOP 'ImageData_set_grid is not yet implemented'
-
         CALL me%initialize(type=grid_type,file_extension=file_extension)
+
         range = geometry%get_range_cnt()
 
         DO i = 1, 3
@@ -71,6 +73,19 @@
         ALLOCATE(me%WholeExtent, source=range_string)
         ALLOCATE(me%grid_type, source=grid_type)
 
+        !! Still need to set the following line of information:
+        !! Origin=”x0 y0 z0” Spacing=”dx dy dz”>
+        SELECT TYPE(geometry)
+        CLASS IS (struct_pts)
+            ALLOCATE(origin_string, source=convert_to_string(geometry%get_origin()))
+            ALLOCATE(spacing_string, source=convert_to_string(geometry%get_spacing()))
+            ALLOCATE(me%extra_string, source='Origin="' // origin_string // '", Spacing="' // spacing_string // '"')
+        CLASS DEFAULT
+            ERROR STOP 'Bad geometry type for ImageData. Terminated in ImageData_set_grid'
+        END SELECT
+
+!        ERROR STOP 'ImageData_set_grid is not yet implemented. Need to set origin, spacing'
+
         !! For now, don't allow "pieces" but instead force the piece to be the whole extent
         IF (.NOT. ALLOCATED(me%piece)) ALLOCATE(me%piece)
         CALL me%piece%set(geometry)

src/utilities/Misc.f90

@@ -18,6 +18,7 @@ MODULE Misc
     INTERFACE convert_to_string
         PROCEDURE :: convert_real32_to_string
         PROCEDURE :: convert_real64_to_string
+        PROCEDURE :: convert_real64_array_to_string
         PROCEDURE :: convert_int32_to_string
         PROCEDURE :: convert_int64_to_string
         PROCEDURE :: convert_logical_to_string
@@ -86,6 +87,13 @@ MODULE FUNCTION convert_real64_to_string (var) RESULT (string)
         CHARACTER(LEN=:), ALLOCATABLE :: string   !! Character string
         END FUNCTION convert_real64_to_string
 
+        MODULE FUNCTION convert_real64_array_to_string (var) RESULT (string)
+        IMPLICIT NONE
+        !! Converts a real64 to a character string
+        REAL(r8k), DIMENSION(:), INTENT(IN) :: var      !! Real array
+        CHARACTER(LEN=:),       ALLOCATABLE :: string   !! Character string
+        END FUNCTION convert_real64_array_to_string
+
         MODULE FUNCTION convert_int32_to_string (var) RESULT (string)
         IMPLICIT NONE
         !! Converts an int32 to a character string

src/utilities/Misc_procedures.f90

@@ -130,6 +130,24 @@
 
         END PROCEDURE convert_real64_to_string
 
+        MODULE PROCEDURE convert_real64_array_to_string
+        IMPLICIT NONE
+        !! Converts a real to a character string
+        INTEGER(i4k) :: i
+        CHARACTER(LEN=:), ALLOCATABLE :: tmp_string
+
+        DO i = 1, SIZE(var)
+            ALLOCATE(tmp_string, source=convert_real64_to_string(var(i)))
+            IF (.NOT. ALLOCATED(string)) THEN
+                ALLOCATE(string,source=tmp_string)
+            ELSE
+                string = string // " " // tmp_string
+            END IF
+            DEALLOCATE(tmp_string)
+        END DO
+
+        END PROCEDURE convert_real64_array_to_string
+
         MODULE PROCEDURE convert_int32_to_string
         IMPLICIT NONE
         CHARACTER(LEN=20) :: tmp_string = '                    '

src/utilities/xml.f90

@@ -54,14 +54,14 @@ MODULE XML
     CONTAINS
         PROCEDURE, PUBLIC  :: setup => element_setup   !! Set up element block
         PROCEDURE, PRIVATE :: begin => element_begin   !! Write open of element block
-        PROCEDURE, PRIVATE :: element_add_data         !! Write raw data inside of element block
+        PROCEDURE, PRIVATE :: element_add_string       !! Write raw data inside of element block
         PROCEDURE, PRIVATE :: element_add_element      !! Write another element inside element block
         PROCEDURE, PRIVATE :: element_add_real32       !! Write real32 into a string inside of element block
         PROCEDURE, PRIVATE :: element_add_real64       !! Write real64 into a string inside of element block
         PROCEDURE, PRIVATE :: element_add_int32        !! Write ints32 into a string inside of element block
         PROCEDURE, PRIVATE :: element_add_int64        !! Write ints64 into a string inside of element block
         PROCEDURE, PRIVATE :: element_add_logical      !! Write logical into a string inside of element block
-        GENERIC, PUBLIC    :: add   => element_add_data
+        GENERIC, PUBLIC    :: add   => element_add_string
         GENERIC, PUBLIC    :: add   => element_add_element
         GENERIC, PUBLIC    :: add   => element_add_real64
         GENERIC, PUBLIC    :: add   => element_add_real32
@@ -147,12 +147,13 @@ RECURSIVE MODULE SUBROUTINE element_add_logical (me, var)
         LOGICAL, DIMENSION(:), INTENT(IN)    :: var   !! Data to write
         END SUBROUTINE element_add_logical
 
-        RECURSIVE MODULE SUBROUTINE element_add_data (me, string)
+        RECURSIVE MODULE SUBROUTINE element_add_string (me, string, quotes)
         IMPLICIT NONE
         !! This adds data inside of an xml element block
         CLASS(xml_element_dt), INTENT(INOUT) :: me      !! XML element derived type
         CHARACTER(LEN=*),      INTENT(IN)    :: string  !! String of data to write
-        END SUBROUTINE element_add_data
+        LOGICAL, OPTIONAL,     INTENT(IN)    :: quotes  !! Flag to turn quotation marks around string on/off
+        END SUBROUTINE element_add_string
 
         RECURSIVE MODULE SUBROUTINE element_add_element (me, element)
         IMPLICIT NONE

src/utilities/xml_procedures.f90

@@ -58,7 +58,7 @@
         CASE (ascii)
             WRITE(unit,'(a)',advance='no') prior_offset // '<' // me%name // me%additional_data // '>' // new_line('a')
         CASE (binary)
-            WRITE(unit) prior_offset // '<' // me%name // me%additional_data // '>' // new_line('a')
+            WRITE(unit) '<' // me%name // me%additional_data // '>' // new_line('a')
         END SELECT
 
         ALLOCATE(tmp_offset,source=prior_offset // me%offset)   !! Set the new offset length
@@ -113,11 +113,9 @@
         USE Misc, ONLY : convert_to_string
         IMPLICIT NONE
         !! This adds data inside of an xml element block
-        INTEGER(i4k) :: i
         TYPE(real64_dt) :: real64
         TYPE(string_dt), DIMENSION(:), ALLOCATABLE :: tmp_string_dt
         TYPE(real64_dt), DIMENSION(:), ALLOCATABLE :: tmp_real64_dt
-        CHARACTER(LEN=:), ALLOCATABLE :: string
 
         SELECT CASE (file_format)
         CASE (binary)
@@ -136,16 +134,8 @@
             tmp_string_dt(1:SIZE(me%string)) = me%string
             CALL MOVE_ALLOC(tmp_string_dt, me%string)
 
-            DO i = 1, SIZE(var)
-                IF (i == 1) THEN
-                    ALLOCATE(string, source=convert_to_string(var(i)))
-                ELSE
-                    string = string // " " // convert_to_string(var(i))
-                END IF
-            END DO
-
             ASSOCIATE (my_entry => UBOUND(me%string,DIM=1))
-                ALLOCATE(me%string(my_entry)%text,source= string // new_line('a'))
+                ALLOCATE(me%string(my_entry)%text,source=convert_to_string(var) // new_line('a'))
             END ASSOCIATE
         END SELECT
 
@@ -241,11 +231,18 @@
 
         END PROCEDURE element_add_logical
 
-        MODULE PROCEDURE element_add_data
+        MODULE PROCEDURE element_add_string
         IMPLICIT NONE
         !! This adds data inside of an xml element block
+        LOGICAL :: add_quotes
         TYPE(string_dt), DIMENSION(:), ALLOCATABLE :: tmp_string_dt
 
+        IF (PRESENT(quotes)) THEN
+            add_quotes = quotes
+        ELSE
+            add_quotes = .TRUE.  !! By default, add quotation marks around a string
+        END IF
+
         IF (.NOT. ALLOCATED(me%string)) THEN
             ALLOCATE(me%string(0))
         END IF
@@ -255,10 +252,14 @@
         CALL MOVE_ALLOC(tmp_string_dt, me%string)
 
         ASSOCIATE (my_entry => UBOUND(me%string,DIM=1))
-            ALLOCATE(me%string(my_entry)%text,source='"' // string // '"' // new_line('a'))
+            IF (add_quotes) THEN
+                ALLOCATE(me%string(my_entry)%text,source='"' // string // '"' // new_line('a'))
+            ELSE
+                ALLOCATE(me%string(my_entry)%text,source= string // new_line('a'))
+            END IF
         END ASSOCIATE
 
-        END PROCEDURE element_add_data
+        END PROCEDURE element_add_string
 
         MODULE PROCEDURE element_add_element
         IMPLICIT NONE
@@ -302,7 +303,7 @@
         CASE (ascii)
             WRITE(unit,'(a)',advance='no') prior_offset // '</' // me%name // '>' // new_line('a')
         CASE (binary)
-            WRITE(unit) prior_offset // '</' // me%name // '>' // new_line('a')
+            WRITE(unit) '</' // me%name // '>' // new_line('a')
         END SELECT
 
         END PROCEDURE element_end
@@ -324,20 +325,22 @@
                 CASE (ASCII)
                     WRITE(unit,'(a)',advance='no') prior_offset // me%string(i)%text
                 CASE (BINARY)
-                    WRITE(unit) prior_offset // me%string(i)%text
+                    WRITE(unit) me%string(i)%text
                 END SELECT
             END DO
         ELSE IF (ALLOCATED(me%real32)) THEN
             DO i = 1, SIZE(me%real32)
                 ASSOCIATE (n_vals => SIZE(me%real32(i)%val))
-                    WRITE(unit) prior_offset, (me%real32(i)%val(j),j=1,n_vals)
+                    WRITE(unit) (me%real32(i)%val(j),j=1,n_vals)
                 END ASSOCIATE
             END DO
             WRITE(unit) new_line('a')
         ELSE IF (ALLOCATED(me%real64)) THEN
             DO i = 1, SIZE(me%real64)
                 ASSOCIATE (n_vals => SIZE(me%real64(i)%val))
-                    WRITE(unit) prior_offset, (me%real64(i)%val(j),j=1,n_vals)
+                    DO j = 1, n_vals
+                        WRITE(unit) me%real64(i)%val(j)
+                    END DO
                 END ASSOCIATE
             END DO
             WRITE(unit) new_line('a')