!Copyright (c) 2022 by LEEE under guide of Huaifeng Sun(sunhuaifeng@email.sdu.edu.cn) !written by Qi Zhao(zhaoqi_326326@163.com) ! --------------------------------Subroutine part---------------------------------------------! Module VTK_Fortran USE Precision, ONLY : i4k, r8k USE vtk_fix_header IMPLICIT NONE !! Author: Qi Zhao !! Date: 03/11/2024 !! !! This module contains the dataset formats for vtk format, referencing https://blog.sina.com.cn/s/blog_6d5f47470102yi7g.html !! !! There are availble dataset formats as follow: !! 1) Structured grids !! private public :: Struct_grid TYPE :: struct_grid !! Structured grids PRIVATE INTEGER(i4k), PUBLIC :: error CHARACTER(25) :: dataset_structure = 'DATASET UNSTRUCTURED_GRID' INTEGER(i4k) :: num_of_point_each_element = 8 INTEGER(i4k) :: unit INTEGER(i4k), DIMENSION(3) :: dims REAL(r8k), DIMENSION(:), ALLOCATABLE :: Coord_x,Coord_y,Coord_z CONTAINS PROCEDURE, PUBLIC :: init PROCEDURE, PUBLIC :: write => struct_grid_write PROCEDURE, PUBLIC :: add => struct_grid_add PROCEDURE, PUBLIC :: close => struct_grid_close END TYPE struct_grid CONTAINS SUBROUTINE init (self, title, filename, dims, Coord_x, Coord_y, Coord_z) !! author: Qi Zhao !! date: 03/11/2024 !! !! This subtoutine is used to initialize the basic parameters !! IMPLICIT NONE CLASS (struct_grid), INTENT(OUT) :: self CHARACTER(*), INTENT(IN), OPTIONAL :: title CHARACTER(*), INTENT(IN), OPTIONAL :: filename INTEGER(i4k), DIMENSION(3), INTENT(IN) :: dims REAL(r8k), DIMENSION(:), INTENT(IN) :: Coord_x, Coord_y, Coord_z self%dims = dims ALLOCATE(self%Coord_x(SIZE(Coord_x))) ALLOCATE(self%Coord_y(SIZE(Coord_y))) ALLOCATE(self%Coord_z(SIZE(Coord_z))) self%Coord_x = Coord_x self%Coord_y = Coord_y self%Coord_z = Coord_z IF (PRESENT(title)) THEN ALLOCATE( vtktitle, source=title) !! Calling program provided a title ELSE ALLOCATE(vtktitle, source=default_title) !! Calling program did not provide a title. Use default END IF IF (PRESENT(filename)) THEN ALLOCATE( vtkfilename, source=filename) !! Calling program provided a filename ELSE ALLOCATE(vtkfilename, source=default_filename) !! Calling program did not provide a filename. Use default END IF END SUBROUTINE init SUBROUTINE struct_grid_write (self) !! author: Qi Zhao !! date: 03/11/2024 !! !! This subtoutine is used to write the data to the .vtk file !! !! The following programs will be executed !! 1) Write the header key !! 2) Write the points key and data !! 3) Write the cells key and data !! IMPLICIT NONE CLASS (struct_grid) :: self INTEGER(i4k) ::unit INTEGER(i4k):: error unit = open_file( vtkfilename ) self%unit = unit error = write_header_to_file( unit,version ) error = write_header_to_file( unit,vtktitle ) error = write_header_to_file( unit,vtk_form ) error = write_header_to_file( unit,self%dataset_structure ) error = write_point_to_file( unit, self%Coord_x, self%Coord_y, self%Coord_z, self%dims ) error = write_cell_to_file ( unit, self%num_of_point_each_element, self%dims ) END SUBROUTINE struct_grid_write SUBROUTINE struct_grid_add(self, names,values) !! author: Qi Zhao !! date: 03/11/2024 !! !! This subroutine is used to write the data value with name to the .vtk file !! IMPLICIT NONE CLASS (struct_grid), INTENT(IN) :: self CHARACTER(*), INTENT(IN) :: names REAL(r8k), DIMENSION(:,:,:), INTENT(IN) :: values INTEGER(i4k):: error error = write_value_to_file ( self%unit, names, values, self%dims ) END SUBROUTINE struct_grid_add SUBROUTINE struct_grid_close(self) !! author: Qi Zhao !! date: 03/11/2024 !! !! -------------------------------------------------------------------------------------------------------- !! !! This subroutine is used to write the data value with name to the .vtk file !! IMPLICIT NONE CLASS (struct_grid), INTENT(IN) :: self close(self%unit) END SUBROUTINE struct_grid_close FUNCTION open_file( filename ) result(unit) !! author: Qi Zhao !! date: 03/11/2024 !! !! This function is used to open the .vtk file !! character(*), intent(in):: filename integer(i4k):: error integer(i4k):: unit open(newunit=unit, & file=trim(adjustl(filename)), & !form='UNFORMATTED', & !access='STREAM', & action='WRITE', & status='REPLACE', & iostat=error) END FUNCTION open_file FUNCTION write_header_to_file( unit, header ) result(error) !! author: Qi Zhao !! date: 03/11/2024 !! !! This function is used to write the key to the .vtk file !! character(*), intent(in):: header integer(i4k) :: error integer(i4k):: unit write(unit=unit,fmt='(a)', iostat=error) header END FUNCTION write_header_to_file FUNCTION write_point_to_file( unit, Coord_x, Coord_y, Coord_z, dims ) result(error) !! author: Qi Zhao !! date: 03/11/2024 !! !! This function is used to write the point key and data to the .vtk file !! INTEGER(i4k), DIMENSION(3), INTENT(IN) :: dims REAL(r8k), INTENT(IN) :: Coord_x( dims(1)+1 ), Coord_y( dims(2)+1 ), Coord_z( dims(3)+1 ) INTEGER(i4k) :: error INTEGER(i4k) :: unit INTEGER(i4k) :: points INTEGER(i4k) :: temp,I,J,K INTEGER(i4k)::NXB,NYB,NZB NXB=dims(1)+1 NYB=dims(2)+1 NZB=dims(3)+1 points =NXB * NYB * NZB temp = 0 write(unit=unit,fmt='(A,I0,A)', iostat=error) "POINTS ", points, " double" do k=1,NZB do j=1,NYB do i=1,NXB temp = temp + 1 write(unit, fmt='(3F25.16)', iostat=error) Coord_x(i), Coord_y(j), Coord_z(k) end do end do end do END FUNCTION write_point_to_file FUNCTION write_cell_to_file( unit, nums, dims ) result(error) !! author: Qi Zhao !! date: 03/11/2024 !! !! This function is used to write the cell key and data to the .vtk file !! CHARACTER(9) :: Value_site_cell="CELL_DATA" INTEGER(i4k), DIMENSION(3), INTENT(IN) :: dims INTEGER(i4k), INTENT(IN) :: nums INTEGER(i4k), PARAMETER :: num_cell_types = 11 INTEGER(i4k) :: error INTEGER(i4k) :: unit INTEGER(i4k) :: cells INTEGER(i4k) :: total_cells INTEGER(i4k) :: temp,I,J,K INTEGER(i4k)::NX,NY,NZ,NXB,NYB,NZB NX = dims(1) NY = dims(2) NZ = dims(3) NXB = NX+1 NYB = NY+1 NZB = NZ+1 cells = NX*NY*NZ total_cells = (nums+1)*cells temp = 0 write(unit=unit,fmt='(A,I0,A,I0)', iostat=error) "CELLS ", cells," ",total_cells do k=1, NZ do j=1, NY do i=1,NX temp = temp + 1 write(unit, fmt='(9I12)', iostat=error)nums,& ((i ) + (j-1)*NXB + (k-1)*NXB*NYB) -1, & ((i+1) + (j-1)*NXB + (k-1)*NXB*NYB) -1, & ((i ) + (j )*NXB + (k-1)*NXB*NYB) -1, & ((i+1) + (j )*NXB + (k-1)*NXB*NYB) -1, & ((i ) + (j-1)*NXB + (k )*NXB*NYB) -1, & ((i+1) + (j-1)*NXB + (k )*NXB*NYB) -1, & ((i ) + (j )*NXB + (k )*NXB*NYB) -1, & ((i+1) + (j )*NXB + (k )*NXB*NYB) -1 end do end do end do write(unit=unit,fmt='(A,I0,A,I0)', iostat=error) "CELL_TYPES ", cells do i=1, temp write(unit, fmt='(I12)', iostat=error)num_cell_types end do write(unit=unit,fmt='(2A,I0)', iostat=error) Value_site_cell," ", cells END FUNCTION write_cell_to_file FUNCTION write_value_to_file( unit, data_name,values, dims ) result(error) !! author: Qi Zhao !! date: 03/11/2024 !! !! This function is used to write the cell key and data to the .vtk file !! INTEGER(i4k), DIMENSION(3), INTENT(IN) :: dims REAL(r8k), INTENT(IN) :: values( dims(1), dims(2), dims(3)) CHARACTER(10) :: Value_site_point="POINT_DATA" CHARACTER(7) :: Value_type_scalars = "SCALARS" CHARACTER(6) :: Value_type_vector = "VECTOR" CHARACTER(6) :: Value_type_tensor = "TENSOR" CHARACTER(5) :: table_name = "Table" CHARACTER(6) :: data_type_double = "double" INTEGER(i4k) :: numComp CHARACTER(12) :: table_name_dict = "LOOKUP_TABLE" CHARACTER(*), INTENT(IN) :: data_name INTEGER(i4k) :: error INTEGER(i4k) :: unit INTEGER(i4k) :: temp,I,J,K INTEGER(i4k)::NX,NY,NZ,NXB,NYB,NZB NX = dims(1) NY = dims(2) NZ = dims(3) numComp = 1 write(unit=unit,fmt='(6A,I0)', iostat=error) Value_type_scalars, " ", data_name, " ", data_type_double, " ", numComp write(unit=unit,fmt='(3A)', iostat=error) table_name_dict," ",table_name do k=1, NZ do j=1, NY do i=1,NX temp = temp + 1 write(unit, fmt='(F25.16)', iostat=error)values(i,j,k) end do end do end do END FUNCTION write_value_to_file end Module VTK_Fortran