324 行
12 KiB
Fortran
324 行
12 KiB
Fortran
!Copyright (c) 2022 by LEEE under guide of Huaifeng Sun(sunhuaifeng@gmail.com)
|
|
!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='(3f)', 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='(9i)', 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='(i)', 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='(f)', iostat=error)values(i,j,k)
|
|
end do
|
|
end do
|
|
end do
|
|
|
|
|
|
END FUNCTION write_value_to_file
|
|
|
|
|
|
end Module VTK_Fortran
|