module FEMDomainClass
   use, intrinsic :: iso_fortran_env
   use MathClass
   use ArrayClass
   use ShapeFunctionClass
   use MeshClass
   use MaterialPropClass
   use BoundaryConditionClass
   use ControlParameterClass
   use std

   implicit none

   ! VTK-FORMAT
   integer(int32), parameter, public :: VTK_VERTEX = 1 !        Vertex
   integer(int32), parameter, public :: VTK_POLY_VERTEX = 2 !        Vertex
   integer(int32), parameter, public :: VTK_LINE = 3 !        Edge Lagrange P1
   integer(int32), parameter, public :: VTK_TRIANGLE = 5 !        Triangle Lagrange P1
   integer(int32), parameter, public :: VTK_PIXEL = 8 !        Quadrilateral Lagrange P1
   integer(int32), parameter, public :: VTK_QUAD = 9 !        Quadrilateral Lagrange P1
   integer(int32), parameter, public :: VTK_TETRA = 10 !        Tetrahedron Lagrange P1
   integer(int32), parameter, public :: VTK_VOXEL = 11 !        Hexahedron Lagrange P1
   integer(int32), parameter, public :: VTK_HEXAHEDRON = 12 !        Hexahedron Lagrange P1
   integer(int32), parameter, public :: VTK_WEDGE = 13 !        Wedge Lagrange P1
   integer(int32), parameter, public :: VTK_QUADRATIC_EDGE = 21 !        Edge Lagrange P2
   integer(int32), parameter, public :: VTK_QUADRATIC_TRIANGLE = 22 !        Triangle Lagrange P2
   integer(int32), parameter, public :: VTK_QUADRATIC_QUAD = 23 !        Quadrilateral Lagrange P2
   integer(int32), parameter, public :: VTK_QUADRATIC_TETRA = 24 !        Tetrahedron Lagrange P2
   integer(int32), parameter, public :: VTK_QUADRATIC_HEXAHEDRON = 25 !        Hexahedron Lagrange P2
   integer(int32), parameter, public :: VTK_QUADRATIC_LINEAR_WEDGE = 31

   integer(int32), parameter, public :: MSH_LINE = 1 !        Edge Lagrange P1
   integer(int32), parameter, public :: MSH_TRIANGLE = 2 !        Triangle Lagrange P1
   integer(int32), parameter, public :: MSH_QUAD = 3 !        Quadrilateral Lagrange P1
   integer(int32), parameter, public :: MSH_TETRA = 4 !        Tetrahedron Lagrange P1
   integer(int32), parameter, public :: MSH_HEXAHEDRON = 5 !        Hexahedron Lagrange P1
   integer(int32), parameter, public :: MSH_PRISM = 6 !        Edge Lagrange P2
   integer(int32), parameter, public :: MSH_PYRAMID = 7 !        Triangle Lagrange P2

   integer(int32), parameter, public :: FEMDomain_Overset_GPP = 1
   integer(int32), parameter, public :: FEMDomain_Overset_P2P = 2

   !integer(int32),parameter,public :: INFO_NUMBER_OF_POINTS  = 1 !        Information id#1 number of node
   !integer(int32),parameter,public :: INFO_NUMBER_OF_ELEMENTS  = 1 !        Information id#1 number of node
   !integer(int32),parameter,public :: INFO_NUMBER_OF_ELEMENTS  = 1 !        Information id#1 number of node

   type::Meshp_
      type(Mesh_), pointer :: Meshp => null()
   end type

   type::Materialp_
      type(MaterialProp_), pointer :: Materialp => null()
   end type

   type::Boundaryp_
      type(Boundary_), pointer :: Boundaryp => null()
   end type

   type :: OversetConnect_
      logical :: active = .false.
      real(real64), allocatable :: position(:)
      integer(int32) :: ElementID, GaussPointID, projection, MyElementID
      integer(int32), allocatable :: InterConnect(:)
      integer(int32), allocatable :: DomainIDs12(:)
   end type

   type::FEMDomain_
      type(Mesh_)             :: Mesh
      type(MaterialProp_)     :: MaterialProp
      type(Boundary_)         :: Boundary
      type(ControlParameter_) :: ControlPara
      type(ShapeFunction_)    :: ShapeFunction

      type(PhysicalField_), allocatable :: PhysicalField(:)
      integer(int32) :: numoflayer = 0
      character(len=36) :: uuid

      character(len=36) :: link(2)
      character(len=70) :: meshtype

      real(real64), allocatable :: scalar(:)
      real(real64), allocatable :: vector(:, :)
      real(real64), allocatable :: tensor(:, :, :)

      real(real64) :: RealTime = 1.0d0
      integer(int32) :: NumOfDomain = 1
      character(:), allocatable :: FilePath!="None"
      character(:), allocatable :: FileName!="None"
      character(:), allocatable :: Name!="None"
      character(:), allocatable :: SolverType!="None"
      character(:), allocatable :: Category1! ="None"
      character(:), allocatable :: Category2!="None"
      character(:), allocatable :: Category3!="None"
      character*9 :: Dtype = "None"
      integer(int32) :: DomainID = 1
      integer(int32) :: timestep = 1
      integer(int32) :: NumberOfBoundaries = 0
      integer(int32) ::  NumberOfMaterials = 0

      ! for MPI
      integer(int32), allocatable :: mpi_global_node_idx(:)
      integer(int32), allocatable :: mpi_shared_node_info(:, :)

      ! for overset, optional.
      type(OversetConnect_), allocatable :: OversetConnect(:)
      integer(int32), allocatable :: OversetExists(:, :)
      integer(int32) :: num_oversetconnect = 0

      ! それか，pairingだけを決める．

      ! juncs

      type(Meshp_), allocatable :: Meshes(:)
      type(Materialp_), allocatable :: Materials(:)
      type(Boundaryp_), allocatable :: Boundaries(:)

      real(real64), allocatable :: ObjectPosition(:)

      real(real64) :: total_rotation(1:3) = 0.0d0
      !type(FEMDomainp_),allocatable :: FEMDomains(:)

      ! pyhsical modifiers
      integer(int32), allocatable :: grub_NodeList(:)

      logical :: debug_mode = .false.

   contains
      procedure, public :: add => addFEMDomain
      procedure, public :: addNBC => AddNBCFEMDomain
      procedure, public :: add_point => add_pointFEMDomain
      procedure, public :: importLayer => importLayerFEMDomain

      procedure, pass :: addLayerFEMDomain
      procedure, pass :: addLayerFEMDomainScalar
      procedure, pass :: addLayerFEMDomainVector
      procedure, pass :: addLayerFEMDomainTensor
      generic, public :: addLayer => addLayerFEMDomainScalar, addLayerFEMDomain, &
         addLayerFEMDomainVector, &
         addLayerFEMDomainTensor

      procedure, public :: mpi_matmul => mpi_matmulFEMDomain
      procedure, public :: showLayer => showLayerFEMDomain
      procedure, public :: searchLayer => searchLayerFEMDomain

      procedure, public :: addDBoundCondition => AddDBoundCondition
      procedure, public :: addNBoundCondition => AddNBoundCondition
      procedure, public :: addTBoundCondition => AddTBoundCondition
      procedure, public :: addMaterialID => AddMaterialID
      procedure, public :: assign => ImportFEMDomain
      procedure, public :: allconnectivity => allconnectivityFEMDomain

      procedure, public :: bake => bakeFEMDomain
      procedure, public :: bakeMaterials => bakeMaterialsFEMDomain
      procedure, public :: bakeDBoundaries => bakeDBoundariesFEMDomain
      procedure, public :: bakeNBoundaries => bakeNBoundariesFEMDomain
      procedure, public :: bakeTBoundaries => bakeTBoundariesFEMDomain
      procedure, public :: Boolean => BooleanFEMDomain
      procedure, public :: bond => bondFEMDomain

      procedure, public :: checkConnectivity => CheckConnedctivityFEMDomain
      procedure, public :: connectivity => connectivityFEMDomain
      procedure, public :: copy => copyFEMDomain

      ! >>>>>>>> un-recommended >>>>>>>>>
      procedure, public :: convertMeshType => convertMeshTypeFEMDomain
      ! <<<<<<<< un-recommended <<<<<<<<<

      procedure, public :: changeElementType => changeElementTypeFEMDomain
      procedure, public :: clipVector => clipVectorFEMDomain

      procedure, public :: contactdetect => contactdetectFEMDomain
      procedure, public :: centerPosition => centerPositionFEMDomain

      procedure, pass :: centerPositionFEMDomain
      procedure, pass :: centerPositionByNodeListFEMD
      generic, public :: getCenter => centerPositionFEMDomain, centerPositionByNodeListFEMD

      procedure, public :: create => createFEMDomain

      !>>> direct object generation
      procedure, public :: cube => cubeFEMDomain
      !<<< direct object generation

      procedure, public :: delete => DeallocateFEMDomain
      procedure, public :: display => displayFEMDomain

      procedure, pass :: divide_mpi_FEMDomain
      procedure, pass :: divide_nFEMDomain

      generic ::  divide => divide_mpi_FEMDomain, divide_nFEMDomain
      !procedure,public :: distribute => distributeFEMDomain
      procedure, public :: Delaunay3D => Delaunay3DFEMDomain
      procedure, public :: Delaunay2D => Delaunay2DFEMDomain
      procedure, public :: deform => deformFEMDomain
      procedure, public :: Deduplicate => DeduplicateFEMDomain

      procedure, public :: export => ExportFEMDomain

      procedure, public :: edit => editFEMDomain
      procedure, public :: empty => emptyFEMDomain
      procedure, public :: extract => extractFacetElementFEMDomain

      procedure, public :: field => fieldFEMDomain
      procedure, public :: fixReversedElements => fixReversedElementsFEMDomain
      procedure, public :: fit => fitFEMDomain
      procedure, public :: fitSegmentToSegment => fitSegmentToSegmentFEMDomain
      procedure, public :: full => fullFEMDomain

      procedure, public :: gmshPlotMesh => GmshPlotMesh
      procedure, public :: gmsh => GmshPlotMesh
      procedure, public :: gmshPlotContour => GmshPlotContour
      procedure, public :: gmshPlotVector => GmshPlotVector
      procedure, public :: gmshPlotContour2D => GmshPlotContour2D
      procedure, public :: gnuplotPlotContour => GnuplotPlotContour
      procedure, public :: gnuplotExportStress => GnuplotExportStress
      procedure, public :: getDBCVector => getDBCVectorFEMDomain
      procedure, public :: getVolume => getVolumeFEMDomain

      procedure, public :: getJacobiMatrix => getJacobiMatrixFEMDomain
      procedure, pass :: getLayer_scalarFEMDomain
      generic :: getLayer => getLayer_scalarFEMDomain

      procedure, public :: getLayerID => getLayerIDFEMDomain
      procedure, public :: getLayerAttribute => getLayerAttributeFEMDomain
      procedure, public :: getLayerDataStyle => getLayerDataStyleFEMDomain
      procedure, public :: getShapeFunction => getShapeFunctionFEMDomain
      procedure, public :: getNearestNodeID => getNearestNodeIDFEMDomain
      procedure, public :: getE2Econnectivity => getE2EconnectivityFEMDomain
      procedure, public :: getElementCauchyStress => getElementCauchyStressFEMDomain
      procedure, public :: getMyID => getMyIDFEMDomain
      procedure, public :: getValue => getValueFEMDomain
      procedure, public :: getStrainTensor => getStrainTensorFEMDomain
      procedure, public :: getSpinTensor => getSpinTensorFEMDomain
      procedure, public :: getVelocityGradient => getVelocityGradientFEMDomain
      procedure, public :: getNumberOfOversetForElement => getNumberOfOversetForElementFEMDomain

      procedure, public :: getSurface => getSurfaceFEMDomain
      procedure, public :: getSurfaceElements => getSurfaceElementsFEMDomain
      procedure, public :: getVertices => getVerticesFEMDomain
      procedure, public ::        NodeID => NodeIDFEMDomain
      procedure, public ::        getElementID => getElementIDFEMDomain
      procedure, public ::        getNodeList => getNodeListFEMDomain
      procedure, public :: getDuplicatedNodeList => getDuplicatedNodeListFEMDomain

      procedure, public :: has => hasFEMDomain
      procedure, public :: have => hasFEMDomain

      !procedure, public :: getSubDomain => getSubDomainFEMDomain
      ! filters
      procedure, public :: MovingAverageFilter => MovingAverageFilterFEMDomain

      procedure, public :: getElement => getElementFEMDOmain

      procedure, public :: getNeighboringElementList => getNeighboringElementListFEMDomain
      procedure, public :: to_ElementID => to_ElementIDFEMDomain

      procedure, pass   :: getElementListFEMDomain
      procedure, pass   :: getElementList_by_radiusFEMDomain

      generic, public :: getElementList => getElementList_by_radiusFEMDomain, getElementListFEMDomain

      procedure, public :: getScalarField => getScalarFieldFEMDomain
      procedure, public :: getSingleFacetNodeID => getSingleFacetNodeIDFEMDomain
      procedure, public :: getFacetLocalNodeID => getFacetLocalNodeIDFEM

      procedure,pass  :: getFacetList_by_range
      procedure,pass  :: getFacetListFEMDomain

      generic, public :: getFacetList => getFacetList_by_range, getFacetListFEMDomain
      procedure,public :: getFacetList_as_Idx => getFacetList_as_Idx_by_range
      !procedure,public :: getNumberOfPoint => getNumberOfPointFEMDomain

      procedure, public :: getLocalCoordinate => getLocalCoordinateFEMDomain
      procedure, public :: GlobalPositionOfGaussPoint => getGlobalPositionOfGaussPointFEMDomain

      procedure, public :: getElevation => getElevationFEMDomain

      procedure, public :: init => InitializeFEMDomain
      procedure, public :: import => ImportFEMDomain
      procedure, public :: importVTKFile => ImportVTKFileFEMDomain
      procedure, public :: importSTLFile => ImportSTLFileFEMDomain

      procedure, public :: importMesh => ImportMeshFEMDomain
      procedure, public :: importMaterials => ImportMaterialsFEMDomain
      procedure, public :: importBoundaries => ImportBoundariesFEMDomain
      procedure, public :: initDBC => InitDBC
      procedure, public :: initNBC => InitNBC
      procedure, public :: initTBC => InitTBC
      procedure, public :: inside_of_element => inside_of_elementFEMDomain

      procedure, public :: json => jsonFEMDomain

      procedure, public :: killElement => killElementFEMDomain
      procedure, public :: killNodes => killNodesFEMDomain

      procedure, public :: length => lengthFEMDomain

      procedure, public :: meltingSkelton => MeltingSkeltonFEMDomain
      procedure, public :: move => moveFEMDomain
      procedure, public :: meshing => meshingFEMDomain
      procedure, public :: merge => MergeFEMDomain

      procedure, public :: msh => mshFEMDomain

      ! number of points
      procedure, public :: nn => nnFEMDomain
      procedure, public :: np => nnFEMDomain
      ! number of dimensions
      procedure, public :: nd => ndFEMDomain
      ! number of elements
      procedure, public :: ne => neFEMDomain
      ! number of points per element
      procedure, public ::        nne => nneFEMDomain
      ! number of Gauss-points
      procedure, public ::        ngp => ngpFEMDomain
      ! number of overset elements
      procedure, public :: NumOversetElements => NumOversetElementsFEMDomain

      ! getter
      procedure, public ::        x => xFEMDomain

      procedure, public ::        y => yFEMDomain
      procedure, public ::        z => zFEMDomain
      procedure, public ::        getPoint => getPointFEMDomain
      procedure, public ::        Point => getPointFEMDomain
      procedure, public ::        getPoint_x => getPoint_xFEMDomain
      procedure, public ::        getPoint_y => getPoint_yFEMDomain
      procedure, public ::        getPoint_z => getPoint_zFEMDomain

      procedure, public ::        setPoint_x => set_xFEMDomain
      procedure, public ::        setPoint_y => set_yFEMDomain
      procedure, public ::        setPoint_z => set_zFEMDomain

      procedure, public ::        xyz => xyzFEMDomain

      ! converter
      procedure, public :: asGlobalVector => asGlobalVectorFEMDomain
      procedure, public :: ElementID2NodeID => ElementID2NodeIDFEMDomain
      procedure, public :: open => openFEMDomain

      procedure, pass  :: oversetFEMDomain
      procedure, pass  :: oversetFEMDomains
      generic :: overset => oversetFEMDomain, oversetFEMDomains
      generic :: overlap => oversetFEMDomain, oversetFEMDomains
      generic :: chimera => oversetFEMDomain, oversetFEMDomains

      procedure, public :: PCAvector => PCAvectorFEMDomain
      procedure, public :: ply => plyFEMDomain
      procedure, public :: projection => projectionFEMDomain
      procedure, public :: position => positionFEMDomain
      procedure, public :: position_x => position_xFEMDomain
      procedure, public :: position_y => position_yFEMDomain
      procedure, public :: position_z => position_zFEMDomain
      procedure, public ::        points => xyzFEMDomain

      procedure, public :: span => spanFEMDomain

      ! editor
      procedure, public :: to_HollowTube => to_HollowTube_FEMDomain
      procedure, public :: to_Tube => to_HollowTube_FEMDomain
      procedure, public :: to_culm => to_culm_FEMDomain
      procedure, public :: to_multi_culm => to_multi_culm_FEMDomain
      procedure, public :: to_cylinder => to_cylinder_FEMDomain
      procedure, public :: to_vertexData => to_vertexData_FEMDomain

      procedure, public :: xmin => xminFEMDomain
      procedure, public :: x_min => xminFEMDomain
      procedure, public :: xmax => xmaxFEMDomain
      procedure, public :: x_max => xmaxFEMDomain
      procedure, public :: ymin => yminFEMDomain
      procedure, public :: y_min => yminFEMDomain
      procedure, public :: ymax => ymaxFEMDomain
      procedure, public :: y_max => ymaxFEMDomain
      procedure, public :: zmin => zminFEMDomain
      procedure, public :: z_min => zminFEMDomain
      procedure, public :: zmax => zmaxFEMDomain
      procedure, public :: z_max => zmaxFEMDomain

      procedure, public :: xrange => xrangeFEMDomain
      procedure, public :: x_range => xrangeFEMDomain
      procedure, public :: xr => xrangeFEMDomain

      procedure, public :: yrange => yrangeFEMDomain
      procedure, public :: y_range => yrangeFEMDomain
      procedure, public :: yr => yrangeFEMDomain

      procedure, public :: zrange => zrangeFEMDomain
      procedure, public :: z_range => zrangeFEMDomain
      procedure, public :: zr => zrangeFEMDomain

      procedure, public ::        x_len => x_lenFEMDomain
      procedure, public ::        y_len => y_lenFEMDomain
      procedure, public ::        z_len => z_lenFEMDomain

      procedure, public :: removeMaterials => removeMaterialsFEMDomain
      procedure, public :: rotate => rotateFEMDomain
      procedure, public :: removeBoundaries => removeBoundariesFEMDomain
      procedure, public :: rename => renameFEMDomain
      procedure, public :: resize => resizeFEMDomain
      procedure, public :: fat => fatFEMDomain
      procedure, pass   ::removeElementFEMDomain, removeElement_by_radius_FEMDomain

      generic, public :: removeElement => removeElementFEMDomain, removeElement_by_radius_FEMDomain
      generic, public :: removeElements => removeElementFEMDomain, removeElement_by_radius_FEMDomain

      procedure, public :: remove => removeFEMDomain
      procedure, public :: remove_duplication => remove_duplication_FEMDomain
      procedure, pass ::  refineFEMDomain
      procedure, pass ::  refine_elementsFEMDomain
      generic, public :: refine => refineFEMDomain, refine_elementsFEMDomain

      procedure, pass   :: readFEMDomain
      procedure, pass   :: read_vtk_domain_decomposed_FEMDOmain
      generic :: read => readFEMDomain

      procedure, pass   :: read_SCALAR_FEMDomain
      generic :: read_SCALAR => read_SCALAR_FEMDomain

      generic :: read_vtk => read_vtk_domain_decomposed_FEMDOmain

      procedure, public :: read_mpi_property => read_mpi_propertyFEMDomain
      procedure, public :: remesh => remeshFEMDomain
      procedure, public :: randomDance => randomDanceFEMDomain

      procedure, public :: save => saveFEMDomain

      procedure, public :: setDataType => SetDataType
      procedure, public :: setSolver => SetSolver
      procedure, public :: setName => SetName
      procedure, public :: setUp => SetUpFEMDomain
      procedure, public :: setBoundary => setBoundaryFEMDomain
      procedure, public :: setControlPara => SetControlParaFEMDomain

      procedure, pass :: selectFEMDomain ! select nodes
      !procedure,pass :: select_by_functionFEMDomain ! select nodes
      generic, public :: select => selectFEMDomain!,select_by_functionFEMDomain

      procedure, public :: show => showFEMDomain
      procedure, public :: showRange => showRangeFEMDomain
      procedure, public :: showMaterials => showMaterialsFEMDomain
      procedure, public :: showBoundaries => showBoundariesFEMDomain
      procedure, public :: stl => stlFEMDomain
      procedure, public :: obj => objFEMDomain

      procedure, pass :: vtk_MPI_FEMDOmain
      procedure, pass :: vtkFEMDOmain
      

      generic :: vtk => vtkFEMDomain, vtk_MPI_FEMDOmain
      procedure, public :: x3d => x3dFEMDomain
      
      procedure, public :: csv => csvFEMDomain

      procedure, public :: ifc => ifcFEMDomain
      ! >>> revising for adopting quad mesh >>> (2024.05.13)
      ! matrices
      procedure, public :: Bmatrix => BMatrixFEMDomain ! 
      procedure, public :: Lmatrix => LMatrixFEMDomain ! 2025/04/25
      procedure, public :: Wmatrix => WMatrixFEMDomain ! 2025/04/25

      procedure, pass :: DMatrix_generic_FEMDomain
      procedure, pass :: DMatrixFEMDomain
      generic, public :: Dmatrix => DMatrixFEMDomain, DMatrix_generic_FEMDomain

      procedure, public :: MassVector => MassVectorFEMDomain
      procedure, public :: PressureVector => PressureVectorFEMDomain
      procedure, public :: StrainMatrix => StrainMatrixFEMDomain
      procedure, public :: StrainVector => StrainVectorFEMDomain
      procedure, public :: StressMatrix => StressMatrixFEMDomain
      procedure, public :: StressVector => StressVectorFEMDomain
      procedure, public :: ViscousBoundaryForce => ViscousBoundaryForceFEMDomain
      ! Element-wize matrix
      procedure, pass :: DiffusionMatrixFEMDomain

      procedure, pass :: StiffnessMatrixFEMDomain
      procedure, pass :: StiffnessMatrix_generic_FEMDomain

      procedure, pass :: MassMatrixFEMDomain

      procedure, public :: ConnectMatrix => ConnectMatrixFEMDomain
      procedure, public :: ConnectVector => ConnectVectorFEMDomain
      procedure, public :: ElementVector => ElementVectorFEMDomain
      procedure, public :: GlobalVector => GlobalVectorFEMDomain

      procedure, pass   :: TractionVectorFEMDomain
      procedure, pass   :: TractionVector_by_elemFEMDomain
      generic, public :: TractionVector => TractionVectorFEMDomain, TractionVector_by_elemFEMDomain

      ! Force vector
      !<Torsional>
      procedure, public :: PointTorsionalForce => PointTorsionalForceFEMDomain
      procedure, public :: TorsionalForce => TorsionalForceFEMDomain
      !<Point Force>
      procedure, public :: PointForceVector => PointForceVectorFEMDomain

      procedure, public :: FlowVector => FlowVectorFEMDomain

      ! Domain-wize matrix (as CRS-format)

      procedure, pass :: DiffusionMatrix_as_CRS_FEMDomain
      procedure, pass :: StiffnessMatrix_as_CRS_FEMDomain
      procedure, pass :: MassMatrix_as_CRS_FEMDomain
      procedure, pass :: M_inv_K_Matrix_CRS_FEMDomain
      procedure, pass :: ZeroMatrix_as_CRS_FEMDomain
      procedure, pass :: ZeroMatrix_as_COO_FEMDomain

      generic ::DiffusionMatrix => DiffusionMatrixFEMDomain, DiffusionMatrix_as_CRS_FEMDomain
      generic ::StiffnessMatrix => StiffnessMatrixFEMDomain, &
         StiffnessMatrix_generic_FEMDomain, &
         StiffnessMatrix_as_CRS_FEMDomain

      generic ::MassMatrix => MassMatrixFEMDomain, MassMatrix_as_CRS_FEMDomain


      ! subroutine version
      procedure, public :: setMassMatrix => setMassMatrix_as_CRS_FEMDomain
      procedure, public :: setStiffnessMatrix =>setStiffnessMatrix_as_CRS_FEMDomain


      generic ::M_inv_K_Matrix => M_inv_K_Matrix_CRS_FEMDomain
      generic ::ZeroMatrix => ZeroMatrix_as_CRS_FEMDomain
      generic ::ZeroMatrix_as_COO => ZeroMatrix_as_COO_FEMDomain

      ! <<< revising for adopting quad mesh <<< (2024.05.13)

      procedure, public :: loadPoints => loadPointsFEMDomain
      procedure, public :: particles => particlesFEMDomain

      procedure, public :: sync => syncFEMDomain

      ! Vector editor
      procedure,public :: setVectorValue => setVectorValueFEMDomain

      !# physical modifiers
      ! Is it necessary?
      !procedure :: grub    => grubFEMDomain ! grub some part of object in range
      !procedure :: hold    => holdFEMDomain ! hold some part of object in range
      !procedure :: release => releaseFEMDomain !

   end type FEMDomain_

   !type:: FEMDomainp_
   !        type(FEMDomain_),pointer :: FEMDomain
   !end type

   type, extends(FEMDomain_) :: STFEMDomain_
      type(ShapeFunction_)    :: TimeShapeFunction
      type(Mesh_)             :: TimeMesh
   end type

   type :: FEMDomainp_
      type(FEMDomain_), pointer :: femdomainp => null()
   contains
      procedure, public :: getMyID => getMyIDFEMDomainp
      procedure, public :: overset => overset_FEMDomainp
      procedure, public :: connect => overset_FEMDomainp
      procedure, public :: overlap => overset_FEMDomainp
   end type



   public :: operator(+)

   interface operator(+)
      module procedure appendfemdomain
   end interface


   interface ZeroMatrix_as_CRS
      module procedure ZeroMatrix_as_CRS_FEMDomains
   end interface ZeroMatrix_as_CRS

   interface to_composite_beam
      module procedure to_composite_beam_FEMDomain
   end interface

   ! for FEMDomainPointers
   interface to_ptr
      module procedure to_ptr_femdomain, to_ptr_femdomains
   end interface

   interface num_node
      module procedure num_node_femdomain_pointers
   end interface

   interface num_element
      module procedure num_element_femdomain_pointers
   end interface

   interface get_element_idx
      module procedure get_element_idx_FEMDomainPointer
   end interface

   interface get_node_list
      module procedure get_node_list_by_range_FEMDP
   end interface

   interface export_vtk
      module procedure export_vtk_FEMDomainPointer
   end interface export_vtk

   interface diff 
      module procedure diff_for_real_array
   end interface diff

contains

! ####################################################################
   subroutine addFEMDomain(this, mesh, from, length, rot_x, rot_y, rot_z, x, y, z, dx, dy, dz)
      class(FEMDomain_), intent(inout) :: this
      class(Mesh_), optional, intent(inout)    :: mesh
      integer(int32), optional, intent(in) :: from
      real(real64), optional, intent(in) :: length, rot_x, rot_y, rot_z, x, y, z, dx, dy, dz
      call this%mesh%add(mesh, from, length, rot_x, rot_y, rot_z, x=x, y=y, z=z, dx=dx, dy=dy, dz=dz)
   end subroutine
! ####################################################################

! ####################################################################
   function lengthFEMDomain(this) result(length)
      class(FEMDomain_), intent(in) :: this
      real(real64) :: length(3)

      length(:) = this%Mesh%length()
   end function

! ####################################################################

! ####################################################################
   function x_lenFEMDomain(this) result(length)
      class(FEMDomain_), intent(in) :: this
      real(real64) :: length

      length = this%xmax() - this%xmin()
   end function

! ####################################################################

! ####################################################################
   function y_lenFEMDomain(this) result(length)
      class(FEMDomain_), intent(in) :: this
      real(real64) :: length

      length = this%ymax() - this%ymin()
   end function

! ####################################################################

! ####################################################################
   function z_lenFEMDomain(this) result(length)
      class(FEMDomain_), intent(in) :: this
      real(real64) :: length

      length = this%zmax() - this%zmin()
   end function

! ####################################################################
   subroutine openFEMDomain(this, path, name)

      class(FEMDomain_), intent(inout) :: this
      character(*), intent(in) :: path
      character(*), optional, intent(in) :: name
      character(:), allocatable :: pathi
      type(IO_) :: f
      integer(int32) :: n

      if (index(path, ".vtk") /= 0) then
         call this%ImportVTKFile(name=path)
         return
      end if

      if (index(path, ".stl") /= 0) then
         call this%ImportSTLFile(name=path)
         return
      end if

      if (present(name)) then
         if (index(name, ".vtk") /= 0) then
            call this%ImportVTKFile(name=path//"/"//name)
            return
         end if
      end if

      ! remove and initialze
      call this%remove()

      if (present(name)) then
         pathi = path
         !if( index(path, "/", back=.true.) == len(path) )then
         !        n=index(path, "/", back=.true.)
         !        pathi(n:n)= " "
         !endif

         call execute_command_line("mkdir -p "//pathi)
         call execute_command_line("mkdir -p "//pathi//"/"//name)
         call this%Mesh%open(path=pathi//"/"//name, name="Mesh") !implement!
         call this%MaterialProp%open(path=pathi//"/"//name, name="MaterialProp")!implement!
         call this%Boundary%open(path=pathi//"/"//name, name="Boundary")!implement!
         call this%ControlPara%open(path=pathi//"/"//name, name="ControlPara")!implement!
         call this%ShapeFunction%open(path=pathi//"/"//name, name="ShapeFunction")!implement!

         call f%open(pathi//"/"//name//"/"//"FEMDomain"//".prop")
         write (f%fh, *) this%RealTime
         write (f%fh, *) this%NumOfDomain
         write (f%fh, '(A)') this%FilePath
         write (f%fh, '(A)') this%FileName
         write (f%fh, '(A)') this%name
         write (f%fh, '(A)') this%dtype
         write (f%fh, '(A)') this%SolverType
         write (f%fh, '(A)') this%Category1
         write (f%fh, '(A)') this%Category2
         write (f%fh, '(A)') this%Category3
         write (f%fh, *) this%timestep, this%NumberOfBoundaries, this%NumberOfMaterials
         call f%close()
      else
         pathi = path
         !if( index(path, "/", back=.true.) == len(path) )then
         !        n=index(path, "/", back=.true.)
         !        pathi(n:n)= " "
         !endif

         call execute_command_line("mkdir -p "//pathi)
         call execute_command_line("mkdir -p "//pathi//"/FEMDomain")
         call this%Mesh%open(path=pathi//"/"//"FEMDomain", name="Mesh")
         call this%MaterialProp%open(path=pathi//"/"//"FEMDomain", name="MaterialProp")
         call this%Boundary%open(path=pathi//"/"//"FEMDomain", name="Boundary")
         call this%ControlPara%open(path=pathi//"/"//"FEMDomain", name="ControlPara")
         call this%ShapeFunction%open(path=pathi//"/"//"FEMDomain", name="ShapeFunction")

         call f%open(pathi//"/FEMDomain"//"/FEMDomain"//".prop")
         write (f%fh, *) this%RealTime
         write (f%fh, *) this%NumOfDomain
         write (f%fh, '(A)') this%FilePath
         write (f%fh, '(A)') this%FileName
         write (f%fh, '(A)') this%name
         write (f%fh, '(A)') this%dtype
         write (f%fh, '(A)') this%SolverType
         write (f%fh, '(A)') this%Category1
         write (f%fh, '(A)') this%Category2
         write (f%fh, '(A)') this%Category3
         write (f%fh, *) this%timestep, this%NumberOfBoundaries, this%NumberOfMaterials
         call f%close()
      end if

   end subroutine
! ####################################################################

   recursive subroutine removeElement_by_radius_FEMDomain(this, center, r)

      class(FEMDomain_), intent(inout) :: this
      real(real64), intent(in) :: center(1:3), r
      real(real64), allocatable :: x(:)
      integer(int32), allocatable :: killElemList(:)
      integer(int32) :: i

      killElemList = zeros(this%ne())

      do i = 1, this%ne()
         x = this%centerPosition(ElementID=i)
         if (norm(x - center) <= r) then
            killElemList(i) = 1
         end if
      end do

      call this%killElement(blacklist=killElemList, flag=1)

   end subroutine

   recursive subroutine removeElementFEMDomain(this, x_min, x_max, y_min, y_max, z_min, z_max, &
                                               xr, yr, zr)

      class(FEMDomain_), intent(inout) :: this
      real(real64), optional, intent(in) :: x_min, x_max, y_min, y_max, z_min, z_max, &
                                            xr(1:2), yr(1:2), zr(1:2)
      real(real64) :: xr_(1:2), yr_(1:2), zr_(1:2)
      real(real64) :: xr__(1:2), yr__(1:2), zr__(1:2)
      real(real64), allocatable :: x(:)
      integer(int32), allocatable :: killElemList(:)
      integer(int32) :: i

      killElemList = zeros(this%ne())
      xr_(1) = input(default=this%x_min(), option=x_min)
      xr_(2) = input(default=this%x_max(), option=x_max)
      yr_(1) = input(default=this%y_min(), option=y_min)
      yr_(2) = input(default=this%y_max(), option=y_max)
      zr_(1) = input(default=this%z_min(), option=z_min)
      zr_(2) = input(default=this%z_max(), option=z_max)

      if (present(xr)) then
         xr_ = xr
      end if

      if (present(yr)) then
         yr_ = yr
      end if

      if (present(zr)) then
         zr_ = zr
      end if

      do i = 1, this%ne()
         x = this%centerPosition(ElementID=i)
         if (xr_(1) <= x(1) .and. x(1) <= xr_(2)) then
            if (yr_(1) <= x(2) .and. x(2) <= yr_(2)) then
               if (zr_(1) <= x(3) .and. x(3) <= zr_(2)) then
                  killElemList(i) = 1
               end if
            end if
         end if
      end do

      call this%killElement(blacklist=killElemList, flag=1)

   end subroutine

! ####################################################################
   subroutine removeFEMDomain(this)
      class(FEMDomain_), intent(inout) :: this

      ! remove all objects

      call this%Mesh%remove()
      call this%MaterialProp%remove()
      call this%Boundary%remove()
      call this%ControlPara%remove()
      call this%ShapeFunction%remove()

      if (allocated(this%Meshes)) then
         deallocate (this%Meshes)
      end if
      if (allocated(this%Materials)) then
         deallocate (this%Materials)
      end if
      if (allocated(this%Boundaries)) then
         deallocate (this%Boundaries)
      end if
      !if(allocated(this%FEMDomains))then
      !        deallocate(this%FEMDomains)
      !endif

      if (allocated(this%scalar)) then
         deallocate (this%scalar)
      end if
      if (allocated(this%vector)) then
         deallocate (this%vector)
      end if
      if (allocated(this%tensor)) then
         deallocate (this%tensor)
      end if

      this%RealTime = 1.0d0
      this%NumOfDomain = 1
      this%FilePath = "None"
      this%FileName = "None"
      this%Name = "None"
      this%Dtype = "None"
      this%SolverType = "None"
      this%Category1 = "None"
      this%Category2 = "None"
      this%Category3 = "None"
      this%timestep = 1
      this%NumberOfBoundaries = 0
      this%NumberOfMaterials = 0

      if (allocated(this%OversetConnect)) deallocate (this%OversetConnect)
      if (allocated(this%OversetExists)) deallocate (this%OversetExists)
      this%num_oversetconnect = 0

      this%total_rotation = 0.0d0

   end subroutine
! ####################################################################

! ####################################################################
   subroutine saveFEMDomain(this, path, name)
      class(FEMDomain_), intent(inout) :: this
      character(*), intent(in) :: path
      character(*), optional, intent(in) :: name
      character(:), allocatable :: pathi
      type(IO_) :: f
      integer(int32) :: n

      if (present(name)) then
         pathi = path
         !if( index(path, "/", back=.true.) == len(path) )then
         !        n=index(path, "/", back=.true.)
         !        pathi(n:n)= " "
         !endif

         call execute_command_line("mkdir -p "//pathi)
         call execute_command_line("mkdir -p "//pathi//"/"//name)
         call this%Mesh%save(path=pathi//"/"//name, name="Mesh")
         call this%MaterialProp%save(path=pathi//"/"//name, name="MaterialProp")
         call this%Boundary%save(path=pathi//"/"//name, name="Boundary")
         call this%ControlPara%save(path=pathi//"/"//name, name="ControlPara")
         call this%ShapeFunction%save(path=pathi//"/"//name, name="ShapeFunction")

         call f%open(pathi//"/"//name, "/"//"FEMDomain", ".prop")
         write (f%fh, *) this%RealTime
         write (f%fh, *) this%NumOfDomain
         write (f%fh, '(A)') this%FilePath
         write (f%fh, '(A)') this%FileName
         write (f%fh, '(A)') this%name
         write (f%fh, '(A)') this%dtype
         write (f%fh, '(A)') this%SolverType
         write (f%fh, '(A)') this%Category1
         write (f%fh, '(A)') this%Category2
         write (f%fh, '(A)') this%Category3
         write (f%fh, *) this%timestep, this%NumberOfBoundaries, this%NumberOfMaterials
         call f%close()
      else
         pathi = path
         !if( index(path, "/", back=.true.) == len(path) )then
         !        n=index(path, "/", back=.true.)
         !        pathi(n:n)= " "
         !endif

         call execute_command_line("mkdir -p "//pathi)
         call execute_command_line("mkdir -p "//pathi//"/FEMDomain")
         call this%Mesh%save(path=pathi//"/"//"FEMDomain", name="Mesh")
         call this%MaterialProp%save(path=pathi//"/"//"FEMDomain", name="MaterialProp")
         call this%Boundary%save(path=pathi//"/"//"FEMDomain", name="Boundary")
         call this%ControlPara%save(path=pathi//"/"//"FEMDomain", name="ControlPara")
         call this%ShapeFunction%save(path=pathi//"/"//"FEMDomain", name="ShapeFunction")

         call f%open(pathi//"/FEMDomain"//"/FEMDomain"//".prop")
         write (f%fh, *) this%RealTime
         write (f%fh, *) this%NumOfDomain
         write (f%fh, '(A)') this%FilePath
         write (f%fh, '(A)') this%FileName
         write (f%fh, '(A)') this%name
         write (f%fh, '(A)') this%dtype
         write (f%fh, '(A)') this%SolverType
         write (f%fh, '(A)') this%Category1
         write (f%fh, '(A)') this%Category2
         write (f%fh, '(A)') this%Category3
         write (f%fh, *) this%timestep, this%NumberOfBoundaries, this%NumberOfMaterials
         call f%close()
      end if
   end subroutine

!##################################################
   function divide_mpi_FEMDomain(this, mpid) result(FEMDomain)
      class(FEMDomain_), intent(inout)::this
      type(FEMDomain_) :: FEMDomain

      type(Mesh_), allocatable :: meshes(:)
      type(MPI_), intent(inout) :: mpid
      integer(int32) :: n

      integer(int32), allocatable :: proc_id(:), next_elems(:), global_node_idx(:)

      ! incremental method
      integer(int32), allocatable :: subdomain_idx(:), elem_idx(:)
      integer(int32), allocatable :: subdomain_center_elem_idx(:), node_idx(:), &
                                     sendbuf(:), recvbuf(:), new_combination(:), new_info(:), my_node_idx(:), your_node_idx(:)
      real(real64), allocatable :: subdomain_center_coord(:, :)

      real(real64), allocatable :: norms(:), new_center(:), num_shared_elem(:)

      integer(int32) :: i, j, elem_id, last_elem_id, max_elem_per_subdomain, elem_counter, &
                        subdomain_id, ne, nn, elemid, k, proc_idx

      type(Random_) :: random

      !>>> Passed the test "Tutorial/fem/divide_mesh.f90"

      ! split obj into n objects
      ! incremental method(逐次追加法)
      n = mpid%petot

      if (n == 1) then
         femdomain = this
         return
      end if
      subdomain_idx = int(zeros(this%ne()))
      subdomain_center_coord = zeros(n, this%nd())
      subdomain_center_elem_idx = int(zeros(n))
      elem_idx = [(i, i=1, this%ne())]
      norms = zeros(n)
      ! set kernel of each subdomain
      subdomain_center_elem_idx = random%draw(elem_idx, n)

      if (mpid%myrank == 0) then

         !num_shared_elem = int(zeros(this%ne() ) )
                ! !$OMP parallel do
         !do i=1,size(this%mesh%elemnod,1)
         !        num_shared_elem(this%mesh%elemnod(i,:) ) = num_shared_elem(this%mesh%elemnod(i,:) ) + 1
         !enddo
                ! !$OMP end parallel do

         !$OMP parallel do
         do i = 1, n
            subdomain_center_coord(i, :) = this%centerPosition(ElementID=subdomain_center_elem_idx(i))
         end do
         !$OMP end parallel do

         !$OMP parallel do private(new_center,norms)
         do i = 1, this%ne()
            new_center = this%centerPosition(ElementID=i)
            do j = 1, n
               norms(j) = dot_product(new_center - subdomain_center_coord(j, :), new_center - subdomain_center_coord(j, :))
            end do
            subdomain_idx(i) = minvalid(norms)
         end do
         !$OMP end parallel do

      end if
      call mpid%bcast(from=0, val=subdomain_idx)

      ! select ones
      i = mpid%myrank + 1
      ne = countif(array=subdomain_idx, Equal=.true., value=i)
      allocate (femdomain%mesh%elemnod(ne, this%nne()))
      elemid = 0
      do j = 1, this%ne()
         if (subdomain_idx(j) == i) then
            elemid = elemid + 1
            ! store global node id
            femdomain%mesh%elemnod(elemid, :) = this%mesh%elemnod(j, :)
         end if
      end do
      femdomain%mpi_global_node_idx = RemoveOverlap(to_vector(femdomain%mesh%elemnod))
      femdomain%mesh%nodcoord = zeros(size(femdomain%mpi_global_node_idx), this%nd())

      ! Global index to local index
      do j = 1, size(femdomain%mpi_global_node_idx)
         femdomain%mesh%nodcoord(j, :) = this%mesh%nodcoord(femdomain%mpi_global_node_idx(j), :)
      end do
      do j = 1, size(femdomain%mesh%elemnod, 1)
         do k = 1, size(femdomain%mesh%elemnod, 2)
            femdomain%mesh%elemnod(j, k) = 1.of.getIdx(vec=femdomain%mpi_global_node_idx, &
                                                       equal_to=femdomain%mesh%elemnod(j, k))
         end do
      end do

      do proc_idx = 0, mpid%petot - 1
         if (mpid%myrank == proc_idx) then
            k = size(femdomain%mpi_global_node_idx)
            call mpid%bcast(from=proc_idx, val=k)
            call mpid%bcast(from=proc_idx, val=femdomain%mpi_global_node_idx)
         else
            call mpid%bcast(from=proc_idx, val=k)
            recvbuf = int(zeros(k))
            call mpid%bcast(from=proc_idx, val=recvbuf)
            new_combination = femdomain%mpi_global_node_idx.cap.recvbuf
            if (size(new_combination) == 0) cycle
            my_node_idx = getIdx(vec=femdomain%mpi_global_node_idx, equal_to=new_combination)
            your_node_idx = getIdx(vec=recvbuf, equal_to=new_combination)

            if (size(new_combination) == 0) then
               ! do nothing
            else
               if (.not. allocated(femdomain%mpi_shared_node_info)) then
                  allocate (femdomain%mpi_shared_node_info(size(new_combination), 3))
                  femdomain%mpi_shared_node_info(:, 1) = my_node_idx
                  femdomain%mpi_shared_node_info(:, 2) = (proc_idx)*int(ones(size(new_combination)))
                  femdomain%mpi_shared_node_info(:, 3) = your_node_idx
               else
                  femdomain%mpi_shared_node_info = &
                     femdomain%mpi_shared_node_info.v. &
                     (my_node_idx.h. &
                      (proc_idx)*int(ones(size(new_combination))) &
                      .h.your_node_idx)
               end if
            end if
         end if
         call mpid%barrier()
      end do

   end function

!##################################################
   function divide_nFEMDomain(this, n) result(FEMDomains)
      class(FEMDomain_), intent(inout)::this
      type(FEMDomain_), allocatable :: FEMDomains(:)
      !integer(int32),allocatable :: FEMDomains(:)

      type(Mesh_), allocatable :: meshes(:)
      integer(int32), intent(in) :: n

      integer(int32), allocatable :: proc_id(:), next_elems(:), global_node_idx(:)

      ! incremental method
      integer(int32), allocatable :: subdomain_idx(:), elem_idx(:), global_to_local(:)
      integer(int32), allocatable :: subdomain_center_elem_idx(:), &
                                     node_idx(:), count_shared(:), mpi_shared_node_info(:, :)
      real(real64), allocatable :: subdomain_center_coord(:, :)

      real(real64), allocatable :: norms(:), new_center(:)

      integer(int32) :: i, j, elem_id, last_elem_id, max_elem_per_subdomain, elem_counter, &
                        subdomain_id, ne, nn, elemid, k
      type(Random_) :: random

      type :: global_to_local_
         integer(int32), allocatable :: global_to_local(:)
      end type
      type(global_to_local_), allocatable :: forall_g2l(:)

      if (n == 1) then
         allocate (femdomains(1))
         femdomains(1) = this
         return
      end if

      ! split obj into n objects
      ! incremental method(逐次追加法)
      subdomain_idx = int(zeros(this%ne()))
      subdomain_center_coord = zeros(n, this%nd())
      subdomain_center_elem_idx = int(zeros(n))
      elem_idx = [(i, i=1, this%ne())]
      norms = zeros(n)
      ! set kernel of each subdomain
      subdomain_center_elem_idx = random%draw(elem_idx, n)

      !$OMP parallel do
      do i = 1, n
         subdomain_center_coord(i, :) = this%centerPosition(ElementID=subdomain_center_elem_idx(i))
      end do
      !$OMP end parallel do

      ! select ones
      !$OMP parallel do private(new_center,norms)
      do i = 1, this%ne()
         new_center = this%centerPosition(ElementID=i)
         do j = 1, n
            norms(j) = dot_product(new_center - subdomain_center_coord(j, :), new_center - subdomain_center_coord(j, :))
         end do
         subdomain_idx(i) = minvalid(norms)
      end do
      !$OMP end parallel do

      allocate (femdomains(n))

      !>> slow
      allocate (forall_g2l(n))
      !$OMP parallel do private(ne,elemid,j,k)
      do i = 1, n
         ne = countif(array=subdomain_idx, Equal=.true., value=i)
         allocate (femdomains(i)%mesh%elemnod(ne, this%nne()))
         elemid = 0
         do j = 1, this%ne()
            if (subdomain_idx(j) == i) then
               elemid = elemid + 1
               ! store global node id
               femdomains(i)%mesh%elemnod(elemid, :) = this%mesh%elemnod(j, :)
            end if
         end do

         femdomains(i)%mpi_global_node_idx = &
            RemoveOverlap(to_vector(femdomains(i)%mesh%elemnod))

         femdomains(i)%mesh%nodcoord = zeros(size(femdomains(i)%mpi_global_node_idx), this%nd())

         do j = 1, size(femdomains(i)%mpi_global_node_idx)
            femdomains(i)%mesh%nodcoord(j, :) = this%mesh%nodcoord(femdomains(i)%mpi_global_node_idx(j), :)
         end do

         ! change global node-idx to local node-idx
!                if(present(fast) )then
         if (.not. allocated(forall_g2l(i)%global_to_local)) then
            allocate (forall_g2l(i)%global_to_local(minval(femdomains(i)%mpi_global_node_idx): &
                                                    maxval(femdomains(i)%mpi_global_node_idx)))
         end if

         do j = 1, size(femdomains(i)%mpi_global_node_idx)
            forall_g2l(i)%global_to_local(femdomains(i)%mpi_global_node_idx(j)) = j
         end do
         do j = 1, size(femdomains(i)%mesh%elemnod, 1)
            do k = 1, size(femdomains(i)%mesh%elemnod, 2)
               femdomains(i)%mesh%elemnod(j, k) = forall_g2l(i)%global_to_local(femdomains(i)%mesh%elemnod(j, k))
            end do
         end do

!                else
!                        do j=1,size(femdomains(i)%mesh%elemnod,1)
!                                do k=1,size(femdomains(i)%mesh%elemnod,2)
!                                        femdomains(i)%mesh%elemnod(j,k) = &
!                                        1 .of. getIdx(vec=femdomains(i)%mpi_global_node_idx,equal_to=femdomains(i)%mesh%elemnod(j,k))
!                                enddo
!                        enddo
!                endif

      end do
      !$OMP end parallel do

      !$OMP parallel do private(j,count_shared,mpi_shared_node_info)
      do i = 1, size(femdomains)
         do j = 1, size(femdomains)
            if (i == j) cycle
            count_shared = femdomains(i)%mpi_global_node_idx &
                           .cap.femdomains(j)%mpi_global_node_idx

            if (size(count_shared) == 0) then
               cycle
            end if

!                        if(present(fast) )then

            mpi_shared_node_info = int(zeros(size(count_shared), 3))

            mpi_shared_node_info(:, 1) = forall_g2l(i)%global_to_local(count_shared)
            mpi_shared_node_info(:, 2) = j - 1
            mpi_shared_node_info(:, 3) = forall_g2l(j)%global_to_local(count_shared)

            if (.not. allocated(femdomains(i)%mpi_shared_node_info)) then
               femdomains(i)%mpi_shared_node_info = mpi_shared_node_info
            else
               femdomains(i)%mpi_shared_node_info = &
                  femdomains(i)%mpi_shared_node_info.v.mpi_shared_node_info

            end if
!                        else

!                                mpi_shared_node_info = int(zeros(size(count_shared),3 )  )
!
!                                mpi_shared_node_info(:,1) = &
!                                                getIdx(femdomains(i)%mpi_global_node_idx,&
!                                        equal_to=count_shared)
!                                mpi_shared_node_info(:,2) = j-1
!                                mpi_shared_node_info(:,3) = &
!                                                getIdx(femdomains(j)%mpi_global_node_idx,&
!                                        equal_to=count_shared)
!
!                                if(.not.allocated(femdomains(i)%mpi_shared_node_info))then
!                                        femdomains(i)%mpi_shared_node_info = mpi_shared_node_info
!                                else
!                                        femdomains(i)%mpi_shared_node_info = &
!                                        femdomains(i)%mpi_shared_node_info .v. mpi_shared_node_info
!
!                                endif
!                        endif

         end do
      end do
      !$OMP end parallel do

      return

!        return
!
!                ! greedy method
!                allocate(FEMDomains(n))
!                proc_id = int(zeros(this%ne() ) )
!                proc_id(1) = 1
!                last_elem_id = 1
!                max_elem_per_subdomain = size(proc_id)/n + 1
!                ! divide domain by Greedy method
!                do subdomain_id = 1,n
!                        elem_counter = 0
!                        do
!                                next_elems = this%getNeighboringElementList(ElementID=last_elem_id)
!                                do i=1,size(next_elems)
!                                        elem_counter = elem_counter + 1
!                                        proc_id( next_elems(i) ) = subdomain_id
!                                        if(elem_counter > max_elem_per_subdomain)then
!                                                exit
!                                        endif
!                                enddo
!                                if(elem_counter > max_elem_per_subdomain)then
!                                        exit
!                                endif
!                        enddo
!                        if(elem_counter > max_elem_per_subdomain)then
!                                do i=1,size(proc_id)
!                                        last_elem_id = 0
!                                        if(proc_id(i)==0 )then
!                                                last_elem_id = i
!                                        endif
!                                enddo
!                        endif
!                enddo
!                femdomains = proc_id
!        return
      ! >>>> following has some bugs
!                ! split obj into n objects
!                allocate(FEMDomains(n))
!
!                ! Greedy algorithm
!                if(this%Mesh%empty() .eqv. .true. )then
!                        print *, "divideFEMDomain >> ERROR >> No mesh is imported."
!                        stop
!                endif
!
!                meshes = this%mesh%divide(n)
!
!                ! import mesh
!                do i=1,n
!                        call FEMDomains(i)%import(Mesh=meshes(i))
!                enddo

   end function divide_nFEMDomain
!##################################################

!##################################################
   subroutine displayFEMDomain(this, path, name, extention, field)
      class(FEMDomain_), intent(inout) :: this
      character(*), intent(in) :: path, name, extention
      integer(int32) :: i, j, n
      integer(int32), allocatable :: facet_connect(:, :)
      real(real64), optional, intent(in) :: field(:)
      real(real64) :: val

      open (10, file=path//name//extention)
      if (extention == ".vtk") then
         write (10, '(A)') "# vtk DataFile Version 2.0"
         write (10, '(A)') "Cube example"
         write (10, '(A)') "ASCII"
         write (10, '(A)') "DATASET POLYDATA"
         write (10, '(A)', advance="no") "POINTS "
         write (10, '(i10)', advance="no") size(this%mesh%NodCoord, 1)
         write (10, '(A)') " float"
         do i = 1, size(this%mesh%NodCoord, 1)
            do j = 1, size(this%mesh%NodCoord, 2)
               if (j == size(this%mesh%NodCoord, 2)) then
                  write (10, '(f20.8)') this%mesh%NodCoord(i, j)
               else
                  write (10, '(f20.8)', advance="no") this%mesh%NodCoord(i, j)
                  write (10, '(A)', advance="no") " "
               end if
            end do
         end do
         write (10, '(A)', advance="no") " POLYGONS "
         write (10, '(i10)', advance="no") 6*size(this%mesh%ElemNod, 1)
         write (10, '(A)', advance="no") " "
         write (10, '(i10)') size(this%mesh%ElemNod, 1)*5*6
         do i = 1, size(this%mesh%ElemNod, 1)
            write (10, '(A)', advance="no") "4 "
            write (10, '(i10)', advance="no") this%mesh%ElemNod(i, 1) - 1
            write (10, '(A)', advance="no") " "
            write (10, '(i10)', advance="no") this%mesh%ElemNod(i, 2) - 1
            write (10, '(A)', advance="no") " "
            write (10, '(i10)', advance="no") this%mesh%ElemNod(i, 3) - 1
            write (10, '(A)', advance="no") " "
            write (10, '(i10)', advance="no") this%mesh%ElemNod(i, 4) - 1
            write (10, '(A)') " "
            write (10, '(A)', advance="no") "4 "
            write (10, '(i10)', advance="no") this%mesh%ElemNod(i, 5) - 1
            write (10, '(A)', advance="no") " "
            write (10, '(i10)', advance="no") this%mesh%ElemNod(i, 6) - 1
            write (10, '(A)', advance="no") " "
            write (10, '(i10)', advance="no") this%mesh%ElemNod(i, 7) - 1
            write (10, '(A)', advance="no") " "
            write (10, '(i10)', advance="no") this%mesh%ElemNod(i, 8) - 1
            write (10, '(A)') " "
            write (10, '(A)', advance="no") "4 "
            write (10, '(i10)', advance="no") this%mesh%ElemNod(i, 1) - 1
            write (10, '(A)', advance="no") " "
            write (10, '(i10)', advance="no") this%mesh%ElemNod(i, 2) - 1
            write (10, '(A)', advance="no") " "
            write (10, '(i10)', advance="no") this%mesh%ElemNod(i, 6) - 1
            write (10, '(A)', advance="no") " "
            write (10, '(i10)', advance="no") this%mesh%ElemNod(i, 5) - 1
            write (10, '(A)') " "
            write (10, '(A)', advance="no") "4 "
            write (10, '(i10)', advance="no") this%mesh%ElemNod(i, 3) - 1
            write (10, '(A)', advance="no") " "
            write (10, '(i10)', advance="no") this%mesh%ElemNod(i, 4) - 1
            write (10, '(A)', advance="no") " "
            write (10, '(i10)', advance="no") this%mesh%ElemNod(i, 8) - 1
            write (10, '(A)', advance="no") " "
            write (10, '(i10)', advance="no") this%mesh%ElemNod(i, 7) - 1
            write (10, '(A)') " "
            write (10, '(A)', advance="no") "4 "
            write (10, '(i10)', advance="no") this%mesh%ElemNod(i, 1) - 1
            write (10, '(A)', advance="no") " "
            write (10, '(i10)', advance="no") this%mesh%ElemNod(i, 5) - 1
            write (10, '(A)', advance="no") " "
            write (10, '(i10)', advance="no") this%mesh%ElemNod(i, 8) - 1
            write (10, '(A)', advance="no") " "
            write (10, '(i10)', advance="no") this%mesh%ElemNod(i, 4) - 1
            write (10, '(A)') " "
            write (10, '(A)', advance="no") "4 "
            write (10, '(i10)', advance="no") this%mesh%ElemNod(i, 2) - 1
            write (10, '(A)', advance="no") " "
            write (10, '(i10)', advance="no") this%mesh%ElemNod(i, 3) - 1
            write (10, '(A)', advance="no") " "
            write (10, '(i10)', advance="no") this%mesh%ElemNod(i, 7) - 1
            write (10, '(A)', advance="no") " "
            write (10, '(i10)', advance="no") this%mesh%ElemNod(i, 6) - 1
            write (10, '(A)') " "
         end do
         write (10, '(A)') "CELL_DATA 6"
      elseif (extention == ".ply") then
         write (10, '(A)') "ply"
         write (10, '(A)') "format ascii 1.0"
         write (10, '(A)', advance="no") "element vertex "
         write (10, '(i10)') size(this%mesh%NodCoord, 1)
         write (10, '(A)') "property float32 x"
         write (10, '(A)') "property float32 y"
         write (10, '(A)') "property float32 z"
         write (10, '(A)') "property uchar red"
         write (10, '(A)') "property uchar green"
         write (10, '(A)') "property uchar blue"
         if (present(field)) then
            write (10, '(A)') "property float32 field"
         end if
         write (10, '(A)', advance="no") "element face "
         write (10, '(i10)') size(this%mesh%ElemNod, 1)*6
         write (10, '(A)') "property list uint8 int32 vertex_indices"
         write (10, '(A)') "end_header"
         do i = 1, size(this%mesh%NodCoord, 1)
            do j = 1, size(this%mesh%NodCoord, 2)
               if (j == size(this%mesh%NodCoord, 2)) then
                  write (10, '(f20.8)', advance="no") this%mesh%NodCoord(i, j)
                  write (10, '(A)', advance="no") " "
               else
                  write (10, '(f20.8)', advance="no") this%mesh%NodCoord(i, j)
                  write (10, '(A)', advance="no") " "
               end if
            end do
            write (10, '(A)', advance="no") " "
            write (10, '(i3)', advance="no") int(this%mesh%NodCoord(i, 1)*255.0d0/maxval(this%mesh%NodCoord(:, 1)))
            write (10, '(A)', advance="no") " "
            write (10, '(i3)', advance="no") int(this%mesh%NodCoord(i, 2)*255.0d0/maxval(this%mesh%NodCoord(:, 2)))
            if (present(field)) then
               write (10, '(A)', advance="no") " "
               write (10, '(i3)', advance="no") int(this%mesh%NodCoord(i, 3)*255.0d0/maxval(this%mesh%NodCoord(:, 3)))
               write (10, '(A)', advance="no") " "
               write (10, '(A)') str(real(field(i)))
            else
               write (10, '(A)', advance="no") " "
               write (10, '(i3)') int(this%mesh%NodCoord(i, 3)*255.0d0/maxval(this%mesh%NodCoord(:, 3)))
            end if

         end do
         allocate (facet_connect(6, 4))
         facet_connect(1, :) = [3, 2, 1, 0]
         facet_connect(2, :) = [0, 1, 5, 4]
         facet_connect(3, :) = [1, 2, 6, 5]
         facet_connect(4, :) = [2, 3, 7, 6]
         facet_connect(5, :) = [3, 0, 4, 7]
         facet_connect(6, :) = [4, 5, 6, 7]
         facet_connect(:, :) = facet_connect(:, :) + 1

         do i = 1, size(this%mesh%ElemNod, 1)
            !val = dble(this%mesh%ElemNod(i,1)-1)
            !if(present(field) )then
            !        val=field(i)
            !endif
            do j = 1, size(facet_connect, 1)
               write (10, '(A)', advance="no") "4 "
               write (10, '(i10)', advance="no") this%mesh%ElemNod(i, facet_connect(j, 1)) - 1
               write (10, '(A)', advance="no") " "
               write (10, '(i10)', advance="no") this%mesh%ElemNod(i, facet_connect(j, 2)) - 1
               write (10, '(A)', advance="no") " "
               write (10, '(i10)', advance="no") this%mesh%ElemNod(i, facet_connect(j, 3)) - 1
               write (10, '(A)', advance="no") " "
               write (10, '(i10)', advance="no") this%mesh%ElemNod(i, facet_connect(j, 4)) - 1
               write (10, '(A)') " "
            end do
            !write(10,'(A)') " "
            !write(10,'(A)',advance="no") "4 "
            !write(10,'(i10)',advance="no") int(val)
            !write(10,'(A)',advance="no") " "
            !write(10,'(i10)',advance="no") int(val)
            !write(10,'(A)',advance="no") " "
            !write(10,'(i10)',advance="no") int(val)
            !write(10,'(A)',advance="no") " "
            !write(10,'(i10)',advance="no") int(val)
            !write(10,'(A)') " "
            !write(10,'(A)',advance="no") "4 "
            !write(10,'(i10)',advance="no") int(val)
            !write(10,'(A)',advance="no") " "
            !write(10,'(i10)',advance="no") int(val)
            !write(10,'(A)',advance="no") " "
            !write(10,'(i10)',advance="no") int(val)
            !write(10,'(A)',advance="no") " "
            !write(10,'(i10)',advance="no") int(val)
            !write(10,'(A)') " "
            !write(10,'(A)',advance="no") "4 "
            !write(10,'(i10)',advance="no") int(val)
            !write(10,'(A)',advance="no") " "
            !write(10,'(i10)',advance="no") int(val)
            !write(10,'(A)',advance="no") " "
            !write(10,'(i10)',advance="no") int(val)
            !write(10,'(A)',advance="no") " "
            !write(10,'(i10)',advance="no") int(val)
            !write(10,'(A)') " "
            !write(10,'(A)',advance="no") "4 "
            !write(10,'(i10)',advance="no") int(val)
            !write(10,'(A)',advance="no") " "
            !write(10,'(i10)',advance="no") int(val)
            !write(10,'(A)',advance="no") " "
            !write(10,'(i10)',advance="no") int(val)
            !write(10,'(A)',advance="no") " "
            !write(10,'(i10)',advance="no") int(val)
            !write(10,'(A)') " "
            !write(10,'(A)',advance="no") "4 "
            !write(10,'(i10)',advance="no") int(val)
            !write(10,'(A)',advance="no") " "
            !write(10,'(i10)',advance="no") int(val)
            !write(10,'(A)',advance="no") " "
            !write(10,'(i10)',advance="no") int(val)
            !write(10,'(A)',advance="no") " "
            !write(10,'(i10)',advance="no") int(val)
            !write(10,'(A)') " "
         end do

      else
         print *, "Invalid extention :: ", extention
         stop
      end if
      close (10)

   end subroutine displayFEMDomain
!##################################################

!##################################################
   subroutine fieldFEMDomain(this, scalar, vector, tensor)
      class(FEMDomain_), intent(inout) :: this
      real(real64), optional, intent(in) :: scalar(:), vector(:, :), tensor(:, :, :)
      integer(int32) :: i, j, k, n

      ! import data >> to obj
      if (present(scalar)) then
         if (size(scalar, 1) == 0) then
            print *, "displayFEMDomain :: ERROR :: scalar is not allocated."
            stop
         end if
         if (allocated(this%scalar)) then
            deallocate (this%scalar)
         end if
         i = size(scalar)
         if (this%mesh%empty() .eqv. .true.) then
            print *, "displayFEMDomain :: ERROR :: element is not imported."
            stop
         end if
         if (i /= size(this%mesh%ElemNod, 1)) then
            print *, "displayFEMDomain :: ERROR :: size(scalar/=size(this%mesh%ElemNod,1)"
            stop
         end if
         allocate (this%scalar(i))
         this%scalar(:) = scalar(:)
      end if

      ! import data >> to obj
      if (present(vector)) then
         if (size(vector, 1) == 0) then
            print *, "displayFEMDomain :: ERROR :: vector is not allocated."
            stop
         end if
         if (allocated(this%vector)) then
            deallocate (this%vector)
         end if
         i = size(vector, 1)
         j = size(vector, 2)
         if (this%mesh%empty() .eqv. .true.) then
            print *, "displayFEMDomain :: ERROR :: element is not imported."
            stop
         end if
         if (i /= size(this%mesh%ElemNod, 1)) then
            print *, "displayFEMDomain :: ERROR :: size(vector/=size(this%mesh%ElemNod,1)"
            stop
         end if
         allocate (this%vector(i, j))
         this%vector(:, :) = vector(:, :)
      end if

      ! import data >> to obj
      if (present(tensor)) then
         if (size(tensor, 1) == 0) then
            print *, "displayFEMDomain :: ERROR :: tensor is not allocated."
            stop
         end if
         if (allocated(this%tensor)) then
            deallocate (this%tensor)
         end if
         i = size(tensor, 1)
         j = size(tensor, 2)
         k = size(tensor, 3)
         if (this%mesh%empty() .eqv. .true.) then
            print *, "displayFEMDomain :: ERROR :: element is not imported."
            stop
         end if
         if (i /= size(this%mesh%ElemNod, 1)) then
            print *, "displayFEMDomain :: ERROR :: size(tensor/=size(this%mesh%ElemNod,1)"
            stop
         end if
         allocate (this%tensor(i, j, k))
         this%tensor(:, :, :) = tensor(:, :, :)
      end if

   end subroutine fieldFEMDomain
!##################################################

!##################################################
   subroutine DeallocateFEMDomain(this)
      class(FEMDomain_), intent(inout)::this

      call DeallocateMesh(this%Mesh)
      call DeallocateMaterialProp(this%MaterialProp)
      call DeallocateBoundary(this%Boundary)
      call DeallocateShapeFunction(this%ShapeFunction)

   end subroutine DeallocateFEMDomain
!##################################################

! ################################################
   subroutine renameFEMDomain(this, Name)
      class(FEMDomain_), intent(inout) :: this
      character(*), intent(in) :: Name

      this%Name = ""
      this%Name = name

   end subroutine renameFEMDomain

!##################################################
   subroutine InitializeFEMDomain(this, Default, FileName, simple)
      class(FEMDomain_), intent(inout)::this
      character(*), optional, intent(in) :: FileName
      logical, optional, intent(in)::Default, simple

      this%FilePath = "None"
      this%FileName = "None"
      this%Name = "None"
      this%SolverType = "None"
      this%Category1 = "None"
      this%Category2 = "None"
      this%Category3 = "None"

      if (.not. present(FileName)) then
         this%FileName = "noName"
      else
         this%FileName = FileName
      end if

      if (present(simple)) then
         if (simple .eqv. .true.) then
            return
         end if

      end if

      if (Default .eqv. .true.) then
         this%Dtype = "FEMDomain"
      end if
      call InitializeMesh(this%Mesh)
      call InitializeMaterial(this%MaterialProp)
      call this%Boundary%Init(Default)
      this%timestep = 0

   end subroutine InitializeFEMDomain
!##################################################

!##################################################
   subroutine showFEMDomain(this)
      class(FEMDomain_), intent(in)::this
      integer(int32)::i

      print *, "=========================="
      print *, "Name :: ", this%name
      print *, "Materials :: "
      if (.not. allocated(this%Materials)) then
         print *, "No material is imported"
      else
         do i = 1, this%NumberOfMaterials
            if (associated(this%Materials(i)%materialp)) then
               call this%Materials(i)%materialp%show()
            else
               cycle
            end if
         end do
      end if
      print *, "Boundaries :: "
      if (.not. allocated(this%boundaries)) then
         print *, "No Boundary is imported"
      else
         do i = 1, this%NumberOfBoundaries
            if (associated(this%Boundaries(i)%Boundaryp)) then
               call this%Boundaries(i)%Boundaryp%show()
            else
               cycle
            end if
         end do
      end if

   end subroutine showFEMDomain
!##################################################

!##################################################
   subroutine ImportFEMDomain(this, OptionalFileFormat, OptionalProjectName, FileHandle, Mesh, Boundaries &
                              , Boundary, Materials, Material, NumberOfBoundaries, BoundaryID, NumberOfMaterials, MaterialID, &
                              node, element, materialinfo, dirichlet, neumann, file)
      class(FEMDomain_), intent(inout)::this
      type(Mesh_), optional, intent(in)::Mesh
      type(Mesh_)::mobj
      type(Boundary_), optional, intent(in)::Boundary
      type(MaterialProp_), optional, intent(in)::Material
      character*4, optional, intent(in)::OptionalFileFormat
      character(*), optional, intent(in)::OptionalProjectName
      logical, optional, intent(in) :: node, element, materialinfo, dirichlet, neumann
      type(IO_) :: f

      character(*), optional, intent(in) :: file
      character*4::FileFormat
      character(:), allocatable::ProjectName
      character(:), allocatable ::FileName
      character*9  :: DataType
      integer, allocatable::IntMat(:, :)
      real(8), allocatable::RealMat(:, :)
      integer, optional, intent(in)::FileHandle, NumberOfBoundaries, BoundaryID, MaterialID, NumberOfMaterials
      integer :: fh, i, j, k, NumOfDomain, n, m, DimNum, GpNum, nodenum, matnum, paranum
      character(:), allocatable ::  Msg, name, ch
      logical, optional, intent(in) :: Boundaries, Materials

      if (present(file)) then
         if (index(file, ".vtk") /= 0) then
            call this%ImportVTKFile(name=file)
            print *, "imported ", file
            return
         end if
      end if

      if (getext(file) == "mesh") then

         call f%open(file)
         read (f%fh, *) ch
         read (f%fh, *) ch
         read (f%fh, *) n
         read (f%fh, *) ch
         read (f%fh, *) m
         allocate (mobj%NodCoord(m, n))
         do i = 1, m
            read (f%fh, *) mobj%NodCoord(i, :)
         end do
         do
            read (f%fh, *) ch
            if (ch == "Tetrahedra") then
               read (f%fh, *) n
               allocate (mobj%ElemNod(n, 4), mobj%ElemMat(n))
               mobj%ElemMat(:) = 1
               do i = 1, n
                  read (f%fh, *) mobj%ElemNod(i, 1:4)
               end do
               exit
            elseif (ch == "End") then
               exit
            else
               read (f%fh, *) n
               do i = 1, n
                  read (f%fh, *) ch
               end do
            end if
         end do
         call f%close()
         call mobj%convertTetraToHexa()
         call this%Mesh%copy(mobj)
         return
      end if

      if (present(node)) then
         if (node .eqv. .true.) then
            if (.not. present(file)) then
               print *, "Please iput filename"
               stop
            end if
            call f%open(file)
            read (f%fh, *) nodenum, dimnum
            if (allocated(this%Mesh%NodCoord)) then
               deallocate (this%Mesh%NodCoord)
            end if
            allocate (this%Mesh%NodCoord(nodenum, dimnum))
            do i = 1, nodenum
               read (f%fh, *) this%Mesh%NodCoord(i, :)
            end do
            call f%close()
            return
         end if
      end if

      if (present(Element)) then
         if (Element .eqv. .true.) then
            if (.not. present(file)) then
               print *, "Please iput filename"
               stop
            end if
            call f%open(file)
            read (f%fh, *) nodenum, dimnum
            if (allocated(this%Mesh%ElemNod)) then
               deallocate (this%Mesh%ElemNod)
            end if
            allocate (this%Mesh%ElemNod(nodenum, dimnum))
            do i = 1, nodenum
               read (f%fh, *) this%Mesh%ElemNod(i, :)
            end do
            call f%close()
            return
         end if
      end if

      if (present(materialinfo)) then
         if (materialinfo .eqv. .true.) then
            if (.not. present(file)) then
               print *, "Please iput filename"
               stop
            end if
            call f%open(file)
            read (f%fh, *) nodenum
            if (allocated(this%Mesh%ElemMat)) then
               deallocate (this%Mesh%ElemMat)
            end if
            allocate (this%Mesh%ElemMat(nodenum))
            do i = 1, nodenum
               read (f%fh, *) this%Mesh%ElemMat(i)
            end do

            read (f%fh, *) matnum, paranum
            if (allocated(this%MaterialProp%MatPara)) then
               deallocate (this%MaterialProp%MatPara)
            end if
            allocate (this%MaterialProp%MatPara(matnum, paranum))
            do i = 1, matnum
               read (f%fh, *) this%MaterialProp%MatPara(i, :)
            end do
            call f%close()
            return
         end if
      end if

      if (present(dirichlet)) then
         if (dirichlet .eqv. .true.) then
            if (.not. present(file)) then
               print *, "Please iput filename"
               stop
            end if
            call f%open(file)
            dimnum = size(this%mesh%NodCoord, 2)
            if (allocated(this%Boundary%DboundNum)) then
               deallocate (this%Boundary%DboundNum)
            end if
            allocate (this%Boundary%DboundNum(dimnum))
            read (f%fh, *) this%Boundary%DboundNum(:)
            if (allocated(this%Boundary%DboundNodID)) then
               deallocate (this%Boundary%DboundNodID)
            end if
            allocate (this%Boundary%DboundNodID(maxval(this%Boundary%DboundNum), dimnum))
            if (allocated(this%Boundary%DBoundVal)) then
               deallocate (this%Boundary%DBoundVal)
            end if
            allocate (this%Boundary%DBoundVal(maxval(this%Boundary%DboundNum), dimnum))

            do i = 1, size(this%Boundary%DboundNodID, 1)
               read (f%fh, *) this%Boundary%DboundNodID(i, :)
            end do
            do i = 1, size(this%Boundary%DboundVal, 1)
               read (f%fh, *) this%Boundary%DboundVal(i, :)
            end do
            call f%close()
            return
         end if
      end if

      if (present(neumann)) then
         if (neumann .eqv. .true.) then
            if (.not. present(file)) then
               print *, "Please iput filename"
               stop
            end if
            call f%open(file)
            dimnum = size(this%mesh%NodCoord, 2)
            if (allocated(this%Boundary%NboundNum)) then
               deallocate (this%Boundary%NboundNum)
            end if
            allocate (this%Boundary%NboundNum(dimnum))
            read (f%fh, *) this%Boundary%NboundNum(:)
            if (allocated(this%Boundary%NboundNodID)) then
               deallocate (this%Boundary%NboundNodID)
            end if
            allocate (this%Boundary%NboundNodID(maxval(this%Boundary%NboundNum), dimnum))
            if (allocated(this%Boundary%NBoundVal)) then
               deallocate (this%Boundary%NBoundVal)
            end if
            allocate (this%Boundary%NBoundVal(maxval(this%Boundary%NboundNum), dimnum))

            do i = 1, size(this%Boundary%NboundNodID, 1)
               read (f%fh, *) this%Boundary%NboundNodID(i, :)
            end do
            do i = 1, size(this%Boundary%NboundVal, 1)
               read (f%fh, *) this%Boundary%NboundVal(i, :)
            end do
            call f%close()
            return
         end if
      end if

      if (present(Boundaries)) then
         if (Boundaries .eqv. .true.) then
            call this%ImportBoundaries(Boundary, NumberOfBoundaries, BoundaryID)
            return
         end if
      end if

      if (present(Materials)) then
         if (materials .eqv. .true.) then
            call this%ImportMaterials(Material, NumberOfMaterials, MaterialID)
            return
         end if
      end if
      if (present(Mesh)) then
         call this%Mesh%import(Mesh=Mesh)
         return
      end if

!call DeallocateFEMDomain(this)
      name = "untitled"
      this%FileName = input(default=name, option=OptionalProjectName)

      if (present(FileHandle)) then
         fh = FileHandle
      else
         fh = 104
      end if

      if (present(OptionalFileFormat)) then
         FileFormat = OptionalFileFormat
      else
         FileFormat = ".scf"
      end if

      if (present(OptionalProjectName)) then
         ProjectName = OptionalProjectName
      else
         ProjectName = "untitled"
      end if

      FileName = ProjectName//FileFormat

! !print *, "Project : ",ProjectName
! !print *, "is Exported as : ",FileFormat," format"
! !print *, "File Name is : ",FileName

      open (fh, file=FileName, status="old")

      if (FileFormat == ".scf") then

         read (fh, *) DataType
         if (DataType /= "domain") then
            print *, "ERROR :: Datatype ", DataType, " is not valid."
            return
         end if
         this%Dtype = DataType
         read (fh, *) this%SolverType
         read (fh, *) this%NumOfDomain
         allocate (IntMat(this%NumOfDomain, 2))
         allocate (this%Mesh%SubMeshNodFromTo(this%NumOfDomain, 3))
         allocate (this%Mesh%SubMeshElemFromTo(this%NumOfDomain, 3))

         do i = 1, this%NumOfDomain
            this%Mesh%SubMeshNodFromTo(i, 1) = i
            read (fh, *) this%Mesh%SubMeshNodFromTo(i, 2), this%Mesh%SubMeshNodFromTo(i, 3)
         end do

         do i = 1, this%NumOfDomain
            this%Mesh%SubMeshElemFromTo(i, 1) = i
            read (fh, *) this%Mesh%SubMeshElemFromTo(i, 3)
            if (i == 1) then
               this%Mesh%SubMeshElemFromTo(i, 2) = 1
            else
               this%Mesh%SubMeshElemFromTo(i, 2) = this%Mesh%SubMeshElemFromTo(i - 1, 3) + 1
            end if
         end do

         read (fh, *) n, m
         DimNum = m

         allocate (this%Mesh%NodCoord(n, m))
         call ImportArray(this%Mesh%NodCoord, OptionalFileHandle=fh)
         call CopyArray(this%Mesh%NodCoord, this%Mesh%NodCoordInit)

         read (fh, *) n, m

         read (fh, *) this%Mesh%ElemType

         !this%ShapeFunction%ElemType=this%Mesh%ElemType
         allocate (this%Mesh%ElemNod(n, m))
         allocate (this%Mesh%ElemMat(n))
         call ImportArray(this%Mesh%ElemNod, OptionalFileHandle=fh)
         do i = 1, n
            read (fh, *) this%Mesh%ElemMat(i)
         end do
         read (fh, *) n, m

         allocate (this%MaterialProp%MatPara(n, m))
         call ImportArray(this%MaterialProp%MatPara, OptionalFileHandle=fh)

         !DirichletBoundary
         read (fh, *) n !DirichletBoundaryDimension

         if (n <= 0) then
            print *, "ImportFEMDomain >> Caution :: no Dirichlet Boundary Condition is loaded. "
         else
            allocate (this%Boundary%DBoundNum(n))
            read (fh, *) this%Boundary%DBoundNum(:)

            allocate (this%Boundary%DBoundNodID(maxval(this%Boundary%DBoundNum), size(this%Boundary%DBoundNum)))
            allocate (this%Boundary%DBoundVal(maxval(this%Boundary%DBoundNum), size(this%Boundary%DBoundNum)))

            this%Boundary%DBoundNodID(:, :) = -1
            this%Boundary%DBoundVal(:, :) = 0.0d0

            do i = 1, size(this%Boundary%DBoundNum, 1)
               do j = 1, this%Boundary%DBoundNum(i)
                  read (fh, *) this%Boundary%DBoundNodID(j, i)
                ! !print *,this%Boundary%DBoundNodID(j,i)
               end do
               do j = 1, this%Boundary%DBoundNum(i)
                  read (fh, *) this%Boundary%DBoundVal(j, i)
                ! !print *,this%Boundary%DBoundVal(j,i)
               end do
            end do

         end if

         read (fh, *) DimNum

         if (DimNum <= 0) then

            print *, "ImportFEMDomain >> Caution :: no Neumann Boundary Condition is loaded. "
         else
            read (fh, *) n
            allocate (this%Boundary%NBoundNum(DimNum))
            allocate (this%Boundary%NBoundNodID(n, size(this%Boundary%NBoundNum)))
            allocate (this%Boundary%NBoundVal(n, size(this%Boundary%NBoundNum)))
            this%Boundary%NBoundNodID(:, :) = -1
            this%Boundary%NBoundVal(:, :) = 0.0d0

            this%Boundary%NBoundNum(:) = n
            do i = 1, n
               read (fh, *) m
               this%Boundary%NBoundNodID(i, :) = m
            end do

            do i = 1, n
               read (fh, *) this%Boundary%NBoundVal(i, :)
            end do

         end if

         !######### Initial conditions #################
         ! For node-wize
         read (fh, *) DimNum
         if (DimNum <= 0) then
            print *, "Caution :: no Initial Condition (Node-wise) Condition is loaded. "
         else
            read (fh, *) n
            allocate (this%Boundary%TBoundNodID(n, DimNum))
            allocate (this%Boundary%TBoundVal(n, DimNum))
            allocate (this%Boundary%TBoundNum(DimNum))

            this%Boundary%TBoundNum(:) = n

            if (n /= 0) then
               if (n < 0) then
                  print *, "ERROR :: number of initial conditions are to be zero"
               else
                  do i = 1, n
                     read (fh, *) this%Boundary%TBoundNodID(i, :)
                  end do
                  do i = 1, n
                     read (fh, *) this%Boundary%TBoundVal(i, :)
                  end do
               end if
            end if
         end if
         !######### Initial conditions #################

         !######### Initial conditions #################
         ! For ElementGP-wize
         read (fh, *) DimNum
         if (DimNum <= 0) then
            print *, "Caution :: no Initial Condition (Gp) is loaded. "
         else
            read (fh, *) GpNum
            read (fh, *) n
            allocate (this%Boundary%TBoundElemID(n))
            allocate (this%Boundary%TBoundElemGpVal(n, GpNum, DimNum))

            if (n /= 0) then
               if (n < 0) then
                  print *, "ERROR :: number of initial conditions are to be zero"
               else
                  do i = 1, n
                     read (fh, *) this%Boundary%TBoundElemID(i)
                  end do
                  do i = 1, n
                     do j = 1, GpNum
                        do k = 1, DimNum
                           read (fh, *) this%Boundary%TBoundElemGpVal(i, j, k)
                        end do
                     end do
                  end do
               end if
            end if

         end if
         !######### Initial conditions #################

         read (fh, *) this%ControlPara%SimMode, this%ControlPara%ItrTol, this%ControlPara%Timestep

         close (fh)
      else
    ! !print *, "ERROR :: ExportFEMDomain >> only .scf file can be exported."
      end if

   end subroutine ImportFEMDomain
!##################################################

!##################################################
   subroutine ImportMeshFEMDomain(this, Mesh)
      class(FEMDomain_), intent(inout)::this
      class(Mesh_), intent(inout)::Mesh

      call this%Mesh%copy(Mesh)
   end subroutine
!##################################################

   subroutine resizeFEMDomain(this, x_rate, y_rate, z_rate, x_len, y_len, z_len, &
                              x, y, z)
      class(FEMDomain_), intent(inout) :: this
      real(real64), optional, intent(in) :: x_rate, y_rate, z_rate, x_len, y_len, z_len
      real(real64), optional, intent(in) :: x, y, z

      call this%Mesh%resize(x_rate=x_rate, y_rate=y_rate, z_rate=z_rate, x_len=x_len, y_len=y_len, z_len=z_len)
      call this%Mesh%resize(x_len=x, y_len=y, z_len=z)

   end subroutine

   subroutine fatFEMDomain(this, ratio)
      class(FEMDomain_), intent(inout) :: this
      real(real64), intent(in) :: ratio
      real(real64), allocatable :: center(:), dx(:)
      integer(int32) :: i

      if (ratio < 0.0d0) then
         print *, "[CAUTION] fatFEMDomain >> ratio should be >= 0"
      end if

      center = zeros(this%nd())
      dx = zeros(this%nd())
      do i = 1, size(center)
         center(i) = average(this%mesh%nodcoord(:, i))
      end do

      do i = 1, this%nn()
         dx = this%mesh%nodcoord(i, :) - center
         this%mesh%nodcoord(i, :) = center(:) + (1.0d0 + ratio)*dx(:)
      end do
   end subroutine

!##################################################
   subroutine MergeFEMDomain(inobj1, inobj2, outobj)
      class(FEMDomain_), intent(in) ::inobj1, inobj2
      class(FEMDomain_), intent(out)::outobj

      call MergeMesh(inobj1%Mesh, inobj2%Mesh, outobj%Mesh)
      call MergeMaterialProp(inobj1%MaterialProp, inobj2%MaterialProp, outobj%MaterialProp)
      call MergeDBound(inobj1%Boundary, inobj1%Mesh, inobj2%Boundary, inobj2%Mesh, outobj%Boundary)
      call MergeNBound(inobj1%Boundary, inobj1%Mesh, inobj2%Boundary, inobj2%Mesh, outobj%Boundary)

   end subroutine MergeFEMDomain
!##################################################

   subroutine DeduplicateFEMDomain(this, error, num_removed_node)
      class(FEMDomain_), intent(inout) :: this
      real(real64), intent(in) :: error
      real(real64), allocatable :: nodcoord(:, :)
      integer(int32), optional, intent(inout) :: num_removed_node
      integer(int32) :: i, j, n
      logical, allocatable :: dup(:)
      integer(int32), allocatable :: num_dup
      integer(int32), allocatable :: old_id_to_new(:), same_as(:)
      ! if dupulicate node exists, merge them
      allocate (dup(this%nn()))
      allocate (same_as(this%nn()))
      old_id_to_new = int(zeros(this%nn()))
      dup(:) = .false.
      num_dup = 0
      ! O(n^2)
      do i = 1, this%nn() - 1
         if (dup(i)) cycle
         do j = i + 1, this%nn()
            if (dup(j)) cycle
            if (norm(this%mesh%nodcoord(i, :) - this%mesh%nodcoord(j, :)) < error) then
               dup(j) = .true.
               num_dup = num_dup + 1
               same_as(j) = i
            end if
         end do
      end do

      j = 0
      do i = 1, this%nn()
         if (dup(i)) then
            old_id_to_new(i) = old_id_to_new(same_as(i))
         else
            j = j + 1
            old_id_to_new(i) = j
         end if
      end do

      do i = 1, this%ne()
         do j = 1, this%nne()
            this%mesh%elemnod(i, j) = &
               old_id_to_new(this%mesh%elemnod(i, j))
         end do
      end do

      nodcoord = zeros(this%nn() - num_dup, this%nd())

      j = 0
      do i = 1, this%nn()
         if (dup(i)) then
            cycle
         else
            j = j + 1
            nodcoord(j, :) = this%mesh%nodcoord(i, :)
         end if
      end do
      if (present(num_removed_node)) then
         num_removed_node = num_dup
      end if
      this%mesh%nodcoord = nodcoord

   end subroutine

!##################################################
   subroutine ExportFEMDomain(this, OptionalFileFormat, OptionalProjectName, FileHandle, SolverType, MeshDimension, &
                              FileName, Name, regacy, with, path, extention, step, FieldValue, restart)
      class(FEMDomain_), intent(inout)::this
      class(FEMDomain_), optional, intent(inout)::with
      character(*), optional, intent(in)::OptionalFileFormat, path, extention
      character(*), optional, intent(in)::OptionalProjectName, SolverType, FileName
      character*4::FileFormat
      character(*), optional, intent(in) :: Name
      logical, optional, intent(in) :: regacy, restart
      character(:), allocatable::ProjectName
      character(:), allocatable ::iFileName
      real(real64), optional, intent(in) :: FieldValue(:, :)
      integer(int32), allocatable::IntMat(:, :)
      real(real64), allocatable::RealMat(:, :)
      integer(int32), optional, intent(in)::FileHandle, MeshDimension, step
      integer(int32) :: fh, i, j, k, n, m, DimNum, GpNum, nn
      character*70 Msg
      type(IO_) :: f

      if (present(restart)) then
         if (.not. present(path)) then
            print *, "FEMDomain ERROR :: .not.present(path)"
            stop
         end if

         call execute_command_line("mkdir -p "//path)
         call execute_command_line("mkdir -p "//path//"/FEMDomain")
         call this%Mesh%export(path=path//"/FEMDomain", restart=.true.)
         call this%MaterialProp%export(path=path//"/FEMDomain", restart=.true.)
         call this%Boundary%export(path=path//"/FEMDomain", restart=.true.)
         call this%ControlPara%export(path=path//"/FEMDomain", restart=.true.)
         call this%ShapeFunction%export(path=path//"/FEMDomain", restart=.true.)

         call f%open(path//"/FEMDomain"//"/FEMDomain"//".prop")
         write (f%fh, *) this%RealTime
         write (f%fh, *) this%NumOfDomain
         write (f%fh, '(A)') this%FilePath
         write (f%fh, '(A)') this%FileName
         write (f%fh, '(A)') this%name
         write (f%fh, '(A)') this%dtype
         write (f%fh, '(A)') this%SolverType
         write (f%fh, '(A)') this%Category1
         write (f%fh, '(A)') this%Category2
         write (f%fh, '(A)') this%Category3
         write (f%fh, *) this%timestep, this%NumberOfBoundaries, this%NumberOfMaterials
         call f%close()
         return
      end if

      if (present(regacy)) then
         if (regacy .eqv. .true.) then
            ! export as regacy mode
            ! request Name
            if (.not. present(Name)) then
               print *, "ExportFEMDomain :: please import Name"
               stop
            end if

            open (100, file=name)
            print *, "Exporting .scf file >>> ", name
            if (present(with)) then
               print *, "Mode :: contact problem"
               write (100, '(A)') "2"
               write (100, '(A)') "  "
               n = size(this%Mesh%NodCoord, 1)
               m = size(with%Mesh%NodCoord, 1)
               write (100, '(A)') "1  "//fstring(n)
               write (100, '(A)') fstring(n + 1)//"  "//fstring(n + m)
               write (100, '(A)') "  "
               n = size(this%Mesh%ElemNod, 1)
               m = size(with%Mesh%ElemNod, 1)
               write (100, '(A)') fstring(n)
               write (100, '(A)') fstring(n + m)
               write (100, '(A)') "  "
               n = size(this%Mesh%NodCoord, 1)
               m = size(this%Mesh%NodCoord, 2)
               write (100, *) size(this%Mesh%NodCoord, 1) + size(with%Mesh%NodCoord, 1)
               write (100, '(A)') "  "
               do i = 1, n
                  write (100, *) this%Mesh%NodCoord(i, :)
               end do
               n = size(with%Mesh%NodCoord, 1)
               m = size(with%Mesh%NodCoord, 2)
               do i = 1, n
                  write (100, *) with%Mesh%NodCoord(i, :)
               end do
               write (100, '(A)') "  "
               n = size(with%Mesh%ElemNod, 1) + size(this%Mesh%ElemNod, 1)
               m = size(this%Mesh%ElemNod, 2)
               write (100, *) fstring(n), "  ", fstring(m)
               n = size(this%Mesh%ElemNod, 1)
               m = size(this%Mesh%ElemNod, 2)
               write (100, '(A)') "  "
               do i = 1, n
                  write (100, *) this%Mesh%ElemNod(i, :)
               end do
               n = size(with%Mesh%ElemNod, 1)
               m = size(with%Mesh%ElemNod, 2)
               nn = size(this%Mesh%NodCoord, 1)
               do i = 1, n
                  write (100, *) with%Mesh%ElemNod(i, :) + nn
               end do
               print *, "Elem-mat"
               write (100, '(A)') "  "
               n = size(this%Mesh%ElemNod, 1)
               if (.not. allocated(this%Mesh%ElemMat)) then
                  allocate (this%Mesh%ElemMat(n))
                  this%Mesh%ElemMat(:) = 1
               end if
               write (100, '(A)') "  "

               do i = 1, n
                  write (100, *) this%Mesh%ElemMat(i)
               end do
               write (100, '(A)') "  "
               n = size(with%Mesh%ElemNod, 1)
               if (.not. allocated(with%Mesh%ElemMat)) then
                  allocate (with%Mesh%ElemMat(n))
                  with%Mesh%ElemMat(:) = 2
               end if
               write (100, '(A)') "  "
               do i = 1, n
                  write (100, *) with%Mesh%ElemMat(i)
               end do
               write (100, '(A)') "  "

               print *, "Material parameters will be put in here."
               write (100, *) size(this%MaterialProp%MatPara, 1)
               write (100, '(A)') "  "
               do i = 1, size(this%MaterialProp%MatPara, 1)
                  write (100, *) this%MaterialProp%MatPara(i, :)
               end do
               write (100, '(A)') "  "
               print *, "Dboundary will be put in here."

               ! count number of dirichlet condition for x
               n = 0
               do i = 1, size(this%Boundary%DBoundNodID, 1)
                  if (this%Boundary%DBoundNodID(i, 1) >= 1) then
                     n = n + 1
                  else
                     cycle
                  end if
               end do
               do i = 1, size(with%Boundary%DBoundNodID, 1)
                  if (with%Boundary%DBoundNodID(i, 1) >= 1) then
                     n = n + 1
                  else
                     cycle
                  end if
               end do
               ! count number of dirichlet condition for y
               m = 0
               do i = 1, size(this%Boundary%DBoundNodID, 1)
                  if (this%Boundary%DBoundNodID(i, 2) >= 1) then
                     m = m + 1
                  else
                     cycle
                  end if
               end do
               do i = 1, size(with%Boundary%DBoundNodID, 1)
                  if (with%Boundary%DBoundNodID(i, 2) >= 1) then
                     m = m + 1
                  else
                     cycle
                  end if
               end do
               ! write number of dirichlet condition for x and y
               write (100, *) n, m

               ! write out dirichlet boundary for x
               do i = 1, size(this%Boundary%DBoundNodID, 1)
                  if (this%Boundary%DBoundNodID(i, 1) >= 1) then
                     write (100, *) this%Boundary%DBoundNodID(i, 1)
                  else
                     cycle
                  end if
               end do
               do i = 1, size(with%Boundary%DBoundNodID, 1)
                  if (with%Boundary%DBoundNodID(i, 1) >= 1) then
                     write (100, *) with%Boundary%DBoundNodID(i, 1) + nn
                  else
                     cycle
                  end if
               end do
               write (100, '(A)') "  "

               ! write out value of dirichlet boundary for x
               do i = 1, size(this%Boundary%DBoundNodID, 1)
                  if (this%Boundary%DBoundNodID(i, 1) >= 1) then
                     write (100, *) this%Boundary%DBoundVal(i, 1)
                  else
                     cycle
                  end if
               end do
               do i = 1, size(with%Boundary%DBoundNodID, 1)
                  if (with%Boundary%DBoundNodID(i, 1) >= 1) then
                     write (100, *) with%Boundary%DBoundVal(i, 1)
                  else
                     cycle
                  end if
               end do
               write (100, '(A)') "  "

               ! write out dirichlet boundary for y
               do i = 1, size(this%Boundary%DBoundNodID, 1)
                  if (this%Boundary%DBoundNodID(i, 2) >= 1) then
                     write (100, *) this%Boundary%DBoundNodID(i, 2)
                  else
                     cycle
                  end if
               end do
               do i = 1, size(with%Boundary%DBoundNodID, 1)
                  if (with%Boundary%DBoundNodID(i, 2) >= 1) then
                     write (100, *) with%Boundary%DBoundNodID(i, 2) + nn
                  else
                     cycle
                  end if
               end do
               write (100, '(A)') "  "
               ! write outvalue of  dirichlet boundary for y
               do i = 1, size(this%Boundary%DBoundNodID, 1)
                  if (this%Boundary%DBoundNodID(i, 2) >= 1) then
                     write (100, *) this%Boundary%DBoundVal(i, 2)
                  else
                     cycle
                  end if
               end do
               do i = 1, size(with%Boundary%DBoundNodID, 1)
                  if (with%Boundary%DBoundNodID(i, 2) >= 1) then
                     write (100, *) with%Boundary%DBoundVal(i, 2)
                  else
                     cycle
                  end if
               end do
               write (100, '(A)') "  "

               if (.not. allocated(this%Boundary%NBoundNodID)) then
                  write (100, *) 0
               else
                  if (size(this%Boundary%NBoundNodID, 1) == 0) then
                     write (100, *) 0
                  else
                     print *, "ERROR :: ExportFEMDOmain :: Neumann boundary will be implemented."
                     stop
                  end if
               end if
               write (100, '(A)') "  "

               ! surface nodes
               ! count surface nodes
               n = 0
               n = size(this%Mesh%SurfaceLine2D) + size(with%Mesh%SurfaceLine2D)
               write (100, *) n
               write (100, '(A)') "  "

               do i = 1, size(this%Mesh%SurfaceLine2D)
                  write (100, *) this%Mesh%SurfaceLine2D(i)
               end do
               do i = 1, size(with%Mesh%SurfaceLine2D)
                  write (100, *) with%Mesh%SurfaceLine2D(i) + nn
               end do
               write (100, '(A)') "  "
               write (100, *) 1, size(this%Mesh%SurfaceLine2D)
               write (100, *) size(this%Mesh%SurfaceLine2D) + 1, size(this%Mesh%SurfaceLine2D) + size(with%Mesh%SurfaceLine2D)

               write (100, *) 0.010d0, 0.010d0
               write (100, *) 1, 1
               write (100, *) 1, n, 1
               write (100, *) 1
               write (100, *) 0.5000000000000E+05, 0.5000000000000E+05, 0.2402100000000E+01, 0.5404000000000E+00
               write (100, *) 1, 200, 1

            end if
            close (100)
            return

         end if
      end if

      if (present(OptionalFileFormat)) then
         if (OptionalFileFormat == "stl" .or. OptionalFileFormat == ".stl") then
            if (present(Name)) then
               call ExportFEMDomainAsSTL(this=this, &
                                         FileHandle=FileHandle, MeshDimension=MeshDimension, FileName=name)
            else
               call ExportFEMDomainAsSTL(this=this, &
                                         FileHandle=FileHandle, MeshDimension=MeshDimension, FileName=FileName)
            end if

            return
         end if
      end if

      ProjectName = ""
      iFileName = ""
      Msg = ""

      if (present(FileHandle)) then
         fh = FileHandle
      else
         fh = 104
      end if

      if (present(OptionalFileFormat)) then
         FileFormat = OptionalFileFormat
      else
         FileFormat = ".scf"
      end if

      if (present(OptionalProjectName)) then
         ProjectName = OptionalProjectName
      else
         ProjectName = "untitled"
      end if
      iFileName = ProjectName//FileFormat

    ! !print *, "Project : ",ProjectName
    ! !print *, "is Exported as : ",FileFormat," format"
    ! !print *, "File Name is : ",iFileName

      if (present(Name)) then
         open (fh, file=name//".scf", status="replace")
      else
         open (fh, file=iFileName, status="replace")
      end if

      if (FileFormat == ".scf") then

         if (allocated(this%Mesh%SubMeshNodFromTo)) then
            this%NumOfDomain = size(this%Mesh%SubMeshNodFromTo, 1)
         else
            this%NumOfDomain = 1
         end if

         this%Dtype = "domain"
         write (fh, '(A)') this%Dtype
         write (*, '(A)') this%Dtype, iFileName
         write (fh, *) "  "
         write (fh, '(A)') this%SolverType
         write (fh, *) "  "
         write (fh, *) this%NumOfDomain
         write (fh, *) "  "

         print *, "########### Meta Info ###########"
         print *, this%Dtype
         print *, this%SolverType
         print *, this%NumOfDomain
         print *, "########### Meta Info ###########"

         if (.not. allocated(this%Mesh%SubMeshNodFromTo)) then
            print *, "this%Mesh%SubMeshNodFromTo is not allocated"
            stop
         end if

         do i = 1, this%NumOfDomain
            write (fh, *) this%Mesh%SubMeshNodFromTo(i, 2), this%Mesh%SubMeshNodFromTo(i, 3)
         end do
         write (fh, *) "  "
         do i = 1, this%NumOfDomain
            write (fh, *) this%Mesh%SubMeshElemFromTo(i, 3)
         end do
         write (fh, *) "  "

         print *, "########### Domain info ###########"
         do i = 1, this%NumOfDomain
            !write(*,*) this%Mesh%SubMeshNodFromTo(i,2),this%Mesh%SubMeshNodFromTo(i,3)
         end do
         do i = 1, this%NumOfDomain
            !write(*,*) this%Mesh%SubMeshElemFromTo(i,3)
         end do

         print *, "########### Domain info ###########"

         n = size(this%Mesh%NodCoord, 1)
         m = size(this%Mesh%NodCoord, 2)
         if (present(MeshDimension)) then
            m = MeshDimension
         end if
         write (fh, *) n, m
         DimNum = m

         write (fh, *) "  "
         do i = 1, n
            write (fh, *) this%Mesh%NodCoord(i, 1:m)
         end do
         flush (fh)

         print *, " "
         print *, "########### Node info ###########"
         print *, "Number of node : ", n, "Dimension : ", m
         print *, "########### Node info ###########"
         print *, " "

         n = size(this%Mesh%ElemNod, 1)
         m = size(this%Mesh%ElemNod, 2)
         write (fh, *) n, m
         write (fh, *) "  "

         write (fh, '(A)') this%Mesh%getElemType()
         write (fh, *) "  "
         do i = 1, n
            write (fh, *) this%Mesh%ElemNod(i, :)
            if (this%Mesh%ElemNod(i, 1) == 0) then
               exit
            end if
         end do
         write (fh, *) "  "
         flush (fh)

         print *, " "
         print *, "########### Element info ###########"
         print *, "Element Type : ", this%Mesh%getElemType()
         print *, "Number of Element : ", n, "Number of node per element : ", m
         print *, "Successfully Exported"
         print *, "########### Element info ###########"
         print *, " "

         n = size(this%Mesh%ElemNod, 1)
         do i = 1, n
            write (fh, *) this%Mesh%ElemMat(i)
         end do
         write (fh, *) "  "

         n = size(this%MaterialProp%MatPara, 1)
         m = size(this%MaterialProp%MatPara, 2)
         write (fh, *) n, m
         do i = 1, n
            write (fh, *) this%MaterialProp%MatPara(i, :)
         end do
         write (fh, *) "  "
         flush (fh)

         print *, "########### Material info ###########"
         n = size(this%Mesh%ElemNod, 1)
         !write(*,*) size(this%Mesh%ElemMat,1)
         n = size(this%MaterialProp%MatPara, 1)
         m = size(this%MaterialProp%MatPara, 2)
         !write(*,*) n,m
         do i = 1, n
            write (*, *) this%MaterialProp%MatPara(i, :)
         end do
         print *, "Successfully Exported"
         print *, "########### Material info ###########"

         !DirichletBoundary

         if (.not. allocated(this%Boundary%DBoundNodID)) then

            write (fh, *) "0" !DirichletBoundaryDimension
            write (fh, *) "  "
            print *, "ImportFEMDomain >> Caution :: no Dirichlet Boundary Condition is loaded. "
            stop
         else
            ! update this%Boundary%DBoundNum
            if (allocated(this%Boundary%DBoundNum)) then
               deallocate (this%Boundary%DBoundNum)
            end if
            n = size(this%Boundary%DBoundNodID, 2)
            allocate (this%Boundary%DBoundNum(n))
            m = size(this%Boundary%DBoundNodID, 1)
            do i = 1, n
               this%Boundary%DBoundNum(i) = m - countif(Array=this%Boundary%DBoundNodID(:, i), Equal=.true., Value=-1)
            end do

            n = size(this%Boundary%DBoundNum)
            write (fh, *) n !DirichletBoundaryDimension
            write (fh, *) "  "

            !allocate(this%Boundary%DBoundNum(n ))
            write (fh, *) this%Boundary%DBoundNum(:)
            write (fh, *) "  "
            !allocate(this%Boundary%DBoundNodID( maxval(this%Boundary%DBoundNum), size(this%Boundary%DBoundNum)  )  )
            !allocate(this%Boundary%DBoundVal( maxval(this%Boundary%DBoundNum), size(this%Boundary%DBoundNum)  )  )

            !this%Boundary%DBoundNodID(:,:)=-1
            !this%Boundary%DBoundVal(:,:)  =0.0d0

            do i = 1, size(this%Boundary%DBoundNum, 1)
               do j = 1, this%Boundary%DBoundNum(i)
                  write (fh, *) this%Boundary%DBoundNodID(j, i)
                    ! !print *,this%Boundary%DBoundNodID(j,i)
               end do
               write (fh, *) "  "
               do j = 1, this%Boundary%DBoundNum(i)
                  write (fh, *) this%Boundary%DBoundVal(j, i)
                    ! !print *,this%Boundary%DBoundVal(j,i)
               end do
               write (fh, *) "  "
            end do

         end if

         print *, "########### Dirichlet Boundary info ###########"
         if (.not. allocated(this%Boundary%DBoundNum)) then

            write (*, *) "0" !DirichletBoundaryDimension
            write (*, *) "  "
            stop "ERROR :: FEMDomainClass :: no Dirichlet boundary is found"
            !print *, "ImportFEMDomain >> Caution :: no Dirichlet Boundary Condition is loaded. "
         else

            n = size(this%Boundary%DBoundNum)
            !write(*,*) n !DirichletBoundaryDimension
            !write(*,*) "  "

            !allocate(this%Boundary%DBoundNum(n ))
            !write(*,*) this%Boundary%DBoundNum(:)
            !write(*,*) "  "
            !allocate(this%Boundary%DBoundNodID( maxval(this%Boundary%DBoundNum), size(this%Boundary%DBoundNum)  )  )
            !allocate(this%Boundary%DBoundVal( maxval(this%Boundary%DBoundNum), size(this%Boundary%DBoundNum)  )  )

            !this%Boundary%DBoundNodID(:,:)=-1
            !this%Boundary%DBoundVal(:,:)  =0.0d0

            do i = 1, size(this%Boundary%DBoundNum, 1)
               do j = 1, this%Boundary%DBoundNum(i)
                  !write(*,*) this%Boundary%DBoundNodID(j,i)
                    ! !print *,this%Boundary%DBoundNodID(j,i)
               end do
               !write(*,*) "  "
               do j = 1, this%Boundary%DBoundNum(i)
                  !write(*,*) this%Boundary%DBoundVal(j,i)
                    ! !print *,this%Boundary%DBoundVal(j,i)
               end do
               !write(*,*) "  "
            end do

         end if

         print *, "Successfully Exported"
         print *, "########### Dirichlet Boundary info ###########"

         if (.not. allocated(this%Boundary%NBoundNum)) then
            DimNum = 0
         else
            DimNum = size(this%Boundary%NBoundNum, 1)
         end if

         write (fh, *) DimNum
         write (fh, *) "  "
         if (DimNum <= 0) then
            !print *, "ImportFEMDomain >> Caution :: no Neumann Boundary Condition is loaded. "
         else
            n = size(this%Boundary%NBoundNodID, 1)
            write (fh, *) n
            write (fh, *) "  "
            !allocate( this%Boundary%NBoundNum(DimNum))
            !allocate(this%Boundary%NBoundNodID(n, size(this%Boundary%NBoundNum)  )  )
            !allocate(this%Boundary%NBoundVal( n, size(this%Boundary%NBoundNum)  )  )
            !this%Boundary%NBoundNodID(:,:)=-1
            !this%Boundary%NBoundVal(:,:)  =0.0d0

            !this%Boundary%NBoundNum(:)=n
            do i = 1, n
               write (fh, *) this%Boundary%NBoundNodID(i, :)
               !this%Boundary%NBoundNodID(i,:)=m
            end do
            write (fh, *) "  "

            do i = 1, n
               write (fh, *) this%Boundary%NBoundVal(i, :)
            end do
            write (fh, *) "  "

         end if

         print *, "########### Neumann Boundary info ###########"

         if (.not. allocated(this%Boundary%NBoundNum)) then
            DimNum = 0
         else
            DimNum = size(this%Boundary%NBoundNum, 1)
         end if
         !write(*,*) DimNum
         !write(*,*) "  "
         if (DimNum <= 0) then
            !print *, "ImportFEMDomain >> Caution :: no Neumann Boundary Condition is loaded. "
         else
            n = size(this%Boundary%NBoundNodID, 1)
            !write(*,*) n
            !write(*,*) "  "
            !allocate( this%Boundary%NBoundNum(DimNum))
            !allocate(this%Boundary%NBoundNodID(n, size(this%Boundary%NBoundNum)  )  )
            !allocate(this%Boundary%NBoundVal( n, size(this%Boundary%NBoundNum)  )  )
            !this%Boundary%NBoundNodID(:,:)=-1
            !this%Boundary%NBoundVal(:,:)  =0.0d0

            !this%Boundary%NBoundNum(:)=n
            do i = 1, n
               !write(*,*) this%Boundary%NBoundNodID(i,:)
               !this%Boundary%NBoundNodID(i,:)=m
            end do
            !write(*,*) "  "

            do i = 1, n
               !write(*,*) this%Boundary%NBoundVal(i,:)
            end do
            !write(*,*) "  "

         end if
         print *, "Successfully Exported"
         print *, "########### Neumann Boundary info ###########"

         print *, "########### Initial Condition info ###########"

         !######### Initial conditions #################
         ! For node-wize

         if (.not. allocated(this%Boundary%TBoundVal)) then
            DimNum = 0
         else
            DimNum = size(this%Boundary%TBoundVal, 2)
         end if
         write (fh, *) DimNum
         write (fh, *) "  "

         if (DimNum <= 0) then
            !print *, "Caution :: no Initial Condition (Node-wise) Condition is loaded. "
         else
            n = size(this%Boundary%TBoundVal, 1)
            write (fh, *) n
            write (fh, *) "  "
            !allocate(this%Boundary%TBoundNodID(n,DimNum) )
            !allocate(this%Boundary%TBoundVal(  n,DimNum) )
            !allocate(this%Boundary%TBoundNum(  DimNum) )

            !this%Boundary%TBoundNum(:)=n

            if (n /= 0) then
               if (n < 0) then
                  print *, "ERROR :: number of initial conditions are to be zero"
               else
                  do i = 1, n
                     write (fh, *) this%Boundary%TBoundNodID(i, :)
                  end do
                  write (fh, *) "  "
                  do i = 1, n
                     write (fh, *) this%Boundary%TBoundVal(i, :)
                  end do
                  write (fh, *) "  "
               end if
            end if
         end if
         !######### Initial conditions #################

         print *, "Successfully Exported"
         print *, "########### Initial Condition info ###########"

         print *, "########### Initial Condition (Element-wize) info ###########"
         !######### Initial conditions #################
         ! For ElementGP-wize
         if (.not. allocated(this%Boundary%TBoundElemGpVal)) then
            DimNum = 0
         else
            DimNum = size(this%Boundary%TBoundElemGpVal, 3)
         end if

         write (fh, *) DimNum
         write (fh, *) "  "
         if (DimNum <= 0) then
            !print *, "Caution :: no Initial Condition (Gp) is loaded. "
         else
            !write(fh,*)
            GpNum = size(this%Boundary%TBoundElemGpVal, 2)
            write (fh, *) GpNum
            write (fh, *) "  "
            !write(fh,*)
            n = size(this%Boundary%TBoundElemGpVal, 1)
            write (fh, *) n
            write (fh, *) "  "
            !allocate(this%Boundary%TBoundElemID(n) )
            !allocate(this%Boundary%TBoundElemGpVal(n,GpNum,DimNum) )

            if (n /= 0) then
               if (n < 0) then
                  print *, "ERROR :: number of initial conditions are to be zero"
               else
                  do i = 1, n
                     write (fh, *) this%Boundary%TBoundElemID(i)
                  end do
                  write (fh, *) "  "
                  do i = 1, n
                     do j = 1, GpNum
                        do k = 1, DimNum
                           write (fh, *) this%Boundary%TBoundElemGpVal(i, j, k)
                        end do
                     end do
                  end do
                  write (fh, *) "  "
               end if
            end if

         end if
         !######### Initial conditions #################

         print *, "Successfully Exported"
         print *, "########### Initial Condition (Element-wize) info ###########"

         write (fh, *) this%ControlPara%SimMode, this%ControlPara%ItrTol, this%ControlPara%Timestep
         flush (fh)
         close (fh)
      else
         print *, "ERROR :: ExportFEMDomain >> only .scf file can be exported."
      end if

   end subroutine ExportFEMDomain
!##################################################

!##################################################
   subroutine InitDBC(this, NumOfValPerNod)
      class(FEMDomain_), intent(inout)::this
      integer(int32), intent(in) :: NumOfValPerNod

      integer(int32) :: n, m
      !if the facet is not created, create facets (surface elements)
      
      ! this subroutine has bugs.
      ! 
      call GetSurface(this%Mesh)


      n = size(this%Mesh%FacetElemNod, 1)
      m = size(this%Mesh%FacetElemNod, 2)

      if (allocated(this%Boundary%DBoundNum)) then
         deallocate (this%Boundary%DBoundNum)
      end if

      if (allocated(this%Boundary%DBoundNodID)) then
         deallocate (this%Boundary%DBoundNodID)
      end if

      if (allocated(this%Boundary%DBoundVal)) then
         deallocate (this%Boundary%DBoundVal)
      end if

      allocate (this%Boundary%DBoundNum(NumOfValPerNod))
      this%Boundary%DBoundNum(:) = 0
      allocate (this%Boundary%DBoundNodID(n*m, NumOfValPerNod))
      this%Boundary%DBoundNodID(:, :) = -1
      allocate (this%Boundary%DBoundVal(n*m, NumOfValPerNod))
      this%Boundary%DBoundVal(:, :) = 0.0d0


   end subroutine
!##################################################

!##################################################
   subroutine AddDBoundCondition(this, xmin, xmax, ymin, ymax, zmin, zmax, &
                                 tmin, tmax, valx, valy, valz, val, val_id, NumOfValPerNod, Mode2D)
      class(FEMDomain_), intent(inout)::this
      real(real64), optional, intent(in)::xmin, xmax
      real(real64), optional, intent(in)::ymin, ymax
      real(real64), optional, intent(in)::zmin, zmax
      real(real64), optional, intent(in)::tmin, tmax
      real(real64), optional, intent(in)::val
      integer(int32), optional, intent(in)::val_id, NumOfValPerNod
      real(real64)::x_min, x_max
      real(real64)::y_min, y_max
      real(real64)::z_min, z_max
      real(real64)::t_min, t_max

      real(real64), optional, intent(in)::valx, valy, valz

      logical, optional, intent(in) :: Mode2D
      logical :: InOut
      real(real64) :: minline, maxline, SetDBCound(3)
      integer(int32), allocatable::DBoundNodIDBuf(:, :), CopiedArrayInt(:, :)
      real(real64), allocatable::DBoundValBuf(:, :), CopiedArrayReal(:, :), x(:), rmin(:), rmax(:)
      integer(int32) :: countnum, i, j, k, node_id, n, m, NumVN, newboundnum, ValID, count_n, dim_num

      if (present(val_id)) then
         ValID = val_id
      else
         ValID = 1
      end if

      if (present(NumOfValPerNod)) then
         NumVN = NumOfValPerNod
      else
         NumVN = 3
      end if

      n = size(this%Mesh%NodCoord, 2)
      dim_num = n

      if (present(Mode2D)) then
         if (Mode2D .eqv. .true.) then
            allocate (x(3))
            allocate (rmin(3))
            allocate (rmax(3))
         else
            allocate (x(3))
            allocate (rmin(3))
            allocate (rmax(3))
         end if
      elseif (n == 2) then
         allocate (x(3))
         allocate (rmin(3))
         allocate (rmax(3))
      else
         allocate (x(3))
         allocate (rmin(3))
         allocate (rmax(3))
      end if
      if (.not. present(xmin)) then
         x_min = -1.0e+14

      else
         x_min = xmin
      end if
      if (.not. present(xmax)) then
         x_max = 1.0e+14
      else
         x_max = xmax
      end if

      if (.not. present(ymin)) then
         y_min = -1.0e+14
      else
         y_min = ymin
      end if
      if (.not. present(ymax)) then
         y_max = 1.0e+14
      else
         y_max = ymax
      end if

      if (.not. present(zmin)) then
         z_min = -1.0e+14
      else
         z_min = zmin

      end if
      if (.not. present(zmax)) then
         z_max = 1.0e+14
      else
         z_max = zmax
      end if

      if (.not. present(tmin)) then
         t_min = -1.0e+14
      else
         t_min = tmin
      end if
      if (.not. present(tmax)) then
         t_max = 1.0e+14
      else
         t_max = tmax
      end if

      !print *, "Range is : ",x_max,x_min,y_max,y_min,z_max,z_min,t_max,t_min

      ! get node ID and value

      !if the facet is not created, create facets (surface elements)

      if (.not. allocated(this%Mesh%FacetElemNod)) then
         call this%InitDBC(NumOfValPerNod)
         print *, "add dbc :: initialized"
      end if

      if (.not. allocated(this%Boundary%DBoundNodID)) then
         call this%InitDBC(NumOfValPerNod)
      end if
      rmin(1) = x_min
      rmin(2) = y_min
      rmin(3) = z_min

      rmax(1) = x_max
      rmax(2) = y_max
      rmax(3) = z_max

      n = size(this%Mesh%FacetElemNod, 1)
      m = size(this%Mesh%FacetElemNod, 2)
      count_n = 0

      if (.not. allocated(this%Boundary%DBoundNum)) then
         i = size(this%Boundary%DBoundNodID, 2)
         allocate (this%Boundary%DBoundNum(i))
      end if

      do i = 1, size(this%Mesh%FacetElemNod, 1)
         do j = 1, size(this%Mesh%FacetElemNod, 2)
            if (this%Mesh%FacetElemNod(i, j) > size(this%Mesh%NodCoord, 1)) then
               print *, "ERROR :: this%Mesh%FacetElemNod is out of range"
               print *, "Number of nodes: ", size(this%Mesh%NodCoord, 1), &
                  "this%Mesh%FacetElemNod(i,j) is ", this%Mesh%FacetElemNod(i, j)
               stop
            end if
            x(:) = 0.0d0
            x(1:dim_num) = this%Mesh%NodCoord(this%Mesh%FacetElemNod(i, j), 1:dim_num)
            InOut = InOrOut(x, rmax, rmin)
            if (InOut .eqv. .true.) then
               if ((i - 1)*m + j > n*m) then
                  stop "sgdssdfssssssssssssss"
               end if
               count_n = count_n + 1
               if (size(this%Boundary%DBoundNodID, 1) < (i - 1)*m + j) then
                  print *, "ERROR :: this%Boundary%DBoundNodID is out of range"
                  print *, size(this%Boundary%DBoundNodID, 1), size(this%Boundary%DBoundNodID, 2), size(this%Mesh%NodCoord, 1), &
                     ValID, this%Mesh%FacetElemNod(i, j)
                  stop
               end if
               this%Boundary%DBoundNum(ValID) = this%Boundary%DBoundNum(ValID) + 1
               this%Boundary%DBoundNodID((i - 1)*m + j, ValID) = this%Mesh%FacetElemNod(i, j)
               this%Boundary%DBoundVal((i - 1)*m + j, ValID) = val
            end if

         end do

      end do

      print *, "Total ", count_n, "boundary conditions are set"

   end subroutine AddDBoundCondition
!##################################################

!##################################################
   subroutine InitNBC(this, NumOfValPerNod)
      class(FEMDomain_), intent(inout)::this
      integer(int32), intent(in) :: NumOfValPerNod

      integer(int32) :: n, m
      !if the facet is not created, create facets (surface elements)
      if (.not. allocated(this%Mesh%FacetElemNod)) then
         call GetSurface(this%Mesh)
      end if

      n = size(this%Mesh%FacetElemNod, 1)
      m = size(this%Mesh%FacetElemNod, 2)

      if (allocated(this%Boundary%NBoundNum)) then
         deallocate (this%Boundary%NBoundNum)
      end if

      if (allocated(this%Boundary%NBoundNodID)) then
         deallocate (this%Boundary%NBoundNodID)
      end if

      if (allocated(this%Boundary%NBoundVal)) then
         deallocate (this%Boundary%NBoundVal)
      end if

      allocate (this%Boundary%NBoundNum(NumOfValPerNod))
      this%Boundary%NBoundNum(:) = 0
      allocate (this%Boundary%NBoundNodID(n*m, NumOfValPerNod))
      this%Boundary%NBoundNodID(:, :) = -1
      allocate (this%Boundary%NBoundVal(n*m, NumOfValPerNod))
      this%Boundary%NBoundVal(:, :) = 0.0d0

      return

   end subroutine
!##################################################

!##################################################
   subroutine AddNBoundCondition(this, xmin, xmax, ymin, ymax, zmin, zmax, &
                                 tmin, tmax, valx, valy, valz, val, val_id, NumOfValPerNod, Mode2D)
      class(FEMDomain_), intent(inout)::this
      real(real64), optional, intent(in)::xmin, xmax
      real(real64), optional, intent(in)::ymin, ymax
      real(real64), optional, intent(in)::zmin, zmax
      real(real64), optional, intent(in)::tmin, tmax
      real(real64), optional, intent(in)::val
      integer(int32), optional, intent(in)::val_id, NumOfValPerNod
      real(real64)::x_min, x_max
      real(real64)::y_min, y_max
      real(real64)::z_min, z_max
      real(real64)::t_min, t_max, area
      type(Triangle_) :: tobj

      real(real64), optional, intent(in)::valx, valy, valz

      logical, optional, intent(in) :: Mode2D
      logical :: InOut
      real(real64) :: minline, maxline, SetDBCound(3)
      integer(int32), allocatable::NBoundNodINBuf(:, :), CopiedArrayInt(:, :)
      real(real64), allocatable::NBoundValBuf(:, :), CopiedArrayReal(:, :), x(:), rmin(:), rmax(:)
      integer(int32) :: countnum, i, j, k, node_id, n, m, NumVN, newboundnum, ValID, dim, nodenum

      if (present(val_id)) then
         ValID = val_id
      else
         ValID = 1
      end if

      if (present(NumOfValPerNod)) then
         NumVN = NumOfValPerNod
      else
         NumVN = 3
      end if

      n = size(this%Mesh%NodCoord, 2)

      if (present(Mode2D)) then
         if (Mode2D .eqv. .true.) then
            allocate (x(2))
            allocate (rmin(3))
            allocate (rmax(3))
         else
            allocate (x(3))
            allocate (rmin(3))
            allocate (rmax(3))
         end if
      elseif (n == 2) then
         allocate (x(2))
         allocate (rmin(3))
         allocate (rmax(3))
      else
         allocate (x(3))
         allocate (rmin(3))
         allocate (rmax(3))
      end if

      if (.not. present(xmin)) then
         x_min = -1.0e+14

      else
         x_min = xmin
      end if
      if (.not. present(xmax)) then
         x_max = 1.0e+14
      else
         x_max = xmax
      end if

      if (.not. present(ymin)) then
         y_min = -1.0e+14
      else
         y_min = ymin
      end if
      if (.not. present(ymax)) then
         y_max = 1.0e+14
      else
         y_max = ymax
      end if

      if (.not. present(zmin)) then
         z_min = -1.0e+14
      else
         z_min = zmin

      end if

      if (.not. present(zmax)) then
         z_max = 1.0e+14
      else
         z_max = zmax
      end if

      if (.not. present(tmin)) then
         t_min = -1.0e+14
      else
         t_min = tmin
      end if
      if (.not. present(tmax)) then
         t_max = 1.0e+14
      else
         t_max = tmax
      end if

      ! get node ID and value

      !if the facet is not created, create facets (surface elements)

      if (.not. allocated(this%Mesh%FacetElemNod)) then
         call this%InitNBC(NumOfValPerNod)

      end if

      rmin(1) = x_min
      rmin(2) = y_min
      rmin(3) = z_min

      rmax(1) = x_max
      rmax(2) = y_max
      rmax(3) = z_max
      n = size(this%Mesh%FacetElemNod, 1)
      m = size(this%Mesh%FacetElemNod, 2)

      do i = 1, size(this%Mesh%FacetElemNod, 1)
         do j = 1, size(this%Mesh%FacetElemNod, 2)
            x(:) = this%Mesh%NodCoord(this%Mesh%FacetElemNod(i, j), :)
            InOut = InOrOut(x, rmax, rmin)
            if (InOut .eqv. .true.) then
               if ((i - 1)*m + j > n*m) then
                  stop "sgdssdfssssssssssssss"
               end if
               this%Boundary%NBoundNum(ValID) = this%Boundary%NBoundNum(ValID) + 1
               this%Boundary%NBoundNodID((i - 1)*m + j, ValID) = this%Mesh%FacetElemNod(i, j)
               nodenum = size(this%Mesh%ElemNod, 2)
               if (nodenum == 3) then
                  call tobj%init(dim=3)
                  tobj%NodCoord(1, 1:3) = &
                     this%Mesh%NodCoord(this%Mesh%FacetElemNod(i, 1), 1:3)
                  tobj%NodCoord(2, 1:3) = &
                     this%Mesh%NodCoord(this%Mesh%FacetElemNod(i, 1), 1:3)
                  tobj%NodCoord(3, 1:3) = &
                     this%Mesh%NodCoord(this%Mesh%FacetElemNod(i, 1), 1:3)
                  area = tobj%getArea()
               elseif (nodenum >= 4) then
                  nodenum = 4
                  call tobj%init(dim=3)
                  tobj%NodCoord(1, 1:3) = &
                     this%Mesh%NodCoord(this%Mesh%FacetElemNod(i, 1), 1:3)
                  tobj%NodCoord(2, 1:3) = &
                     this%Mesh%NodCoord(this%Mesh%FacetElemNod(i, 2), 1:3)
                  tobj%NodCoord(3, 1:3) = &
                     this%Mesh%NodCoord(this%Mesh%FacetElemNod(i, 3), 1:3)
                  area = tobj%getArea()
                  call tobj%init(dim=3)
                  tobj%NodCoord(1, 1:3) = &
                     this%Mesh%NodCoord(this%Mesh%FacetElemNod(i, 2), 1:3)
                  tobj%NodCoord(2, 1:3) = &
                     this%Mesh%NodCoord(this%Mesh%FacetElemNod(i, 3), 1:3)
                  tobj%NodCoord(3, 1:3) = &
                     this%Mesh%NodCoord(this%Mesh%FacetElemNod(i, 4), 1:3)
                  area = area + tobj%getArea()
               else
                  print *, "ERROR :: Node num = ", nodenum, "is not implemented."
                  stop
               end if
               if (area == 0.0d0 .or. area /= area) then
                  print *, "area==0.0d0 .or. area/=area"
                  stop
               end if
               this%Boundary%NBoundVal((i - 1)*m + j, ValID) = val*area/dble(nodenum)
            end if
         end do
      end do
      return

!
!    if(.not.present(valx) ) then
!        SetNBCound(1)=0.0d0
!    else
!        SetNBCound(1)=valx
!    endif
!    if(.not.present(valy) ) then
!        SetNBCound(2)=0.0d0
!    else
!        SetNBCound(2)=valy
!    endif
!    if(.not.present(valz) ) then
!        SetNBCound(3)=0.0d0
!    else
!        SetNBCound(3)=valz
!    endif
!
!
!    allocate(NBoundNodINBuf(size(this%Mesh%SurfaceLine2D),size(this%Boundary%NBoundNodID,2) ) )
!    allocate(NBoundValBuf  (size(this%Mesh%SurfaceLine2D),size(this%Boundary%NBoundNodID,2) ) )
!
!    NBoundNodINBuf(:,:) = -1
!    NBoundValBuf(:,:)   = -1.0d0
!
!
!    k=0
!    do i=1,size(this%Mesh%SurfaceLine2D,1)
!        countnum=0
!        node_id=this%Mesh%SurfaceLine2D(i)
!
!        do j=1,size(this%Mesh%NodCoord,2)
!            if(j==1)then
!                minline=x_min
!                maxline=x_max
!            elseif(j==2)then
!                minline=y_min
!                maxline=y_max
!            elseif(j==3)then
!                minline=z_min
!                maxline=z_max
!            elseif(j==4)then
!                minline=t_min
!                maxline=t_max
!            else
!                !print *, "ERROR :: EditClass >> AddNBoundCondition >> dimension should 0 < d < 5"
!            endif
!            if(minline <= this%Mesh%NodCoord(node_id,j) .and. this%Mesh%NodCoord(node_id,j) <= maxline )then
!                countnum=countnum+1
!            endif
!        enddo
!
!        if(countnum==size(this%Mesh%NodCoord,2))then
!            k=k+1
!            do j=1,size(this%Mesh%NodCoord,2)
!                if(j==1)then
!                    if(.not.present(valx) ) then
!                        NBoundNodINBuf(k,1)=-1
!                    else
!                        NBoundNodINBuf(k,1)=node_id
!                        NBoundValBuf(k,1)=valx
!                    endif
!                elseif(j==2)then
!                    if(.not.present(valy) ) then
!                        NBoundNodINBuf(k,2)=-1
!                    else
!                        NBoundNodINBuf(k,2)=node_id
!                        NBoundValBuf(k,2)=valy
!                    endif
!                elseif(j==3)then
!                    if(.not.present(valz) ) then
!                        NBoundNodINBuf(k,3)=-1
!                    else
!                        NBoundNodINBuf(k,3)=node_id
!                        NBoundValBuf(k,3)=valz
!                    endif
!                else
!                    stop "EditClass >Time domain is not implemented "
!                endif
!            enddo
!        endif
!    enddo
!
!
!
!    ! MergeArray
!
!    call TrimArray(DBoundNodIDBuf,k)
!    call TrimArray(DBoundValBuf,k)
!    call CopyArray(this%Boundary%DBoundNodID,CopiedArrayInt)
!    call CopyArray(this%Boundary%DBoundVal,CopiedArrayReal)
!    call MergeArray(CopiedArrayInt,DBoundNodIDBuf,this%Boundary%DBoundNodID)
!    call MergeArray(CopiedArrayReal,DBoundValBuf,this%Boundary%DBoundVal)
!
!    call DeleteOverlapBoundary(this%Boundary)

   end subroutine AddNBoundCondition
!##################################################

!##################################################
   subroutine InitTBC(this, NumOfValPerNod)
      class(FEMDomain_), intent(inout)::this
      integer(int32), intent(in) :: NumOfValPerNod

      integer(int32) :: n, m
      !if the facet is not created, create facets (surface elements)
      if (.not. allocated(this%Mesh%FacetElemNod)) then
         call GetSurface(this%Mesh)
      end if
      n = size(this%Mesh%NodCoord, 1)
      m = size(this%Mesh%NodCoord, 2)

      if (allocated(this%Boundary%TBoundNum)) then
         deallocate (this%Boundary%TBoundNum)
      end if

      if (allocated(this%Boundary%TBoundNodID)) then
         deallocate (this%Boundary%TBoundNodID)
      end if

      if (allocated(this%Boundary%TBoundVal)) then
         deallocate (this%Boundary%TBoundVal)
      end if

      allocate (this%Boundary%TBoundNum(NumOfValPerNod))
      this%Boundary%TBoundNum(:) = 0
      allocate (this%Boundary%TBoundNodID(n, NumOfValPerNod))
      this%Boundary%TBoundNodID(:, :) = -1
      allocate (this%Boundary%TBoundVal(n, NumOfValPerNod))
      this%Boundary%TBoundVal(:, :) = 0.0d0

      return

   end subroutine
!##################################################

!##################################################
   subroutine AddTBoundCondition(this, xmin, xmax, ymin, ymax, zmin, zmax, &
                                 tmin, tmax, valx, valy, valz, val, val_id, NumOfValPerNod, Mode2D)
      class(FEMDomain_), intent(inout)::this
      real(real64), optional, intent(in)::xmin, xmax
      real(real64), optional, intent(in)::ymin, ymax
      real(real64), optional, intent(in)::zmin, zmax
      real(real64), optional, intent(in)::tmin, tmax
      real(real64), optional, intent(in)::val
      integer(int32), optional, intent(in)::val_id, NumOfValPerNod
      real(real64)::x_min, x_max
      real(real64)::y_min, y_max
      real(real64)::z_min, z_max
      real(real64)::t_min, t_max

      real(real64), optional, intent(in)::valx, valy, valz

      logical, optional, intent(in) :: Mode2D
      logical :: InOut
      real(real64) :: minline, maxline, SetDBCound(3)
      integer(int32), allocatable::TBoundNodITBuf(:, :), CopiedArrayInt(:, :)
      real(real64), allocatable::TBoundValBuf(:, :), CopiedArrayReal(:, :), x(:), rmin(:), rmax(:)
      integer(int32) :: countnum, i, j, k, node_id, n, m, NumVN, newboundnum, ValID, count_n

      if (present(val_id)) then
         ValID = val_id
      else
         ValID = 1
      end if

      if (present(NumOfValPerNod)) then
         NumVN = NumOfValPerNod
      else
         NumVN = 3
      end if

      n = size(this%Mesh%NodCoord, 2)

      if (present(Mode2D)) then
         if (Mode2D .eqv. .true.) then
            allocate (x(2))
            allocate (rmin(3))
            allocate (rmax(3))
         else
            allocate (x(3))
            allocate (rmin(3))
            allocate (rmax(3))
         end if
      elseif (n == 2) then
         allocate (x(2))
         allocate (rmin(3))
         allocate (rmax(3))
      else
         allocate (x(3))
         allocate (rmin(3))
         allocate (rmax(3))
      end if

      if (.not. present(xmin)) then
         x_min = -1.0e+14

      else
         x_min = xmin
      end if
      if (.not. present(xmax)) then
         x_max = 1.0e+14
      else
         x_max = xmax
      end if

      if (.not. present(ymin)) then
         y_min = -1.0e+14
      else
         y_min = ymin
      end if
      if (.not. present(ymax)) then
         y_max = 1.0e+14
      else
         y_max = ymax
      end if

      if (.not. present(zmin)) then
         z_min = -1.0e+14
      else
         z_min = zmin

      end if
      if (.not. present(zmax)) then
         z_max = 1.0e+14
      else
         z_max = zmax
      end if

      if (.not. present(tmin)) then
         t_min = -1.0e+14
      else
         t_min = tmin
      end if
      if (.not. present(tmax)) then
         t_max = 1.0e+14
      else
         t_max = tmax
      end if

      ! get node ID and value

      !if the facet is not created, create facets (surface elements)

      if (size(this%Mesh%NodCoord, 1) /= size(this%Boundary%TBoundNodID, 1)) then
         call this%InitTBC(NumOfValPerNod)
         print *, "sifdh"
      end if

      rmin(1) = x_min
      rmin(2) = y_min
      rmin(3) = z_min

      rmax(1) = x_max
      rmax(2) = y_max
      rmax(3) = z_max
      n = size(this%Mesh%NodCoord, 1)

      count_n = 0
      do i = 1, n
         x(:) = this%Mesh%NodCoord(i, :)
         InOut = InOrOut(x, rmax, rmin)
         if (InOut .eqv. .true.) then
            count_n = count_n + 1
            this%Boundary%TBoundNum(ValID) = this%Boundary%TBoundNum(ValID) + 1
            this%Boundary%TBoundNodID(i, ValID) = i
            this%Boundary%TBoundVal(i, ValID) = val
         end if

      end do
      print *, "Initial value is in : ", count_n, "value is : ", val
      return

   end subroutine AddTBoundCondition
!##################################################

! !##################################################
!subroutine AddNBoundCondition(this,xmin,xmax,ymin,ymax,zmin,zmax,&
!    tmin,tmax,valx,valy,valz)
!    class(FEMDomain_),intent(inout)::this
!    real(real64),optional,intent(in)::xmin,xmax
!    real(real64),optional,intent(in)::ymin,ymax
!    real(real64),optional,intent(in)::zmin,zmax
!    real(real64),optional,intent(in)::tmin,tmax
!    real(real64)::x_min,x_max
!    real(real64)::y_min,y_max
!    real(real64)::z_min,z_max
!    real(real64)::t_min,t_max
!
!    real(real64),optional,intent(in)::valx,valy,valz
!
!    real(real64) :: minline,maxline,SetNBCound(3)
!    integer(int32),allocatable::NBoundNodIDBuf(:,:),CopiedArrayInt(:,:)
!    real(real64),allocatable::NBoundValBuf(:,:),CopiedArrayReal(:,:)
!    integer(int32) :: countnum,i,j,k,node_id
!
!
!
!
!
!
!    if(.not.present(xmin) ) then
!        x_min = -1.0e+14
!    else
!        x_min=xmin
!    endif
!    if(.not.present(xmax) ) then
!        x_max = 1.0e+14
!    else
!        x_max=xmax
!    endif
!
!    if(.not.present(ymin) ) then
!        y_min = -1.0e+14
!    else
!        y_min=ymin
!    endif
!    if(.not.present(ymax) ) then
!        y_max = 1.0e+14
!    else
!        y_max=ymax
!    endif
!
!    if(.not.present(zmin) ) then
!        z_min = -1.0e+14
!    else
!        z_min = zmin
!
!    endif
!    if(.not.present(zmax) ) then
!        z_max = 1.0e+14
!    else
!        z_max=zmin
!    endif
!
!    if(.not.present(tmin) ) then
!        t_min = -1.0e+14
!    else
!        t_min = tmin
!    endif
!    if(.not.present(tmax) ) then
!        t_max = 1.0e+14
!    else
!        t_max = tmax
!    endif
!
!    if(.not.present(valx) ) then
!        SetNBCound(1)=0.0d0
!    else
!        SetNBCound(1)=valx
!    endif
!    if(.not.present(valy) ) then
!        SetNBCound(2)=0.0d0
!    else
!        SetNBCound(2)=valy
!    endif
!    if(.not.present(valz) ) then
!        SetNBCound(3)=0.0d0
!    else
!        SetNBCound(3)=valz
!    endif
!
!
!    ! get node ID and value
!    allocate(NBoundNodIDBuf(size(this%Mesh%SurfaceLine2D),size(this%Boundary%NBoundNodID,2) ) )
!    allocate(NBoundValBuf  (size(this%Mesh%SurfaceLine2D),size(this%Boundary%NBoundNodID,2) ) )
!    NBoundNodIDBuf(:,:) = -1
!    NBoundValBuf(:,:)   = -1.0d0
!
!
!
!    k=0
!    do i=1,size(this%Mesh%SurfaceLine2D,1)
!        countnum=0
!        node_id=this%Mesh%SurfaceLine2D(i)
!
!        do j=1,size(this%Mesh%NodCoord,2)
!            if(j==1)then
!                minline=x_min
!                maxline=x_max
!            elseif(j==2)then
!                minline=y_min
!                maxline=y_max
!            elseif(j==3)then
!                minline=z_min
!                maxline=z_max
!            elseif(j==4)then
!                minline=t_min
!                maxline=t_max
!            else
!                !print *, "ERROR :: EditClass >> AddNBoundCondition >> dimension should 0 < d < 5"
!            endif
!            if(minline <= this%Mesh%NodCoord(node_id,j) .and. this%Mesh%NodCoord(node_id,j) <= maxline )then
!                countnum=countnum+1
!            endif
!        enddo
!
!        if(countnum==size(this%Mesh%NodCoord,2))then
!            k=k+1
!            do j=1,size(this%Mesh%NodCoord,2)
!                if(j==1)then
!                    if(.not.present(valx) ) then
!                        NBoundNodIDBuf(k,1)=-1
!                    else
!                        NBoundNodIDBuf(k,1)=node_id
!                        NBoundValBuf(k,1)=valx
!                    endif
!                elseif(j==2)then
!                    if(.not.present(valy) ) then
!                        NBoundNodIDBuf(k,2)=-1
!                    else
!                        NBoundNodIDBuf(k,2)=node_id
!                        NBoundValBuf(k,2)=valy
!                    endif
!                elseif(j==3)then
!                    if(.not.present(valz) ) then
!                        NBoundNodIDBuf(k,3)=-1
!                    else
!                        NBoundNodIDBuf(k,3)=node_id
!                        NBoundValBuf(k,3)=valz
!                    endif
!                else
!                    stop "EditClass >Time domain is not implemented "
!                endif
!            enddo
!        endif
!    enddo
!
!
!
!    ! MergeArray
!
!    call TrimArray(NBoundNodIDBuf,k)
!    call TrimArray(NBoundValBuf,k)
!    call CopyArray(this%Boundary%NBoundNodID,CopiedArrayInt)
!    call CopyArray(this%Boundary%NBoundVal,CopiedArrayReal)
! !    call MergeArray(CopiedArrayInt,NBoundNodIDBuf,this%Boundary%NBoundNodID)
! !    call MergeArray(CopiedArrayReal,NBoundValBuf,this%Boundary%NBoundVal)
! !    call DeleteOverlapBoundary(this%Boundary)
! !    call InitializeBoundary(this%Boundary)
! !
! !
! !
! !end subroutine
! !##################################################
!
!
!
!
!
!
!
!
! !##################################################
!subroutine AddTBoundCondition(this,xmin,xmax,ymin,ymax,zmin,zmax,&
!    tmin,tmax,valx,valy,valz)
!    class(FEMDomain_),intent(inout)::this
!    real(real64),optional,intent(in)::xmin,xmax
!    real(real64),optional,intent(in)::ymin,ymax
!    real(real64),optional,intent(in)::zmin,zmax
!    real(real64),optional,intent(in)::tmin,tmax
!    real(real64)::x_min,x_max
!    real(real64)::y_min,y_max
!    real(real64)::z_min,z_max
!    real(real64)::t_min,t_max
!
!    real(real64),optional,intent(in)::valx,valy,valz
!
!    real(real64) :: minline,maxline,SetTBCound(3)
!    integer(int32),allocatable::TBoundNodIDBuf(:,:),CopiedArrayInt(:,:)
!    real(real64),allocatable::TBoundValBuf(:,:),CopiedArrayReal(:,:)
!    integer(int32) :: countnum,i,j,k,node_id
!
!
!
!
!
!
!    if(.not.present(xmin) ) then
!        x_min = -1.0e+14
!    else
!        x_min=xmin
!    endif
!    if(.not.present(xmax) ) then
!        x_max = 1.0e+14
!    else
!        x_max=xmax
!    endif
!
!    if(.not.present(ymin) ) then
!        y_min = -1.0e+14
!    else
!        y_min=ymin
!    endif
!    if(.not.present(ymax) ) then
!        y_max = 1.0e+14
!    else
!        y_max=ymax
!    endif
!
!    if(.not.present(zmin) ) then
!        z_min = -1.0e+14
!    else
!        z_min = zmin
!
!    endif
!    if(.not.present(zmax) ) then
!        z_max = 1.0e+14
!    else
!        z_max=zmin
!    endif
!
!    if(.not.present(tmin) ) then
!        t_min = -1.0e+14
!    else
!        t_min = tmin
!    endif
!    if(.not.present(tmax) ) then
!        t_max = 1.0e+14
!    else
!        t_max = tmax
!    endif
!
!    if(.not.present(valx) ) then
!        SetTBCound(1)=0.0d0
!    else
!        SetTBCound(1)=valx
!    endif
!    if(.not.present(valy) ) then
!        SetTBCound(2)=0.0d0
!    else
!        SetTBCound(2)=valy
!    endif
!    if(.not.present(valz) ) then
!        SetTBCound(3)=0.0d0
!    else
!        SetTBCound(3)=valz
!    endif
!
!
!    ! get node ID and value
!    allocate(TBoundNodIDBuf(size(this%Mesh%SurfaceLine2D),size(this%Boundary%TBoundNodID,2) ) )
!    allocate(TBoundValBuf  (size(this%Mesh%SurfaceLine2D),size(this%Boundary%TBoundNodID,2) ) )
!    TBoundNodIDBuf(:,:) = -1
!    TBoundValBuf(:,:)   = -1.0d0
!
!
!
!    k=0
!    do i=1,size(this%Mesh%SurfaceLine2D,1)
!        countnum=0
!        node_id=this%Mesh%SurfaceLine2D(i)
!
!        do j=1,size(this%Mesh%NodCoord,2)
!            if(j==1)then
!                minline=x_min
!                maxline=x_max
!            elseif(j==2)then
!                minline=y_min
!                maxline=y_max
!            elseif(j==3)then
!                minline=z_min
!                maxline=z_max
!            elseif(j==4)then
!                minline=t_min
!                maxline=t_max
!            else
!                !print *, "ERROR :: EditClass >> AddTBoundCondition >> dimension should 0 < d < 5"
!            endif
!            if(minline <= this%Mesh%NodCoord(node_id,j) .and. this%Mesh%NodCoord(node_id,j) <= maxline )then
!                countnum=countnum+1
!            endif
!        enddo
!
!        if(countnum==size(this%Mesh%NodCoord,2))then
!            k=k+1
!            do j=1,size(this%Mesh%NodCoord,2)
!                if(j==1)then
!                    if(.not.present(valx) ) then
!                        TBoundNodIDBuf(k,1)=-1
!                    else
!                        TBoundNodIDBuf(k,1)=node_id
!                        TBoundValBuf(k,1)=valx
!                    endif
!                elseif(j==2)then
!                    if(.not.present(valy) ) then
!                        TBoundNodIDBuf(k,2)=-1
!                    else
!                        TBoundNodIDBuf(k,2)=node_id
!                        TBoundValBuf(k,2)=valy
!                    endif
!                elseif(j==3)then
!                    if(.not.present(valz) ) then
!                        TBoundNodIDBuf(k,3)=-1
!                    else
!                        TBoundNodIDBuf(k,3)=node_id
!                        TBoundValBuf(k,3)=valz
!                    endif
!                else
!                    stop "EditClass >Time domain is not implemented "
!                endif
!            enddo
!        endif
!    enddo
!
!
!    ! MergeArray
!
!    call TrimArray(TBoundNodIDBuf,k)
!    call TrimArray(TBoundValBuf,k)
!    call CopyArray(this%Boundary%TBoundNodID,CopiedArrayInt)
!    call CopyArray(this%Boundary%TBoundVal,CopiedArrayReal)
!    call MergeArray(CopiedArrayInt,TBoundNodIDBuf,this%Boundary%TBoundNodID)
!    call MergeArray(CopiedArrayReal,TBoundValBuf,this%Boundary%TBoundVal)
!    call DeleteOverlapBoundary(this%Boundary)
!    call InitializeBoundary(this%Boundary)
!
!
!
!end subroutine
! !##################################################

!##################################################
   subroutine SetSolver(this, inSolverType)
      class(FEMDomain_), intent(inout)::this
      character(*), intent(in) :: inSolverType

      this%SolverType = inSolverType

   end subroutine
!##################################################

!##################################################
   subroutine SetName(this, Name)
      class(FEMDomain_), intent(inout)::this
      character(*), intent(in) :: Name

      this%FileName = Name

   end subroutine
!##################################################

!##################################################
   subroutine SetDataType(this, inDType)
      class(FEMDomain_), intent(inout)::this
      character(*), intent(in) :: inDType

      this%DType = inDType

   end subroutine

!##################################################

!##################################################
   subroutine SetUpFEMDomain(this)
      class(FEMDomain_), intent(inout)::this

      logical :: NodeExist
      logical :: ElementExist

      if (allocated(this%Mesh%NodCoord)) then
         NodeExist = .true.
      else
         NodeExist = .false.
      end if

      if (allocated(this%Mesh%ElemNod)) then
         ElementExist = .true.
      else
         ElementExist = .false.
      end if

      if (NodeExist .eqv. .false.) then
         print *, "ERROR :: SetUp FEMDomain_ >> No Nodes are imported"
         return
      end if
      if (ElementExist .eqv. .false.) then
         print *, "ERROR :: SetUp FEMDomain_ >> No Elements are imported"
         return
      end if

   end subroutine
!##################################################

!##################################################
   subroutine SetControlParaFEMDomain(this, OptionalTol, OptionalItrTol, OptionalTimestep, OptionalSimMode)
      class(FEMDomain_), intent(inout)::this
      real(real64), optional, intent(in)::OptionalTol
      integer(int32), optional, intent(in)::OptionalSimMode, OptionalItrTol, OptionalTimestep

      call SetControlPara(this%ControlPara, OptionalTol, OptionalItrTol, OptionalTimestep, OptionalSimMode)
   end subroutine
!##################################################

!##################################################
   subroutine AddMaterialID(this, xmin, xmax, ymin, ymax, zmin, zmax, &
                            tmin, tmax, valx, valy, valz, MaterialID, mode2D)
      class(FEMDomain_), intent(inout)::this
      real(real64), optional, intent(in)::xmin, xmax
      real(real64), optional, intent(in)::ymin, ymax
      real(real64), optional, intent(in)::zmin, zmax
      real(real64), optional, intent(in)::tmin, tmax

      integer(int32), optional, intent(in)::MaterialID
      real(real64)::x_min, x_max
      real(real64)::y_min, y_max
      real(real64)::z_min, z_max
      real(real64)::t_min, t_max

      real(real64), optional, intent(in)::valx, valy, valz

      logical, optional, intent(in) :: Mode2D
      logical :: InOut
      real(real64) :: minline, maxline, SetDBCound(3)
      integer(int32), allocatable::TBoundNodITBuf(:, :), CopiedArrayInt(:, :)
      real(real64), allocatable::TBoundValBuf(:, :), CopiedArrayReal(:, :), x(:), rmin(:), rmax(:)
      integer(int32) :: countnum, i, j, k, node_id, n, m, NumVN, newboundnum, ValID, md

      if (present(MaterialID)) then
         md = MaterialID
      else
         md = 1
      end if

      n = size(this%Mesh%NodCoord, 2)

      if (present(Mode2D)) then
         if (Mode2D .eqv. .true.) then
            allocate (x(2))
            allocate (rmin(3))
            allocate (rmax(3))
         else
            allocate (x(3))
            allocate (rmin(3))
            allocate (rmax(3))
         end if
      elseif (n == 2) then
         allocate (x(2))
         allocate (rmin(3))
         allocate (rmax(3))
      else
         allocate (x(3))
         allocate (rmin(3))
         allocate (rmax(3))
      end if

      if (.not. present(xmin)) then
         x_min = -1.0e+14

      else
         x_min = xmin
      end if
      if (.not. present(xmax)) then
         x_max = 1.0e+14
      else
         x_max = xmax
      end if

      if (.not. present(ymin)) then
         y_min = -1.0e+14
      else
         y_min = ymin
      end if
      if (.not. present(ymax)) then
         y_max = 1.0e+14
      else
         y_max = ymax
      end if

      if (.not. present(zmin)) then
         z_min = -1.0e+14
      else
         z_min = zmin

      end if
      if (.not. present(zmax)) then
         z_max = 1.0e+14
      else
         z_max = zmax
      end if

      if (.not. present(tmin)) then
         t_min = -1.0e+14
      else
         t_min = tmin
      end if
      if (.not. present(tmax)) then
         t_max = 1.0e+14
      else
         t_max = tmax
      end if

      ! get node ID and value

      !if the facet is not created, create facets (surface elements)

      rmin(1) = x_min
      rmin(2) = y_min
      rmin(3) = z_min

      rmax(1) = x_max
      rmax(2) = y_max
      rmax(3) = z_max
      n = size(this%Mesh%ElemMat, 1)

      do i = 1, n
         x(:) = 0.0d0
         do j = 1, size(this%Mesh%ElemNod, 2)
            x(:) = x(:) + this%Mesh%NodCoord(this%Mesh%ElemNod(i, j), :)
         end do

         x(:) = 1.0d0/dble(size(this%Mesh%ElemNod, 2))*x(:)

         InOut = InOrOut(x, rmax, rmin)
         if (InOut .eqv. .true.) then

            this%Mesh%ElemMat(i) = md
         end if

      end do

   end subroutine
!##################################################

!##################################################
   subroutine MeltingSkeltonFEMDomain(this)
      class(FEMDomain_), intent(inout)::this

      call this%Mesh%MeltingSkelton()

   end subroutine
!##################################################

!##################################################
   recursive subroutine mshFEMDomain(this, name, scalar, vector, tensor, step, fieldname, NodeList)
      ! export as msh format
      class(FEMDomain_), intent(in)::this
      type(FEMDomain_)::mini_obj
      character(*), intent(in) :: name
      character(*), optional, intent(in) :: fieldname
      real(real64), optional, intent(in):: vector(:, :), scalar(:, :), tensor(:, :, :)
      real(real64), allocatable :: eigenvector(:, :), eigens(:), tens(:, :), vec1(:, :), vec2(:, :), scalar_(:, :)
      real(real64), allocatable :: vector_(:, :)
      integer(int32), optional, intent(in) :: step, NodeList(:)
      character(:), allocatable :: fname
      type(IO_) :: f
      integer(int32) :: i, j, typeid, n

      if (present(NodeList)) then
         n = size(NodeList, 1)
         mini_obj%mesh%nodcoord = zeros(n, this%nd())
         mini_obj%mesh%elemNod = zeros(n, this%nne())
         do i = 1, n
            mini_obj%mesh%nodcoord(i, :) = this%mesh%nodcoord(NodeList(i), :)
         end do
         do i = 1, n
            mini_obj%mesh%elemNod(i, :) = i
         end do
         call mini_obj%msh(name=name)
         return
      end if

      if (present(tensor)) then

         if (size(tensor, 2) == 2) then

            allocate (tens(size(tensor, 2), size(tensor, 3)))
            allocate (vec1(size(tensor, 1), size(tensor, 2)), vec2(size(tensor, 1), size(tensor, 2)))
            do i = 1, size(tensor, 1)
               tens(:, :) = tensor(i, :, :)
               call eigen_2d(tens, eigenvector)
               vec1(i, :) = eigenvector(1, :)
               vec2(i, :) = eigenvector(2, :)
            end do
            call this%msh(vector=vec1, name="first_eigen_plus"//name)
            call this%msh(vector=vec2, name="second_eigen_plus"//name)
            do i = 1, size(vec1, 1)
               vec1(i, :) = -vec1(i, :)
               vec2(i, :) = -vec2(i, :)
            end do
            call this%msh(vector=vec1, name="first_eigen_minus"//name)
            call this%msh(vector=vec2, name="second_eigen_minus"//name)
            return
         else
            ! only rank-2 tensor is now implemented.
            ! for arbitrary rank-size, please implement them in src/MathClass
            return
         end if
      end if

      if (present(Vector)) then
         n = input(default=1, option=step)
         if (present(fieldname)) then
            fname = fieldname
         else
            fname = "Vector Field"
         end if
         vector_ = array(size(vector, 1), 3)
         vector_(:, 1:size(vector, 2)) = vector(:, 1:size(vector, 2))
         call this%GmshPlotVector(Vector=vector_, name=name, FieldName=fname, step=n)
         return
      end if

      if (present(Scalar)) then
         n = input(default=1, option=step)
         if (present(fieldname)) then
            fname = fieldname
         else
            fname = "Scalar Field"
         end if
         call this%GmshPlotContour(gp_value=scalar, OptionalContorName=fname, OptionalStep=n, Name=name)
         return
      end if

      if (present(fieldname)) then
         ! fieldname がどこかのレイヤーの名前と一致した場合
         do i = 1, size(this%PhysicalField)
            if (this%PhysicalField(i)%name == fieldname) then

               if (allocated(this%PhysicalField(i)%scalar)) then
                  scalar_ = array(size(this%PhysicalField(i)%scalar), 1)
                  do j = 1, size(scalar_)
                     scalar_(j, :) = this%PhysicalField(i)%scalar(j)
                  end do
                  call this%msh(name=name, scalar=scalar_, step=step, fieldname=fieldname)
                  return
               end if
               if (allocated(this%PhysicalField(i)%vector)) then
                  call this%msh(name=name, vector=this%PhysicalField(i)%vector, step=step, fieldname=fieldname)
                  return
               end if
               if (allocated(this%PhysicalField(i)%tensor)) then
                  call this%msh(name=name, tensor=this%PhysicalField(i)%tensor, step=step, fieldname=fieldname)
                  return
               end if
            end if
         end do
      end if

      call f%open(name//".msh", 'w')
      write (f%fh, '(a)') "$MeshFormat"
      ! version of gmsh, 0=ASCII, 8=real(8)
      write (f%fh, '(a)') "2.2 0 8"
      write (f%fh, '(a)') "$EndMeshFormat"

      write (f%fh, '(a)') "$Nodes"
      write (f%fh, '(a)') str(size(this%mesh%nodcoord, 1))
      do i = 1, size(this%mesh%nodcoord, 1)
         write (f%fh, '(a)', advance="no") str(i)//" "
         do j = 1, size(this%mesh%nodcoord, 2) - 1
            write (f%fh, '(a)', advance="no") str(this%mesh%nodcoord(i, j))//" "
         end do
         j = size(this%mesh%nodcoord, 2)
         if (3 - j == 0) then
            write (f%fh, '(a)', advance="yes") str(this%mesh%nodcoord(i, j))
         elseif (3 - j == 1) then
            write (f%fh, '(a)', advance="no") str(this%mesh%nodcoord(i, j))//" "
            write (f%fh, '(a)', advance="yes") "0.00000  "
         elseif (3 - j == 2) then
            write (f%fh, '(a)', advance="no") str(this%mesh%nodcoord(i, j))//" "
            write (f%fh, '(a)', advance="no") "0.00000  "
            write (f%fh, '(a)', advance="yes") "0.00000  "
         else
            print *, "ERROR :: mshFEMDomain >> invalid node dimension"
            stop
         end if
      end do
      write (f%fh, '(a)') "$EndNodes"

      write (f%fh, '(a)') "$Elements"
      write (f%fh, '(a)') str(size(this%mesh%elemnod, 1))
      ! id, type, tag
      ! 1 : 2-node line
      ! 2 : 3-node line
      ! 3 : 4-node quadrangle
      ! 4 : 4-node tetrahedron
      ! 5 : 8-node hexahedron
      ! ...etc.
      if (size(this%mesh%elemnod, 2) == 8 .and. size(this%mesh%nodcoord, 2) == 3) then
         typeid = 5
      elseif (size(this%mesh%elemnod, 2) == 4 .and. size(this%mesh%nodcoord, 2) == 3) then
         typeid = 4
      elseif (size(this%mesh%elemnod, 2) == 4 .and. size(this%mesh%nodcoord, 2) == 2) then
         typeid = 3
      elseif (size(this%mesh%elemnod, 2) == 3 .and. size(this%mesh%nodcoord, 2) == 1) then
         typeid = 2
      elseif (size(this%mesh%elemnod, 2) == 2 .and. size(this%mesh%nodcoord, 2) == 1) then
         typeid = 1
      else
         print *, "mshFEMDomain >> meshtype is not supported. (only 1-5 for elm-type)"
         stop
      end if

      do i = 1, size(this%mesh%elemnod, 1)
         write (f%fh, '(a)', advance="no") str(i)//" "//str(typeid)//" 0 "
         do j = 1, size(this%mesh%elemnod, 2) - 1
            write (f%fh, '(a)', advance="no") str(this%mesh%elemnod(i, j))//" "
         end do
         j = size(this%mesh%elemnod, 2)
         write (f%fh, '(a)', advance="yes") str(this%mesh%elemnod(i, j))
      end do
      write (f%fh, '(a)') "$EndElements"
      call f%close()

   end subroutine
!##################################################

! #########################################################################################
   subroutine GmshPlotMesh(this, OptionalContorName, OptionalAbb, OptionalStep, Name, withNeumannBC, withDirichletBC &
                           , onlyNeumannBC, onlyDirichletBC, asMsh, withMaterial, Tag, timestep, field)
      class(FEMDomain_), intent(inout)::this
      real(real64), allocatable::gp_value(:, :)
      real(real64), allocatable, optional, intent(in)::field(:)
      integer(int32), optional, intent(in)::OptionalStep, timestep
      character, optional, intent(in):: OptionalContorName*30, OptionalAbb*6
      character(*), optional, intent(in)::Name, Tag
      logical, optional, intent(in)::withNeumannBC, withDirichletBC, onlyNeumannBC, onlyDirichletBC, asMsh, withMaterial
      real(real64), allocatable::x_double(:, :)
      real(real64), allocatable::x(:, :)
      integer(int32) i, j, k, l, step, fh, nodeid1, nodeid2
      character filename0*11, filename0msh*11
      character(:), allocatable ::  filename
      character filetitle*6
      character(:), allocatable ::  command
      character:: mapname*30, abbmap*6

      if (present(OptionalContorName)) then
         mapname = OptionalContorName
      elseif (present(Tag)) then
         mapname = Tag
      else
         mapname = "Value"
      end if

      if (present(OptionalAbb)) then
         abbmap = OptionalAbb
      else
         abbmap = "Values"
      end if

      if (present(OptionalStep)) then
         step = OptionalStep
      elseif (present(timeStep)) then
         step = timestep
      else
         step = 1
      end if

      fh = 123

      filetitle(1:6) = abbmap(1:6)

      if (.not. allocated(this%Mesh%ElemMat)) then
         allocate (this%Mesh%ElemMat(size(this%Mesh%ElemNod, 1)))
         this%Mesh%ElemMat(:) = 1
      end if

      !---------------------
      write (filename0, '("_", i6.6, ".pos")') step ! ここでファイル名を生成している
      if (present(Name)) then
         filename = filename0

         !call execute_command_line(  "touch "//name//this%FileName//filename )
         open (fh, file=name//filetitle//filename)
         print *, "writing ", name//filetitle//filename, " step>>", step
      else
         filename = filename0
         !call execute_command_line(  "touch "//this%FileName//filename )
         !print *, this%FileName//filetitle//filename
         open (fh, file=this%FileName//filetitle//filename)
         print *, "writing ", this%FileName//filetitle//filename, " step>>", step
      end if

      !---------------------
      if (size(this%Mesh%ElemNod, 2) == 4 .and. size(this%Mesh%NodCoord, 2) == 2) then
         allocate (x(4, 3))
         allocate (x_double(4, 3))
         x(:, :) = 0.0d0
         x_double(:, :) = 0.0d0
      elseif (size(this%Mesh%ElemNod, 2) == 8 .and. size(this%Mesh%NodCoord, 2) == 3) then
         allocate (x(8, 3))
         allocate (x_double(8, 3))
         x(:, :) = 0.0d0
         x_double(:, :) = 0.0d0

      end if

      allocate (gp_value(size(this%Mesh%ElemNod, 1), size(this%Mesh%ElemNod, 2)))
      if (allocated(this%Mesh%ElemMat)) then
         do i = 1, size(this%Mesh%ElemMat, 1)
            gp_value(i, :) = dble(this%Mesh%ElemMat(i))
         end do
      else
         gp_value(i, :) = 0.0d0
      end if
      if (present(Field)) then
         do i = 1, size(gp_value, 1)
            gp_value(i, :) = field(i)
         end do
      end if

      if (present(withDirichletBC)) then
         if (withDirichletBC .eqv. .true.) then
            ! search Dirichlet BC and change color
            if (.not. allocated(this%Boundary%DBoundNodID)) then
               print *, "ERROR GmshPlotMesh >> withDirichletBC >> no NBC is found."
               return
            else
               if (this%debug_mode) then
            print *, "[ok] GmshPlotMesh", filename, " is exported withDirichletBC. The value is:", maxval(this%Mesh%ElemMat(:)) + 40
               end if
            end if
            do i = 1, size(this%Boundary%DBoundNodID, 1)
               do j = 1, size(this%Boundary%DBoundNodID, 2)

                  if (this%Boundary%DBoundNodID(i, j) > 0) then
                     nodeid1 = this%Boundary%DBoundNodID(i, j)
                  else
                     cycle
                  end if

                  do k = 1, size(this%Mesh%ElemNod, 1)
                     do l = 1, size(this%Mesh%ElemNod, 2)
                        nodeid2 = this%Mesh%ElemNod(k, l)
                        if (nodeid1 == nodeid2) then
                           gp_value(k, :) = dble(maxval(this%Mesh%ElemMat(:))) + 40.0d0 ! Dirichlet is +20
                        end if
                     end do
                  end do
               end do
            end do

         end if
      end if

      if (present(withNeumannBC)) then
         if (withNeumannBC .eqv. .true.) then
            ! search Neumann BC and change color
            if (.not. allocated(this%Boundary%NBoundNodID)) then
               print *, "ERROR GmshPlotMesh >> withNeumannBC >> no NBC is found."
               return
            else
               if (this%debug_mode) then
              print *, "[ok] GmshPlotMesh", filename, " is exported withNeumannBC. The value is:", maxval(this%Mesh%ElemMat(:)) + 20
               end if
            end if
            do i = 1, size(this%Boundary%NBoundNodID, 1)
               do j = 1, size(this%Boundary%NBoundNodID, 2)

                  if (this%Boundary%NBoundNodID(i, j) > 0 .and. this%Boundary%NBoundVal(i, j) /= 0.0d0) then
                     nodeid1 = this%Boundary%NBoundNodID(i, j)
                  else
                     cycle
                  end if

                  do k = 1, size(this%Mesh%ElemNod, 1)
                     do l = 1, size(this%Mesh%ElemNod, 2)
                        nodeid2 = this%Mesh%ElemNod(k, l)
                        if (nodeid1 == nodeid2) then
                           gp_value(k, :) = dble(maxval(this%Mesh%ElemMat(:))) + 20.0d0 ! neumann is +20
                        end if
                     end do
                  end do
               end do
            end do

         end if
      end if

      if (present(onlyDirichletBC)) then
         if (onlyDirichletBC .eqv. .true.) then
            ! search Dirichlet BC and change color
            if (.not. allocated(this%Boundary%DBoundNodID)) then
               print *, "ERROR GmshPlotMesh >> onlyDirichletBC >> no NBC is found."
               return
            else
               if (this%debug_mode) then
            print *, "[ok] GmshPlotMesh", filename, " is exported onlyDirichletBC. The value is:", maxval(this%Mesh%ElemMat(:)) + 40
               end if
            end if
            do i = 1, size(this%Boundary%DBoundNodID, 1)
               do j = 1, size(this%Boundary%DBoundNodID, 2)

                  if (this%Boundary%DBoundNodID(i, j) > 0) then
                     nodeid1 = this%Boundary%DBoundNodID(i, j)
                  else
                     cycle
                  end if

                  do k = 1, size(this%Mesh%ElemNod, 1)
                     do l = 1, size(this%Mesh%ElemNod, 2)
                        nodeid2 = this%Mesh%ElemNod(k, l)
                        if (nodeid1 == nodeid2) then
                           if (l > size(gp_value, 2)) then
                              exit
                           end if
                           gp_value(k, l) = this%Boundary%DBoundVal(i, j)
                        end if
                     end do
                  end do
               end do
            end do

         end if
      end if

      x(:, :) = 0.0d0
      write (fh, *) 'View "', mapname, '" {'
      do i = 1, size(gp_value, 1)
         if (size(this%Mesh%ElemNod, 2) == 4 .and. size(this%Mesh%NodCoord, 2) == 2) then

            ! 2-D, 4 noded, isoparametric elements with four gauss points
            x_double(1, 1:2) = this%Mesh%NodCoord(this%Mesh%ElemNod(i, 1), 1:2)
            x_double(2, 1:2) = &
               0.50d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 1), 1:2) + 0.50d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 2), 1:2)
            x_double(3, 1:2) = &
               0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 1), 1:2) + 0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 2), 1:2) &
               + 0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 3), 1:2) + 0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 4), 1:2)
            x_double(4, 1:2) = &
               0.50d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 4), 1:2) + 0.50d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 1), 1:2)

            x(:, :) = x_double(:, :)

            write (fh, *) " SQ(", x(1, 1), ",", x(1, 2), ",", x(1, 3), "," &
               , x(2, 1), ",", x(2, 2), ",", x(2, 3), "," &
               , x(3, 1), ",", x(3, 2), ",", x(3, 3), "," &
               , x(4, 1), ",", x(4, 2), ",", x(4, 3), "){", gp_value(i, 1), ",", &
               gp_value(i, 1), ",", gp_value(i, 1), ",", gp_value(i, 1), "};"

            x_double(1, 1:2) = this%Mesh%NodCoord(this%Mesh%ElemNod(i, 2), 1:2)
            x_double(2, 1:2) = &
               0.50d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 2), 1:2) + 0.50d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 3), 1:2)
            x_double(3, 1:2) = &
               0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 1), 1:2) + 0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 2), 1:2) &
               + 0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 3), 1:2) + 0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 4), 1:2)
            x_double(4, 1:2) = &
               0.50d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 1), 1:2) + 0.50d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 2), 1:2)

            x(:, :) = x_double(:, :)

            write (fh, *) " SQ(", x(1, 1), ",", x(1, 2), ",", x(1, 3), "," &
               , x(2, 1), ",", x(2, 2), ",", x(2, 3), "," &
               , x(3, 1), ",", x(3, 2), ",", x(3, 3), "," &
               , x(4, 1), ",", x(4, 2), ",", x(4, 3), "){", gp_value(i, 2), ",", &
               gp_value(i, 2), ",", gp_value(i, 2), ",", gp_value(i, 2), "};"

            x_double(1, 1:2) = this%Mesh%NodCoord(this%Mesh%ElemNod(i, 3), 1:2)
            x_double(2, 1:2) = &
               0.50d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 3), 1:2) + 0.50d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 4), 1:2)
            x_double(3, 1:2) = &
               0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 1), 1:2) + 0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 2), 1:2) &
               + 0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 3), 1:2) + 0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 4), 1:2)
            x_double(4, 1:2) = &
               0.50d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 2), 1:2) + 0.50d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 3), 1:2)

            x(:, :) = x_double(:, :)

            write (fh, *) " SQ(", x(1, 1), ",", x(1, 2), ",", x(1, 3), "," &
               , x(2, 1), ",", x(2, 2), ",", x(2, 3), "," &
               , x(3, 1), ",", x(3, 2), ",", x(3, 3), "," &
               , x(4, 1), ",", x(4, 2), ",", x(4, 3), "){", gp_value(i, 3), ",", &
               gp_value(i, 3), ",", gp_value(i, 3), ",", gp_value(i, 3), "};"

            x_double(1, 1:2) = this%Mesh%NodCoord(this%Mesh%ElemNod(i, 4), 1:2)
            x_double(2, 1:2) = &
               0.50d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 4), 1:2) + 0.50d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 1), 1:2)
            x_double(3, 1:2) = &
               0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 1), 1:2) + 0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 2), 1:2) &
               + 0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 3), 1:2) + 0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 4), 1:2)
            x_double(4, 1:2) = &
               0.50d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 3), 1:2) + 0.50d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 4), 1:2)

            x(:, :) = x_double(:, :)

            write (fh, *) " SQ(", x(1, 1), ",", x(1, 2), ",", x(1, 3), "," &
               , x(2, 1), ",", x(2, 2), ",", x(2, 3), "," &
               , x(3, 1), ",", x(3, 2), ",", x(3, 3), "," &
               , x(4, 1), ",", x(4, 2), ",", x(4, 3), "){", gp_value(i, 4), ",", &
               gp_value(i, 4), ",", gp_value(i, 4), ",", gp_value(i, 4), "};"

         elseif (size(this%Mesh%ElemNod, 2) == 8 .and. size(this%Mesh%NodCoord, 2) == 3) then

            ! 3-D, 8 noded, isoparametric elements with 8 gauss points
            ! 1/8

            x_double(1, 1:3) = this%Mesh%NodCoord(this%Mesh%ElemNod(i, 1), 1:3)
            x_double(2, 1:3) = &
               0.50d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 1), 1:3) + 0.50d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 2), 1:3)
            x_double(3, 1:3) = &
               0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 1), 1:3) + 0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 2), 1:3) &
               + 0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 3), 1:3) + 0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 4), 1:3)
            x_double(4, 1:3) = &
               0.50d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 4), 1:3) + 0.50d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 1), 1:3)

            x_double(5, 1:3) = &
               0.50d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 1), 1:3) + 0.50d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 5), 1:3)

            x_double(6, 1:3) = &
               0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 1), 1:3) + 0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 2), 1:3) &
               + 0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 5), 1:3) + 0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 6), 1:3)

            x_double(7, 1:3) = &
             0.1250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 1), 1:3) + 0.1250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 2), 1:3) &
           + 0.1250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 3), 1:3) + 0.1250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 4), 1:3) &
           + 0.1250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 5), 1:3) + 0.1250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 6), 1:3) &
             + 0.1250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 7), 1:3) + 0.1250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 8), 1:3)

            x_double(8, 1:3) = &
               0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 1), 1:3) + 0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 4), 1:3) &
               + 0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 5), 1:3) + 0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 8), 1:3)

            x(:, :) = x_double(:, :)

            write (fh, *) " SQ(", x(4, 1), ",", x(4, 2), ",", x(4, 3), "," &
               , x(3, 1), ",", x(3, 2), ",", x(3, 3), "," &
               , x(2, 1), ",", x(2, 2), ",", x(2, 3), "," &
               , x(1, 1), ",", x(1, 2), ",", x(1, 3), "){", gp_value(i, 1), ",", &
               gp_value(i, 1), ",", gp_value(i, 1), ",", gp_value(i, 1), "};"
            write (fh, *) " SQ(", x(1, 1), ",", x(1, 2), ",", x(1, 3), "," &
               , x(2, 1), ",", x(2, 2), ",", x(2, 3), "," &
               , x(6, 1), ",", x(6, 2), ",", x(6, 3), "," &
               , x(5, 1), ",", x(5, 2), ",", x(5, 3), "){", gp_value(i, 1), ",", &
               gp_value(i, 1), ",", gp_value(i, 1), ",", gp_value(i, 1), "};"
            write (fh, *) " SQ(", x(2, 1), ",", x(2, 2), ",", x(2, 3), "," &
               , x(3, 1), ",", x(3, 2), ",", x(3, 3), "," &
               , x(7, 1), ",", x(7, 2), ",", x(7, 3), "," &
               , x(6, 1), ",", x(6, 2), ",", x(6, 3), "){", gp_value(i, 1), ",", &
               gp_value(i, 1), ",", gp_value(i, 1), ",", gp_value(i, 1), "};"
            write (fh, *) " SQ(", x(3, 1), ",", x(3, 2), ",", x(3, 3), "," &
               , x(4, 1), ",", x(4, 2), ",", x(4, 3), "," &
               , x(8, 1), ",", x(8, 2), ",", x(8, 3), "," &
               , x(7, 1), ",", x(7, 2), ",", x(7, 3), "){", gp_value(i, 1), ",", &
               gp_value(i, 1), ",", gp_value(i, 1), ",", gp_value(i, 1), "};"
            write (fh, *) " SQ(", x(4, 1), ",", x(4, 2), ",", x(4, 3), "," &
               , x(1, 1), ",", x(1, 2), ",", x(1, 3), "," &
               , x(5, 1), ",", x(5, 2), ",", x(5, 3), "," &
               , x(8, 1), ",", x(8, 2), ",", x(8, 3), "){", gp_value(i, 1), ",", &
               gp_value(i, 1), ",", gp_value(i, 1), ",", gp_value(i, 1), "};"
            write (fh, *) " SQ(", x(5, 1), ",", x(5, 2), ",", x(5, 3), "," &
               , x(6, 1), ",", x(6, 2), ",", x(6, 3), "," &
               , x(7, 1), ",", x(7, 2), ",", x(7, 3), "," &
               , x(8, 1), ",", x(8, 2), ",", x(8, 3), "){", gp_value(i, 1), ",", &
               gp_value(i, 1), ",", gp_value(i, 1), ",", gp_value(i, 1), "};"

            ! 2/8

            x_double(1, 1:3) = &
               0.50d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 1), 1:3) + 0.50d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 2), 1:3)

            x_double(2, 1:3) = this%Mesh%NodCoord(this%Mesh%ElemNod(i, 2), 1:3)

            x_double(3, 1:3) = &
               0.50d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 2), 1:3) + 0.50d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 3), 1:3)

            x_double(4, 1:3) = &
               0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 1), 1:3) + 0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 2), 1:3) &
               + 0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 3), 1:3) + 0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 4), 1:3)

            x_double(5, 1:3) = &
               0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 1), 1:3) + 0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 2), 1:3) &
               + 0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 5), 1:3) + 0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 6), 1:3)

            x_double(6, 1:3) = &
               0.50d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 2), 1:3) + 0.50d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 6), 1:3)

            x_double(7, 1:3) = &
               0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 2), 1:3) + 0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 3), 1:3) &
               + 0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 6), 1:3) + 0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 7), 1:3)

            x_double(8, 1:3) = &
             0.1250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 1), 1:3) + 0.1250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 2), 1:3) &
           + 0.1250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 3), 1:3) + 0.1250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 4), 1:3) &
           + 0.1250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 5), 1:3) + 0.1250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 6), 1:3) &
             + 0.1250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 7), 1:3) + 0.1250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 8), 1:3)

            x(:, :) = x_double(:, :)

            write (fh, *) " SQ(", x(4, 1), ",", x(4, 2), ",", x(4, 3), "," &
               , x(3, 1), ",", x(3, 2), ",", x(3, 3), "," &
               , x(2, 1), ",", x(2, 2), ",", x(2, 3), "," &
               , x(1, 1), ",", x(1, 2), ",", x(1, 3), "){", gp_value(i, 2), ",", &
               gp_value(i, 2), ",", gp_value(i, 2), ",", gp_value(i, 2), "};"
            write (fh, *) " SQ(", x(1, 1), ",", x(1, 2), ",", x(1, 3), "," &
               , x(2, 1), ",", x(2, 2), ",", x(2, 3), "," &
               , x(6, 1), ",", x(6, 2), ",", x(6, 3), "," &
               , x(5, 1), ",", x(5, 2), ",", x(5, 3), "){", gp_value(i, 2), ",", &
               gp_value(i, 2), ",", gp_value(i, 2), ",", gp_value(i, 2), "};"
            write (fh, *) " SQ(", x(2, 1), ",", x(2, 2), ",", x(2, 3), "," &
               , x(3, 1), ",", x(3, 2), ",", x(3, 3), "," &
               , x(7, 1), ",", x(7, 2), ",", x(7, 3), "," &
               , x(6, 1), ",", x(6, 2), ",", x(6, 3), "){", gp_value(i, 2), ",", &
               gp_value(i, 2), ",", gp_value(i, 2), ",", gp_value(i, 2), "};"
            write (fh, *) " SQ(", x(3, 1), ",", x(3, 2), ",", x(3, 3), "," &
               , x(4, 1), ",", x(4, 2), ",", x(4, 3), "," &
               , x(8, 1), ",", x(8, 2), ",", x(8, 3), "," &
               , x(7, 1), ",", x(7, 2), ",", x(7, 3), "){", gp_value(i, 2), ",", &
               gp_value(i, 2), ",", gp_value(i, 2), ",", gp_value(i, 2), "};"
            write (fh, *) " SQ(", x(4, 1), ",", x(4, 2), ",", x(4, 3), "," &
               , x(1, 1), ",", x(1, 2), ",", x(1, 3), "," &
               , x(5, 1), ",", x(5, 2), ",", x(5, 3), "," &
               , x(8, 1), ",", x(8, 2), ",", x(8, 3), "){", gp_value(i, 2), ",", &
               gp_value(i, 2), ",", gp_value(i, 2), ",", gp_value(i, 2), "};"
            write (fh, *) " SQ(", x(5, 1), ",", x(5, 2), ",", x(5, 3), "," &
               , x(6, 1), ",", x(6, 2), ",", x(6, 3), "," &
               , x(7, 1), ",", x(7, 2), ",", x(7, 3), "," &
               , x(8, 1), ",", x(8, 2), ",", x(8, 3), "){", gp_value(i, 2), ",", &
               gp_value(i, 2), ",", gp_value(i, 2), ",", gp_value(i, 2), "};"

            ! 3/8

            x_double(8, 1:3) = &
               0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 3), 1:3) + 0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 4), 1:3) &
               + 0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 8), 1:3) + 0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 7), 1:3)

            x_double(3, 1:3) = this%Mesh%NodCoord(this%Mesh%ElemNod(i, 3), 1:3)

            x_double(2, 1:3) = &
               0.50d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 2), 1:3) + 0.50d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 3), 1:3)

            x_double(1, 1:3) = &
               0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 1), 1:3) + 0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 2), 1:3) &
               + 0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 3), 1:3) + 0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 4), 1:3)

            x_double(6, 1:3) = &
               0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 3), 1:3) + 0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 2), 1:3) &
               + 0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 7), 1:3) + 0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 6), 1:3)

            x_double(7, 1:3) = &
               0.50d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 3), 1:3) + 0.50d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 7), 1:3)

            x_double(4, 1:3) = &
               0.50d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 4), 1:3) + 0.50d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 3), 1:3)

            x_double(5, 1:3) = &
             0.1250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 1), 1:3) + 0.1250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 2), 1:3) &
           + 0.1250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 3), 1:3) + 0.1250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 4), 1:3) &
           + 0.1250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 5), 1:3) + 0.1250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 6), 1:3) &
             + 0.1250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 7), 1:3) + 0.1250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 8), 1:3)

            x(:, :) = x_double(:, :)

            write (fh, *) " SQ(", x(4, 1), ",", x(4, 2), ",", x(4, 3), "," &
               , x(3, 1), ",", x(3, 2), ",", x(3, 3), "," &
               , x(2, 1), ",", x(2, 2), ",", x(2, 3), "," &
               , x(1, 1), ",", x(1, 2), ",", x(1, 3), "){", gp_value(i, 3), ",", &
               gp_value(i, 3), ",", gp_value(i, 3), ",", gp_value(i, 3), "};"
            write (fh, *) " SQ(", x(1, 1), ",", x(1, 2), ",", x(1, 3), "," &
               , x(2, 1), ",", x(2, 2), ",", x(2, 3), "," &
               , x(6, 1), ",", x(6, 2), ",", x(6, 3), "," &
               , x(5, 1), ",", x(5, 2), ",", x(5, 3), "){", gp_value(i, 3), ",", &
               gp_value(i, 3), ",", gp_value(i, 3), ",", gp_value(i, 3), "};"
            write (fh, *) " SQ(", x(2, 1), ",", x(2, 2), ",", x(2, 3), "," &
               , x(3, 1), ",", x(3, 2), ",", x(3, 3), "," &
               , x(7, 1), ",", x(7, 2), ",", x(7, 3), "," &
               , x(6, 1), ",", x(6, 2), ",", x(6, 3), "){", gp_value(i, 3), ",", &
               gp_value(i, 3), ",", gp_value(i, 3), ",", gp_value(i, 3), "};"
            write (fh, *) " SQ(", x(3, 1), ",", x(3, 2), ",", x(3, 3), "," &
               , x(4, 1), ",", x(4, 2), ",", x(4, 3), "," &
               , x(8, 1), ",", x(8, 2), ",", x(8, 3), "," &
               , x(7, 1), ",", x(7, 2), ",", x(7, 3), "){", gp_value(i, 3), ",", &
               gp_value(i, 3), ",", gp_value(i, 3), ",", gp_value(i, 3), "};"
            write (fh, *) " SQ(", x(4, 1), ",", x(4, 2), ",", x(4, 3), "," &
               , x(1, 1), ",", x(1, 2), ",", x(1, 3), "," &
               , x(5, 1), ",", x(5, 2), ",", x(5, 3), "," &
               , x(8, 1), ",", x(8, 2), ",", x(8, 3), "){", gp_value(i, 3), ",", &
               gp_value(i, 3), ",", gp_value(i, 3), ",", gp_value(i, 3), "};"
            write (fh, *) " SQ(", x(5, 1), ",", x(5, 2), ",", x(5, 3), "," &
               , x(6, 1), ",", x(6, 2), ",", x(6, 3), "," &
               , x(7, 1), ",", x(7, 2), ",", x(7, 3), "," &
               , x(8, 1), ",", x(8, 2), ",", x(8, 3), "){", gp_value(i, 3), ",", &
               gp_value(i, 3), ",", gp_value(i, 3), ",", gp_value(i, 3), "};"

            ! 4/8

            x_double(6, 1:3) = &
               0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 3), 1:3) + 0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 4), 1:3) &
               + 0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 8), 1:3) + 0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 7), 1:3)

            x_double(3, 1:3) = this%Mesh%NodCoord(this%Mesh%ElemNod(i, 4), 1:3)

            x_double(7, 1:3) = &
               0.50d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 4), 1:3) + 0.50d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 8), 1:3)

            x_double(1, 1:3) = &
               0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 1), 1:3) + 0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 2), 1:3) &
               + 0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 3), 1:3) + 0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 4), 1:3)

            x_double(8, 1:3) = &
               0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 1), 1:3) + 0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 4), 1:3) &
               + 0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 8), 1:3) + 0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 5), 1:3)

            x_double(4, 1:3) = &
               0.50d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 4), 1:3) + 0.50d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 1), 1:3)

            x_double(2, 1:3) = &
               0.50d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 4), 1:3) + 0.50d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 3), 1:3)

            x_double(5, 1:3) = &
             0.1250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 1), 1:3) + 0.1250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 2), 1:3) &
           + 0.1250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 3), 1:3) + 0.1250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 4), 1:3) &
           + 0.1250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 5), 1:3) + 0.1250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 6), 1:3) &
             + 0.1250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 7), 1:3) + 0.1250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 8), 1:3)

            x(:, :) = x_double(:, :)

            write (fh, *) " SQ(", x(4, 1), ",", x(4, 2), ",", x(4, 3), "," &
               , x(3, 1), ",", x(3, 2), ",", x(3, 3), "," &
               , x(2, 1), ",", x(2, 2), ",", x(2, 3), "," &
               , x(1, 1), ",", x(1, 2), ",", x(1, 3), "){", gp_value(i, 4), ",", &
               gp_value(i, 4), ",", gp_value(i, 4), ",", gp_value(i, 4), "};"
            write (fh, *) " SQ(", x(1, 1), ",", x(1, 2), ",", x(1, 3), "," &
               , x(2, 1), ",", x(2, 2), ",", x(2, 3), "," &
               , x(6, 1), ",", x(6, 2), ",", x(6, 3), "," &
               , x(5, 1), ",", x(5, 2), ",", x(5, 3), "){", gp_value(i, 4), ",", &
               gp_value(i, 4), ",", gp_value(i, 4), ",", gp_value(i, 4), "};"
            write (fh, *) " SQ(", x(2, 1), ",", x(2, 2), ",", x(2, 3), "," &
               , x(3, 1), ",", x(3, 2), ",", x(3, 3), "," &
               , x(7, 1), ",", x(7, 2), ",", x(7, 3), "," &
               , x(6, 1), ",", x(6, 2), ",", x(6, 3), "){", gp_value(i, 4), ",", &
               gp_value(i, 4), ",", gp_value(i, 4), ",", gp_value(i, 4), "};"
            write (fh, *) " SQ(", x(3, 1), ",", x(3, 2), ",", x(3, 3), "," &
               , x(4, 1), ",", x(4, 2), ",", x(4, 3), "," &
               , x(8, 1), ",", x(8, 2), ",", x(8, 3), "," &
               , x(7, 1), ",", x(7, 2), ",", x(7, 3), "){", gp_value(i, 4), ",", &
               gp_value(i, 4), ",", gp_value(i, 4), ",", gp_value(i, 4), "};"
            write (fh, *) " SQ(", x(4, 1), ",", x(4, 2), ",", x(4, 3), "," &
               , x(1, 1), ",", x(1, 2), ",", x(1, 3), "," &
               , x(5, 1), ",", x(5, 2), ",", x(5, 3), "," &
               , x(8, 1), ",", x(8, 2), ",", x(8, 3), "){", gp_value(i, 4), ",", &
               gp_value(i, 4), ",", gp_value(i, 4), ",", gp_value(i, 4), "};"
            write (fh, *) " SQ(", x(5, 1), ",", x(5, 2), ",", x(5, 3), "," &
               , x(6, 1), ",", x(6, 2), ",", x(6, 3), "," &
               , x(7, 1), ",", x(7, 2), ",", x(7, 3), "," &
               , x(8, 1), ",", x(8, 2), ",", x(8, 3), "){", gp_value(i, 4), ",", &
               gp_value(i, 4), ",", gp_value(i, 4), ",", gp_value(i, 4), "};"

            ! 5/8

            x_double(7, 1:3) = &
               0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 5), 1:3) + 0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 6), 1:3) &
               + 0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 8), 1:3) + 0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 7), 1:3)

            x_double(5, 1:3) = this%Mesh%NodCoord(this%Mesh%ElemNod(i, 5), 1:3)

            x_double(6, 1:3) = &
               0.50d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 5), 1:3) + 0.50d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 6), 1:3)

            x_double(2, 1:3) = &
               0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 1), 1:3) + 0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 2), 1:3) &
               + 0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 6), 1:3) + 0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 5), 1:3)

            x_double(4, 1:3) = &
               0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 1), 1:3) + 0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 4), 1:3) &
               + 0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 8), 1:3) + 0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 5), 1:3)

            x_double(1, 1:3) = &
               0.50d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 5), 1:3) + 0.50d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 1), 1:3)

            x_double(8, 1:3) = &
               0.50d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 5), 1:3) + 0.50d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 8), 1:3)

            x_double(3, 1:3) = &
             0.1250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 1), 1:3) + 0.1250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 2), 1:3) &
           + 0.1250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 3), 1:3) + 0.1250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 4), 1:3) &
           + 0.1250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 5), 1:3) + 0.1250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 6), 1:3) &
             + 0.1250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 7), 1:3) + 0.1250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 8), 1:3)

            x(:, :) = x_double(:, :)

            write (fh, *) " SQ(", x(4, 1), ",", x(4, 2), ",", x(4, 3), "," &
               , x(3, 1), ",", x(3, 2), ",", x(3, 3), "," &
               , x(2, 1), ",", x(2, 2), ",", x(2, 3), "," &
               , x(1, 1), ",", x(1, 2), ",", x(1, 3), "){", gp_value(i, 5), ",", &
               gp_value(i, 5), ",", gp_value(i, 5), ",", gp_value(i, 5), "};"
            write (fh, *) " SQ(", x(1, 1), ",", x(1, 2), ",", x(1, 3), "," &
               , x(2, 1), ",", x(2, 2), ",", x(2, 3), "," &
               , x(6, 1), ",", x(6, 2), ",", x(6, 3), "," &
               , x(5, 1), ",", x(5, 2), ",", x(5, 3), "){", gp_value(i, 5), ",", &
               gp_value(i, 5), ",", gp_value(i, 5), ",", gp_value(i, 5), "};"
            write (fh, *) " SQ(", x(2, 1), ",", x(2, 2), ",", x(2, 3), "," &
               , x(6, 1), ",", x(6, 2), ",", x(6, 3), "," &
               , x(3, 1), ",", x(3, 2), ",", x(3, 3), "," &
               , x(7, 1), ",", x(7, 2), ",", x(7, 3), "){", gp_value(i, 5), ",", &
               gp_value(i, 5), ",", gp_value(i, 5), ",", gp_value(i, 5), "};"
            write (fh, *) " SQ(", x(3, 1), ",", x(3, 2), ",", x(3, 3), "," &
               , x(4, 1), ",", x(4, 2), ",", x(4, 3), "," &
               , x(8, 1), ",", x(8, 2), ",", x(8, 3), "," &
               , x(7, 1), ",", x(7, 2), ",", x(7, 3), "){", gp_value(i, 5), ",", &
               gp_value(i, 5), ",", gp_value(i, 5), ",", gp_value(i, 5), "};"
            write (fh, *) " SQ(", x(4, 1), ",", x(4, 2), ",", x(4, 3), "," &
               , x(1, 1), ",", x(1, 2), ",", x(1, 3), "," &
               , x(5, 1), ",", x(5, 2), ",", x(5, 3), "," &
               , x(8, 1), ",", x(8, 2), ",", x(8, 3), "){", gp_value(i, 5), ",", &
               gp_value(i, 5), ",", gp_value(i, 5), ",", gp_value(i, 5), "};"
            write (fh, *) " SQ(", x(5, 1), ",", x(5, 2), ",", x(5, 3), "," &
               , x(6, 1), ",", x(6, 2), ",", x(6, 3), "," &
               , x(7, 1), ",", x(7, 2), ",", x(7, 3), "," &
               , x(8, 1), ",", x(8, 2), ",", x(8, 3), "){", gp_value(i, 5), ",", &
               gp_value(i, 5), ",", gp_value(i, 5), ",", gp_value(i, 5), "};"

            ! 6/8

            x_double(8, 1:3) = &
               0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 5), 1:3) + 0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 6), 1:3) &
               + 0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 8), 1:3) + 0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 7), 1:3)

            x_double(6, 1:3) = this%Mesh%NodCoord(this%Mesh%ElemNod(i, 6), 1:3)

            x_double(5, 1:3) = &
               0.50d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 5), 1:3) + 0.50d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 6), 1:3)

            x_double(1, 1:3) = &
               0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 1), 1:3) + 0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 2), 1:3) &
               + 0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 6), 1:3) + 0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 5), 1:3)

            x_double(3, 1:3) = &
               0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 2), 1:3) + 0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 3), 1:3) &
               + 0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 7), 1:3) + 0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 6), 1:3)

            x_double(2, 1:3) = &
               0.50d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 6), 1:3) + 0.50d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 2), 1:3)

            x_double(7, 1:3) = &
               0.50d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 6), 1:3) + 0.50d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 7), 1:3)

            x_double(4, 1:3) = &
             0.1250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 1), 1:3) + 0.1250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 2), 1:3) &
           + 0.1250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 3), 1:3) + 0.1250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 4), 1:3) &
           + 0.1250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 5), 1:3) + 0.1250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 6), 1:3) &
             + 0.1250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 7), 1:3) + 0.1250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 8), 1:3)

            x(:, :) = x_double(:, :)

            write (fh, *) " SQ(", x(4, 1), ",", x(4, 2), ",", x(4, 3), "," &
               , x(3, 1), ",", x(3, 2), ",", x(3, 3), "," &
               , x(2, 1), ",", x(2, 2), ",", x(2, 3), "," &
               , x(1, 1), ",", x(1, 2), ",", x(1, 3), "){", gp_value(i, 6), ",", &
               gp_value(i, 6), ",", gp_value(i, 6), ",", gp_value(i, 6), "};"
            write (fh, *) " SQ(", x(1, 1), ",", x(1, 2), ",", x(1, 3), "," &
               , x(2, 1), ",", x(2, 2), ",", x(2, 3), "," &
               , x(6, 1), ",", x(6, 2), ",", x(6, 3), "," &
               , x(5, 1), ",", x(5, 2), ",", x(5, 3), "){", gp_value(i, 6), ",", &
               gp_value(i, 6), ",", gp_value(i, 6), ",", gp_value(i, 6), "};"
            write (fh, *) " SQ(", x(2, 1), ",", x(2, 2), ",", x(2, 3), "," &
               , x(3, 1), ",", x(3, 2), ",", x(3, 3), "," &
               , x(7, 1), ",", x(7, 2), ",", x(7, 3), "," &
               , x(6, 1), ",", x(6, 2), ",", x(6, 3), "){", gp_value(i, 6), ",", &
               gp_value(i, 6), ",", gp_value(i, 6), ",", gp_value(i, 6), "};"
            write (fh, *) " SQ(", x(3, 1), ",", x(3, 2), ",", x(3, 3), "," &
               , x(4, 1), ",", x(4, 2), ",", x(4, 3), "," &
               , x(8, 1), ",", x(8, 2), ",", x(8, 3), "," &
               , x(7, 1), ",", x(7, 2), ",", x(7, 3), "){", gp_value(i, 6), ",", &
               gp_value(i, 6), ",", gp_value(i, 6), ",", gp_value(i, 6), "};"
            write (fh, *) " SQ(", x(4, 1), ",", x(4, 2), ",", x(4, 3), "," &
               , x(1, 1), ",", x(1, 2), ",", x(1, 3), "," &
               , x(5, 1), ",", x(5, 2), ",", x(5, 3), "," &
               , x(8, 1), ",", x(8, 2), ",", x(8, 3), "){", gp_value(i, 6), ",", &
               gp_value(i, 6), ",", gp_value(i, 6), ",", gp_value(i, 6), "};"
            write (fh, *) " SQ(", x(5, 1), ",", x(5, 2), ",", x(5, 3), "," &
               , x(6, 1), ",", x(6, 2), ",", x(6, 3), "," &
               , x(7, 1), ",", x(7, 2), ",", x(7, 3), "," &
               , x(8, 1), ",", x(8, 2), ",", x(8, 3), "){", gp_value(i, 6), ",", &
               gp_value(i, 6), ",", gp_value(i, 6), ",", gp_value(i, 6), "};"

            ! 7/8

            x_double(5, 1:3) = &
               0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 5), 1:3) + 0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 6), 1:3) &
               + 0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 8), 1:3) + 0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 7), 1:3)

            x_double(7, 1:3) = this%Mesh%NodCoord(this%Mesh%ElemNod(i, 7), 1:3)

            x_double(8, 1:3) = &
               0.50d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 7), 1:3) + 0.50d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 8), 1:3)

            x_double(4, 1:3) = &
               0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 3), 1:3) + 0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 4), 1:3) &
               + 0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 7), 1:3) + 0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 8), 1:3)

            x_double(2, 1:3) = &
               0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 2), 1:3) + 0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 3), 1:3) &
               + 0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 6), 1:3) + 0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 7), 1:3)

            x_double(3, 1:3) = &
               0.50d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 3), 1:3) + 0.50d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 7), 1:3)

            x_double(6, 1:3) = &
               0.50d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 6), 1:3) + 0.50d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 7), 1:3)

            x_double(1, 1:3) = &
             0.1250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 1), 1:3) + 0.1250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 2), 1:3) &
           + 0.1250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 3), 1:3) + 0.1250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 4), 1:3) &
           + 0.1250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 5), 1:3) + 0.1250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 6), 1:3) &
             + 0.1250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 7), 1:3) + 0.1250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 8), 1:3)

            x(:, :) = x_double(:, :)

            write (fh, *) " SQ(", x(4, 1), ",", x(4, 2), ",", x(4, 3), "," &
               , x(3, 1), ",", x(3, 2), ",", x(3, 3), "," &
               , x(2, 1), ",", x(2, 2), ",", x(2, 3), "," &
               , x(1, 1), ",", x(1, 2), ",", x(1, 3), "){", gp_value(i, 7), ",", &
               gp_value(i, 7), ",", gp_value(i, 7), ",", gp_value(i, 7), "};"
            write (fh, *) " SQ(", x(1, 1), ",", x(1, 2), ",", x(1, 3), "," &
               , x(2, 1), ",", x(2, 2), ",", x(2, 3), "," &
               , x(6, 1), ",", x(6, 2), ",", x(6, 3), "," &
               , x(5, 1), ",", x(5, 2), ",", x(5, 3), "){", gp_value(i, 7), ",", &
               gp_value(i, 7), ",", gp_value(i, 7), ",", gp_value(i, 7), "};"
            write (fh, *) " SQ(", x(2, 1), ",", x(2, 2), ",", x(2, 3), "," &
               , x(3, 1), ",", x(3, 2), ",", x(3, 3), "," &
               , x(7, 1), ",", x(7, 2), ",", x(7, 3), "," &
               , x(6, 1), ",", x(6, 2), ",", x(6, 3), "){", gp_value(i, 7), ",", &
               gp_value(i, 7), ",", gp_value(i, 7), ",", gp_value(i, 7), "};"
            write (fh, *) " SQ(", x(3, 1), ",", x(3, 2), ",", x(3, 3), "," &
               , x(4, 1), ",", x(4, 2), ",", x(4, 3), "," &
               , x(8, 1), ",", x(8, 2), ",", x(8, 3), "," &
               , x(7, 1), ",", x(7, 2), ",", x(7, 3), "){", gp_value(i, 7), ",", &
               gp_value(i, 7), ",", gp_value(i, 7), ",", gp_value(i, 7), "};"
            write (fh, *) " SQ(", x(4, 1), ",", x(4, 2), ",", x(4, 3), "," &
               , x(1, 1), ",", x(1, 2), ",", x(1, 3), "," &
               , x(5, 1), ",", x(5, 2), ",", x(5, 3), "," &
               , x(8, 1), ",", x(8, 2), ",", x(8, 3), "){", gp_value(i, 7), ",", &
               gp_value(i, 7), ",", gp_value(i, 7), ",", gp_value(i, 7), "};"
            write (fh, *) " SQ(", x(5, 1), ",", x(5, 2), ",", x(5, 3), "," &
               , x(6, 1), ",", x(6, 2), ",", x(6, 3), "," &
               , x(7, 1), ",", x(7, 2), ",", x(7, 3), "," &
               , x(8, 1), ",", x(8, 2), ",", x(8, 3), "){", gp_value(i, 7), ",", &
               gp_value(i, 7), ",", gp_value(i, 7), ",", gp_value(i, 7), "};"

            ! 8/8

            x_double(5, 1:3) = &
               0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 5), 1:3) + 0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 6), 1:3) &
               + 0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 8), 1:3) + 0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 7), 1:3)

            x_double(7, 1:3) = this%Mesh%NodCoord(this%Mesh%ElemNod(i, 8), 1:3)

            x_double(6, 1:3) = &
               0.50d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 7), 1:3) + 0.50d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 8), 1:3)

            x_double(2, 1:3) = &
               0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 3), 1:3) + 0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 4), 1:3) &
               + 0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 7), 1:3) + 0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 8), 1:3)

            x_double(4, 1:3) = &
               0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 1), 1:3) + 0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 4), 1:3) &
               + 0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 5), 1:3) + 0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 8), 1:3)

            x_double(3, 1:3) = &
               0.50d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 4), 1:3) + 0.50d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 8), 1:3)

            x_double(8, 1:3) = &
               0.50d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 5), 1:3) + 0.50d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 8), 1:3)

            x_double(1, 1:3) = &
             0.1250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 1), 1:3) + 0.1250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 2), 1:3) &
           + 0.1250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 3), 1:3) + 0.1250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 4), 1:3) &
           + 0.1250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 5), 1:3) + 0.1250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 6), 1:3) &
             + 0.1250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 7), 1:3) + 0.1250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 8), 1:3)

            x(:, :) = x_double(:, :)

            write (fh, *) " SQ(", x(4, 1), ",", x(4, 2), ",", x(4, 3), "," &
               , x(3, 1), ",", x(3, 2), ",", x(3, 3), "," &
               , x(2, 1), ",", x(2, 2), ",", x(2, 3), "," &
               , x(1, 1), ",", x(1, 2), ",", x(1, 3), "){", gp_value(i, 8), ",", &
               gp_value(i, 8), ",", gp_value(i, 8), ",", gp_value(i, 8), "};"
            write (fh, *) " SQ(", x(1, 1), ",", x(1, 2), ",", x(1, 3), "," &
               , x(2, 1), ",", x(2, 2), ",", x(2, 3), "," &
               , x(6, 1), ",", x(6, 2), ",", x(6, 3), "," &
               , x(5, 1), ",", x(5, 2), ",", x(5, 3), "){", gp_value(i, 8), ",", &
               gp_value(i, 8), ",", gp_value(i, 8), ",", gp_value(i, 8), "};"
            write (fh, *) " SQ(", x(2, 1), ",", x(2, 2), ",", x(2, 3), "," &
               , x(3, 1), ",", x(3, 2), ",", x(3, 3), "," &
               , x(7, 1), ",", x(7, 2), ",", x(7, 3), "," &
               , x(6, 1), ",", x(6, 2), ",", x(6, 3), "){", gp_value(i, 8), ",", &
               gp_value(i, 8), ",", gp_value(i, 8), ",", gp_value(i, 8), "};"
            write (fh, *) " SQ(", x(3, 1), ",", x(3, 2), ",", x(3, 3), "," &
               , x(4, 1), ",", x(4, 2), ",", x(4, 3), "," &
               , x(8, 1), ",", x(8, 2), ",", x(8, 3), "," &
               , x(7, 1), ",", x(7, 2), ",", x(7, 3), "){", gp_value(i, 8), ",", &
               gp_value(i, 8), ",", gp_value(i, 8), ",", gp_value(i, 8), "};"
            write (fh, *) " SQ(", x(4, 1), ",", x(4, 2), ",", x(4, 3), "," &
               , x(1, 1), ",", x(1, 2), ",", x(1, 3), "," &
               , x(5, 1), ",", x(5, 2), ",", x(5, 3), "," &
               , x(8, 1), ",", x(8, 2), ",", x(8, 3), "){", gp_value(i, 8), ",", &
               gp_value(i, 8), ",", gp_value(i, 8), ",", gp_value(i, 8), "};"
            write (fh, *) " SQ(", x(5, 1), ",", x(5, 2), ",", x(5, 3), "," &
               , x(6, 1), ",", x(6, 2), ",", x(6, 3), "," &
               , x(7, 1), ",", x(7, 2), ",", x(7, 3), "," &
               , x(8, 1), ",", x(8, 2), ",", x(8, 3), "){", gp_value(i, 8), ",", &
               gp_value(i, 8), ",", gp_value(i, 8), ",", gp_value(i, 8), "};"

         else
            print *, " size(this%Mesh%ElemNod,2)==", size(this%Mesh%ElemNod, 2)
            print *, ".and. size(this%Mesh%NodCoord,2)==", size(this%Mesh%NodCoord, 2)
            stop "plot_contour >> now constructing"
         end if
      end do
      write (fh, *) '};'
      close (fh)
   end subroutine
   !===========================================================================================

! ########################################################################################
   subroutine GmshPlotContour(this, gp_value, OptionalContorName, OptionalAbb, OptionalStep, Name)
      class(FEMDomain_), intent(in)::this
      real(real64), intent(in)::gp_value(:, :)
      integer(int32), optional, intent(in)::OptionalStep
      character, optional, intent(in):: OptionalContorName*30, OptionalAbb*6
      character(*), optional, intent(in)::Name
      real(real64), allocatable::x_double(:, :)
      real(real64), allocatable::x(:, :)
      integer(int32) i, j, k, step, fh
      character filename0*11
      character filename*25
      character filetitle*6
      character command*31
      character:: mapname*30, abbmap*6

      if (present(OptionalContorName)) then
         mapname = OptionalContorName
      else
         mapname = "Value"
      end if

      if (present(OptionalAbb)) then
         abbmap = OptionalAbb
      else
         abbmap = "Values"
      end if

      if (present(OptionalStep)) then
         step = OptionalStep
      else
         step = 1
      end if
      fh = 40

      filetitle(1:6) = abbmap(1:6)
      !---------------------
      write (filename0, '("_", i6.6, ".pos")') step ! ここでファイル名を生成している
      filename = filename0
      !command="touch "//this%FileName//filename
      !call execute_command_line("touch "//this%FileName//filename)

      open (fh, file=this%FileName//filetitle//filename)
      print *, "writing ", this%FileName//filetitle//filename, " step>>", step

      !---------------------
      if (size(this%Mesh%ElemNod, 2) == 4 .and. size(this%Mesh%NodCoord, 2) == 2) then
         allocate (x(4, 3))
         allocate (x_double(4, 3))

      elseif (size(this%Mesh%ElemNod, 2) == 8 .and. size(this%Mesh%NodCoord, 2) == 3) then
         allocate (x(8, 3))
         allocate (x_double(8, 3))

      end if

      x(:, :) = 0.0d0
      write (fh, *) 'View "', mapname, '" {'
      do i = 1, size(gp_value, 1)
         if (size(this%Mesh%ElemNod, 2) == 4 .and. size(this%Mesh%NodCoord, 2) == 2) then

            ! 2-D, 4 noded, isoparametric elements with four gauss points
            x_double(1, 1:2) = this%Mesh%NodCoord(this%Mesh%ElemNod(i, 1), 1:2)
            x_double(2, 1:2) = &
               0.50d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 1), 1:2) + 0.50d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 2), 1:2)
            x_double(3, 1:2) = &
               0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 1), 1:2) + 0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 2), 1:2) &
               + 0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 3), 1:2) + 0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 4), 1:2)
            x_double(4, 1:2) = &
               0.50d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 4), 1:2) + 0.50d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 1), 1:2)

            x(:, :) = x_double(:, :)

            write (fh, *) " SQ(", x(1, 1), ",", x(1, 2), ",", x(1, 3), "," &
               , x(2, 1), ",", x(2, 2), ",", x(2, 3), "," &
               , x(3, 1), ",", x(3, 2), ",", x(3, 3), "," &
               , x(4, 1), ",", x(4, 2), ",", x(4, 3), "){", gp_value(i, 1), ",", &
               gp_value(i, 1), ",", gp_value(i, 1), ",", gp_value(i, 1), "};"

            x_double(1, 1:2) = this%Mesh%NodCoord(this%Mesh%ElemNod(i, 2), 1:2)
            x_double(2, 1:2) = &
               0.50d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 2), 1:2) + 0.50d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 3), 1:2)
            x_double(3, 1:2) = &
               0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 1), 1:2) + 0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 2), 1:2) &
               + 0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 3), 1:2) + 0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 4), 1:2)
            x_double(4, 1:2) = &
               0.50d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 1), 1:2) + 0.50d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 2), 1:2)

            x(:, :) = x_double(:, :)

            write (fh, *) " SQ(", x(1, 1), ",", x(1, 2), ",", x(1, 3), "," &
               , x(2, 1), ",", x(2, 2), ",", x(2, 3), "," &
               , x(3, 1), ",", x(3, 2), ",", x(3, 3), "," &
               , x(4, 1), ",", x(4, 2), ",", x(4, 3), "){", gp_value(i, 2), ",", &
               gp_value(i, 2), ",", gp_value(i, 2), ",", gp_value(i, 2), "};"

            x_double(1, 1:2) = this%Mesh%NodCoord(this%Mesh%ElemNod(i, 3), 1:2)
            x_double(2, 1:2) = &
               0.50d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 3), 1:2) + 0.50d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 4), 1:2)
            x_double(3, 1:2) = &
               0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 1), 1:2) + 0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 2), 1:2) &
               + 0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 3), 1:2) + 0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 4), 1:2)
            x_double(4, 1:2) = &
               0.50d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 2), 1:2) + 0.50d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 3), 1:2)

            x(:, :) = x_double(:, :)

            write (fh, *) " SQ(", x(1, 1), ",", x(1, 2), ",", x(1, 3), "," &
               , x(2, 1), ",", x(2, 2), ",", x(2, 3), "," &
               , x(3, 1), ",", x(3, 2), ",", x(3, 3), "," &
               , x(4, 1), ",", x(4, 2), ",", x(4, 3), "){", gp_value(i, 3), ",", &
               gp_value(i, 3), ",", gp_value(i, 3), ",", gp_value(i, 3), "};"

            x_double(1, 1:2) = this%Mesh%NodCoord(this%Mesh%ElemNod(i, 4), 1:2)
            x_double(2, 1:2) = &
               0.50d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 4), 1:2) + 0.50d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 1), 1:2)
            x_double(3, 1:2) = &
               0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 1), 1:2) + 0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 2), 1:2) &
               + 0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 3), 1:2) + 0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 4), 1:2)
            x_double(4, 1:2) = &
               0.50d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 3), 1:2) + 0.50d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 4), 1:2)

            x(:, :) = x_double(:, :)

            write (fh, *) " SQ(", x(1, 1), ",", x(1, 2), ",", x(1, 3), "," &
               , x(2, 1), ",", x(2, 2), ",", x(2, 3), "," &
               , x(3, 1), ",", x(3, 2), ",", x(3, 3), "," &
               , x(4, 1), ",", x(4, 2), ",", x(4, 3), "){", gp_value(i, 4), ",", &
               gp_value(i, 4), ",", gp_value(i, 4), ",", gp_value(i, 4), "};"
         elseif (size(this%Mesh%ElemNod, 2) == 8 .and. size(this%Mesh%NodCoord, 2) == 3) then

            ! 3-D, 8 noded, isoparametric elements with 8 gauss points
            ! 1/8

            x_double(1, 1:3) = this%Mesh%NodCoord(this%Mesh%ElemNod(i, 1), 1:3)
            x_double(2, 1:3) = &
               0.50d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 1), 1:3) + 0.50d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 2), 1:3)
            x_double(3, 1:3) = &
               0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 1), 1:3) + 0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 2), 1:3) &
               + 0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 3), 1:3) + 0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 4), 1:3)
            x_double(4, 1:3) = &
               0.50d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 4), 1:3) + 0.50d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 1), 1:3)

            x_double(5, 1:3) = &
               0.50d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 1), 1:3) + 0.50d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 5), 1:3)

            x_double(6, 1:3) = &
               0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 1), 1:3) + 0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 2), 1:3) &
               + 0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 5), 1:3) + 0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 6), 1:3)

            x_double(7, 1:3) = &
             0.1250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 1), 1:3) + 0.1250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 2), 1:3) &
           + 0.1250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 3), 1:3) + 0.1250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 4), 1:3) &
           + 0.1250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 5), 1:3) + 0.1250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 6), 1:3) &
             + 0.1250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 7), 1:3) + 0.1250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 8), 1:3)

            x_double(8, 1:3) = &
               0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 1), 1:3) + 0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 4), 1:3) &
               + 0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 5), 1:3) + 0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 8), 1:3)

            x(:, :) = x_double(:, :)

            write (fh, *) " SQ(", x(4, 1), ",", x(4, 2), ",", x(4, 3), "," &
               , x(3, 1), ",", x(3, 2), ",", x(3, 3), "," &
               , x(2, 1), ",", x(2, 2), ",", x(2, 3), "," &
               , x(1, 1), ",", x(1, 2), ",", x(1, 3), "){", gp_value(i, 1), ",", &
               gp_value(i, 1), ",", gp_value(i, 1), ",", gp_value(i, 1), "};"
            write (fh, *) " SQ(", x(1, 1), ",", x(1, 2), ",", x(1, 3), "," &
               , x(2, 1), ",", x(2, 2), ",", x(2, 3), "," &
               , x(6, 1), ",", x(6, 2), ",", x(6, 3), "," &
               , x(5, 1), ",", x(5, 2), ",", x(5, 3), "){", gp_value(i, 1), ",", &
               gp_value(i, 1), ",", gp_value(i, 1), ",", gp_value(i, 1), "};"
            write (fh, *) " SQ(", x(2, 1), ",", x(2, 2), ",", x(2, 3), "," &
               , x(3, 1), ",", x(3, 2), ",", x(3, 3), "," &
               , x(7, 1), ",", x(7, 2), ",", x(7, 3), "," &
               , x(6, 1), ",", x(6, 2), ",", x(6, 3), "){", gp_value(i, 1), ",", &
               gp_value(i, 1), ",", gp_value(i, 1), ",", gp_value(i, 1), "};"
            write (fh, *) " SQ(", x(3, 1), ",", x(3, 2), ",", x(3, 3), "," &
               , x(4, 1), ",", x(4, 2), ",", x(4, 3), "," &
               , x(8, 1), ",", x(8, 2), ",", x(8, 3), "," &
               , x(7, 1), ",", x(7, 2), ",", x(7, 3), "){", gp_value(i, 1), ",", &
               gp_value(i, 1), ",", gp_value(i, 1), ",", gp_value(i, 1), "};"
            write (fh, *) " SQ(", x(4, 1), ",", x(4, 2), ",", x(4, 3), "," &
               , x(1, 1), ",", x(1, 2), ",", x(1, 3), "," &
               , x(5, 1), ",", x(5, 2), ",", x(5, 3), "," &
               , x(8, 1), ",", x(8, 2), ",", x(8, 3), "){", gp_value(i, 1), ",", &
               gp_value(i, 1), ",", gp_value(i, 1), ",", gp_value(i, 1), "};"
            write (fh, *) " SQ(", x(5, 1), ",", x(5, 2), ",", x(5, 3), "," &
               , x(6, 1), ",", x(6, 2), ",", x(6, 3), "," &
               , x(7, 1), ",", x(7, 2), ",", x(7, 3), "," &
               , x(8, 1), ",", x(8, 2), ",", x(8, 3), "){", gp_value(i, 1), ",", &
               gp_value(i, 1), ",", gp_value(i, 1), ",", gp_value(i, 1), "};"

            ! 2/8

            x_double(1, 1:3) = &
               0.50d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 1), 1:3) + 0.50d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 2), 1:3)

            x_double(2, 1:3) = this%Mesh%NodCoord(this%Mesh%ElemNod(i, 2), 1:3)

            x_double(3, 1:3) = &
               0.50d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 2), 1:3) + 0.50d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 3), 1:3)

            x_double(4, 1:3) = &
               0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 1), 1:3) + 0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 2), 1:3) &
               + 0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 3), 1:3) + 0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 4), 1:3)

            x_double(5, 1:3) = &
               0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 1), 1:3) + 0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 2), 1:3) &
               + 0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 5), 1:3) + 0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 6), 1:3)

            x_double(6, 1:3) = &
               0.50d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 2), 1:3) + 0.50d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 6), 1:3)

            x_double(7, 1:3) = &
               0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 2), 1:3) + 0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 3), 1:3) &
               + 0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 6), 1:3) + 0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 7), 1:3)

            x_double(8, 1:3) = &
             0.1250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 1), 1:3) + 0.1250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 2), 1:3) &
           + 0.1250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 3), 1:3) + 0.1250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 4), 1:3) &
           + 0.1250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 5), 1:3) + 0.1250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 6), 1:3) &
             + 0.1250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 7), 1:3) + 0.1250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 8), 1:3)

            x(:, :) = x_double(:, :)

            write (fh, *) " SQ(", x(4, 1), ",", x(4, 2), ",", x(4, 3), "," &
               , x(3, 1), ",", x(3, 2), ",", x(3, 3), "," &
               , x(2, 1), ",", x(2, 2), ",", x(2, 3), "," &
               , x(1, 1), ",", x(1, 2), ",", x(1, 3), "){", gp_value(i, 2), ",", &
               gp_value(i, 2), ",", gp_value(i, 2), ",", gp_value(i, 2), "};"
            write (fh, *) " SQ(", x(1, 1), ",", x(1, 2), ",", x(1, 3), "," &
               , x(2, 1), ",", x(2, 2), ",", x(2, 3), "," &
               , x(6, 1), ",", x(6, 2), ",", x(6, 3), "," &
               , x(5, 1), ",", x(5, 2), ",", x(5, 3), "){", gp_value(i, 2), ",", &
               gp_value(i, 2), ",", gp_value(i, 2), ",", gp_value(i, 2), "};"
            write (fh, *) " SQ(", x(2, 1), ",", x(2, 2), ",", x(2, 3), "," &
               , x(3, 1), ",", x(3, 2), ",", x(3, 3), "," &
               , x(7, 1), ",", x(7, 2), ",", x(7, 3), "," &
               , x(6, 1), ",", x(6, 2), ",", x(6, 3), "){", gp_value(i, 2), ",", &
               gp_value(i, 2), ",", gp_value(i, 2), ",", gp_value(i, 2), "};"
            write (fh, *) " SQ(", x(3, 1), ",", x(3, 2), ",", x(3, 3), "," &
               , x(4, 1), ",", x(4, 2), ",", x(4, 3), "," &
               , x(8, 1), ",", x(8, 2), ",", x(8, 3), "," &
               , x(7, 1), ",", x(7, 2), ",", x(7, 3), "){", gp_value(i, 2), ",", &
               gp_value(i, 2), ",", gp_value(i, 2), ",", gp_value(i, 2), "};"
            write (fh, *) " SQ(", x(4, 1), ",", x(4, 2), ",", x(4, 3), "," &
               , x(1, 1), ",", x(1, 2), ",", x(1, 3), "," &
               , x(5, 1), ",", x(5, 2), ",", x(5, 3), "," &
               , x(8, 1), ",", x(8, 2), ",", x(8, 3), "){", gp_value(i, 2), ",", &
               gp_value(i, 2), ",", gp_value(i, 2), ",", gp_value(i, 2), "};"
            write (fh, *) " SQ(", x(5, 1), ",", x(5, 2), ",", x(5, 3), "," &
               , x(6, 1), ",", x(6, 2), ",", x(6, 3), "," &
               , x(7, 1), ",", x(7, 2), ",", x(7, 3), "," &
               , x(8, 1), ",", x(8, 2), ",", x(8, 3), "){", gp_value(i, 2), ",", &
               gp_value(i, 2), ",", gp_value(i, 2), ",", gp_value(i, 2), "};"

            ! 3/8

            x_double(8, 1:3) = &
               0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 3), 1:3) + 0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 4), 1:3) &
               + 0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 8), 1:3) + 0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 7), 1:3)

            x_double(3, 1:3) = this%Mesh%NodCoord(this%Mesh%ElemNod(i, 3), 1:3)

            x_double(2, 1:3) = &
               0.50d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 2), 1:3) + 0.50d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 3), 1:3)

            x_double(1, 1:3) = &
               0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 1), 1:3) + 0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 2), 1:3) &
               + 0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 3), 1:3) + 0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 4), 1:3)

            x_double(6, 1:3) = &
               0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 3), 1:3) + 0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 2), 1:3) &
               + 0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 7), 1:3) + 0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 6), 1:3)

            x_double(7, 1:3) = &
               0.50d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 3), 1:3) + 0.50d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 7), 1:3)

            x_double(4, 1:3) = &
               0.50d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 4), 1:3) + 0.50d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 3), 1:3)

            x_double(5, 1:3) = &
             0.1250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 1), 1:3) + 0.1250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 2), 1:3) &
           + 0.1250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 3), 1:3) + 0.1250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 4), 1:3) &
           + 0.1250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 5), 1:3) + 0.1250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 6), 1:3) &
             + 0.1250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 7), 1:3) + 0.1250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 8), 1:3)

            x(:, :) = x_double(:, :)

            write (fh, *) " SQ(", x(4, 1), ",", x(4, 2), ",", x(4, 3), "," &
               , x(3, 1), ",", x(3, 2), ",", x(3, 3), "," &
               , x(2, 1), ",", x(2, 2), ",", x(2, 3), "," &
               , x(1, 1), ",", x(1, 2), ",", x(1, 3), "){", gp_value(i, 3), ",", &
               gp_value(i, 3), ",", gp_value(i, 3), ",", gp_value(i, 3), "};"
            write (fh, *) " SQ(", x(1, 1), ",", x(1, 2), ",", x(1, 3), "," &
               , x(2, 1), ",", x(2, 2), ",", x(2, 3), "," &
               , x(6, 1), ",", x(6, 2), ",", x(6, 3), "," &
               , x(5, 1), ",", x(5, 2), ",", x(5, 3), "){", gp_value(i, 3), ",", &
               gp_value(i, 3), ",", gp_value(i, 3), ",", gp_value(i, 3), "};"
            write (fh, *) " SQ(", x(2, 1), ",", x(2, 2), ",", x(2, 3), "," &
               , x(3, 1), ",", x(3, 2), ",", x(3, 3), "," &
               , x(7, 1), ",", x(7, 2), ",", x(7, 3), "," &
               , x(6, 1), ",", x(6, 2), ",", x(6, 3), "){", gp_value(i, 3), ",", &
               gp_value(i, 3), ",", gp_value(i, 3), ",", gp_value(i, 3), "};"
            write (fh, *) " SQ(", x(3, 1), ",", x(3, 2), ",", x(3, 3), "," &
               , x(4, 1), ",", x(4, 2), ",", x(4, 3), "," &
               , x(8, 1), ",", x(8, 2), ",", x(8, 3), "," &
               , x(7, 1), ",", x(7, 2), ",", x(7, 3), "){", gp_value(i, 3), ",", &
               gp_value(i, 3), ",", gp_value(i, 3), ",", gp_value(i, 3), "};"
            write (fh, *) " SQ(", x(4, 1), ",", x(4, 2), ",", x(4, 3), "," &
               , x(1, 1), ",", x(1, 2), ",", x(1, 3), "," &
               , x(5, 1), ",", x(5, 2), ",", x(5, 3), "," &
               , x(8, 1), ",", x(8, 2), ",", x(8, 3), "){", gp_value(i, 3), ",", &
               gp_value(i, 3), ",", gp_value(i, 3), ",", gp_value(i, 3), "};"
            write (fh, *) " SQ(", x(5, 1), ",", x(5, 2), ",", x(5, 3), "," &
               , x(6, 1), ",", x(6, 2), ",", x(6, 3), "," &
               , x(7, 1), ",", x(7, 2), ",", x(7, 3), "," &
               , x(8, 1), ",", x(8, 2), ",", x(8, 3), "){", gp_value(i, 3), ",", &
               gp_value(i, 3), ",", gp_value(i, 3), ",", gp_value(i, 3), "};"

            ! 4/8

            x_double(6, 1:3) = &
               0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 3), 1:3) + 0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 4), 1:3) &
               + 0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 8), 1:3) + 0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 7), 1:3)

            x_double(3, 1:3) = this%Mesh%NodCoord(this%Mesh%ElemNod(i, 4), 1:3)

            x_double(7, 1:3) = &
               0.50d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 4), 1:3) + 0.50d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 8), 1:3)

            x_double(1, 1:3) = &
               0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 1), 1:3) + 0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 2), 1:3) &
               + 0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 3), 1:3) + 0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 4), 1:3)

            x_double(8, 1:3) = &
               0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 1), 1:3) + 0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 4), 1:3) &
               + 0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 8), 1:3) + 0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 5), 1:3)

            x_double(4, 1:3) = &
               0.50d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 4), 1:3) + 0.50d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 1), 1:3)

            x_double(2, 1:3) = &
               0.50d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 4), 1:3) + 0.50d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 3), 1:3)

            x_double(5, 1:3) = &
             0.1250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 1), 1:3) + 0.1250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 2), 1:3) &
           + 0.1250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 3), 1:3) + 0.1250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 4), 1:3) &
           + 0.1250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 5), 1:3) + 0.1250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 6), 1:3) &
             + 0.1250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 7), 1:3) + 0.1250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 8), 1:3)

            x(:, :) = x_double(:, :)

            write (fh, *) " SQ(", x(4, 1), ",", x(4, 2), ",", x(4, 3), "," &
               , x(3, 1), ",", x(3, 2), ",", x(3, 3), "," &
               , x(2, 1), ",", x(2, 2), ",", x(2, 3), "," &
               , x(1, 1), ",", x(1, 2), ",", x(1, 3), "){", gp_value(i, 4), ",", &
               gp_value(i, 4), ",", gp_value(i, 4), ",", gp_value(i, 4), "};"
            write (fh, *) " SQ(", x(1, 1), ",", x(1, 2), ",", x(1, 3), "," &
               , x(2, 1), ",", x(2, 2), ",", x(2, 3), "," &
               , x(6, 1), ",", x(6, 2), ",", x(6, 3), "," &
               , x(5, 1), ",", x(5, 2), ",", x(5, 3), "){", gp_value(i, 4), ",", &
               gp_value(i, 4), ",", gp_value(i, 4), ",", gp_value(i, 4), "};"
            write (fh, *) " SQ(", x(2, 1), ",", x(2, 2), ",", x(2, 3), "," &
               , x(3, 1), ",", x(3, 2), ",", x(3, 3), "," &
               , x(7, 1), ",", x(7, 2), ",", x(7, 3), "," &
               , x(6, 1), ",", x(6, 2), ",", x(6, 3), "){", gp_value(i, 4), ",", &
               gp_value(i, 4), ",", gp_value(i, 4), ",", gp_value(i, 4), "};"
            write (fh, *) " SQ(", x(3, 1), ",", x(3, 2), ",", x(3, 3), "," &
               , x(4, 1), ",", x(4, 2), ",", x(4, 3), "," &
               , x(8, 1), ",", x(8, 2), ",", x(8, 3), "," &
               , x(7, 1), ",", x(7, 2), ",", x(7, 3), "){", gp_value(i, 4), ",", &
               gp_value(i, 4), ",", gp_value(i, 4), ",", gp_value(i, 4), "};"
            write (fh, *) " SQ(", x(4, 1), ",", x(4, 2), ",", x(4, 3), "," &
               , x(1, 1), ",", x(1, 2), ",", x(1, 3), "," &
               , x(5, 1), ",", x(5, 2), ",", x(5, 3), "," &
               , x(8, 1), ",", x(8, 2), ",", x(8, 3), "){", gp_value(i, 4), ",", &
               gp_value(i, 4), ",", gp_value(i, 4), ",", gp_value(i, 4), "};"
            write (fh, *) " SQ(", x(5, 1), ",", x(5, 2), ",", x(5, 3), "," &
               , x(6, 1), ",", x(6, 2), ",", x(6, 3), "," &
               , x(7, 1), ",", x(7, 2), ",", x(7, 3), "," &
               , x(8, 1), ",", x(8, 2), ",", x(8, 3), "){", gp_value(i, 4), ",", &
               gp_value(i, 4), ",", gp_value(i, 4), ",", gp_value(i, 4), "};"

            ! 5/8

            x_double(7, 1:3) = &
               0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 5), 1:3) + 0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 6), 1:3) &
               + 0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 8), 1:3) + 0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 7), 1:3)

            x_double(5, 1:3) = this%Mesh%NodCoord(this%Mesh%ElemNod(i, 5), 1:3)

            x_double(6, 1:3) = &
               0.50d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 5), 1:3) + 0.50d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 6), 1:3)

            x_double(2, 1:3) = &
               0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 1), 1:3) + 0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 2), 1:3) &
               + 0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 6), 1:3) + 0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 5), 1:3)

            x_double(4, 1:3) = &
               0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 1), 1:3) + 0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 4), 1:3) &
               + 0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 8), 1:3) + 0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 5), 1:3)

            x_double(1, 1:3) = &
               0.50d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 5), 1:3) + 0.50d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 1), 1:3)

            x_double(8, 1:3) = &
               0.50d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 5), 1:3) + 0.50d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 8), 1:3)

            x_double(3, 1:3) = &
             0.1250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 1), 1:3) + 0.1250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 2), 1:3) &
           + 0.1250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 3), 1:3) + 0.1250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 4), 1:3) &
           + 0.1250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 5), 1:3) + 0.1250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 6), 1:3) &
             + 0.1250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 7), 1:3) + 0.1250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 8), 1:3)

            x(:, :) = x_double(:, :)

            write (fh, *) " SQ(", x(4, 1), ",", x(4, 2), ",", x(4, 3), "," &
               , x(3, 1), ",", x(3, 2), ",", x(3, 3), "," &
               , x(2, 1), ",", x(2, 2), ",", x(2, 3), "," &
               , x(1, 1), ",", x(1, 2), ",", x(1, 3), "){", gp_value(i, 5), ",", &
               gp_value(i, 5), ",", gp_value(i, 5), ",", gp_value(i, 5), "};"
            write (fh, *) " SQ(", x(1, 1), ",", x(1, 2), ",", x(1, 3), "," &
               , x(2, 1), ",", x(2, 2), ",", x(2, 3), "," &
               , x(6, 1), ",", x(6, 2), ",", x(6, 3), "," &
               , x(5, 1), ",", x(5, 2), ",", x(5, 3), "){", gp_value(i, 5), ",", &
               gp_value(i, 5), ",", gp_value(i, 5), ",", gp_value(i, 5), "};"
            write (fh, *) " SQ(", x(2, 1), ",", x(2, 2), ",", x(2, 3), "," &
               , x(6, 1), ",", x(6, 2), ",", x(6, 3), "," &
               , x(3, 1), ",", x(3, 2), ",", x(3, 3), "," &
               , x(7, 1), ",", x(7, 2), ",", x(7, 3), "){", gp_value(i, 5), ",", &
               gp_value(i, 5), ",", gp_value(i, 5), ",", gp_value(i, 5), "};"
            write (fh, *) " SQ(", x(3, 1), ",", x(3, 2), ",", x(3, 3), "," &
               , x(4, 1), ",", x(4, 2), ",", x(4, 3), "," &
               , x(8, 1), ",", x(8, 2), ",", x(8, 3), "," &
               , x(7, 1), ",", x(7, 2), ",", x(7, 3), "){", gp_value(i, 5), ",", &
               gp_value(i, 5), ",", gp_value(i, 5), ",", gp_value(i, 5), "};"
            write (fh, *) " SQ(", x(4, 1), ",", x(4, 2), ",", x(4, 3), "," &
               , x(1, 1), ",", x(1, 2), ",", x(1, 3), "," &
               , x(5, 1), ",", x(5, 2), ",", x(5, 3), "," &
               , x(8, 1), ",", x(8, 2), ",", x(8, 3), "){", gp_value(i, 5), ",", &
               gp_value(i, 5), ",", gp_value(i, 5), ",", gp_value(i, 5), "};"
            write (fh, *) " SQ(", x(5, 1), ",", x(5, 2), ",", x(5, 3), "," &
               , x(6, 1), ",", x(6, 2), ",", x(6, 3), "," &
               , x(7, 1), ",", x(7, 2), ",", x(7, 3), "," &
               , x(8, 1), ",", x(8, 2), ",", x(8, 3), "){", gp_value(i, 5), ",", &
               gp_value(i, 5), ",", gp_value(i, 5), ",", gp_value(i, 5), "};"

            ! 6/8

            x_double(8, 1:3) = &
               0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 5), 1:3) + 0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 6), 1:3) &
               + 0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 8), 1:3) + 0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 7), 1:3)

            x_double(6, 1:3) = this%Mesh%NodCoord(this%Mesh%ElemNod(i, 6), 1:3)

            x_double(5, 1:3) = &
               0.50d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 5), 1:3) + 0.50d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 6), 1:3)

            x_double(1, 1:3) = &
               0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 1), 1:3) + 0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 2), 1:3) &
               + 0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 6), 1:3) + 0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 5), 1:3)

            x_double(3, 1:3) = &
               0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 2), 1:3) + 0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 3), 1:3) &
               + 0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 7), 1:3) + 0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 6), 1:3)

            x_double(2, 1:3) = &
               0.50d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 6), 1:3) + 0.50d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 2), 1:3)

            x_double(7, 1:3) = &
               0.50d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 6), 1:3) + 0.50d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 7), 1:3)

            x_double(4, 1:3) = &
             0.1250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 1), 1:3) + 0.1250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 2), 1:3) &
           + 0.1250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 3), 1:3) + 0.1250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 4), 1:3) &
           + 0.1250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 5), 1:3) + 0.1250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 6), 1:3) &
             + 0.1250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 7), 1:3) + 0.1250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 8), 1:3)

            x(:, :) = x_double(:, :)

            write (fh, *) " SQ(", x(4, 1), ",", x(4, 2), ",", x(4, 3), "," &
               , x(3, 1), ",", x(3, 2), ",", x(3, 3), "," &
               , x(2, 1), ",", x(2, 2), ",", x(2, 3), "," &
               , x(1, 1), ",", x(1, 2), ",", x(1, 3), "){", gp_value(i, 6), ",", &
               gp_value(i, 6), ",", gp_value(i, 6), ",", gp_value(i, 6), "};"
            write (fh, *) " SQ(", x(1, 1), ",", x(1, 2), ",", x(1, 3), "," &
               , x(2, 1), ",", x(2, 2), ",", x(2, 3), "," &
               , x(6, 1), ",", x(6, 2), ",", x(6, 3), "," &
               , x(5, 1), ",", x(5, 2), ",", x(5, 3), "){", gp_value(i, 6), ",", &
               gp_value(i, 6), ",", gp_value(i, 6), ",", gp_value(i, 6), "};"
            write (fh, *) " SQ(", x(2, 1), ",", x(2, 2), ",", x(2, 3), "," &
               , x(3, 1), ",", x(3, 2), ",", x(3, 3), "," &
               , x(7, 1), ",", x(7, 2), ",", x(7, 3), "," &
               , x(6, 1), ",", x(6, 2), ",", x(6, 3), "){", gp_value(i, 6), ",", &
               gp_value(i, 6), ",", gp_value(i, 6), ",", gp_value(i, 6), "};"
            write (fh, *) " SQ(", x(3, 1), ",", x(3, 2), ",", x(3, 3), "," &
               , x(4, 1), ",", x(4, 2), ",", x(4, 3), "," &
               , x(8, 1), ",", x(8, 2), ",", x(8, 3), "," &
               , x(7, 1), ",", x(7, 2), ",", x(7, 3), "){", gp_value(i, 6), ",", &
               gp_value(i, 6), ",", gp_value(i, 6), ",", gp_value(i, 6), "};"
            write (fh, *) " SQ(", x(4, 1), ",", x(4, 2), ",", x(4, 3), "," &
               , x(1, 1), ",", x(1, 2), ",", x(1, 3), "," &
               , x(5, 1), ",", x(5, 2), ",", x(5, 3), "," &
               , x(8, 1), ",", x(8, 2), ",", x(8, 3), "){", gp_value(i, 6), ",", &
               gp_value(i, 6), ",", gp_value(i, 6), ",", gp_value(i, 6), "};"
            write (fh, *) " SQ(", x(5, 1), ",", x(5, 2), ",", x(5, 3), "," &
               , x(6, 1), ",", x(6, 2), ",", x(6, 3), "," &
               , x(7, 1), ",", x(7, 2), ",", x(7, 3), "," &
               , x(8, 1), ",", x(8, 2), ",", x(8, 3), "){", gp_value(i, 6), ",", &
               gp_value(i, 6), ",", gp_value(i, 6), ",", gp_value(i, 6), "};"

            ! 7/8

            x_double(5, 1:3) = &
               0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 5), 1:3) + 0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 6), 1:3) &
               + 0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 8), 1:3) + 0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 7), 1:3)

            x_double(7, 1:3) = this%Mesh%NodCoord(this%Mesh%ElemNod(i, 7), 1:3)

            x_double(8, 1:3) = &
               0.50d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 7), 1:3) + 0.50d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 8), 1:3)

            x_double(4, 1:3) = &
               0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 3), 1:3) + 0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 4), 1:3) &
               + 0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 7), 1:3) + 0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 8), 1:3)

            x_double(2, 1:3) = &
               0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 2), 1:3) + 0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 3), 1:3) &
               + 0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 6), 1:3) + 0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 7), 1:3)

            x_double(3, 1:3) = &
               0.50d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 3), 1:3) + 0.50d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 7), 1:3)

            x_double(6, 1:3) = &
               0.50d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 6), 1:3) + 0.50d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 7), 1:3)

            x_double(1, 1:3) = &
             0.1250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 1), 1:3) + 0.1250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 2), 1:3) &
           + 0.1250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 3), 1:3) + 0.1250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 4), 1:3) &
           + 0.1250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 5), 1:3) + 0.1250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 6), 1:3) &
             + 0.1250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 7), 1:3) + 0.1250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 8), 1:3)

            x(:, :) = x_double(:, :)

            write (fh, *) " SQ(", x(4, 1), ",", x(4, 2), ",", x(4, 3), "," &
               , x(3, 1), ",", x(3, 2), ",", x(3, 3), "," &
               , x(2, 1), ",", x(2, 2), ",", x(2, 3), "," &
               , x(1, 1), ",", x(1, 2), ",", x(1, 3), "){", gp_value(i, 7), ",", &
               gp_value(i, 7), ",", gp_value(i, 7), ",", gp_value(i, 7), "};"
            write (fh, *) " SQ(", x(1, 1), ",", x(1, 2), ",", x(1, 3), "," &
               , x(2, 1), ",", x(2, 2), ",", x(2, 3), "," &
               , x(6, 1), ",", x(6, 2), ",", x(6, 3), "," &
               , x(5, 1), ",", x(5, 2), ",", x(5, 3), "){", gp_value(i, 7), ",", &
               gp_value(i, 7), ",", gp_value(i, 7), ",", gp_value(i, 7), "};"
            write (fh, *) " SQ(", x(2, 1), ",", x(2, 2), ",", x(2, 3), "," &
               , x(3, 1), ",", x(3, 2), ",", x(3, 3), "," &
               , x(7, 1), ",", x(7, 2), ",", x(7, 3), "," &
               , x(6, 1), ",", x(6, 2), ",", x(6, 3), "){", gp_value(i, 7), ",", &
               gp_value(i, 7), ",", gp_value(i, 7), ",", gp_value(i, 7), "};"
            write (fh, *) " SQ(", x(3, 1), ",", x(3, 2), ",", x(3, 3), "," &
               , x(4, 1), ",", x(4, 2), ",", x(4, 3), "," &
               , x(8, 1), ",", x(8, 2), ",", x(8, 3), "," &
               , x(7, 1), ",", x(7, 2), ",", x(7, 3), "){", gp_value(i, 7), ",", &
               gp_value(i, 7), ",", gp_value(i, 7), ",", gp_value(i, 7), "};"
            write (fh, *) " SQ(", x(4, 1), ",", x(4, 2), ",", x(4, 3), "," &
               , x(1, 1), ",", x(1, 2), ",", x(1, 3), "," &
               , x(5, 1), ",", x(5, 2), ",", x(5, 3), "," &
               , x(8, 1), ",", x(8, 2), ",", x(8, 3), "){", gp_value(i, 7), ",", &
               gp_value(i, 7), ",", gp_value(i, 7), ",", gp_value(i, 7), "};"
            write (fh, *) " SQ(", x(5, 1), ",", x(5, 2), ",", x(5, 3), "," &
               , x(6, 1), ",", x(6, 2), ",", x(6, 3), "," &
               , x(7, 1), ",", x(7, 2), ",", x(7, 3), "," &
               , x(8, 1), ",", x(8, 2), ",", x(8, 3), "){", gp_value(i, 7), ",", &
               gp_value(i, 7), ",", gp_value(i, 7), ",", gp_value(i, 7), "};"

            ! 8/8

            x_double(5, 1:3) = &
               0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 5), 1:3) + 0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 6), 1:3) &
               + 0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 8), 1:3) + 0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 7), 1:3)

            x_double(7, 1:3) = this%Mesh%NodCoord(this%Mesh%ElemNod(i, 8), 1:3)

            x_double(6, 1:3) = &
               0.50d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 7), 1:3) + 0.50d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 8), 1:3)

            x_double(2, 1:3) = &
               0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 3), 1:3) + 0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 4), 1:3) &
               + 0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 7), 1:3) + 0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 8), 1:3)

            x_double(4, 1:3) = &
               0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 1), 1:3) + 0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 4), 1:3) &
               + 0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 5), 1:3) + 0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 8), 1:3)

            x_double(3, 1:3) = &
               0.50d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 4), 1:3) + 0.50d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 8), 1:3)

            x_double(8, 1:3) = &
               0.50d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 5), 1:3) + 0.50d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 8), 1:3)

            x_double(1, 1:3) = &
             0.1250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 1), 1:3) + 0.1250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 2), 1:3) &
           + 0.1250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 3), 1:3) + 0.1250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 4), 1:3) &
           + 0.1250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 5), 1:3) + 0.1250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 6), 1:3) &
             + 0.1250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 7), 1:3) + 0.1250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 8), 1:3)

            x(:, :) = x_double(:, :)

            write (fh, *) " SQ(", x(4, 1), ",", x(4, 2), ",", x(4, 3), "," &
               , x(3, 1), ",", x(3, 2), ",", x(3, 3), "," &
               , x(2, 1), ",", x(2, 2), ",", x(2, 3), "," &
               , x(1, 1), ",", x(1, 2), ",", x(1, 3), "){", gp_value(i, 8), ",", &
               gp_value(i, 8), ",", gp_value(i, 8), ",", gp_value(i, 8), "};"
            write (fh, *) " SQ(", x(1, 1), ",", x(1, 2), ",", x(1, 3), "," &
               , x(2, 1), ",", x(2, 2), ",", x(2, 3), "," &
               , x(6, 1), ",", x(6, 2), ",", x(6, 3), "," &
               , x(5, 1), ",", x(5, 2), ",", x(5, 3), "){", gp_value(i, 8), ",", &
               gp_value(i, 8), ",", gp_value(i, 8), ",", gp_value(i, 8), "};"
            write (fh, *) " SQ(", x(2, 1), ",", x(2, 2), ",", x(2, 3), "," &
               , x(3, 1), ",", x(3, 2), ",", x(3, 3), "," &
               , x(7, 1), ",", x(7, 2), ",", x(7, 3), "," &
               , x(6, 1), ",", x(6, 2), ",", x(6, 3), "){", gp_value(i, 8), ",", &
               gp_value(i, 8), ",", gp_value(i, 8), ",", gp_value(i, 8), "};"
            write (fh, *) " SQ(", x(3, 1), ",", x(3, 2), ",", x(3, 3), "," &
               , x(4, 1), ",", x(4, 2), ",", x(4, 3), "," &
               , x(8, 1), ",", x(8, 2), ",", x(8, 3), "," &
               , x(7, 1), ",", x(7, 2), ",", x(7, 3), "){", gp_value(i, 8), ",", &
               gp_value(i, 8), ",", gp_value(i, 8), ",", gp_value(i, 8), "};"
            write (fh, *) " SQ(", x(4, 1), ",", x(4, 2), ",", x(4, 3), "," &
               , x(1, 1), ",", x(1, 2), ",", x(1, 3), "," &
               , x(5, 1), ",", x(5, 2), ",", x(5, 3), "," &
               , x(8, 1), ",", x(8, 2), ",", x(8, 3), "){", gp_value(i, 8), ",", &
               gp_value(i, 8), ",", gp_value(i, 8), ",", gp_value(i, 8), "};"
            write (fh, *) " SQ(", x(5, 1), ",", x(5, 2), ",", x(5, 3), "," &
               , x(6, 1), ",", x(6, 2), ",", x(6, 3), "," &
               , x(7, 1), ",", x(7, 2), ",", x(7, 3), "," &
               , x(8, 1), ",", x(8, 2), ",", x(8, 3), "){", gp_value(i, 8), ",", &
               gp_value(i, 8), ",", gp_value(i, 8), ",", gp_value(i, 8), "};"

         else
            stop "plot_contour >> now constructing"
         end if
      end do
      write (fh, *) '};'
      close (fh)
   end subroutine
!===========================================================================================

!===========================================================================================
   subroutine GmshPlotVector(this, Vector, Name, FieldName, Step, fh, withMsh, ElementWize, NodeWize, onlyDirichlet)
      class(FEMDomain_), intent(in)::this
      real(real64), optional, intent(in)::Vector(:, :)
      character(*), intent(in)::FieldName
      character(*), optional, intent(in)::Name
      integer(int32), intent(in)::Step
      real(real64), allocatable ::DBCVector(:, :)
      integer(int32), optional, intent(in)::fh
      logical, optional, intent(in)::withMsh, ElementWize, NodeWize, onlyDirichlet

      character :: filename0*11, filename1*11, center*15
      integer(int32) :: FileHandle, i, j, k, n, m
      FileHandle = input(default=1000, option=fh)

      if (present(onlyDirichlet)) then
         if (onlyDirichlet .eqv. .true.) then

            call this%getDBCVector(DBCVector)
            do i = 1, size(DBCVector, 1)
               write (10, *) DBCVector(i, :)
            end do

            center = "$NodeData"

            ! only for 3D

            write (filename0, '("_", i6.6, "_vec")') step
            if (present(Name)) then
               open (FileHandle, file=Name//filename0//".msh")
               print *, Name//filename0//".msh"//" is exported!"
            else
               open (FileHandle, file="DBCVector"//filename0//".msh")
               print *, "DBCVector"//filename0//".msh"//" is exported!"
            end if
            write (FileHandle, '(A)') "$MeshFormat"

            write (FileHandle, '(A)') "2.2 0 8"
            write (FileHandle, '(A)') "$EndMeshFormat"
            write (FileHandle, '(A)') center
            write (FileHandle, '(A)') "1"
            write (FileHandle, '(A)') '"'//FieldName//'"'
            write (FileHandle, '(A)') "1"
            write (FileHandle, '(A)') "0.0"
            write (FileHandle, '(A)') "3"
            write (FileHandle, '(A)') "1"
            write (FileHandle, '(A)') "3"
            write (FileHandle, *) size(this%Mesh%NodCoord, 1)
            do i = 1, size(this%Mesh%NodCoord, 1)
               write (FileHandle, *) i, DBCVector(i, :)
            end do

            close (FileHandle)

            if (present(withMsh)) then
               if (withMsh .eqv. .true.) then

                  write (filename1, '("_", i6.6, "_msh")') step
                  if (present(Name)) then
                     open (FileHandle, file=Name//filename1//".msh")
                     print *, Name//filename1//".msh"//" is exported!"
                  else
                     open (FileHandle, file="DBCVector"//filename1//".msh")
                     print *, "DBCVector"//filename1//".msh"//" is exported!"
                  end if
                  write (FileHandle, '(A)') "$MeshFormat"

                  write (FileHandle, '(A)') "2.2 0 8"
                  write (FileHandle, '(A)') "$EndMeshFormat"
                  write (FileHandle, '(A)') "$Nodes"
                  write (FileHandle, *) size(this%Mesh%NodCoord, 1)
                  do i = 1, size(this%Mesh%NodCoord, 1)
                     write (FileHandle, *) i, this%Mesh%NodCoord(i, :)
                  end do
                  write (FileHandle, '(A)') "$EndNodes"
                  write (FileHandle, '(A)') "$Elements"
                  write (FileHandle, *) size(this%Mesh%ElemNod, 1)
                  do i = 1, size(this%Mesh%ElemNod, 1)
                     write (FileHandle, *) i, "5 2 0 1 ", this%Mesh%ElemNod(i, :)
                  end do
                  write (FileHandle, '(A)') "$EndElements"

                  close (FileHandle)
               end if
            end if
            return

         end if
      end if

      if (present(NodeWize)) then
         if (NodeWize .eqv. .true.) then
            center = "$NodeData"
         else
            center = "$ElementData"
         end if
      elseif (present(ElementWize)) then
         if (ElementWize .eqv. .true.) then
            center = "$ElementData"
         else
            center = "$NodeData"
         end if
      else
         center = "$NodeData"
      end if

      ! only for 3D

      write (filename0, '("_", i6.6, "_vec")') step
      if (present(Name)) then
         open (FileHandle, file=Name//filename0//".msh")
         print *, Name//filename0//".msh"//" is exported!"
      else
         open (FileHandle, file="Vector"//filename0//".msh")
         print *, "Vector"//filename0//".msh"//" is exported!"
      end if
      write (FileHandle, '(A)') "$MeshFormat"

      write (FileHandle, '(A)') "2.2 0 8"
      write (FileHandle, '(A)') "$EndMeshFormat"
      write (FileHandle, '(A)') center
      write (FileHandle, '(A)') "1"
      write (FileHandle, '(A)') '"'//FieldName//'"'
      write (FileHandle, '(A)') "1"
      write (FileHandle, '(A)') "0.0"
      write (FileHandle, '(A)') "3"
      write (FileHandle, '(A)') "1"
      write (FileHandle, '(A)') "3"
      write (FileHandle, *) size(this%Mesh%NodCoord, 1)
      do i = 1, size(this%Mesh%NodCoord, 1)
         write (FileHandle, *) i, Vector(i, :)
      end do

      close (FileHandle)

      if (present(withMsh)) then
         if (withMsh .eqv. .true.) then

            write (filename1, '("_", i6.6, "_msh")') step
            if (present(Name)) then
               open (FileHandle, file=Name//filename1//".msh")
               print *, Name//filename1//".msh"//" is exported!"
            else
               open (FileHandle, file="Vector"//filename1//".msh")
               print *, "Vector"//filename1//".msh"//" is exported!"
            end if
            write (FileHandle, '(A)') "$MeshFormat"

            write (FileHandle, '(A)') "2.2 0 8"
            write (FileHandle, '(A)') "$EndMeshFormat"
            write (FileHandle, '(A)') "$Nodes"
            write (FileHandle, *) size(this%Mesh%NodCoord, 1)
            do i = 1, size(this%Mesh%NodCoord, 1)
               write (FileHandle, *) i, this%Mesh%NodCoord(i, :)
            end do
            write (FileHandle, '(A)') "$EndNodes"
            write (FileHandle, '(A)') "$Elements"
            write (FileHandle, *) size(this%Mesh%ElemNod, 1)
            do i = 1, size(this%Mesh%ElemNod, 1)
               write (FileHandle, *) i, "5 2 0 1 ", this%Mesh%ElemNod(i, :)
            end do
            write (FileHandle, '(A)') "$EndElements"

            close (FileHandle)
         end if
      end if

   end subroutine
!===========================================================================================

   subroutine GmshPlotContour2D(this, gp_value, OptionalContorName, OptionalAbb, OptionalStep, Name)
      class(FEMDomain_), intent(in)::this
      real(real64), intent(in)::gp_value(:, :)
      integer(int32), optional, intent(in)::OptionalStep
      character, optional, intent(in):: OptionalContorName*30, OptionalAbb*6
      character(*), optional, intent(in)::Name
      real(real64), allocatable::x(:, :)
      integer(int32) i, j, k, step
      character filename0*11
      character filename*17
      character filetitle*6
      character:: mapname*30, abbmap*6

      if (present(OptionalContorName)) then
         mapname = OptionalContorName
      else
         mapname = "Value"
      end if

      if (present(OptionalAbb)) then
         abbmap = OptionalAbb
      else
         abbmap = "Values"
      end if

      if (present(OptionalStep)) then
         step = OptionalStep
      else
         step = 1
      end if

      filetitle(1:6) = abbmap(1:6)
      !---------------------
      write (filename0, '("_", i6.6, ".pos")') step ! ここでファイル名を生成している
      filename = filename0

      open (40, file=this%FileName//filetitle//filename0)
      print *, "writing ", this%FileName//filetitle//filename0, " step>>", step

      !---------------------
      allocate (x(4, 3))
      x(:, :) = 0.0d0
      write (40, *) 'View "', mapname, '" {'
      do i = 1, size(this%Mesh%ElemNod, 1)
         if (size(this%Mesh%ElemNod, 2) /= 4) stop "GmshPlotContour >> now constructing"

         x(1, 1:2) = this%Mesh%NodCoord(this%Mesh%ElemNod(i, 1), 1:2)
         x(2, 1:2) = &
            0.50d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 1), 1:2) + 0.50d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 2), 1:2)
         x(3, 1:2) = &
            0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 1), 1:2) + 0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 2), 1:2) &
            + 0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 3), 1:2) + 0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 4), 1:2)
         x(4, 1:2) = &
            0.50d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 4), 1:2) + 0.50d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 1), 1:2)
         write (40, *) " SQ(", x(1, 1), ",", x(1, 2), ",", x(1, 3), "," &
            , x(2, 1), ",", x(2, 2), ",", x(2, 3), "," &
            , x(3, 1), ",", x(3, 2), ",", x(3, 3), "," &
            , x(4, 1), ",", x(4, 2), ",", x(4, 3), "){", gp_value(i, 1), ",", &
            gp_value(i, 1), ",", gp_value(i, 1), ",", gp_value(i, 1), "};"

         x(1, 1:2) = this%Mesh%NodCoord(this%Mesh%ElemNod(i, 2), 1:2)
         x(2, 1:2) = &
            0.50d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 2), 1:2) + 0.50d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 3), 1:2)
         x(3, 1:2) = &
            0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 1), 1:2) + 0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 2), 1:2) &
            + 0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 3), 1:2) + 0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 4), 1:2)
         x(4, 1:2) = &
            0.50d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 1), 1:2) + 0.50d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 2), 1:2)
         write (40, *) " SQ(", x(1, 1), ",", x(1, 2), ",", x(1, 3), "," &
            , x(2, 1), ",", x(2, 2), ",", x(2, 3), "," &
            , x(3, 1), ",", x(3, 2), ",", x(3, 3), "," &
            , x(4, 1), ",", x(4, 2), ",", x(4, 3), "){", gp_value(i, 2), ",", &
            gp_value(i, 2), ",", gp_value(i, 2), ",", gp_value(i, 2), "};"

         x(1, 1:2) = this%Mesh%NodCoord(this%Mesh%ElemNod(i, 3), 1:2)
         x(2, 1:2) = &
            0.50d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 3), 1:2) + 0.50d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 4), 1:2)
         x(3, 1:2) = &
            0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 1), 1:2) + 0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 2), 1:2) &
            + 0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 3), 1:2) + 0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 4), 1:2)
         x(4, 1:2) = &
            0.50d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 2), 1:2) + 0.50d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 3), 1:2)
         write (40, *) " SQ(", x(1, 1), ",", x(1, 2), ",", x(1, 3), "," &
            , x(2, 1), ",", x(2, 2), ",", x(2, 3), "," &
            , x(3, 1), ",", x(3, 2), ",", x(3, 3), "," &
            , x(4, 1), ",", x(4, 2), ",", x(4, 3), "){", gp_value(i, 3), ",", &
            gp_value(i, 3), ",", gp_value(i, 3), ",", gp_value(i, 3), "};"

         x(1, 1:2) = this%Mesh%NodCoord(this%Mesh%ElemNod(i, 4), 1:2)
         x(2, 1:2) = &
            0.50d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 4), 1:2) + 0.50d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 1), 1:2)
         x(3, 1:2) = &
            0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 1), 1:2) + 0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 2), 1:2) &
            + 0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 3), 1:2) + 0.250d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 4), 1:2)
         x(4, 1:2) = &
            0.50d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 3), 1:2) + 0.50d0*this%Mesh%NodCoord(this%Mesh%ElemNod(i, 4), 1:2)
         write (40, *) " SQ(", x(1, 1), ",", x(1, 2), ",", x(1, 3), "," &
            , x(2, 1), ",", x(2, 2), ",", x(2, 3), "," &
            , x(3, 1), ",", x(3, 2), ",", x(3, 3), "," &
            , x(4, 1), ",", x(4, 2), ",", x(4, 3), "){", gp_value(i, 4), ",", &
            gp_value(i, 4), ",", gp_value(i, 4), ",", gp_value(i, 4), "};"
      end do
      write (40, *) '};'
   end subroutine GmshPlotContour2D
   !===========================================================================================
   subroutine GmshExportStress(this, uvec, sigma, strain_measure, step, Name)
      class(FEMDomain_), intent(in)::this
      real(real64), intent(in)::uvec(:), sigma(:, :, :), strain_measure(:, :, :)
      integer(int32), intent(in)::step
      character p_stress_field*30
      real(real64), allocatable::c_nod_coord(:, :), gp_value(:, :), F_iJ(:, :), b_ij(:, :)
      real(real64) tr_sigma, tr_C, tr_b
      character q_stress_field*30
      character p_strain_field*30
      character q_strain_field*30
      character mapname*30, abbrivation*6
      character(*), optional, intent(in)::Name
      integer(int32) i, j, n, gp_number, dim_num

      gp_number = size(strain_measure, 2)
      dim_num = size(this%Mesh%NodCoord, 2)

      p_stress_field = "Hydrostatic stress (kPa)"
      q_stress_field = "Deviatoric stress (kPa)"
      p_strain_field = "Hydrostatic strain "
      q_strain_field = "Deviatoric strain "

      allocate (F_iJ(3, 3), b_ij(3, 3))

      allocate (c_nod_coord(size(this%Mesh%NodCoord, 1), size(this%Mesh%NodCoord, 2)))
      allocate (gp_value(size(this%Mesh%ElemNod, 1), gp_number))

      do i = 1, size(this%Mesh%NodCoord, 1)
         c_nod_coord(i, :) = this%Mesh%NodCoord(i, :) + uvec(dim_num*(i - 1) + 1:dim_num*i)
      end do

        ! !"Hydrostatic stress (kPa)"
      do i = 1, size(sigma, 1)
         do j = 1, size(sigma, 2)
            if (dim_num == 2) then
               gp_value(i, j) = sigma(i, j, 1) + sigma(i, j, 2) + sigma(i, j, 4)
               gp_value(i, j) = gp_value(i, j)/3.0d0
            elseif (dim_num == 3) then
               gp_value(i, j) = sigma(i, j, 1) + sigma(i, j, 2) + sigma(i, j, 3)
               gp_value(i, j) = gp_value(i, j)/3.0d0
            end if
         end do
      end do
      mapname = p_stress_field
      abbrivation = "Hysigm"
      call GmshPlotContour(this, gp_value, mapname, abbrivation, step, Name=Name)

        ! !""Deviatoric stress (kPa)"
      do i = 1, size(sigma, 1)
         do j = 1, size(sigma, 2)
            if (dim_num == 2) then
               tr_sigma = sigma(i, j, 1) + sigma(i, j, 2) + sigma(i, j, 4)

               gp_value(i, j) = (1.50d0*(sigma(i, j, 1)*sigma(i, j, 1) + &
                             sigma(i, j, 2)*sigma(i, j, 2) + sigma(i, j, 4)*sigma(i, j, 4) + sigma(i, j, 3)*sigma(i, j, 3)*2.0d0 - &
                                         tr_sigma*tr_sigma/3.0d0))**(0.50d0)
            elseif (dim_num == 3) then

               gp_value(i, j) = (1.50d0*(sigma(i, j, 1)*sigma(i, j, 1) + &
                               sigma(i, j, 2)*sigma(i, j, 2) + sigma(i, j, 3)*sigma(i, j, 3) + sigma(i, j, 4)*sigma(i, j, 4)*3.0d0 &
                                         + sigma(i, j, 5)*sigma(i, j, 5)*3.0d0 + sigma(i, j, 6)*sigma(i, j, 6)*3.0d0 &
                         - sigma(i, j, 1)*sigma(i, j, 2) - sigma(i, j, 2)*sigma(i, j, 3) - sigma(i, j, 3)*sigma(i, j, 1)))**(0.50d0)

            else
               stop "dim_num should be 2 or 3, GmshExportStress"
            end if
         end do
      end do
      mapname = q_stress_field
      abbrivation = "Dvsigm"
      call GmshPlotContour(this, gp_value, mapname, abbrivation, step, Name=Name)

        ! !"Hydrostatic strain"
      do i = 1, size(strain_measure, 1)
         do j = 1, size(strain_measure, 2)
            F_iJ(:, :) = 0.0d0
            if (dim_num == 2) then
               F_iJ(1, 1) = strain_measure(i, j, 11)
               F_iJ(2, 1) = strain_measure(i, j, 14)
               F_iJ(1, 2) = strain_measure(i, j, 13)
               F_iJ(2, 2) = strain_measure(i, j, 12)
               F_iJ(3, 3) = 1.0d0
            elseif (dim_num == 3) then
               F_iJ(1, 1) = strain_measure(i, j, 11)
               F_iJ(2, 1) = strain_measure(i, j, 14)
               F_iJ(1, 2) = strain_measure(i, j, 13)
               F_iJ(2, 2) = strain_measure(i, j, 12)
               F_iJ(3, 3) = strain_measure(i, j, 27)
               F_iJ(1, 3) = strain_measure(i, j, 28)
               F_iJ(2, 3) = strain_measure(i, j, 29)
               F_iJ(3, 1) = strain_measure(i, j, 30)
               F_iJ(3, 2) = strain_measure(i, j, 31)
            else
               stop "dim_num should be 2 or 3"
            end if
            b_ij(:, :) = matmul(F_iJ, transpose(F_iJ))
            gp_value(i, j) = b_iJ(1, 1) + b_iJ(2, 2) + b_iJ(3, 3)
            gp_value(i, j) = gp_value(i, j)/3.0d0
         end do
      end do
      mapname = p_strain_field
      abbrivation = "Hyepsi"
      call GmshPlotContour(this, gp_value, mapname, abbrivation, step, Name=Name)

        ! !"Deviatoric strain"
      do i = 1, size(strain_measure, 1)
         do j = 1, size(strain_measure, 2)
            F_iJ(:, :) = 0.0d0
            if (dim_num == 2) then
               F_iJ(1, 1) = strain_measure(i, j, 11)
               F_iJ(2, 1) = strain_measure(i, j, 14)
               F_iJ(1, 2) = strain_measure(i, j, 13)
               F_iJ(2, 2) = strain_measure(i, j, 12)
               F_iJ(3, 3) = 1.0d0
            elseif (dim_num == 3) then
               F_iJ(1, 1) = strain_measure(i, j, 11)
               F_iJ(2, 1) = strain_measure(i, j, 14)
               F_iJ(1, 2) = strain_measure(i, j, 13)
               F_iJ(2, 2) = strain_measure(i, j, 12)
               F_iJ(3, 3) = strain_measure(i, j, 27)
               F_iJ(1, 3) = strain_measure(i, j, 28)
               F_iJ(2, 3) = strain_measure(i, j, 29)
               F_iJ(3, 1) = strain_measure(i, j, 30)
               F_iJ(3, 2) = strain_measure(i, j, 31)
            else
               stop "dim_num should be 2 or 3"
            end if

            b_ij(:, :) = matmul(F_iJ, transpose(F_iJ))
            gp_value(i, j) = (1.50d0*(b_ij(1, 1)*b_ij(1, 1) + &
                                      b_ij(2, 2)*b_ij(2, 2) + b_ij(3, 3)*b_ij(3, 3) + b_ij(1, 2)*b_ij(1, 2)*3.0d0 &
                                      + b_ij(2, 3)*b_ij(2, 3)*3.0d0 + b_ij(3, 1)*b_ij(3, 1)*3.0d0 &
                                      - b_ij(1, 1)*b_ij(2, 2) - b_ij(2, 2)*b_ij(3, 3) - b_ij(3, 3)*b_ij(1, 1)))**(0.50d0)

         end do
      end do
      mapname = p_stress_field
      abbrivation = "Dvepsi"
      call GmshPlotContour(this, gp_value, mapname, abbrivation, step, Name=Name)

   end subroutine
   !=======================================================================================
   subroutine GnuplotPlotContour(this, gp_value, OptionalContorName, OptionalAbb, OptionalStep)
      class(FEMDomain_), intent(in)::this
      real(real64), intent(in)::gp_value(:, :)
      integer(int32), optional, intent(in)::OptionalStep
      character, optional, intent(in):: OptionalContorName*30, OptionalAbb*6
      real(real64), allocatable::x(:, :)
      integer(int32) i, j, k, step, n
      character filename0*11
      character filename*17
      character filetitle*6
      character:: mapname*30, abbmap*6

      if (present(OptionalContorName)) then
         mapname = OptionalContorName
      else
         mapname = "Value"
      end if

      if (present(OptionalAbb)) then
         abbmap = OptionalAbb
      else
         abbmap = "Values"
      end if

      if (present(OptionalStep)) then
         step = OptionalStep
      else
         step = 1
      end if

      filetitle(1:6) = abbmap(1:6)
      !---------------------
      write (filename0, '("_", i6.6, ".txt")') step ! ここでファイル名を生成している
      filename = filename0
      open (40, file="touch "//this%FileName//filename)
      print *, "writing .gnuplot-txt file... step>>", step
      !---------------------

      do i = 1, size(gp_value, 1)
         do j = 1, size(gp_value, 2)
            n = this%Mesh%ElemNod(i, j)
            write (40, *) this%Mesh%NodCoord(n, :), &
               gp_value(i, j)
         end do
      end do
      close (40)
   end subroutine GnuplotPlotContour
   !===========================================================================================

   !===========================================================================================
   subroutine GnuplotExportStress(this, uvec, sigma, strain_measure, step)
      class(FEMDomain_), intent(in)::this
      real(real64), intent(in)::uvec(:), sigma(:, :, :), strain_measure(:, :, :)
      integer(int32), intent(in)::step
      character p_stress_field*30

      real(real64), allocatable::c_nod_coord(:, :), gp_value(:, :)
      real(real64) tr_sigma, tr_C
      character q_stress_field*30
      character p_strain_field*30
      character q_strain_field*30
      character mapname*30, abbrivation*6
      integer(int32) i, j, n, gp_number, dim_num

      gp_number = size(strain_measure, 2)
      dim_num = size(this%Mesh%NodCoord, 2)

      p_stress_field = "Hydrostatic stress (kPa)"
      q_stress_field = "Deviatoric stress (kPa)"
      p_strain_field = "Hydrostatic strain "
      q_strain_field = "Deviatoric strain "

      allocate (c_nod_coord(size(this%Mesh%NodCoord, 1), size(this%Mesh%NodCoord, 2)))
      allocate (gp_value(size(this%Mesh%ElemNod, 1), gp_number))

      do i = 1, size(this%Mesh%NodCoord, 1)
         c_nod_coord(i, :) = this%Mesh%NodCoord(i, :) + uvec(dim_num*(i - 1) + 1:dim_num*i)
      end do

        ! !"Hydrostatic stress (kPa)"
      do i = 1, size(sigma, 1)
         do j = 1, size(sigma, 2)
            gp_value(i, j) = sigma(i, j, 1) + sigma(i, j, 2) + sigma(i, j, 4)
            gp_value(i, j) = gp_value(i, j)/3.0d0
         end do
      end do
      mapname = p_stress_field
      abbrivation = "Hysigm"
      call GnuplotPlotContour(this, gp_value, mapname, abbrivation, step)

        ! !""Deviatoric stress (kPa)"
      do i = 1, size(sigma, 1)
         do j = 1, size(sigma, 2)
            tr_sigma = sigma(i, j, 1) + sigma(i, j, 2) + sigma(i, j, 4)
            gp_value(i, j) = (1.50d0*(sigma(i, j, 1)*sigma(i, j, 1) + &
                             sigma(i, j, 2)*sigma(i, j, 2) + sigma(i, j, 4)*sigma(i, j, 4) + sigma(i, j, 3)*sigma(i, j, 3)*2.0d0 - &
                                      tr_sigma*tr_sigma/3.0d0))**(0.50d0)
         end do
      end do
      mapname = q_stress_field
      abbrivation = "Dvsigm"
      call GnuplotPlotContour(this, gp_value, mapname, abbrivation, step)

        ! !"Hydrostatic strain"
      do i = 1, size(strain_measure, 1)
         do j = 1, size(strain_measure, 2)
            gp_value(i, j) = strain_measure(i, j, 4) + strain_measure(i, j, 5) + 1.0d0
            gp_value(i, j) = gp_value(i, j)/3.0d0
         end do
      end do
      mapname = p_strain_field
      abbrivation = "Hyepsi"
      call GnuplotPlotContour(this, gp_value, mapname, abbrivation, step)

        ! !"Deviatoric strain"
      do i = 1, size(strain_measure, 1)
         do j = 1, size(strain_measure, 2)
            tr_C = strain_measure(i, j, 4) + strain_measure(i, j, 5) + 1.0d0
            gp_value(i, j) = (1.50d0*(strain_measure(i, j, 4)*strain_measure(i, j, 4) + &
                                      strain_measure(i, j, 5)*strain_measure(i, j, 5) + 1.0d0 &
                                      + strain_measure(i, j, 6)*strain_measure(i, j, 6)*2.0d0 - &
                                      tr_C*tr_C/3.0d0))**(0.50d0)
         end do
      end do
      mapname = p_stress_field
      abbrivation = "Dvepsi"
      call GnuplotPlotContour(this, gp_value, mapname, abbrivation, step)

   end subroutine
   !=======================================================================================

   pure function xrangeFEMDomain(this) result(xrange)
      class(FEMDomain_), intent(in) :: this
      real(real64) :: xrange(1:2)

      if (.not. allocated(this%mesh%nodcoord)) then
         xrange = 0.0d0
      else
         xrange(1) = minval(this%mesh%nodcoord(:, 1))
         xrange(2) = maxval(this%mesh%nodcoord(:, 1))
      end if

   end function

! ################################################

   pure function yrangeFEMDomain(this) result(yrange)
      class(FEMDomain_), intent(in) :: this
      real(real64) :: yrange(1:2)

      if (.not. allocated(this%mesh%nodcoord)) then
         yrange = 0.0d0
      else
         yrange(1) = minval(this%mesh%nodcoord(:, 2))
         yrange(2) = maxval(this%mesh%nodcoord(:, 2))
      end if

   end function

! ################################################

   pure function zrangeFEMDomain(this) result(zrange)
      class(FEMDomain_), intent(in) :: this
      real(real64) :: zrange(1:2)

      if (.not. allocated(this%mesh%nodcoord)) then
         zrange = 0.0d0
      else
         zrange(1) = minval(this%mesh%nodcoord(:, 3))
         zrange(2) = maxval(this%mesh%nodcoord(:, 3))
      end if

   end function

! ################################################
   subroutine moveFEMDomain(this, x, y, z, NodeList, to)
      class(FEMDomain_), intent(inout)::this
      real(real64), optional, intent(in)::x, y, z
      real(real64), allocatable :: center(:)
      integer(int32), optional, intent(in) :: NodeList(:)
      character(*), optional, intent(in) :: to
      integer(int32) :: i, nid

      if (present(to)) then
         select case (to)
         case ("center", "CENTER", "Center")
            center = this%centerPosition()
            call this%move(x=-center(1), y=-center(2), z=-center(3))
         case ("origin", "ORIGIN", "Origin")
            center = zeros(this%nd())
            do i = 1, this%nd()
               center(i) = minval(this%mesh%nodcoord(:, i))
            end do
            call this%move(x=-center(1), y=-center(2), z=-center(3))
         case default
            print *, "ERROR :: moveFEMDomain + arg :: to >> invalid keyword"
            print *, "select center or origin"
         end select
         return
      end if

      if (present(NodeList)) then

         if (present(x)) then
            do i = 1, size(NodeList)
               nid = NodeList(i)
               this%Mesh%NodCoord(nid, 1) = this%Mesh%NodCoord(nid, 1) + x
            end do
         end if

         if (present(y)) then
            do i = 1, size(NodeList)
               nid = NodeList(i)
               this%Mesh%NodCoord(nid, 2) = this%Mesh%NodCoord(nid, 2) + y
            end do
         end if

         if (size(this%Mesh%NodCoord, 2) < 3 .and. present(z)) then
            print *, "ERROR :: moveFEMDomain >> z cannot be imported"
            return
         end if

         if (present(z)) then

            do i = 1, size(NodeList)
               nid = NodeList(i)
               this%Mesh%NodCoord(nid, 3) = this%Mesh%NodCoord(nid, 3) + z
            end do
         end if

      else

         if (present(x)) then
            this%Mesh%NodCoord(:, 1) = this%Mesh%NodCoord(:, 1) + x
         end if

         if (present(y)) then
            this%Mesh%NodCoord(:, 2) = this%Mesh%NodCoord(:, 2) + y
         end if

         if (size(this%Mesh%NodCoord, 2) < 3 .and. present(z)) then
            print *, "ERROR :: moveFEMDomain >> z cannot be imported"
            return
         end if

         if (present(z)) then
            this%Mesh%NodCoord(:, 3) = this%Mesh%NodCoord(:, 3) + z
         end if
      end if

   end subroutine
! ################################################

! ################################################
   subroutine rotateFEMDomain(this, x, y, z, deg)
      class(FEMDomain_), intent(inout)::this
      real(real64), optional, intent(in)::x, y, z
      real(real64) ::xd, yd, zd, x_u, y_u, z_u
      real(real64), allocatable :: midpoint(:), &
                                   rotmat_x(:, :), rotmat_y(:, :), rotmat_z(:, :), &
                                   all_rotmat(:, :), rotation(:), coord(:), total_rot(:)

      integer(int32) :: i, j, n, m
      logical, optional, intent(in) :: deg
      logical :: xyz_nonzero(3)

      ! Euler-XYZ
      xyz_nonzero(1:3) = .true.

      n = size(this%Mesh%NodCoord, 2)
      m = size(this%Mesh%NodCoord, 1)

      if (this%nd() == 2) then

         ! unroll from Y to X

         midpoint = this%centerPosition()
         do i = 1, this%nn()
            this%Mesh%NodCoord(i, :) = this%Mesh%NodCoord(i, :) - midpoint(:)
         end do
         all_rotmat = eyes(this%nd(), this%nd())

         rotmat_x = eyes(this%nd(), this%nd())
         rotmat_y = eyes(this%nd(), this%nd())

         all_rotmat = eyes(2, 2)

         total_rot = this%total_rotation

         x_u = -total_rot(1)
         y_u = -total_rot(2)

         rotmat_x(1, 1) = cos(x_u); rotmat_x(1, 2) = -sin(x_u)
         rotmat_x(2, 1) = sin(x_u); rotmat_x(2, 2) = cos(x_u)
         rotmat_y(1, 1) = cos(y_u); rotmat_y(1, 2) = -sin(y_u)
         rotmat_y(2, 1) = sin(y_u); rotmat_y(2, 2) = cos(y_u)

         ! roll back
         all_rotmat = matmul(rotmat_z, all_rotmat)
         all_rotmat = matmul(rotmat_y, all_rotmat)

         if (present(x)) then
            if (present(deg)) then
               if (deg) then
                  this%total_rotation(1) = this%total_rotation(1) + radian(x)
               else
                  this%total_rotation(1) = this%total_rotation(1) + x
               end if
            else
               this%total_rotation(1) = this%total_rotation(1) + x
            end if
         end if

         if (present(y)) then
            !this%total_rotation(2) = this%total_rotation(2)+ y
            if (present(deg)) then
               if (deg) then
                  this%total_rotation(2) = this%total_rotation(2) + radian(y)
               else
                  this%total_rotation(2) = this%total_rotation(2) + y
               end if
            else
               this%total_rotation(2) = this%total_rotation(2) + y
            end if
         end if

         total_rot = this%total_rotation

         x_u = total_rot(1)
         y_u = total_rot(2)

         rotmat_x(1, 1) = cos(x_u); rotmat_x(1, 2) = -sin(x_u)
         rotmat_x(2, 1) = sin(x_u); rotmat_x(2, 2) = cos(x_u)
         rotmat_y(1, 1) = cos(y_u); rotmat_y(1, 2) = -sin(y_u)
         rotmat_y(2, 1) = sin(y_u); rotmat_y(2, 2) = cos(y_u)

         all_rotmat = matmul(rotmat_x, all_rotmat)
         all_rotmat = matmul(rotmat_y, all_rotmat)

         !$OMP parallel do
         do i = 1, this%nn()
            this%Mesh%NodCoord(i, :) = matmul(all_rotmat, this%Mesh%NodCoord(i, :))
         end do
         !$OMP end parallel do

         !$OMP parallel do
         do i = 1, this%nn()
            this%Mesh%NodCoord(i, :) = this%Mesh%NodCoord(i, :) + midpoint(:)
         end do
         !$OMP end parallel do

      elseif (this%nd() == 3) then
         ! unroll from Z to X

         midpoint = this%centerPosition()
         do i = 1, this%nn()
            this%Mesh%NodCoord(i, :) = this%Mesh%NodCoord(i, :) - midpoint(:)
         end do
         all_rotmat = eyes(this%nd(), this%nd())

         rotmat_x = eyes(this%nd(), this%nd())
         rotmat_y = eyes(this%nd(), this%nd())
         rotmat_z = eyes(this%nd(), this%nd())

         all_rotmat = eyes(3, 3)

         total_rot = this%total_rotation

         x_u = -total_rot(1)
         y_u = -total_rot(2)
         z_u = -total_rot(3)

         rotmat_x(1, 1) = 1.0d0; rotmat_x(1, 2) = 0.0d0; rotmat_x(1, 3) = 0.0d0; 
         rotmat_x(2, 1) = 0.0d0; rotmat_x(2, 2) = cos(x_u); rotmat_x(2, 3) = -sin(x_u); 
         rotmat_x(3, 1) = 0.0d0; rotmat_x(3, 2) = sin(x_u); rotmat_x(3, 3) = cos(x_u); 
         rotmat_y(1, 1) = cos(y_u); rotmat_y(1, 2) = 0.0d0; rotmat_y(1, 3) = sin(y_u); 
         rotmat_y(2, 1) = 0.0d0; rotmat_y(2, 2) = 1.0d0; rotmat_y(2, 3) = 0.0d0; 
         rotmat_y(3, 1) = -sin(y_u); rotmat_y(3, 2) = 0.0d0; rotmat_y(3, 3) = cos(y_u); 
         rotmat_z(1, 1) = cos(z_u); rotmat_z(1, 2) = -sin(z_u); rotmat_z(1, 3) = 0.0d0; 
         rotmat_z(2, 1) = sin(z_u); rotmat_z(2, 2) = cos(z_u); rotmat_z(2, 3) = 0.0d0; 
         rotmat_z(3, 1) = 0.0d0; rotmat_z(3, 2) = 0.0d0; rotmat_z(3, 3) = 1.0d0; 
         ! roll back
         all_rotmat = matmul(rotmat_z, all_rotmat)
         all_rotmat = matmul(rotmat_y, all_rotmat)
         all_rotmat = matmul(rotmat_x, all_rotmat)

         if (present(x)) then
            if (present(deg)) then
               if (deg) then
                  this%total_rotation(1) = this%total_rotation(1) + radian(x)
               else
                  this%total_rotation(1) = this%total_rotation(1) + x
               end if
            else
               this%total_rotation(1) = this%total_rotation(1) + x
            end if
         end if

         if (present(y)) then
            !this%total_rotation(2) = this%total_rotation(2)+ y
            if (present(deg)) then
               if (deg) then
                  this%total_rotation(2) = this%total_rotation(2) + radian(y)
               else
                  this%total_rotation(2) = this%total_rotation(2) + y
               end if
            else
               this%total_rotation(2) = this%total_rotation(2) + y
            end if
         end if

         if (present(z)) then
            if (present(deg)) then
               if (deg) then
                  this%total_rotation(3) = this%total_rotation(3) + radian(z)
               else
                  this%total_rotation(3) = this%total_rotation(3) + z
               end if
            else
               this%total_rotation(3) = this%total_rotation(3) + z
            end if
         end if

         total_rot = this%total_rotation

         x_u = total_rot(1)
         y_u = total_rot(2)
         z_u = total_rot(3)

         rotmat_x(1, 1) = 1.0d0; rotmat_x(1, 2) = 0.0d0; rotmat_x(1, 3) = 0.0d0; 
         rotmat_x(2, 1) = 0.0d0; rotmat_x(2, 2) = cos(x_u); rotmat_x(2, 3) = -sin(x_u); 
         rotmat_x(3, 1) = 0.0d0; rotmat_x(3, 2) = sin(x_u); rotmat_x(3, 3) = cos(x_u); 
         rotmat_y(1, 1) = cos(y_u); rotmat_y(1, 2) = 0.0d0; rotmat_y(1, 3) = sin(y_u); 
         rotmat_y(2, 1) = 0.0d0; rotmat_y(2, 2) = 1.0d0; rotmat_y(2, 3) = 0.0d0; 
         rotmat_y(3, 1) = -sin(y_u); rotmat_y(3, 2) = 0.0d0; rotmat_y(3, 3) = cos(y_u); 
         rotmat_z(1, 1) = cos(z_u); rotmat_z(1, 2) = -sin(z_u); rotmat_z(1, 3) = 0.0d0; 
         rotmat_z(2, 1) = sin(z_u); rotmat_z(2, 2) = cos(z_u); rotmat_z(2, 3) = 0.0d0; 
         rotmat_z(3, 1) = 0.0d0; rotmat_z(3, 2) = 0.0d0; rotmat_z(3, 3) = 1.0d0

         all_rotmat = matmul(rotmat_x, all_rotmat)
         all_rotmat = matmul(rotmat_y, all_rotmat)
         all_rotmat = matmul(rotmat_z, all_rotmat)

         !$OMP parallel do
         do i = 1, this%nn()
            this%Mesh%NodCoord(i, :) = matmul(all_rotmat, this%Mesh%NodCoord(i, :))
         end do
         !$OMP end parallel do

         !$OMP parallel do
         do i = 1, this%nn()
            this%Mesh%NodCoord(i, :) = this%Mesh%NodCoord(i, :) + midpoint(:)
         end do
         !$OMP end parallel do

      end if
   end subroutine
! ################################################

! ################################################
   subroutine AddNBCFEMDomain(this, NodID, DimID, Val, FastMode)
      class(FEMDomain_), intent(inout)::this
      integer(int32), intent(in)::NodID, DimID
      real(real64), intent(in)::Val
      logical, optional, intent(in)::FastMode
      integer(int32) :: installed, i, j, n
      logical :: fmode

      if (present(FastMode)) then
         fmode = FastMode
      else
         fmode = .false.
      end if
      fmode = input(default=.false., option=FastMode)

      if (.not. allocated(this%Boundary%NBoundNodID)) then
         print *, "ERROR  :: AddNBC >> this%Boundary%NBoundNodID should be allocated."
         print *, "Initializing NBC..."
         call this%InitNBC(NumOfValPerNod=3)
         return
      end if

      ! check wheather NodID exisits or not
      ! if this%Boundary%NBoundNodID(NodID) is found, add the current Val to the last value and return.
      do i = 1, size(this%Boundary%NBoundNodID, 1)
         if (this%Boundary%NBoundNodID(i, DimID) == NodID) then
            this%Boundary%NBoundVal(i, DimID) = this%Boundary%NBoundVal(i, DimID) + Val
            return
         end if
      end do

      if (fmode .eqv. .false.) then
         installed = 0
         do i = 1, size(this%Boundary%NBoundNodID, 1)
            if (this%Boundary%NBoundNodID(i, DimID) == -1) then
               this%Boundary%NBoundNodID(i, DimID) = NodID
               this%Boundary%NBoundVal(i, DimID) = Val
               this%Boundary%NBoundNum(DimID) = this%Boundary%NBoundNum(DimID) + 1
               installed = 1
               exit
            else
               cycle
            end if
         end do
      end if

      if (installed == 1) then
         return
      else
         n = size(this%Boundary%NBoundNodID, 1)
         call insertArray(this%Boundary%NBoundNodID, insert1stColumn=.true., DefaultValue=-1, NextOf=n)
         call insertArray(this%Boundary%NBoundVal, insert1stColumn=.true., DefaultValue=0.0d0, NextOf=n)
         i = n + 1
         this%Boundary%NBoundNodID(i, DimID) = NodID
         this%Boundary%NBoundVal(i, DimID) = Val
         this%Boundary%NBoundNum(DimID) = this%Boundary%NBoundNum(DimID) + 1

      end if

   end subroutine
! ################################################
! too slow
   subroutine ExportFEMDomainAsSTL(this, FileHandle, MeshDimension, FileName)
      class(FEMDomain_), intent(inout)::this
      integer(int32), optional, intent(in)::FileHandle, MeshDimension
      character(*), optional, intent(in)::FileName
      real(real64) :: x1(3), x2(3), x3(3)
      character*11  :: filename0
      integer(int32) :: fh, i, dim_num

      if (present(FileName)) then

         dim_num = input(default=3, option=MeshDimension)

         if (present(FileHandle)) then
            fh = FileHandle
         else
            fh = 104
         end if

         write (filename0, '("_", i6.6, ".stl")') this%Timestep ! ここでファイル名を生成している
         call execute_command_line("touch "//filename//filename0)
         print *, filename//filename0

         open (fh, file=filename//filename0)
         ! hot-splot
         call this%Mesh%GetSurface(sorting=.false.)

         if (dim_num /= 3) then
            print *, "Sorry, Export stl is supported only for 3-D mesh"
            close (fh)
            return
         end if
         write (fh, '(A)') "solid "//filename
         print *, "Number of facet is", size(this%Mesh%FacetElemNod, 1)
         do i = 1, size(this%Mesh%FacetElemNod, 1)
            if (size(this%Mesh%FacetElemNod, 2) == 4) then
               ! rectangular
               ! describe two triangular

               x1(:) = this%Mesh%NodCoord(this%Mesh%FacetElemNod(i, 1), :)
               x2(:) = this%Mesh%NodCoord(this%Mesh%FacetElemNod(i, 2), :)
               x3(:) = this%Mesh%NodCoord(this%Mesh%FacetElemNod(i, 3), :)
               write (fh, '(A)') "facet normal 0.0 0.0 1.0"
               write (fh, '(A)') "outer loop"
               write (fh, *) "vertex ", real(x1(1)), real(x1(2)), real(x1(3))
               write (fh, *) "vertex ", real(x2(1)), real(x2(2)), real(x2(3))
               write (fh, *) "vertex ", real(x3(1)), real(x3(2)), real(x3(3))
               write (fh, '(A)') "endloop"
               write (fh, '(A)') "endfacet"
               x1(:) = this%Mesh%NodCoord(this%Mesh%FacetElemNod(i, 1), :)
               x2(:) = this%Mesh%NodCoord(this%Mesh%FacetElemNod(i, 3), :)
               x3(:) = this%Mesh%NodCoord(this%Mesh%FacetElemNod(i, 4), :)
               write (fh, '(A)') "facet normal 0.0 0.0 1.0"
               write (fh, '(A)') "outer loop"
               write (fh, *) "vertex ", real(x1(1)), real(x1(2)), real(x1(3))
               write (fh, *) "vertex ", real(x2(1)), real(x2(2)), real(x2(3))
               write (fh, *) "vertex ", real(x3(1)), real(x3(2)), real(x3(3))
               write (fh, '(A)') "endloop"
               write (fh, '(A)') "endfacet"
            elseif (size(this%Mesh%FacetElemNod, 2) == 3) then
               ! rectangular
               ! describe two triangular
               x1(:) = this%Mesh%NodCoord(this%Mesh%FacetElemNod(i, 1), :)
               x2(:) = this%Mesh%NodCoord(this%Mesh%FacetElemNod(i, 2), :)
               x3(:) = this%Mesh%NodCoord(this%Mesh%FacetElemNod(i, 3), :)
               write (fh, '(A)') "facet normal 0.0 0.0 1.0"
               write (fh, '(A)') "outer loop"
               write (fh, *) "vertex ", real(x1(1)), real(x1(2)), real(x1(3))
               write (fh, *) "vertex ", real(x2(1)), real(x2(2)), real(x2(3))
               write (fh, *) "vertex ", real(x3(1)), real(x3(2)), real(x3(3))
               write (fh, '(A)') "endloop"
               write (fh, '(A)') "endfacet"

            else
               ! other
               print *, "Sorry, Export stl is supported only for rectangular mesh"
               return
               close (fh)
            end if
         end do
         write (fh, '(A)') "endsolid "//filename

         print *, "writing ", filename//filename0, " step>>", this%Timestep
         flush (fh)
         close (fh)
         return

      end if

      if (present(FileHandle)) then

         fh = FileHandle

         call this%Mesh%GetSurface()
         dim_num = input(default=3, option=MeshDimension)
         if (dim_num /= 3) then
            print *, "Sorry, Export stl is supported only for 3-D mesh"
            return
         end if
         write (fh, '(A)') "solid stl"
         print *, "Number of facet is", size(this%Mesh%FacetElemNod, 1)
         do i = 1, size(this%Mesh%FacetElemNod, 1)
            if (size(this%Mesh%FacetElemNod, 2) == 4) then
               ! rectangular
               ! describe two triangular

               x1(:) = this%Mesh%NodCoord(this%Mesh%FacetElemNod(i, 1), :)
               x2(:) = this%Mesh%NodCoord(this%Mesh%FacetElemNod(i, 2), :)
               x3(:) = this%Mesh%NodCoord(this%Mesh%FacetElemNod(i, 3), :)
               write (fh, '(A)') "facet normal 0.0 0.0 1.0"
               write (fh, '(A)') "outer loop"
               write (fh, *) "vertex ", real(x1(1)), real(x1(2)), real(x1(3))
               write (fh, *) "vertex ", real(x2(1)), real(x2(2)), real(x2(3))
               write (fh, *) "vertex ", real(x3(1)), real(x3(2)), real(x3(3))
               write (fh, '(A)') "endloop"
               write (fh, '(A)') "endfacet"
               x1(:) = this%Mesh%NodCoord(this%Mesh%FacetElemNod(i, 1), :)
               x2(:) = this%Mesh%NodCoord(this%Mesh%FacetElemNod(i, 3), :)
               x3(:) = this%Mesh%NodCoord(this%Mesh%FacetElemNod(i, 4), :)
               write (fh, '(A)') "facet normal 0.0 0.0 1.0"
               write (fh, '(A)') "outer loop"
               write (fh, *) "vertex ", real(x1(1)), real(x1(2)), real(x1(3))
               write (fh, *) "vertex ", real(x2(1)), real(x2(2)), real(x2(3))
               write (fh, *) "vertex ", real(x3(1)), real(x3(2)), real(x3(3))
               write (fh, '(A)') "endloop"
               write (fh, '(A)') "endfacet"
            elseif (size(this%Mesh%FacetElemNod, 2) == 3) then
               ! rectangular
               ! describe two triangular
               x1(:) = this%Mesh%NodCoord(this%Mesh%FacetElemNod(i, 1), :)
               x2(:) = this%Mesh%NodCoord(this%Mesh%FacetElemNod(i, 2), :)
               x3(:) = this%Mesh%NodCoord(this%Mesh%FacetElemNod(i, 3), :)
               write (fh, '(A)') "facet normal 0.0 0.0 1.0"
               write (fh, '(A)') "outer loop"
               write (fh, *) "vertex ", real(x1(1)), real(x1(2)), real(x1(3))
               write (fh, *) "vertex ", real(x2(1)), real(x2(2)), real(x2(3))
               write (fh, *) "vertex ", real(x3(1)), real(x3(2)), real(x3(3))
               write (fh, '(A)') "endloop"
               write (fh, '(A)') "endfacet"

            else
               ! other
               print *, "Sorry, Export stl is supported only for rectangular mesh"
               return
               close (fh)
            end if
         end do
         write (fh, '(A)') "endsolid "//filename

         print *, "writing ", filename//filename0, " step>>", this%Timestep
         flush (fh)
         return

      end if

      dim_num = input(default=3, option=MeshDimension)

      if (present(FileHandle)) then
         fh = FileHandle
      else
         fh = 104
      end if

      write (filename0, '("_", i6.6, ".stl")') this%Timestep ! ここでファイル名を生成している
      call execute_command_line("touch "//this%FileName//filename0)
      print *, this%FileName//filename0

      open (fh, file=this%FileName//filename0)

      call this%Mesh%GetSurface()

      if (dim_num /= 3) then
         print *, "Sorry, Export stl is supported only for 3-D mesh"
         close (fh)
         return
      end if
      write (fh, '(A)') "solid "//this%FileName
      print *, "Number of facet is", size(this%Mesh%FacetElemNod, 1)
      do i = 1, size(this%Mesh%FacetElemNod, 1)
         if (size(this%Mesh%FacetElemNod, 2) == 4) then
            ! rectangular
            ! describe two triangular
            x1(:) = this%Mesh%NodCoord(this%Mesh%FacetElemNod(i, 1), :)
            x2(:) = this%Mesh%NodCoord(this%Mesh%FacetElemNod(i, 2), :)
            x3(:) = this%Mesh%NodCoord(this%Mesh%FacetElemNod(i, 3), :)
            write (fh, '(A)') "facet normal 0.0 0.0 1.0"
            write (fh, '(A)') "outer loop"
            write (fh, *) "vertex ", real(x1(1)), real(x1(2)), real(x1(3))
            write (fh, *) "vertex ", real(x2(1)), real(x2(2)), real(x2(3))
            write (fh, *) "vertex ", real(x3(1)), real(x3(2)), real(x3(3))
            write (fh, '(A)') "endloop"
            write (fh, '(A)') "endfacet"
            x1(:) = this%Mesh%NodCoord(this%Mesh%FacetElemNod(i, 1), :)
            x2(:) = this%Mesh%NodCoord(this%Mesh%FacetElemNod(i, 3), :)
            x3(:) = this%Mesh%NodCoord(this%Mesh%FacetElemNod(i, 4), :)
            write (fh, '(A)') "facet normal 0.0 0.0 1.0"
            write (fh, '(A)') "outer loop"
            write (fh, *) "vertex ", real(x1(1)), real(x1(2)), real(x1(3))
            write (fh, *) "vertex ", real(x2(1)), real(x2(2)), real(x2(3))
            write (fh, *) "vertex ", real(x3(1)), real(x3(2)), real(x3(3))
            write (fh, '(A)') "endloop"
            write (fh, '(A)') "endfacet"
         else
            ! other
            print *, "Sorry, Export stl is supported only for rectangular mesh"
            return
            close (fh)
         end if
      end do
      write (fh, '(A)') "endsolid "//this%FileName

      print *, "writing ", this%FileName//filename0, " step>>", this%Timestep
      flush (fh)
      close (fh)

   end subroutine

!#######################################
   subroutine meshingFEMDomain(this)
      class(FEMDomain_), intent(inout)::this

      call this%Mesh%meshing()
   end subroutine
!#######################################

!#######################################
   subroutine removeDBoundCondition(this)
      class(FEMDomain_), intent(inout)::this

      call this%Boundary%removeDBC()
   end subroutine
!#######################################

!#######################################
   subroutine removeNBoundCondition(this)
      class(FEMDomain_), intent(inout)::this
      call this%Boundary%removeNBC()
   end subroutine
!#######################################

!#######################################
   subroutine removeTBoundCondition(this)
      class(FEMDomain_), intent(inout)::this
      call this%Boundary%removeTBC()
   end subroutine
!#######################################

!#######################################
   subroutine CheckConnedctivityFEMDomain(this, fix)
      class(FEMDomain_), intent(inout)::this
      integer(int32), allocatable:: checklist(:, :), new_node_id(:)
      logical, optional, intent(in)::fix
      integer(int32) :: i, n, m, j

      n = size(this%Mesh%NodCoord, 1)
      allocate (checklist(n, 1), new_node_id(n))
      checklist(:, 1) = 0

      do i = 1, n
         new_node_id(i) = i
      end do

      do i = 1, size(this%Mesh%ElemNod, 1)
         do j = 1, size(this%Mesh%ElemNod, 2)
            checklist(this%Mesh%ElemNod(i, j), 1) = 1
         end do
      end do

      do i = 1, n
         if (checklist(i, 1) == 0) then
            ! update node id
            do j = i + 1, n
               new_node_id(j) = new_node_id(j) - 1
            end do
            new_node_id(i) = 0
         else
            cycle
         end if
      end do

      if (minval(checklist) == 0) then
         if (this%debug_mode) then
            print *, "[HIT!] Non-connected nodes exist"
         end if
      else
         if (this%debug_mode) then
            print *, "[OK] All nodes are connected."
         end if
      end if

      if (present(fix)) then
         if (fix .eqv. .true.) then
            ! update connectivity
            do i = 1, size(this%Mesh%ElemNod, 1)
               do j = 1, size(this%Mesh%ElemNod, 2)
                  if (new_node_id(this%Mesh%ElemNod(i, j)) == 0) then
                     print *, "ERROR :: CheckConnedctivityFEMDomain"
                  end if
                  this%Mesh%ElemNod(i, j) = new_node_id(this%Mesh%ElemNod(i, j))
               end do
            end do

            ! remove astray node
            i = 1
            do
               if (checklist(i, 1) == 0) then
                  call removeArray(this%Mesh%NodCoord, remove1stColumn=.true., NextOf=i - 1)
                  call removeArray(checklist, remove1stColumn=.true., NextOf=i - 1)
               else
                  i = i + 1
                  cycle
               end if
               if (minval(checklist) == 1) then
                  exit
               else
                  cycle
               end if
            end do

         end if
      end if
      if (this%debug_mode) then
         print *, "[OK] All nodes are connected."
      end if
   end subroutine
!#######################################

   subroutine getDBCVectorFEMDomain(this, DBCvec)
      class(FEMDomain_), intent(in)::this
      real(real64), allocatable, intent(inout)::DBCvec(:, :)
      integer(int32) :: i, j, n, m, k, l
      n = size(this%Mesh%NodCoord, 1)
      m = size(this%Mesh%NodCoord, 2)
      if (.not. allocated(DBCvec)) then
         allocate (DBCvec(n, m))
         DBCvec(:, :) = 0.0d0
      end if

      ! check number of DBC
      do i = 1, size(this%Boundary%DBoundNum)
         k = countif(Array=this%Boundary%DBoundNodID(:, i), Value=-1, notEqual=.true.)
         l = this%Boundary%DBoundNum(i)
         if (k /= l) then
            print *, "Caution :: FiniteDeformationClass::getDBCVector :: check number of DBC :: k /= l"
         end if
      end do

      do i = 1, size(this%Boundary%DBoundNodID, 1)
         do j = 1, size(this%Boundary%DBoundNodID, 2)
            if (this%Boundary%DBoundNodID(i, j) <= 0) then
               cycle
            end if
            DBCvec(this%Boundary%DBoundNodID(i, j), j) = this%Boundary%DBoundVal(i, j)
         end do
      end do

   end subroutine
! ##################################################

! ##################################################
   subroutine convertMeshTypeFEMDomain(this, Option)
      class(FEMDomain_), intent(inout) :: this
      character(*), intent(in) :: Option

      print *, "[Caution!] >> convertMeshType  is not recommended!"
      print *, "              please use changeElementType()"
      call this%Mesh%convertMeshType(Option=Option)

   end subroutine
! ##################################################

! ##################################################
   subroutine changeElementTypeFEMDomain(this, elementtype)
      class(FEMDomain_), intent(inout) :: this
      integer(int32), intent(in) :: elementtype(:)

      call this%Mesh%changeElementType(elementtype=elementtype)

   end subroutine
! ##################################################

   subroutine remeshFEMDomain(this, meshtype, Name, x_num, y_num, z_num, x_len, y_len, z_len, Le, Lh, Dr, thickness, division, &
                              top, margin, inclineRate, shaperatio, master, slave, x, y, z, dx, dy, dz, coordinate)
      class(FEMDomain_), intent(inout) :: this
      type(FEMDomain_), optional, intent(inout) :: master, slave
      character(*), optional, intent(in) :: meshtype
      character(*), optional, intent(in) ::Name
      integer(int32), optional, intent(in) :: x_num, y_num, z_num ! number of division
      integer(int32) :: xnum, ynum, znum ! number of division
      integer(int32), optional, intent(in) :: division ! for 3D rectangular
      real(real64), optional, intent(in) :: x_len, y_len, z_len, Le, Lh, Dr ! length
      real(real64) :: xlen, ylen, zlen ! length
      real(real64), optional, intent(in) :: thickness ! for 3D rectangular
      real(real64), optional, intent(in) :: shaperatio ! for 3D leaf
      real(real64), optional, intent(in) :: top, margin, inclineRate ! for 3D Ridge and dam
      real(real64), optional, intent(in) :: x, y, z, dx, dy, dz, coordinate(:, :)

      integer, dimension(3), parameter :: versions_to_test = [0, 1, 4]

!        ! create uuid
!
!        this%meshtype = meshtype
!
!        this%uuid = generate_uuid(1)
!        this%mesh%uuid = this%uuid
!
      xnum = input(default=10, option=x_num)
      ynum = input(default=10, option=y_num)
      znum = input(default=10, option=z_num)

      xlen = input(default=1.0d0, option=x_len)
      ylen = input(default=1.0d0, option=y_len)
      zlen = input(default=1.0d0, option=z_len)

!        if(present(Name) )then
!                this%Name=Name
!                this%FileName=Name
!        else
!                this%Name="NoName"
!                this%FileName="NoName"
!        endif

!        ! if create interface, set paired uuid in address
!        this%link(1) = "None"
!        this%link(2) = "None"
!
!        if(present(master) )then
!                this%link(1) = master%uuid
!        endif
!
!        if(present(slave) )then
!                this%link(2) = slave%uuid
!        endif

      if (present(z_num) .or. present(z_len)) then
         call this%Mesh%remesh(meshtype=meshtype, x_num=xnum, y_num=ynum, x_len=xlen, y_len=ylen, Le=Le, &
                               Lh=Lh, Dr=Dr, thickness=zlen, top=top, margin=margin, shaperatio=shaperatio, &
                               master=master%mesh, slave=slave%mesh, x=x, y=y, z=z, dx=dx, dy=dy, dz=dz, &
                               coordinate=coordinate, division=znum)
      elseif (present(thickness)) then
         call this%Mesh%remesh(meshtype=meshtype, x_num=xnum, y_num=ynum, x_len=xlen, y_len=ylen, Le=Le, &
                               Lh=Lh, Dr=Dr, thickness=thickness, top=top, margin=margin, shaperatio=shaperatio, &
                               master=master%mesh, slave=slave%mesh, x=x, y=y, z=z, dx=dx, dy=dy, dz=dz, &
                               coordinate=coordinate, division=znum)
      else
         call this%Mesh%remesh(meshtype=meshtype, x_num=xnum, y_num=ynum, x_len=xlen, y_len=ylen, Le=Le, &
                               Lh=Lh, Dr=Dr, top=top, margin=margin, shaperatio=shaperatio, &
                               master=master%mesh, slave=slave%mesh, x=x, y=y, z=z, dx=dx, dy=dy, dz=dz, &
                               coordinate=coordinate, division=znum)
      end if

!        if(this%nd()==2 .or. this%nd()==3)then
!                call this%getSurface()
!        endif

   end subroutine

! ##################################################
   subroutine createFEMDomain(this, meshtype, Name, x_num, y_num, z_num, x_len, y_len, z_len, Le, Lh, Dr, thickness, division, &
                     top, margin, inclineRate, shaperatio, master, slave, x, y, z, dx, dy, dz, coordinate, species, SoyWidthRatio, &
                              x_axis, y_axis, z_axis)
      class(FEMDomain_), intent(inout) :: this
      type(FEMDomain_), optional, intent(inout) :: master, slave
      character(*), intent(in) :: meshtype
      character(*), optional, intent(in) ::Name
      integer(int32), optional, intent(in) :: x_num, y_num, z_num ! number of division
      integer(int32) :: xnum, ynum, znum ! number of division
      integer(int32), optional, intent(in) :: division ! for 3D rectangular
      real(real64), optional, intent(in) :: x_len, y_len, z_len, Le, Lh, Dr ! length
      real(real64) :: xlen, ylen, zlen ! length
      real(real64), optional, intent(in) :: thickness ! for 3D rectangular
      real(real64), optional, intent(in) :: shaperatio ! for 3D leaf
      real(real64), optional, intent(in) :: top, margin, inclineRate ! for 3D Ridge and dam
      real(real64), optional, intent(in) :: x, y, z, dx, dy, dz, coordinate(:, :)
      real(real64), optional, intent(in) :: x_axis(:), y_axis(:), z_axis(:)
      integer(int32), optional, intent(in) :: species
      real(real64), optional, intent(in) :: SoyWidthRatio
      integer, dimension(3), parameter :: versions_to_test = [0, 1, 4]

      ! create uuid

      this%meshtype = meshtype

      this%uuid = generate_uuid(1)
      this%mesh%uuid = this%uuid

      xnum = input(default=10, option=x_num)
      ynum = input(default=10, option=y_num)
      znum = input(default=10, option=z_num)

      xlen = input(default=1.0d0, option=x_len)
      ylen = input(default=1.0d0, option=y_len)
      zlen = input(default=1.0d0, option=z_len)

      if (present(Name)) then
         this%Name = Name
         this%FileName = Name
      else
         this%Name = "NoName"
         this%FileName = "NoName"
      end if

      ! if create interface, set paired uuid in address
      this%link(1) = "None"
      this%link(2) = "None"

      if (present(master)) then
         this%link(1) = master%uuid
      end if

      if (present(slave)) then
         this%link(2) = slave%uuid
      end if

      select case (meshtype)
      case ("Cube", "Cube3D")
         if (present(x_axis) .and. present(y_axis)) then
            if (present(z_axis)) then
               call this%mesh%cube(x=x_axis, y=y_axis, z=z_axis)
            else
               call this%mesh%cube(x=x_axis, y=y_axis, z=[0.0d0, 1.0d0])
            end if
            
            return
         end if
      case ("Box", "Box2D")
         call this%mesh%box(x=x_axis, y=y_axis)
      case ("Line", "Line1D")
         call this%mesh%line(x_num=x_num, x_axis=x_axis)
         return

      end select

      if (present(z_num) .or. present(z_len)) then
         call this%Mesh%create(meshtype=meshtype, x_num=xnum, y_num=ynum, x_len=xlen, y_len=ylen, Le=Le, &
                               Lh=Lh, Dr=Dr, thickness=zlen, top=top, margin=margin, shaperatio=shaperatio, &
                               master=master%mesh, slave=slave%mesh, x=x, y=y, z=z, dx=dx, dy=dy, dz=dz, &
                               coordinate=coordinate, division=znum, species=species, SoyWidthRatio=SoyWidthRatio)
      elseif (present(thickness)) then
         call this%Mesh%create(meshtype=meshtype, x_num=xnum, y_num=ynum, x_len=xlen, y_len=ylen, Le=Le, &
                               Lh=Lh, Dr=Dr, thickness=thickness, top=top, margin=margin, shaperatio=shaperatio, &
                               master=master%mesh, slave=slave%mesh, x=x, y=y, z=z, dx=dx, dy=dy, dz=dz, &
                               coordinate=coordinate, division=znum, species=species, SoyWidthRatio=SoyWidthRatio)
      else
         call this%Mesh%create(meshtype=meshtype, x_num=xnum, y_num=ynum, x_len=xlen, y_len=ylen, Le=Le, &
                               Lh=Lh, Dr=Dr, top=top, margin=margin, shaperatio=shaperatio, &
                               master=master%mesh, slave=slave%mesh, x=x, y=y, z=z, dx=dx, dy=dy, dz=dz, &
                               coordinate=coordinate, division=znum, species=species, SoyWidthRatio=SoyWidthRatio)
      end if

   end subroutine createFEMDomain
! ##################################################

! ##################################################
   subroutine setBoundaryFEMDomain(this, new, x_max, x_min, y_max, y_min, z_max, z_min, t_max, t_min, value, values)
      class(FEMDomain_), intent(inout) :: this
      real(real64), optional, intent(in) :: x_max, x_min, y_max, y_min, z_max, z_min, t_max, t_min
      real(real64), optional, intent(in) :: value, values(4)
      logical, optional, intent(in) :: new

      !call this%Boundary%setDB(new,x_max,x_min,y_max,y_min,z_max,z_min,t_max,t_min,value,values)

   end subroutine setBoundaryFEMDomain
! ##################################################

! ##################################################
   subroutine showRangeFEMDomain(this)
      class(FEMDomain_)::this

      call this%Mesh%showRange()
   end subroutine
! ##################################################

! ##################################################
   subroutine ImportBoundariesFEMDomain(this, Boundary, NumberOfBoundaries, BoundaryID)
      class(FEMDomain_), intent(inout) :: this
      type(Boundary_), target, intent(in) :: Boundary
      integer(int32), optional, intent(in) :: NumberOfBoundaries, BoundaryID
      integer(int32) :: n, i

      if (.not. allocated(this%Boundaries)) then
         n = input(default=30, option=NumberOfBoundaries)
         allocate (this%Boundaries(n))
         do i = 1, n
            nullify (this%Boundaries(i)%boundaryp)
         end do
         this%NumberOfBoundaries = 0
      end if

      if (present(BoundaryID)) then
         if (BoundaryID > size(this%Boundaries)) then
            print *, "ERROR :: ImportBoundariesFEMDomain >> requested BoundaryID is grater than the size of stack"
            print *, "Stack size is ", size(this%Boundaries), " , and your request is ", BoundaryID
            return
         end if
         if (BoundaryID > this%NumberOfBoundaries) then
            print *, "ERROR :: ImportBoundariesFEMDomain >> requested BoundaryID is grater than the Last ID"
            print *, "The last ID is ", this%NumberOfBoundaries + 1, " , and your request is ", BoundaryID
            print *, "Hence, your request ", BoundaryID, " is accepted as the ID of ", this%NumberOfBoundaries + 1
            this%NumberOfBoundaries = this%NumberOfBoundaries + 1
            this%Boundaries(this%NumberOfBoundaries)%Boundaryp => Boundary
            print *, "Now, number of boundary conditions is ", this%NumberOfBoundaries
            return
         end if
         if (associated(this%Boundaries(BoundaryID)%Boundaryp)) then
            print *, "Boundary ID :: ", BoundaryID, " is overwritten."
            nullify (this%Boundaries(BoundaryID)%Boundaryp)
         end if
         this%Boundaries(BoundaryID)%Boundaryp => Boundary
         return
      end if

      this%NumberOfBoundaries = this%NumberOfBoundaries + 1

      this%Boundaries(this%NumberOfBoundaries)%Boundaryp => Boundary

      print *, "Now, number of boundary conditions is ", this%NumberOfBoundaries

   end subroutine ImportBoundariesFEMDomain
! ##################################################

! ##################################################
   subroutine showBoundariesFEMDomain(this, Name)
      class(FEMDomain_), intent(inout) :: this
      character(*), optional, intent(in)::Name
      integer(int32) :: i

      if (present(Name)) then
         print *, "Domain Name is :: ", name
      end if

      if (.not. allocated(this%Boundaries)) then
         print *, "No boundary is set."
      else
         do i = 1, this%NumberOfBoundaries
            print *, "Layer :: ", this%Boundaries(i)%Boundaryp%Layer, "B.C. ::", i, " => ", &
               associated(this%Boundaries(i)%Boundaryp)
         end do
      end if
   end subroutine showBoundariesFEMDomain
! ##################################################

! ##################################################
   subroutine removeBoundariesFEMDomain(this, Name, BoundaryID)
      class(FEMDomain_), intent(inout) :: this
      character(*), optional, intent(in)::Name
      integer(int32) :: i
      integer(int32), optional, intent(in) ::BoundaryID

      if (present(Name)) then
         print *, "Domain Name is :: ", name
      end if

      if (.not. allocated(this%Boundaries)) then
         print *, "No boundary is set."
      else
         if (present(BoundaryID)) then
            nullify (this%Boundaries(BoundaryID)%Boundaryp)
         else
            do i = 1, this%NumberOfBoundaries
               nullify (this%Boundaries(i)%Boundaryp)
            end do
         end if
      end if
      call this%showBoundaries(Name)

   end subroutine removeBoundariesFEMDomain
! ##################################################

! ##################################################
   subroutine copyFEMDomain(this, OriginalObj, onlyMesh)
      class(FEMDomain_), intent(inout) :: this
      class(FEMDomain_), intent(in) :: OriginalObj
      logical, optional, intent(in) :: onlyMesh

      call this%Mesh%copy(OriginalObj%Mesh)
      this%FileName = OriginalObj%FileName
      this%Name = OriginalObj%Name
      if (present(onlyMesh)) then
         if (onlyMesh .eqv. .true.) then
            print *, "Only mesh is copied."
            return
         end if
      end if

   end subroutine copyFEMDomain
! ##################################################

! ##################################################
   recursive subroutine bakeFEMDomain(this, template, templateFile, &
                                      NodalDOF, NumOfMaterialPara, Tol, SimMode, ItrTol, Timestep)
      class(FEMDomain_), intent(inout) :: this
      character(*), optional, intent(in) :: template
      character(*), optional, intent(in) :: templateFile
      integer(int32) :: SpaceDim, ElemNodNum, NumOfMatPara, NumOfMaterial, NodeDOF, NodeTDOF, i
      integer(int32), optional, intent(in)  :: SimMode, ItrTol, Timestep, NodalDOF, NumOfMaterialPara
      real(real64), optional, intent(in) :: Tol
      type(IO_) :: file
      type(String_) :: line
      ! bake creates a complete input file for a FEM analysis.
      ! You can use build-in templates or your original template.
      ! We prepare following build-in templates.
      ! - FiniteDeform_ :: For 3-D Finite Deformation Analysis
      ! - DiffusionEq_  :: For 3-D Diffusion Analysis
      ! If you want to use your original format, please import
      ! your template file.
      ! (This is being implemented.)
      if (present(template)) then
         if (template == "Original" .or. template == "original") then
            print *, "Please add an argument as 'templateFile = [Your_Template_File]'"
            ! text-based finding is not good. Upper/lower cases >> global module to relate ID and
            ! INTEGER, PARAMETER :: TEMP_FINITE_DEFORM = 1000; call tissue%bake(template=TEMP_FINITE_DEFORM)
            ! SELECT CASE( template ); CASE( TEMP_FINITE_DEFORM)
            ! read line by line
            NumOfMatPara = input(default=3, option=NumOfMaterialPara)
            NodeDOF = input(default=1, option=NodalDOF)
            NodeTDOF = 1

            if (present(templateFile)) then
               call file%open(templateFile)

               do
                  line = file%readline()

                  i = index(line%all, "NumOfMatPara")
                  if (i /= 0) then
                     line%all = line%all(i + 1:)
                     read (line%all, *) NumOfMatPara
                  end if

                  i = index(line%all, "NodeDOF")
                  if (i /= 0) then
                     line%all = line%all(i + 1:)
                     read (line%all, *) NodeDOF
                  end if

                  i = index(line%all, "NodeTDOF")
                  if (i /= 0) then
                     line%all = line%all(i + 1:)
                     read (line%all, *) NodeTDOF
                  end if

                  if (file%EOF .eqv. .true.) then
                     exit
                  end if
               end do
               call file%close()
            end if
         elseif (template == "FiniteDeform_" .or. template == "FiniteDeform") then
            print *, "Build-in template :: FiniteDeform_ is utilized..."
            ! Run bakeing process ...
            NumOfMatPara = 6
            NodeDOF = 3
            NodeTDOF = 1
         elseif (template == "DiffusionEq_" .or. template == "DiffusionEq") then
            print *, "Build-in template :: DiffusionEq_ is utilized..."
            ! Run bakeing process ...
            NumOfMatPara = 1
            NodeDOF = 1
            NodeTDOF = 1
         else
            print *, "In case that you want to use your template, please type template='original'."
            print *, "BakeFEMDomain == default (="
            call this%bake(template="Original", templateFile=templateFile, NodalDOF=NodalDOF, &
                           NumOfMaterialPara=NumOfMaterialPara, Tol=Tol, SimMode=SimMode, ItrTol=ItrTol, Timestep=Timestep)
            return
         end if
      else
         call this%bake(template="Original", templateFile=templateFile, NodalDOF=NodalDOF, &
                        NumOfMaterialPara=NumOfMaterialPara, Tol=Tol, SimMode=SimMode, ItrTol=ItrTol, Timestep=Timestep)
      end if

      ! domain information
      this%Dtype = "domain"
      this%SolverType = template
      this%NumOfDomain = 1

      if (allocated(this%Mesh%SubMeshNodFromTo)) then
         deallocate (this%Mesh%SubMeshNodFromTo)
      end if
      if (allocated(this%Mesh%SubMeshElemFromTo)) then
         deallocate (this%Mesh%SubMeshElemFromTo)
      end if
      allocate (this%Mesh%SubMeshNodFromTo(this%NumOfDomain, 3))
      allocate (this%Mesh%SubMeshElemFromTo(this%NumOfDomain, 3))
      if (this%Mesh%empty() .eqv. .true.) then
         print *, "bakeFEMDomain :: Mesh is Empty!"
         return
      end if
      this%Mesh%ElemType = this%Mesh%GetElemType()
      ! mesh information
      this%Mesh%SubMeshNodFromTo(1, 1) = 1
      this%Mesh%SubMeshNodFromTo(1, 2) = 1
      this%Mesh%SubMeshNodFromTo(1, 3) = size(this%Mesh%NodCoord, 1)
      this%Mesh%SubMeshElemFromTo(1, 1) = 1
      this%Mesh%SubMeshElemFromTo(1, 2) = 1
      this%Mesh%SubMeshElemFromTo(1, 3) = size(this%Mesh%ElemNod, 1)
      if (.not. allocated(this%Mesh%ElemMat)) then
         allocate (this%Mesh%ElemMat(size(this%Mesh%ElemNod, 1)))
         this%Mesh%ElemMat(:) = 1
      end if
      call showarraysize(this%Mesh%SubMeshNodFromTo)
      call showarraysize(this%Mesh%SubMeshElemFromTo)

      call this%bakeMaterials(NumOfMatPara=NumOfMatPara)
      call this%bakeDBoundaries(NodeDOF=NodeDOF)
      call this%bakeNBoundaries(NodeDOF=NodeDOF)
      call this%bakeTBoundaries(NodeDOF=NodeTDOF)

      call this%ControlPara%set(OptionalTol=Tol, &
                                OptionalItrTol=ItrTol, &
                                OptionalTimestep=Timestep, &
                                OptionalSimMode=SimMode)

   end subroutine bakeFEMDomain
! ##################################################

! ##################################################
   subroutine bakeMaterialsFEMDomain(this, NumOfMatPara)
      class(FEMDomain_), intent(inout) :: this
      integer(int32), optional, intent(in) :: NumOfMatPara
      integer(int32) :: i, j, k, l, n, m, NumOfMaterial, layer, in_num, NumOfLayer
      real(real64), allocatable :: matPara(:, :), info(:, :)
      integer(int32), allocatable :: key(:)
      type(Rectangle_) :: rect, mrect
      logical :: in_case
      real(real64) :: matparaval, coord(3), x_max(3), x_min(3)

      ! get Num of Layer
      NumOfLayer = 0
      if (.not. allocated(this%Materials)) then
         print *, "no materials found"
         return
      end if

      do i = 1, size(this%Materials)
         if (associated(this%Materials(i)%materialp)) then
            NumOfLayer = NumOfLayer + 1
         else
            cycle
         end if
      end do

      if (.not. allocated(this%Materials)) then
         print *, "No material is baked. All material IDs are 1 "
         if (.not. allocated(this%Mesh%ElemMat)) then
            allocate (this%Mesh%ElemMat(size(this%Mesh%ElemNod, 1)))
            this%Mesh%ElemMat(:) = 1
         end if
         stop "No material parameters are found."
         return
      else
         ! total $NumOfLayer material parameters exist.
         ! for all materials, resistrate material parameter and material IDs
         m = input(default=NumOfLayer, option=NumOfMatPara)

         allocate (rect%NodCoord(size(this%Mesh%ElemNod, 2), size(this%Mesh%NodCoord, 2)))
         allocate (mrect%NodCoord(size(this%Mesh%ElemNod, 2), size(this%Mesh%NodCoord, 2)))
         allocate (matPara(size(this%Mesh%ElemNod, 1), m))
         matPara(:, :) = 0.0d0
         do i = 1, size(this%Mesh%ElemNod, 1)
            ! for each element

            ! input rectangler
            do j = 1, size(this%Mesh%ElemNod, 2)
               rect%NodCoord(j, :) = this%Mesh%NodCoord(this%Mesh%ElemNod(i, j), :)
            end do

            ! for all materials, check material parameters
            do j = 1, size(this%Materials)
               if (associated(this%Materials(j)%materialp)) then
                  do k = 1, size(this%Materials(j)%materialp%Mesh%ElemNod, 1)
                     ! for each zones, check in-out
                     ! import nodal coordinate
                     do l = 1, size(this%Materials(j)%materialp%Mesh%ElemNod, 2)
                        n = this%Materials(j)%materialp%Mesh%ElemNod(k, l)
                        mrect%NodCoord(l, :) = this%Materials(j)%materialp%Mesh%NodCoord(n, :)
                     end do
                     layer = this%Materials(j)%materialp%layer
                     ! check in-out
                     if (rect%contact(mrect) .eqv. .true.) then
                        ! in
                        matPara(i, layer) = this%Materials(j)%materialp%meshPara(k, 1)
                     else
                        cycle
                     end if
                  end do
               else
                  cycle
               end if
            end do
         end do

      end if

      call getKeyAndValue(Array=matPara, key=this%Mesh%ElemMat, info=this%MaterialProp%MatPara)
      !call showarray(this%Mesh%ElemMat,Name="test1.txt")
      !call showarray(this%MaterialProp%MatPara,Name="test2.txt")
   end subroutine bakeMaterialsFEMDomain
! ##################################################

! ##################################################
   subroutine bakeDBoundariesFEMDomain(this, NodeDOF)
      class(FEMDomain_), intent(inout) :: this
      integer(int32), optional, intent(in) :: NodeDOF
      integer(int32) :: i, j, k, l, n, m, NumOfMaterial, layer, in_num, NumOfLayer, DBCnum, &
                        val_id, NumOfValPerNod
      real(real64), allocatable :: matPara(:, :), info(:, :)
      integer(int32), allocatable :: key(:)
      type(Rectangle_) :: rect, mrect
      logical :: in_case
      real(real64) :: matparaval, coord(3), x_max(3), x_min(3), &
                      xmin, xmax, ymin, ymax, zmin, zmax, tmin, tmax, valx, valy, valz, val

      ! get Num of Layer
      NumOfLayer = 0
      if (.not. allocated(this%Boundaries)) then
         print *, "no Boundaries found"
         return
      end if

      DBCnum = NodeDOF

      if (.not. allocated(this%Boundaries)) then
         print *, "No Dirichlet Boundaries are imported."
         return
      end if

      NumOfLayer = 0
      do i = 1, size(this%Boundaries, 1)
         if (associated(this%Boundaries(i)%Boundaryp)) then
            if (this%Boundaries(i)%Boundaryp%Dbound%empty() .eqv. .false.) then
               NumOfLayer = NumOfLayer + 1
            end if
         else
            cycle
         end if
      end do
      print *, "Number of Layer for Dirichlet Boundary= ", NumOfLayer

      call this%initDBC(NumOfValPerNod=input(default=NumOfLayer, option=NodeDOF))

      if (.not. allocated(this%Boundaries)) then
         print *, "No Dirichlet boundary is baked."
         return
      else
         ! total $NumOfLayer Boundary Conditions exist.
         ! for all Boundaries, resistrate material parameter and material IDs
         do i = 1, size(this%Boundaries, 1)
            ! for each Layer
            if (associated(this%Boundaries(i)%Boundaryp)) then
               if (this%Boundaries(i)%Boundaryp%DBound%empty() .eqv. .false.) then
                  do j = 1, size(this%Boundaries(i)%Boundaryp%DBound%ElemNod, 1)
                     ! for each Zone
                     xmin = minval(this%Boundaries(i)%Boundaryp%DBound%NodCoord &
                                   (this%Boundaries(i)%Boundaryp%DBound%ElemNod(j, :), 1))
                     xmax = maxval(this%Boundaries(i)%Boundaryp%DBound%NodCoord &
                                   (this%Boundaries(i)%Boundaryp%DBound%ElemNod(j, :), 1))
                     ymin = minval(this%Boundaries(i)%Boundaryp%DBound%NodCoord &
                                   (this%Boundaries(i)%Boundaryp%DBound%ElemNod(j, :), 2))
                     ymax = maxval(this%Boundaries(i)%Boundaryp%DBound%NodCoord &
                                   (this%Boundaries(i)%Boundaryp%DBound%ElemNod(j, :), 2))
                     zmin = minval(this%Boundaries(i)%Boundaryp%DBound%NodCoord &
                                   (this%Boundaries(i)%Boundaryp%DBound%ElemNod(j, :), 3))
                     zmax = maxval(this%Boundaries(i)%Boundaryp%DBound%NodCoord &
                                   (this%Boundaries(i)%Boundaryp%DBound%ElemNod(j, :), 3))
                     val = this%Boundaries(i)%Boundaryp%DBoundPara(j, 1)
                     call this%AddDBoundCondition(xmin=xmin, xmax=xmax, ymin=ymin, &
                                                  ymax=ymax, zmin=zmin, zmax=zmax, val=val, &
                                                  val_id=this%Boundaries(i)%Boundaryp%layer)
                  end do
               end if
            end if
         end do
      end if

   end subroutine bakeDBoundariesFEMDomain
! ##################################################

! ##################################################
   subroutine bakeNBoundariesFEMDomain(this, NodeDOF)
      class(FEMDomain_), intent(inout) :: this
      integer(int32), optional, intent(in) :: NodeDOF
      integer(int32) :: i, j, k, l, n, m, NumOfMaterial, layer, in_num, NumOfLayer, DBCnum, &
                        val_id, NumOfValPerNod, numofnode
      real(real64), allocatable :: matPara(:, :), info(:, :)
      integer(int32), allocatable :: key(:)
      type(Rectangle_) :: rect, mrect
      logical :: in_case
      real(real64) :: matparaval, coord(3), x_max(3), x_min(3), &
                      xmin, xmax, ymin, ymax, zmin, zmax, tmin, tmax, valx, valy, valz, val, area

      ! get Num of Layer
      NumOfLayer = 0
      if (.not. allocated(this%Boundaries)) then
         print *, "no Boundaries found"
         return
      end if

      DBCnum = NodeDOF

      if (.not. allocated(this%Boundaries)) then
         print *, "No Neumann Boundaries are imported."
         return
      end if

      NumOfLayer = 0
      do i = 1, size(this%Boundaries, 1)
         if (associated(this%Boundaries(i)%Boundaryp)) then
            if (this%Boundaries(i)%Boundaryp%Nbound%empty() .eqv. .false.) then
               NumOfLayer = NumOfLayer + 1
            end if
         else
            cycle
         end if
      end do
      print *, "Number of Layer for Neumann Boundary= ", NumOfLayer

      call this%initNBC(NumOfValPerNod=input(default=NumOfLayer, option=NodeDOF))

      if (.not. allocated(this%Boundaries)) then
         print *, "No Neumann boundary is baked."
         return
      else
         ! total $NumOfLayer Boundary Conditions exist.
         ! for all Boundaries, resistrate material parameter and material IDs
         do i = 1, size(this%Boundaries, 1)
            ! for each Layer
            if (associated(this%Boundaries(i)%Boundaryp)) then
               if (this%Boundaries(i)%Boundaryp%NBound%empty() .eqv. .false.) then
                  do j = 1, size(this%Boundaries(i)%Boundaryp%NBound%ElemNod, 1)
                     ! for each Zone
                     xmin = minval(this%Boundaries(i)%Boundaryp%NBound%NodCoord &
                                   (this%Boundaries(i)%Boundaryp%NBound%ElemNod(j, :), 1))
                     xmax = maxval(this%Boundaries(i)%Boundaryp%NBound%NodCoord &
                                   (this%Boundaries(i)%Boundaryp%NBound%ElemNod(j, :), 1))
                     ymin = minval(this%Boundaries(i)%Boundaryp%NBound%NodCoord &
                                   (this%Boundaries(i)%Boundaryp%NBound%ElemNod(j, :), 2))
                     ymax = maxval(this%Boundaries(i)%Boundaryp%NBound%NodCoord &
                                   (this%Boundaries(i)%Boundaryp%NBound%ElemNod(j, :), 2))
                     zmin = minval(this%Boundaries(i)%Boundaryp%NBound%NodCoord &
                                   (this%Boundaries(i)%Boundaryp%NBound%ElemNod(j, :), 3))
                     zmax = maxval(this%Boundaries(i)%Boundaryp%NBound%NodCoord &
                                   (this%Boundaries(i)%Boundaryp%NBound%ElemNod(j, :), 3))
                     val = this%Boundaries(i)%Boundaryp%NBoundPara(j, 1)
                     call this%AddNBoundCondition(xmin=xmin, xmax=xmax, ymin=ymin, &
                                                  ymax=ymax, zmin=zmin, zmax=zmax, val=val, &
                                                  val_id=this%Boundaries(i)%Boundaryp%layer)
                  end do
               end if
            end if
         end do
      end if

   end subroutine bakeNBoundariesFEMDomain
! ##################################################

! ##################################################
   subroutine bakeTBoundariesFEMDomain(this, NodeDOF)
      class(FEMDomain_), intent(inout) :: this
      integer(int32), optional, intent(in) :: NodeDOF
      integer(int32) :: i, j, k, l, n, m, NumOfMaterial, layer, in_num, NumOfLayer, DBCnum, &
                        val_id, NumOfValPerNod, numofnode
      real(real64), allocatable :: matPara(:, :), info(:, :)
      integer(int32), allocatable :: key(:)
      type(Rectangle_) :: rect, mrect
      logical :: in_case
      real(real64) :: matparaval, coord(3), x_max(3), x_min(3), &
                      xmin, xmax, ymin, ymax, zmin, zmax, tmin, tmax, valx, valy, valz, val, area

      ! get Num of Layer
      NumOfLayer = 0
      if (.not. allocated(this%Boundaries)) then
         print *, "no Boundaries found"
         return
      end if

      DBCnum = NodeDOF

      if (.not. allocated(this%Boundaries)) then
         print *, "No Time Boundaries are imported."
         return
      end if

      NumOfLayer = 0
      do i = 1, size(this%Boundaries, 1)
         if (associated(this%Boundaries(i)%Boundaryp)) then
            if (this%Boundaries(i)%Boundaryp%Tbound%empty() .eqv. .false.) then
               NumOfLayer = NumOfLayer + 1
            end if
         else
            cycle
         end if
      end do
      print *, "Number of Layer for Time Boundary= ", NumOfLayer

      call this%initTBC(NumOfValPerNod=input(default=NumOfLayer, option=NodeDOF))

      if (.not. allocated(this%Boundaries)) then
         print *, "No Time boundary is baked."
         return
      else
         ! total $NumOfLayer Boundary Conditions exist.
         ! for all Boundaries, resistrate material parameter and material IDs
         do i = 1, size(this%Boundaries, 1)
            ! for each Layer
            if (associated(this%Boundaries(i)%Boundaryp)) then
               if (this%Boundaries(i)%Boundaryp%TBound%empty() .eqv. .false.) then
                  do j = 1, size(this%Boundaries(i)%Boundaryp%TBound%ElemNod, 1)
                     ! for each Zone
                     xmin = minval(this%Boundaries(i)%Boundaryp%TBound%NodCoord &
                                   (this%Boundaries(i)%Boundaryp%TBound%ElemNod(j, :), 1))
                     xmax = maxval(this%Boundaries(i)%Boundaryp%TBound%NodCoord &
                                   (this%Boundaries(i)%Boundaryp%TBound%ElemNod(j, :), 1))
                     ymin = minval(this%Boundaries(i)%Boundaryp%TBound%NodCoord &
                                   (this%Boundaries(i)%Boundaryp%TBound%ElemNod(j, :), 2))
                     ymax = maxval(this%Boundaries(i)%Boundaryp%TBound%NodCoord &
                                   (this%Boundaries(i)%Boundaryp%TBound%ElemNod(j, :), 2))
                     zmin = minval(this%Boundaries(i)%Boundaryp%TBound%NodCoord &
                                   (this%Boundaries(i)%Boundaryp%TBound%ElemNod(j, :), 3))
                     zmax = maxval(this%Boundaries(i)%Boundaryp%TBound%NodCoord &
                                   (this%Boundaries(i)%Boundaryp%TBound%ElemNod(j, :), 3))
                     val = this%Boundaries(i)%Boundaryp%TBoundPara(j, 1)
                     call this%AddTBoundCondition(xmin=xmin, xmax=xmax, ymin=ymin, &
                                                  ymax=ymax, zmin=zmin, zmax=zmax, val=val, &
                                                  val_id=this%Boundaries(i)%Boundaryp%layer)
                  end do
               end if
            end if
         end do
      end if

   end subroutine bakeTBoundariesFEMDomain
! ##################################################

! ##################################################
   subroutine ImportMaterialsFEMDomain(this, Material, NumberOfMaterials, MaterialID)
      class(FEMDomain_), intent(inout) :: this
      type(MaterialProp_), target, intent(in) :: Material
      integer(int32), optional, intent(in) :: NumberOfMaterials, MaterialID
      integer(int32) :: n, i

      if (.not. allocated(this%Materials)) then
         n = input(default=30, option=NumberOfMaterials)
         allocate (this%Materials(n))
         this%NumberOfMaterials = 0
         do i = 1, n
            nullify (this%Materials(i)%materialp)
         end do
      end if

      if (present(MaterialID)) then
         if (MaterialID > size(this%Materials)) then
            print *, "ERROR :: ImportMaterialsFEMDomain >> requested MaterialID is grater than the size of stack"
            print *, "Stack size is ", size(this%Materials), " , and your request is ", MaterialID
            return
         end if
         if (MaterialID > this%NumberOfMaterials) then
            print *, "ERROR :: ImportMaterialsFEMDomain >> requested MaterialID is grater than the Last ID"
            print *, "The last ID is ", this%NumberOfMaterials + 1, " , and your request is ", MaterialID
            print *, "Hence, your request ", MaterialID, " is accepted as the ID of ", this%NumberOfMaterials + 1
            this%NumberOfMaterials = this%NumberOfMaterials + 1
            this%Materials(this%NumberOfMaterials)%Materialp => Material
            print *, "Now, number of Material conditions is ", this%NumberOfMaterials
            return
         end if
         if (associated(this%Materials(MaterialID)%Materialp)) then
            print *, "Material ID :: ", MaterialID, " is overwritten."
            nullify (this%Materials(MaterialID)%Materialp)
         end if
         this%Materials(MaterialID)%Materialp => Material
         return
      end if

      this%NumberOfMaterials = this%NumberOfMaterials + 1

      this%Materials(this%NumberOfMaterials)%Materialp => Material

      print *, "Now, number of Material conditions is ", this%NumberOfMaterials

   end subroutine ImportMaterialsFEMDomain
! ##################################################

! ##################################################
   subroutine showMaterialsFEMDomain(this, Name)
      class(FEMDomain_), intent(inout) :: this
      character(*), optional, intent(in)::Name
      integer(int32) :: i

      if (present(Name)) then
         print *, "Domain Name is :: ", name
      end if

      if (.not. allocated(this%Materials)) then
         print *, "No boundary is set."
      else
         do i = 1, this%NumberOfMaterials
            print *, "Layer :: ", this%Materials(i)%Materialp%Layer, "Material ::", i, " => ", &
               associated(this%Materials(i)%Materialp)
         end do
      end if
   end subroutine showMaterialsFEMDomain
! ##################################################

! ##################################################
   subroutine removeMaterialsFEMDomain(this, Name, BoundaryID)
      class(FEMDomain_), intent(inout) :: this
      character(*), optional, intent(in)::Name
      integer(int32) :: i
      integer(int32), optional, intent(in) ::BoundaryID

      if (present(Name)) then
         print *, "Domain Name is :: ", name
      end if

      if (.not. allocated(this%Materials)) then
         print *, "No boundary is set."
      else
         if (present(BoundaryID)) then
            nullify (this%Materials(BoundaryID)%Materialp)
         else
            do i = 1, this%NumberOfMaterials
               nullify (this%Materials(i)%Materialp)
            end do
         end if
      end if
      call this%showMaterials(Name)

   end subroutine removeMaterialsFEMDomain
! ##################################################

! ##################################################
   subroutine contactdetectFEMDomain(obj1, obj2, ContactModel)
      class(FEMDomain_), intent(inout) :: obj1, obj2
      character(*), optional, intent(in) :: ContactModel
      type(Mesh_) :: BoundBox
      type(Random_) :: random
      type(ContactName_), allocatable :: cnbuf(:)
      integer(int32), allocatable :: buffer(:)
      real(real64), allocatable :: x(:)

      integer(int32) :: i, domain_id, n, id, m, node_id, seg_nod_num

      ! detect contact nodes and assemble contact elements

      ! first, both domains should be named.
      ! If these are not named, name by random name.
      m = size(obj1%Mesh%NodCoord, 2)
      allocate (x(m))

      if (obj1%name == "NoName") then
         obj1%name = random%name()
         print *, "Caution !  object #1 is not named. New name is "//obj1%name
      end if
      if (obj2%name == "NoName") then
         obj2%name = random%name()
         print *, "Caution !  object #2 is not named. New name is "//obj2%name
      end if

      ! create Node-To-Node contact elements
      ! First, let us detect a bounding box, in which contact interfaces are presented.
      call obj1%Mesh%GetInterSectBox(obj2%Mesh, BoundBox)
      ! , where, obj1, obj2 are FEMDomain objects, and BoundBox is the bounding box.

      ! if, the BoundingBox is not allocated, return
      if (BoundBox%empty()) then
         return
      end if

      ! Hereby, two domains are in contact.
      ! let us detect the contact nodes.
      if (.not. allocated(obj1%Boundary%ContactNameList)) then
         allocate (obj1%Boundary%ContactNameList(1))
         obj1%Boundary%ContactNameList(1)%name = obj2%name
         domain_id = 1
      else
         cnbuf = obj1%Boundary%ContactNameList
         n = size(obj1%Boundary%ContactNameList)
         deallocate (obj1%Boundary%ContactNameList)
         allocate (obj1%Boundary%ContactNameList(n + 1))
         obj1%Boundary%ContactNameList(1:n)%name = cnbuf(1:n)%name
         obj1%Boundary%ContactNameList(n + 1)%name = obj2%name
         domain_id = n + 1
      end if

      buffer = obj1%Mesh%getNodeList(BoundingBox=BoundBox)

      call obj1%Mesh%getSurface()
      call obj2%Mesh%getSurface()
      if (m == 2) then
         seg_nod_num = 4
      else
         seg_nod_num = 16
      end if

      do i = 1, size(buffer, 1)
         if (.not. allocated(obj1%Boundary%MasterNodeID)) then
            allocate (obj1%Boundary%MasterNodeID(1, 2))
            allocate (obj1%Boundary%SlaveNodeID(1, 2))
            allocate (obj1%Boundary%MasterSegment(seg_nod_num, 2))
            allocate (obj1%Boundary%SlaveSegment(seg_nod_num, 2))
         else
            call extend(obj1%Boundary%MasterNodeID, extend1stColumn=.true.)
            call extend(obj1%Boundary%SlaveNodeID, extend1stColumn=.true.)
         end if

         n = size(obj1%Boundary%MasterNodeID, 1)

         obj1%Boundary%MasterNodeID(n, 1) = buffer(i)
         obj1%Boundary%MasterNodeID(n, 2) = domain_id
         obj1%Boundary%SlaveNodeID(n, 1) = 0
         obj1%Boundary%SlaveNodeID(n, 2) = domain_id

         !obj1%Boundary%MasterSegment(n,:)=domain_id
         !obj1%Boundary%SlaveSegment( n,:)=domain_id

      end do

      ! assemble Node-To-Node contact element
      do i = 1, size(obj1%Boundary%MasterNodeID, 1)
         node_id = obj1%Boundary%MasterNodeID(i, 1)
         x(:) = obj1%Mesh%NodCoord(node_id, :)
         id = SearchNearestCoord(Array=obj2%Mesh%NodCoord, x=x)
         obj1%Boundary%SlaveNodeID(i, 1) = id
      end do

      ! assemble Node-To-Segment contact element

   end subroutine
! ##################################################

   subroutine getSurfaceFEMDomain(this)
      class(FEMDomain_), intent(inout) :: this

      call this%mesh%getSurface(sorting=.false.)

   end subroutine
! ##################################################

! ##################################################

   function getSurfaceElementsFEMDomain(this, range) result(ret)
      class(FEMDomain_), intent(inout) :: this
      type(Range_), intent(in) :: range
      integer(int32), allocatable :: counted(:) !0 is not output
      integer(int32) :: i,itr
      real(real64), allocatable :: x(:)
      integer(int32), allocatable :: ret(:,:)

      call this%getSurface()

      allocate (counted(size(this%mesh%FacetElemNod, 1)))
      counted(:) = 0
      do i = 1, size(this%mesh%FacetElemNod, 1)
         x = this%getCenter(nodelist=this%mesh%FacetElemNod(i, :))
         if (      range%x_range(1) <= x(1) .and. x(1) <= range%x_range(2)) then
            if (   range%y_range(1) <= x(2) .and. x(2) <= range%y_range(2)) then
               if (range%z_range(1) <= x(3) .and. x(3) <= range%z_range(2)) then
                  counted(i) = 1
               end if
            end if
         end if
      end do
      ! only counted(:)=1 will be returned
      allocate(ret(sum(counted),size(this%mesh%FacetElemNod,2)) )
      
      itr = 0
      do i=1,size(counted)
         if(counted(i)==1 )then
            itr = itr + 1
            ret(itr,:) = this%mesh%FacetElemNod(i,:)
         endif
      enddo

   end function
! ##################################################

   subroutine getVerticesFEMDomain(this, vertices, vertexIDs)
      class(FEMDomain_), intent(inout) :: this
      real(real64), allocatable, intent(inout) :: vertices(:)
      integer(int32), allocatable, intent(inout) :: vertexIDs(:)

      call this%mesh%getVertices(vertices, vertexIDs)

   end subroutine
! ##################################################

! ##################################################
   recursive function getVolumeFEMDomain(this, elem) result(ret)
      class(FEMDomain_), intent(in) :: this
      type(ShapeFunction_) :: sf
      integer(int32), optional, intent(in) :: elem
      real(real64) :: ret
      integer(int32) :: i, j, elemid

      if (present(elem)) then
         sf%ElemType = this%Mesh%GetElemType()
         call SetShapeFuncType(sf)
         i = elem
         ret = 0.0d0
         do j = 1, sf%numOfGP
            call GetAllShapeFunc(sf, elem_id=i, nod_coord=this%Mesh%NodCoord, &
                                 elem_nod=this%Mesh%ElemNod, OptionalGpID=j)
            ret = ret + sf%detJ*((2.0d0)**this%nd())/dble(sf%numOfGP)
         end do
      else
         ! count all
         ret = 0.0d0
         do elemid = 1, this%ne()
            ret = ret + this%getVolume(elem=elemid)
         end do
      end if
   end function
! ##################################################

! ##################################################
   function getJacobiMatrixFEMDomain(this, elem) result(ret)
      class(FEMDomain_), intent(inout) :: this
      integer(int32), intent(in) :: elem
      real(real64), allocatable :: ret(:, :)
      integer(int32) :: i, j

      this%ShapeFunction%ElemType = this%Mesh%GetElemType()
      call SetShapeFuncType(this%ShapeFunction)
      i = elem
      call GetAllShapeFunc(this%ShapeFunction, elem_id=i, nod_coord=this%Mesh%NodCoord, &
                           elem_nod=this%Mesh%ElemNod, OptionalGpID=1)
      ret = this%ShapeFunction%Jmat

   end function
! ##################################################

   function getFacetLocalNodeIDFEM(this) result(facet)
      class(FEMDomain_), intent(in) :: this
      integer(int32), allocatable :: facet(:, :)
      integer(int32) :: i, j

      if (this%nd() == 3 .and. this%nne() == 8) then
         allocate (Facet(6, 4))
         Facet(1, 1:4) = [4, 3, 2, 1]
         Facet(2, 1:4) = [1, 2, 6, 5]
         Facet(3, 1:4) = [2, 3, 7, 6]
         Facet(4, 1:4) = [3, 4, 8, 7]
         Facet(5, 1:4) = [4, 1, 5, 8]
         Facet(6, 1:4) = [5, 6, 7, 8]
      elseif (this%nd() == 3 .and. this%nne() == 4) then
         allocate (Facet(4, 3))
         Facet(1, 1:3) = [3, 2, 1]
         Facet(2, 1:3) = [1, 2, 4]
         Facet(3, 1:3) = [2, 3, 4]
         Facet(4, 1:3) = [3, 1, 4]
      elseif (this%nd() == 2 .and. this%nne() == 4) then
         allocate (Facet(4, 2))
         Facet(1, 1:2) = [1, 2]
         Facet(2, 1:2) = [2, 3]
         Facet(3, 1:2) = [3, 4]
         Facet(4, 1:2) = [4, 1]
      else
         print *, "ERROR :: getSingleFacetNodeIDFEMDomain >> "
         print *, "No implementation for such element type"
         print *, "Please send issue on the Github."
         stop
      end if

   end function

   function getSingleFacetNodeIDFEMDomain(this, ElementID) result(facet)
      class(FEMDomain_), intent(in) :: this
      integer(int32), intent(in) :: ElementID
      integer(int32), allocatable :: facet(:, :)
      integer(int32) :: i, j

      if (this%nd() == 3 .and. this%nne() == 8) then
         allocate (Facet(6, 4))
         Facet(1, 1:4) = [4, 3, 2, 1]
         Facet(2, 1:4) = [1, 2, 6, 5]
         Facet(3, 1:4) = [2, 3, 7, 6]
         Facet(4, 1:4) = [3, 4, 8, 7]
         Facet(5, 1:4) = [4, 1, 5, 8]
         Facet(6, 1:4) = [5, 6, 7, 8]
      elseif (this%nd() == 3 .and. this%nne() == 4) then
         allocate (Facet(4, 3))
         Facet(1, 1:3) = [3, 2, 1]
         Facet(2, 1:3) = [1, 2, 4]
         Facet(3, 1:3) = [2, 3, 4]
         Facet(4, 1:3) = [3, 1, 4]
      elseif (this%nd() == 2 .and. this%nne() == 4) then
         allocate (Facet(4, 2))
         Facet(1, 1:2) = [1, 2]
         Facet(2, 1:2) = [2, 3]
         Facet(3, 1:2) = [3, 4]
         Facet(4, 1:2) = [4, 1]
      else
         print *, "ERROR :: getSingleFacetNodeIDFEMDomain >> "
         print *, "No implementation for such element type"
         print *, "Please send issue on the Github."
         stop
      end if

      do i = 1, size(Facet, 1)
         do j = 1, size(Facet, 2)
            Facet(i, j) = this%mesh%elemnod(ElementID, Facet(i, j))
         end do
      end do

   end function

   subroutine x3dFEMDomain(this, name)
      class(FEMDomain_), intent(inout) :: this
      character(*), intent(in) :: name
      type(IO_) :: f
      integer(int32), allocatable ::Facet(:, :)
      integer(int32) :: ElementID, FacetID, PointID

      ! export as X3D
      call f%open(name + ".x3d", "w")
      !write(f%fh,*) '<X3D version="3.0" profile="Immersive" xmlns:xsd="http://www.w3.org/2001/XMLSchema-instance" xsd:noNamespaceSchemaLocation="http://www.web3d.org/specifications/x3d-3.0.xsd">'
      write (f%fh, *) '<X3D version="3.0">'
      write (f%fh, *) '<Scene>'
      write (f%fh, *) '<Shape>'
      write (f%fh, *) '<IndexedFaceSet'
      write (f%fh, *) 'solid="false"'
      write (f%fh, *) 'coordIndex="'

      do ElementID = 1, this%ne()
         facet = this%getSingleFacetNodeID(ElementID=ElementID)
         facet(:, :) = facet(:, :) - 1
         do FacetID = 1, size(Facet, 1)
            write (f%fh, *) Facet(FacetID, :), "-1"
         end do
      end do

      write (f%fh, *) '">'

      write (f%fh, *) '<Coordinate DEF="coords_ME_Cube" point="'

      do PointID = 1, this%nn()
         write (f%fh, *) this%mesh%nodcoord(PointID, :)
      end do

      write (f%fh, *) '"/>'
      write (f%fh, *) '</IndexedFaceSet>'

      write (f%fh, *) '</Shape>'
      write (f%fh, *) '</Scene>'
      write (f%fh, *) '</X3D>'

   end subroutine
! ##################################################
   subroutine vtk_MPI_FEMDOmain(this, name, num_division, remove)
      class(FEMDomain_), intent(inout) :: this
      integer(int32), intent(in) :: num_division
      character(*), intent(in) :: name
      logical, optional, intent(in) :: remove
      type(FEMDomain_), allocatable :: domains(:)
      integer(int32) :: i, j, nn
      type(IO_) :: f

      nn = this%nn()
      domains = this%divide(n=num_division)

      if (present(remove)) then
         if (remove) then
            call this%remove()
         end if
      end if

      do i = 1, num_division
         call domains(i)%vtk(name + "_"+zfill(i - 1, 6))
      end do

      do i = 1, num_division
         ! domain connectivity
         call f%open(name + "_"+zfill(i - 1, 6) + ".csv", "w")
         call f%write("# number of global node, number of local node, number of shared node,&
&                        number of division ")

         call f%write(str(nn) + " ,"+str(domains(i)%nn()) + " ," &
                      +str(size(domains(i)%mpi_shared_node_info, 1)) + " ," &
                      +str(num_division))
         call f%write("# local node Idx, global node Idx ")
         if (allocated(domains(i)%mpi_global_node_idx)) then
            do j = 1, size(domains(i)%mpi_global_node_idx)
               call f%write(str(j) + " ,"+str(domains(i)%mpi_global_node_idx(j)))
            end do
         end if
         call f%write("# local node Idx, domain Idx, shared local node Idx ")
         if (allocated(domains(i)%mpi_shared_node_info)) then
            do j = 1, size(domains(i)%mpi_shared_node_info, 1)
               call f%write(str(domains(i)%mpi_shared_node_info(j, 1)) &
                            + " ,"+str(domains(i)%mpi_shared_node_info(j, 2)) &
                            + " ,"+str(domains(i)%mpi_shared_node_info(j, 3)))
            end do
         end if
         call f%close()
      end do

      return

   end subroutine

! ##################################################
recursive subroutine vtkFEMDomain(this, name, scalar, vector, tensor, field, ElementType, NodeList, debug, displacement, only_field)
      class(FEMDomain_), intent(inout) :: this
      type(FEMDomain_) :: mini_obj
      character(*), intent(in) :: name
      character(*), optional, intent(in) :: field
      real(real64), optional, intent(in) :: scalar(:), vector(:, :), tensor(:, :, :), displacement(:)
      integer(int32), optional, intent(in) :: ElementType, Nodelist(:)
      character(len=:), allocatable :: point_scalars, point_vectors, point_tensors, cell_scalars, cell_vectors, cell_tensors
      logical, optional, intent(in) :: only_field
      type(IO_) :: f
      integer(int32) ::i, dim_num(3), j, VTK_CELL_TYPE, num_node, k, n
      logical, optional, intent(in) :: debug

      if (present(displacement)) then
         call this%deform(disp=displacement)
         call this%vtk(name=name, scalar=scalar, vector=vector, tensor=tensor, &
                       field=field, ElementType=ElementType, NodeList=NodeList, debug=debug)
         call this%deform(disp=-displacement)
         return
      end if

      if (this%nd() == 2) then
         mini_obj = this
         call mini_obj%mesh%convert2Dto3D(division=1, thickness=dble(1.0e-8))
         call mini_obj%vtk(name=name, scalar=scalar, vector=vector, tensor=tensor, &
                           field=field, ElementType=ElementType, NodeList=NodeList, debug=debug)
         return
      end if

      if (present(NodeList)) then
         n = size(NodeList, 1)
         mini_obj%mesh%nodcoord = zeros(n, this%nd())
         mini_obj%mesh%elemNod = zeros(n, this%nne())
         do i = 1, n
            mini_obj%mesh%nodcoord(i, :) = this%mesh%nodcoord(NodeList(i), :)
         end do
         do i = 1, n
            mini_obj%mesh%elemNod(i, :) = i
         end do
         call mini_obj%vtk(name=name)
         return
      end if

      if (present(field)) then
         point_scalars = field
         point_vectors = field
         point_tensors = field
         cell_scalars = field
         cell_vectors = field
         cell_tensors = field
      else
         point_scalars = "point_scalars"
         point_vectors = "point_vectors"
         point_tensors = "point_tensors"
         cell_scalars = "cell_scalars"
         cell_vectors = "cell_vectors"
         cell_tensors = "cell_tensors"
      end if

      if (this%mesh%empty() .eqv. .true.) then
         print *, "ERROR :: vtkFEMDomain >> this%mesh%empty() .eqv. .true., nothing exported"
         return
      end if

      if (.not. allocated(this%mesh%elemnod)) then
         VTK_CELL_TYPE = 1 ! point
      elseif (this%nd() == 3 .and. this%nne() == 2) then
         VTK_CELL_TYPE = 1 ! point
      elseif (this%nd() == 2 .and. this%nne() == 3) then
         VTK_CELL_TYPE = 5 ! triangle
      elseif (this%nd() == 2 .and. this%nne() == 4) then
         VTK_CELL_TYPE = 9 ! square
      elseif (this%nd() == 3 .and. this%nne() == 4) then
         VTK_CELL_TYPE = 10 ! 4-node triangle
      elseif (this%nd() == 3 .and. this%nne() == 8) then
         VTK_CELL_TYPE = 12 ! 8-node box
      else
         VTK_CELL_TYPE = elementType2VTKCellType(this%mesh%getElementType())
         if (VTK_CELL_TYPE == -1) then
            print *, "VTKFEMDomain >> ERROR :: Nothing is exported."
            return
         end if
      end if

      if (present(ElementType)) then
         VTK_CELL_TYPE = ElementType
      end if

      !call displayFEMDomain(this,path="./",name=name,extention=".vtk")
      if (index(name, ".vtk") /= 0 .or. index(name, ".VTK") /= 0) then
         call f%open(name, 'w')
      else
         call f%open(name//".vtk", 'w')
      end if

      call f%write("# vtk DataFile Version 2.0")
      call f%write(name)
      call f%write("ASCII")
      call f%write("DATASET UNSTRUCTURED_GRID")
      call f%write("POINTS "//str(this%nn())//" float")
      do i = 1, this%nn()
         do j = 1, this%nd() - 1
            write (f%fh, '(A)', advance="no") str(this%mesh%nodcoord(i, j))//" "
         end do
         write (f%fh, '(A)', advance="yes") str(this%mesh%nodcoord(i, this%nd()))
      end do

      call f%write("CELLS "//str(this%ne())//" "//str(this%ne()*(this%nne() + 1)))
      do i = 1, this%ne()
         num_node = this%nne()
         if (present(ElementType)) then
            if (ElementType == 1) then
               num_node = 1
            elseif (ElementType == 5) then
               num_node = 3
            elseif (ElementType == 9) then
               num_node = 4
            elseif (ElementType == 10) then
               num_node = 4
            elseif (ElementType == 12) then
               num_node = 8
            elseif (ElementType == 13) then
               num_node = 6
            elseif (ElementType == 14) then
               num_node = 4
            end if
         end if

         write (f%fh, '(A)', advance="no") str(num_node)//" "

         do j = 1, num_node - 1
            write (f%fh, '(A)', advance="no") str(this%mesh%elemnod(i, j) - 1)//" "
         end do
         write (f%fh, '(A)', advance="yes") str(this%mesh%elemnod(i, num_node) - 1)
      end do

      call f%write("CELL_TYPES "//str(this%ne()))
      do i = 1, this%ne()
         call f%write(str(VTK_CELL_TYPE))
      end do

      ! if scalar or vector exists..
      if (present(scalar)) then
         if (size(scalar) == this%nn()) then
            call f%write("POINT_DATA "//str(this%nn()))
            call f%write("SCALARS "//point_scalars//" float")
            call f%write("LOOKUP_TABLE default")
            do i = 1, this%nn()
               write (f%fh, *) real(scalar(i))
            end do
         elseif (size(scalar) == this%ne()) then
            call f%write("CELL_DATA "//str(this%ne()))
            call f%write("SCALARS "//cell_scalars//" float")
            call f%write("LOOKUP_TABLE default")
            do i = 1, this%ne()
               write (f%fh, *) real(scalar(i))
            end do
         else
            call print("vtkFEMDOmain ERROR ::size(scalar) should be this%nn() or this%ne()  ")
            call print("size(scalar)="//str(size(scalar))//" <> this%nn() = "//str(this%nn())// &
                       " <> this%ne() = "//str(this%ne()))
            call f%close()
            return
         end if
      end if

      if (present(vector)) then
         if (size(vector, 1) == this%nn()) then
            call f%write("POINT_DATA "//str(this%nn()))
            call f%write("VECTORS "//point_vectors//" float")
            do i = 1, this%nn()
               do j = 1, size(vector, 2) - 1
                  write (f%fh, '(A)', advance="no") str(vector(i, j))//" "
               end do
               write (f%fh, '(A)', advance="yes") str(vector(i, size(vector, 2)))
            end do
         elseif (size(vector, 1) == this%ne()) then
            call f%write("CELL_DATA "//str(this%ne()))
            call f%write("VECTORS "//cell_vectors//" float")
            do i = 1, this%ne()
               do j = 1, size(vector, 2) - 1
                  write (f%fh, '(A)', advance="no") str(vector(i, j))//" "
               end do
               write (f%fh, '(A)', advance="yes") str(vector(i, size(vector, 2)))
            end do
         else
            call print("vtkFEMDOmain ERROR ::size(vector,1) sould be this%nn()   ")
            call print("size(vector,1)="//str(size(vector, 1))//" and this%nn() = "//str(this%nn()))
            call f%close()
            return
         end if
      end if

      if (present(tensor)) then
         if (size(tensor, 1) == this%nn()) then
            call f%write("POINT_DATA "//str(this%nn()))
            call f%write("TENSORS "//point_tensors//" float")
            do i = 1, this%nn()
               do j = 1, size(tensor, 2)
                  do k = 1, size(tensor, 3) - 1
                     write (f%fh, '(A)', advance="no") str(tensor(i, j, k))//" "
                  end do
                  write (f%fh, '(A)', advance="yes") str(tensor(i, j, size(tensor, 3)))
               end do

            end do
         elseif (size(tensor, 1) == this%ne()) then
            call f%write("CELL_DATA "//str(this%ne()))
            call f%write("TENSORS "//cell_tensors//" float")
            do i = 1, this%ne()
               do j = 1, size(tensor, 2)
                  do k = 1, size(tensor, 3) - 1
                     write (f%fh, '(A)', advance="no") str(tensor(i, j, k))//" "
                  end do
                  write (f%fh, '(A)', advance="yes") str(tensor(i, j, size(tensor, 3)))
                  !do j=1,size(tensor,2)-1
                  !        write(f%fh,'(A)',advance="no") str(tensor(i,j) )//" "
                  !enddo
                  !write(f%fh,'(A)',advance="yes") str(tensor(i, size(tensor,2) ) )
               end do
            end do
         else
            call print("vtkFEMDOmain ERROR ::size(tensor,1) sould be this%nn()   ")
            call print("size(tensor,1)="//str(size(tensor, 1))//" and this%nn() = "//str(this%nn()))
            call f%close()
            return
         end if
      end if

      if (present(debug)) then
         if (debug) then
            print *, name//".vtk is exported."
         end if
      end if

      call f%close()

   end subroutine
! ##################################################

! ##################################################
   subroutine plyFEMDomain(this, name, NodeList, scalar)
      class(FEMDomain_), intent(inout) :: this
      type(FEMDomain_) :: mini_obj
      character(*), intent(in) :: name
      type(IO_) :: f
      integer(int32), optional, intent(in) :: NodeList(:)
      real(real64), optional, intent(in) :: scalar(:)
      integer(int32) ::i, n

      if (this%mesh%empty() .eqv. .true.) then
         print *, "ERROR :: vtkFEMDomain >> this%mesh%empty() .eqv. .true., nothing exported"
         return
      end if

      if (present(NodeList)) then
         n = size(NodeList, 1)
         mini_obj%mesh%nodcoord = zeros(n, this%nd())
         mini_obj%mesh%elemNod = zeros(n, this%nne())
         do i = 1, n
            mini_obj%mesh%nodcoord(i, :) = this%mesh%nodcoord(NodeList(i), :)
         end do
         do i = 1, n
            mini_obj%mesh%elemNod(i, :) = i
         end do
         call mini_obj%stl(name=name)
         return
      end if

      call displayFEMDomain(this, path="./", name=name, extention=".ply", field=scalar)
      return

   end subroutine
! ##################################################

   subroutine stlFEMDomain(this, name, NodeList)
      class(FEMDomain_), intent(inout) :: this
      type(IO_) :: f
      type(FEMDomain_) :: mini_obj
      integer(int32), optional, intent(in) :: NodeList(:)
      character(*), intent(in) :: name
      integer(int32) :: i, j, n

      if (present(NodeList)) then
         n = size(NodeList, 1)
         mini_obj%mesh%nodcoord = zeros(n, this%nd())
         mini_obj%mesh%elemNod = zeros(n, this%nne())
         do i = 1, n
            mini_obj%mesh%nodcoord(i, :) = this%mesh%nodcoord(NodeList(i), :)
         end do
         do i = 1, n
            mini_obj%mesh%elemNod(i, :) = i
         end do
         call mini_obj%stl(name=name)
         return
      end if

      !call f%open(name//".stl")
      call ExportFEMDomainAsSTL(this, MeshDimension=size(this%mesh%Nodcoord, 2), FileName=name)
      !call f%close()
   end subroutine
! ##################################################

! ##################################################
   subroutine objFEMDomain(this, name)
      class(FEMDomain_), intent(inout) :: this
      type(IO_) :: f
      character(*), intent(in) :: name
      integer(int32) :: i, j, k

      call f%open(name//".obj")
      do i = 1, this%nn()
         write (f%fh, '(A)', advance="no") "v "
         do j = 1, size(this%mesh%Nodcoord, 2) - 1
            write (f%fh, '(A)', advance="no") str(this%mesh%Nodcoord(i, j))//" "
         end do
         write (f%fh, '(A)', advance="yes") str(this%mesh%Nodcoord(i, size(this%mesh%Nodcoord, 2)))
      end do

      call f%close()
   end subroutine
! ##################################################

! ##################################################
   subroutine jsonFEMDomain(this, name, fh, endl)
      class(FEMDomain_), intent(in) :: this
      type(IO_) :: f
      integer(int32), optional, intent(in) :: fh
      character(*), optional, intent(in) :: name
      character(:), allocatable :: fname

      integer(int32) :: fileid
      logical, optional, intent(in) :: endl

      ! export JSON file
      if (present(name)) then
         if (present(fh)) then
            ![ok] name
            ![ok] file handle
            !append
            fileid = fh
            fname = name
         else
            call f%open(name)
            fileid = f%fh
            fname = name
            ![ok] name
            ![--] file handle
            ! > create new file with Name=name
         end if
      else
         if (present(fh)) then
            fileid = fh
            fname = "untitled"
            ![--] name
            ![ok] file handle
            !append
         else
            ![--] name
            ![--] file handle
            !append
            call f%open(name="untitled.json")
            fileid = f%fh
            fname = "untitled"
         end if
      end if

      write (fileid, '(A)') '{'
      if (present(name)) then
         write (fileid, *) '"name": "'//name//'",'
      end if
      write (fileid, *) '"type": "femdomain",'

      call this%mesh%json(fh=fileid)

      if (present(endl)) then
         if (endl .eqv. .false.) then
            write (fileid, *) '},'
         else
            write (fileid, *) '}'
         end if
      else
         write (fileid, *) '}'
      end if

      if (present(name)) then
         if (present(fh)) then
            fileid = fh
         else
            call f%close()
            fileid = f%fh
         end if
      else
         if (present(fh)) then
            fileid = fh
         else
            call f%close()
            fileid = f%fh
         end if
      end if

   end subroutine
! ##############################################
   subroutine readFEMDomain(this, name, DimNum, ElementType)
      class(FEMDomain_), intent(inout) :: this
      character(*), intent(in) :: name
      character(:), allocatable :: line
      integeR(int32), allocatable :: elemnod(:, :), node_list(:), element_list(:), g_node_list(:), cell_types(:)
      integer(int32), optional, intent(in) :: DimNum, ElementType
      logical :: ret = .false.
      real(real64) :: x(3)
      real(real64), allocatable :: nodcoord(:, :)
      integer(int32) :: node_num, elem_num, i, j, id, itr, n, m, num_node_new, num_node, num_entity
      integer(int32) :: num_dim, num_c_node, nne, node_id
      type(IO_) :: f

      if (index(name, ".vtk") /= 0) then
         call this%ImportVTKFile(name=name)
         this%mesh%elementType = [0,0,0]
         this%mesh%elementType(1) = this%nd()
         this%mesh%elementType(2) = this%nne()

         ! Number of Gauss points
         if (this%mesh%elementType(1) == 1) then
            ! 1D -> ngp = nne - 1
            this%mesh%elementType(3) = this%nne() - 1

         elseif (this%mesh%elementType(1) == 2) then
            if (this%mesh%elementType(2)==3)then
               this%mesh%elementType(3) = 1
            else 
               this%mesh%elementType(3) = this%mesh%elementType(2)
            endif
            
         elseif  (this%mesh%elementType(1) == 3) then
            if (this%mesh%elementType(2)==4)then
               this%mesh%elementType(3) = 1
            else 
               this%mesh%elementType(3) = this%mesh%elementType(2)
            endif
         else
            print *, "[ERROR] readFEMDomain >> invalid %nd()", this%nd()
            stop
         endif
         return
      end if

      if (index(name, "json") /= 0) then
         call f%open(name)

         ! json読み取ります

         call f%close()
         ret = .true.
      end if

      if (index(name, "msh") /= 0) then
         call f%open(name, "r")
         ! get nodal coordinate
         ! For MSH 4.1
         if (.not. present(DimNum)) then
            print *, "ERROR :: readFEMDomain >> DimNum should be 2 or 3"
            stop
         end if
         do
            line = f%readline()
            if (f%EOF) exit
            if (index(line, "$Nodes") /= 0) then
               line = f%readline()
               read (line, *) num_entity, num_node, n, m
               allocate (g_node_list(num_node))
               g_node_list(:) = 0
               allocate (node_list(num_node))
               this%mesh%nodcoord = zeros(num_node, 3)
               node_id = 0
               do
                  line = f%readline()
                  read (line, *) num_dim, num_c_node, n, m
                  if (num_dim == DimNum) then
                     ! 2-D mesh"

                     do i = 1, m
                        line = f%readline()
                        read (line, *) node_list(i)
                        print *, node_list(i)
                        g_node_list(node_list(i)) = node_list(i)
                     end do
                     do i = 1, m
                        line = f%readline()
                        node_id = node_id + 1
                        read (line, *) this%mesh%nodcoord(node_id, 1:3)
                     end do
                     exit
                  else
                     ! ignore
                     line = f%readline()
                     read (line, *) n
                     g_node_list(n) = n
                     line = f%readline()
                     node_id = node_id + 1
                     read (line, *) this%mesh%nodcoord(n, 1:3)
                  end if
               end do
            end if

            if (index(line, "$Elements") /= 0) then
               line = f%readline()
               read (line, *) num_entity, num_node, n, m
               do
                  line = f%readline()
                  read (line, *) num_dim, num_c_node, n, m
                  if (num_dim == DimNum) then
                     ! 2-D mesh"
                     allocate (element_list(m))
                     !defines the geometrical type of the n-th element:
                     !
                     !1
                     !2-node line.
                     !
                     !2
                     !3-node triangle.
                     !
                     !3
                     !4-node quadrangle.
                     !
                     !4
                     !4-node tetrahedron.
                     !
                     !5
                     !8-node hexahedron.
                     !
                     !6
                     !6-node prism.
                     !
                     !7
                     !5-node pyramid.
                     if (n == 1) then
                        nne = 2
                     elseif (n == 2) then
                        nne = 3
                     elseif (n == 3) then
                        nne = 4
                     elseif (n == 4) then
                        nne = 4
                     elseif (n == 5) then
                        nne = 8
                     elseif (n == 6) then
                        nne = 6
                     elseif (n == 7) then
                        nne = 5
                     else
                        print *, "[CAUTION] ReadFEMDomain >> No such elemtype as", n
                        exit
                     end if
                     allocate (this%mesh%elemnod(m, nne))
                     do i = 1, m
                        line = f%readline()
                        print *, line
                        read (line, *) element_list(i), this%mesh%elemnod(i, 1:)
                     end do
                     exit
                  else
                     ! ignore
                     do i = 1, m
                        line = f%readline()
                     end do
                  end if
               end do
               ! got nodcoord & elemnod

               do i = 1, size(this%mesh%elemnod, 1)
                  do j = 1, size(this%mesh%elemnod, 2)
                     m = g_node_list(this%mesh%elemnod(i, j))
                     if (m == 0) then
                        print *, g_node_list(845:)
                        print *, "[ERROR] ReadFEMDomain >> this%mesh%elemnod(i,j) = m", i, j, this%mesh%elemnod(i, j)
                        stop
                     else
                        this%mesh%elemnod(i, j) = m
                     end if
                  end do
               end do

            end if
         end do
         call f%close()
         ret = .true.
         print *, g_node_list
         return
      end if

      if (index(name, "vtk") /= 0) then
         itr = 0
         call f%open(name, "r")

         ! msh読み取ります
         elem_num = 0
         do
            line = f%readline()
            if (f%EOF) then
               ! post processing
               if (present(ElementType)) then
                  do i = 1, size(cell_types)
                     if (cell_types(i) /= ElementType) then
                        cell_types(i) = -1
                     end if
                  end do
                  call this%killElement(blacklist=cell_types, flag=-1)
               end if
               this%mesh%elemnod = this%mesh%elemnod + 1
               return
            end if

            if (index(line, "POINTS") /= 0) then

               n = index(line, "POINTS")
               read (line(n + 6:), *) node_num
               allocate (node_list(node_num))
               node_list(:) = 0
               this%mesh%nodcoord = zeros(node_num, 3)
               do i = 1, node_num
                  line = f%readline()
                  read (line, *) this%mesh%nodcoord(i, :)
               end do
            end if

            if (index(line, "CELLS") /= 0) then
               n = index(line, "CELLS")
               read (line(n + 5:), *) elem_num
               if (allocated(this%mesh%elemnod)) deallocate (this%mesh%elemnod)
               allocate (this%mesh%elemnod(elem_num, 8))
               this%mesh%ElemNod(:, :) = 0
               j = 0
               do i = 1, elem_num
                  line = f%readline()
                  j = j + 1
                  read (line, *) m, this%mesh%elemnod(j, 1:m)
               end do

!                                elemnod = this%mesh%elemnod
!                                deallocate(this%mesh%elemnod)
!                                allocate(this%mesh%elemnod(elem_num,4))
!                                elem_num=0
!                                do i=1,this%ne()
!                                        if(elemnod(i,1)/=0 )then
!                                                elem_num=elem_num+1
!                                                this%mesh%elemnod(elem_num,:) = elemnod(i,:)
!                                        endif
!                                enddo
!                                this%mesh%elemnod(:,:) = this%mesh%elemnod(:,:) + 1
!                                ! 要素の節点番号を振り直す。
!                                do i=1,size(this%mesh%elemnod,1)
!                                        do j=1,size(this%mesh%elemnod,2)
!                                                node_list( this%mesh%elemnod(i,j) ) = 1
!                                        enddo
!                                enddo
!                                j=0
!                                do i=1,size(node_list)
!                                        if(node_list(i)==1 )then
!                                                j=j+1
!                                                node_list(i) = j
!                                        endif
!                                enddo
!                                num_node_new = j
!
!                                ! new node-id
!                                do i=1,size(this%mesh%elemnod,1)
!                                        do j=1,size(this%mesh%elemnod,2)
!                                                this%mesh%elemnod(i,j) = node_list( this%mesh%elemnod(i,j) )
!                                        enddo
!                                enddo

               ! remove un-associated nodes
               !nodcoord = this%mesh%nodcoord
               !this%mesh%nodcoord = zeros(num_node_new,3)
               !do i=1, size(node_list)
               !        j = node_list(i)
               !        if(j == 0)then
               !                cycle
               !        else
               !                this%mesh%nodcoord(node_list(i) ,:   ) = nodcoord(i,:)
               !        endif
               !enddo

            end if

            if (index(line, "CELL_TYPES") /= 0) then
               n = index(line, "CELL_TYPES")
               read (line(n + 10:), *) elem_num
               allocate (cell_types(elem_num))
               do i = 1, elem_num
                  line = f%readline()
                  read (line, *) cell_types(i)
               end do
            end if

         end do

         call f%close()
         ret = .true.
         return
      end if

      if (ret .eqv. .false.) then
         print *, "ERROR >> readFEMDomain >> not such file as ", name
         return
      end if

   end subroutine
! ##############################################

! ##############################################
   subroutine addLayerFEMDomain(this, name, attribute, datastyle, vectorrank, tensorrank1, tensorrank2)
      class(FEMDomain_), intent(inout) :: this
      type(PhysicalField_), allocatable :: pfa(:)
      character(*), intent(in) :: attribute ! should be NODAL, ELEMENTAL, or GAUSSPOINT
      character(*), intent(in) :: datastyle ! should be SCALAR, VECTOR, or TENSOR
      character(*), intent(in) :: name
      integer, optional, intent(in) :: vectorrank, tensorrank1, tensorrank2
      integer(int32) :: datasize, datadimension, vector_rank, tensor_rank1, tensor_rank2, i

      vector_rank = input(default=3, option=vectorrank)
      tensor_rank1 = input(default=3, option=tensorrank1)
      tensor_rank2 = input(default=3, option=tensorrank2)

      if (.not. allocated(this%PhysicalField)) then
         allocate (this%PhysicalField(100)) ! 100 layer as default
         this%numoflayer = 0
      end if
      this%numoflayer = this%numoflayer + 1

      if (this%numoflayer > size(this%PhysicalField)) then
         pfa = this%PhysicalField
         deallocate (this%PhysicalField)
         allocate (this%PhysicalField(size(pfa)*100))
         do i = 1, size(this%physicalfield)
            this%PhysicalField(i)%name = "untitled"
         end do
         this%PhysicalField(1:size(pfa)) = pfa(:)
      end if

      this%PhysicalField(this%numoflayer)%name = name
      if (this%mesh%empty() .eqv. .true.) then
         print *, "ERROR >> addLayerFEMDomain >> mesh should be defined preliminary."
         return
      end if

      datasize = 0
      select case (attribute)
      case ("Nodal", "NODAL", "node-wize", "Node-Wize", "NODEWIZE", "Node", "node")
         datasize = size(this%mesh%nodcoord, 1)
         this%PhysicalField(this%numoflayer)%attribute = 1
      case ("Elemental", "ELEMENTAL", "element-wize", "Element-Wize", "ELEMENTWIZE", "Element", "element")
         datasize = size(this%mesh%elemnod, 1)
         this%PhysicalField(this%numoflayer)%attribute = 2
      case ("Gausspoint", "GAUSSPOINT", "gausspoint-wize", "GaussPoint-Wize", "GAUSSPOINTWIZE")
         datasize = size(this%mesh%elemnod, 1)
         this%PhysicalField(this%numoflayer)%attribute = 3
      end select

      select case (datastyle)
      case ("Scalar", "SCALAR", "scalar")
         allocate (this%PhysicalField(this%numoflayer)%scalar(datasize))
         this%PhysicalField(this%numoflayer)%datastyle = 1
         this%PhysicalField(this%numoflayer)%scalar(:) = 0.0d0
      case ("Vector", "VECTOR", "vector")
         allocate (this%PhysicalField(this%numoflayer)%vector(datasize, vector_rank))
         this%PhysicalField(this%numoflayer)%vector(:, :) = 0.0d0
         this%PhysicalField(this%numoflayer)%datastyle = 2
      case ("Tensor", "TENSOR", "tensor")
         allocate (this%PhysicalField(this%numoflayer)%tensor(datasize, tensor_rank1, tensor_rank2))
         this%PhysicalField(this%numoflayer)%tensor(:, :, :) = 0.0d0
         this%PhysicalField(this%numoflayer)%datastyle = 3
      end select

      !if(present(scalar) )then
      !        this %PhysicalField(this%numoflayer) % scalar = scalar
      !endif

   end subroutine
! ######################################################################

! ######################################################################
   subroutine addLayerFEMDomainScalar(this, name, scalar)
      class(FEMDomain_), intent(inout) :: this
      type(PhysicalField_), allocatable :: pfa(:)
      real(real64), intent(in) :: scalar(:)
      character(*), intent(in) :: name
      integer(int32) :: datasize, i

      if (.not. allocated(this%PhysicalField)) then
         allocate (this%PhysicalField(100)) ! 100 layer as default
         this%numoflayer = 0
      end if
      this%numoflayer = this%numoflayer + 1

      if (this%numoflayer > size(this%PhysicalField)) then
         pfa = this%PhysicalField
         deallocate (this%PhysicalField)
         allocate (this%PhysicalField(size(pfa)*100))
         do i = 1, size(this%physicalfield)
            this%PhysicalField(i)%name = "untitled"
         end do
         this%PhysicalField(1:size(pfa)) = pfa(:)
      end if

      this%PhysicalField(this%numoflayer)%name = name
      if (this%mesh%empty() .eqv. .true.) then
         print *, "ERROR >> addLayerFEMDomain >> mesh should be defined preliminary."
         return
      end if

      this%PhysicalField(this%numoflayer)%scalar = scalar

      ! auto detection of the type of layer
      this%PhysicalField(this%numoflayer)%datastyle = 1
      if (size(scalar, 1) == this%nn()) then
         ! Node-wise scalar field
         this%PhysicalField(this%numoflayer)%attribute = 1
      elseif (size(scalar, 1) == this%ne()) then
         ! Element-wise scalar field
         this%PhysicalField(this%numoflayer)%attribute = 2
      elseif (size(scalar, 1) == this%nne()*this%nn()) then
         ! GausPoint-wise field
         this%PhysicalField(this%numoflayer)%attribute = 3
      else
         this%PhysicalField(this%numoflayer)%attribute = 0
         print *, "addLaayerFEMDOmainScalar :: layer ", name, "is not node-wise, not element-wize nor GaussPoint-wise"
      end if

   end subroutine
! ######################################################################

! ######################################################################
   subroutine addLayerFEMDomainVector(this, name, vector)
      class(FEMDomain_), intent(inout) :: this
      type(PhysicalField_), allocatable :: pfa(:)
      real(real64), intent(in) :: vector(:, :)
      character(*), intent(in) :: name
      integer(int32) :: datasize, datadimension, i

      if (.not. allocated(this%PhysicalField)) then
         allocate (this%PhysicalField(100)) ! 100 layer as default
         this%numoflayer = 0
      end if
      this%numoflayer = this%numoflayer + 1

      if (this%numoflayer > size(this%PhysicalField)) then
         pfa = this%PhysicalField
         deallocate (this%PhysicalField)
         allocate (this%PhysicalField(size(pfa)*100))
         do i = 1, size(this%physicalfield)
            this%PhysicalField(i)%name = "untitled"
         end do
         this%PhysicalField(1:size(pfa)) = pfa(:)
      end if

      this%PhysicalField(this%numoflayer)%name = name
      if (this%mesh%empty() .eqv. .true.) then
         print *, "ERROR >> addLayerFEMDomain >> mesh should be defined preliminary."
         return
      end if
      this%PhysicalField(this%numoflayer)%vector = vector

      ! auto detection of the type of layer
      this%PhysicalField(this%numoflayer)%datastyle = 2
      if (size(vector, 1) == this%nn()) then
         ! Node-wise vector field
         this%PhysicalField(this%numoflayer)%attribute = 1
      elseif (size(vector, 1) == this%ne()) then
         ! Element-wise vector field
         this%PhysicalField(this%numoflayer)%attribute = 2
      elseif (size(vector, 1) == this%nne()*this%nn()) then
         ! GausPoint-wise field
         this%PhysicalField(this%numoflayer)%attribute = 3
      else
         this%PhysicalField(this%numoflayer)%attribute = 0
         print *, "addLaayerFEMDOmainvector :: layer ", name, "is not node-wise, not element-wize nor GaussPoint-wise"
      end if

   end subroutine
! ######################################################################

! ######################################################################
   subroutine addLayerFEMDomaintensor(this, name, tensor)
      class(FEMDomain_), intent(inout) :: this
      type(PhysicalField_), allocatable :: pfa(:)
      real(real64), intent(in) :: tensor(:, :, :)
      character(*), intent(in) :: name
      integer(int32) :: datasize, datadimension, i

      if (.not. allocated(this%PhysicalField)) then
         allocate (this%PhysicalField(100)) ! 100 layer as default
         this%numoflayer = 0
      end if
      this%numoflayer = this%numoflayer + 1

      if (this%numoflayer > size(this%PhysicalField)) then
         pfa = this%PhysicalField
         deallocate (this%PhysicalField)
         allocate (this%PhysicalField(size(pfa)*100))
         do i = 1, size(this%physicalfield)
            this%PhysicalField(i)%name = "untitled"
         end do
         this%PhysicalField(1:size(pfa)) = pfa(:)
      end if

      this%PhysicalField(this%numoflayer)%name = name
      if (this%mesh%empty() .eqv. .true.) then
         print *, "ERROR >> addLayerFEMDomain >> mesh should be defined preliminary."
         return
      end if

      this%PhysicalField(this%numoflayer)%tensor = tensor
      ! auto detection of the type of layer
      this%PhysicalField(this%numoflayer)%datastyle = 3
      if (size(tensor, 1) == this%nn()) then
         ! Node-wise tensor field
         this%PhysicalField(this%numoflayer)%attribute = 1
      elseif (size(tensor, 1) == this%ne()) then
         ! Element-wise tensor field
         this%PhysicalField(this%numoflayer)%attribute = 2
      elseif (size(tensor, 1) == this%nne()*this%nn()) then
         ! GausPoint-wise field
         this%PhysicalField(this%numoflayer)%attribute = 3
      else
         this%PhysicalField(this%numoflayer)%attribute = 0
         print *, "addLaayerFEMDOmaintensor :: layer ", name, "is not node-wise, not element-wize nor GaussPoint-wise"
      end if

   end subroutine
! ######################################################################

! ######################################################################
   subroutine importLayerFEMDomain(this, name, id, scalar, vector, tensor)
      class(FEMDomain_), intent(inout) :: this
      character(*), optional, intent(in) :: name
      integer(int32), optional, intent(in)  :: id
      real(real64), optional, intent(in) :: scalar(:), vector(:, :), tensor(:, :, :)
      integer(int32) :: i, j, n

      if (present(name)) then
         do i = 1, this%numoflayer
            if (this%PhysicalField(i)%name == name) then
               if (present(scalar)) then
                  this%PhysicalField(i)%scalar = scalar
               end if
               if (present(vector)) then
                  this%PhysicalField(i)%vector = vector
               end if
               if (present(tensor)) then
                  this%PhysicalField(i)%tensor = tensor
               end if
            end if
         end do
      end if

      if (present(id)) then
         if (present(scalar)) then
            this%PhysicalField(id)%scalar = scalar
         end if
         if (present(vector)) then
            this%PhysicalField(id)%vector = vector
         end if
         if (present(tensor)) then
            this%PhysicalField(id)%tensor = tensor
         end if
      end if

   end subroutine
! ######################################################################

! ######################################################################
   subroutine showLayerFEMDomain(this)
      class(FEMDomain_), intent(inout) :: this
      integer(int32) :: i, j, n

      print *, "Number of layers : ", this%numoflayer
      do i = 1, this%numoflayer
         print *, this%PhysicalField(i)%name//" : scalar >> " &
            //str(allocated(this%PhysicalField(i)%scalar))//" : vector >> " &
            //str(allocated(this%PhysicalField(i)%vector))//" : tensor >> " &
            //str(allocated(this%PhysicalField(i)%tensor))
      end do

   end subroutine
! ######################################################################

! ######################################################################
   function searchLayerFEMDomain(this, name, id) result(ret)
      class(FEMDomain_), intent(inout) :: this
      character(*), optional, intent(in) :: name
      integer(int32), optional, intent(in) :: id
      integer(int32) :: i
      logical :: ret

      ret = .False.
      if (present(name)) then
         do i = 1, this%numoflayer
            if (this%PhysicalField(i)%name == name) then
               ret = .true.
               return
            end if
         end do
         return
      end if

      if (present(id)) then
         if (id <= this%numoflayer) then
            !print *, "Layer-ID : ",id," is : ",this%PhysicalField(id)%name
            ret = .true.
         else
            print *, "id ", id, "is greater than the number of layers", this%numoflayer
         end if
      end if

   end function
! ######################################################################

! ######################################################################
   function getLayerIDFEMDomain(this, name) result(id)
      class(FEMDomain_), intent(inout) :: this
      character(*), intent(in) :: name
      integer(int32) :: id
      integer(int32)::i

      do i = 1, this%numoflayer
         if (this%PhysicalField(i)%name == name) then
            id = i
            return
         end if
      end do

   end function
! ######################################################################

! ######################################################################
   function getLayerAttributeFEMDomain(this, name) result(id)
      class(FEMDomain_), intent(inout) :: this
      character(*), intent(in) :: name
      integer(int32):: id
      integer(int32)::i

      do i = 1, this%numoflayer
         if (this%PhysicalField(i)%name == name) then
            id = this%PhysicalField(i)%attribute
            return
         end if
      end do

   end function
! ######################################################################

! ######################################################################
   function getLayerDataStyleFEMDomain(this, name) result(id)
      class(FEMDomain_), intent(inout) :: this
      character(*), intent(in) :: name
      integer(int32) :: id
      integer(int32)::i

      do i = 1, this%numoflayer
         if (this%PhysicalField(i)%name == name) then
            id = this%PhysicalField(i)%DataStyle
            return
         end if
      end do

   end function
! ######################################################################

! ######################################################################
   subroutine projectionFEMDomain(this, direction, domain, PhysicalField, debug)
      class(FEMDomain_), intent(inout) :: this
      character(2), intent(in) :: direction ! "=>, <=, -> or <-"
      type(FEMDomain_), intent(inout) :: domain
      type(ShapeFunction_) :: shapefunc
      !type(MPI_),optional,intent(inout) :: mpid
      character(*), intent(in) :: PhysicalField
      logical, optional, intent(in) :: debug
      logical :: inside
      integer(int32) :: i, j, n, k, field_id, dim_num, start_id, end_id, from_rank
      integer(int32) :: num_node
      real(real64), allocatable :: Jmat(:, :), center(:), x(:), gzi(:), dx(:), dgzi(:), j_inv(:, :)
      real(real64), allocatable :: LocalCoord(:, :), nodvalue(:), original_scalar(:), xvec(:), x_max(:), x_min(:)
      integer(int32), allocatable :: ElemID(:)
      real(real64) :: scalar, val

      ! pre-check list
      ! PhysicalField exists for both domains?
      dim_num = size(this%mesh%nodcoord, 2)
      if (dim_num /= 3) then
         print *, "Caution :: femdomain%projection is ready for 3-D, not for other dimensions"
         return
      end if
      allocate (xvec(dim_num))
      allocate (x_max(dim_num))
      allocate (x_min(dim_num))

      !(1) completed
      if (present(debug)) then
         if (debug .eqv. .true.) then
            print *, "[>>] projectionFEMDomain :: checklist starts."
         end if
      end if

      if (this%searchLayer(name=PhysicalField) .eqv. .false.) then
         print *, "ERROR >> projectionFEMDomain >> no such physicalfield as '"//PhysicalField &
            //"' of domain#1"
         return
      end if
      if (domain%searchLayer(name=PhysicalField) .eqv. .false.) then
         print *, "ERROR >> projectionFEMDomain >> no such physicalfield as '"//PhysicalField &
            //"' of domain#1"
         return
      end if
      if (present(debug)) then
         if (debug .eqv. .true.) then
            print *, "[OK] projectionFEMDomain :: checklist #1 fields exists."
         end if
      end if

      ! check datastyle and attribute
      if (this%getLayerDataStyle(name=PhysicalField) /= &
          domain%getLayerDataStyle(name=PhysicalField)) then
         print *, "ERROR >> projectionFEMDomain >> INVALID DataStyle >> node=1, element=2, gauss point = 3"
         print *, "this%getLayerDataStyle(name=PhysicalField) :: ", this%getLayerDataStyle(name=PhysicalField)
         print *, "domain%getLayerDataStyle(name=PhysicalField) :: ", domain%getLayerDataStyle(name=PhysicalField)
         return
      end if
      if (this%getLayerAttribute(name=PhysicalField) /= &
          domain%getLayerAttribute(name=PhysicalField)) then
         print *, "ERROR >> projectionFEMDomain >> INVALID attribute >> node=1, element=2, gauss point = 3"
         print *, "this%getLayerAttribute(name=PhysicalField) :: ", this%getLayerAttribute(name=PhysicalField)
         print *, "domain%getLayerAttribute(name=PhysicalField) :: ", domain%getLayerAttribute(name=PhysicalField)
         return
      end if

      if (present(debug)) then
         if (debug .eqv. .true.) then
            print *, "[OK] projectionFEMDomain :: checklist #2 datastyles and attributes are valid."
         end if
      end if

      if (present(debug)) then
         if (debug .eqv. .true.) then
            print *, "[<<] projectionFEMDomain :: checklist completed."
         end if
      end if

      ! projection starts
      ! if this%getLayerAttribute(name=PhysicalField) == 1 (nodal values)
      if (this%getLayerAttribute(name=PhysicalField) == 1) then
         if (present(debug)) then
            if (debug .eqv. .true.) then
               print *, "[>>] projectionFEMDomain :: projestion starts."
               print *, "[>>] projectionFEMDomain :: attribute #1 :: scalar."
            end if
         end if

         select case (direction)
         case ("=>", "->")
            ! project obj-side field to => domain

            allocate (ElemID(size(domain%mesh%nodcoord, 1)))
            ElemID(:) = -1
            k = size(domain%mesh%nodcoord, 2)
            allocate (LocalCoord(size(domain%mesh%nodcoord, 1), k))
            LocalCoord(:, :) = 0.0d0
            shapefunc%ElemType = this%Mesh%GetElemType()
            call SetShapeFuncType(shapefunc)

                                ! !call GetAllShapeFunc(shapefunc,elem_id=1,nod_coord=this%Mesh%NodCoord,&
            !elem_nod=this%Mesh%ElemNod,OptionalGpID=1)

            ! for mpi acceralation
            start_id = 1
            end_id = size(domain%mesh%nodcoord, 1)
!                                if(present(mpid) )then
!                                        call mpid%initItr(end_id)
!                                        start_id = mpid%start_id
!                                        end_id = mpid%end_id
!                                endif

            do i = start_id, end_id ! for each node
               do j = 1, size(this%mesh%elemnod, 1) ! for each element

                  ! get Jacobian matrix (dx/dgzi)
                  do k = 1, shapefunc%NumOfGP
                     call GetAllShapeFunc(shapefunc, elem_id=j, nod_coord=this%Mesh%NodCoord, &
                                          elem_nod=this%Mesh%ElemNod, OptionalGpID=k)
                     if (k == 1) then
                        Jmat = shapefunc%Jmat
                     else
                        Jmat = Jmat + shapefunc%Jmat
                     end if
                  end do
                  ! In-Or-out
                  xvec(:) = domain%mesh%nodcoord(i, :)
                  do k = 1, dim_num
                     x_max(k) = maxval(shapefunc%elemcoord(:, k))
                     x_min(k) = minval(shapefunc%elemcoord(:, k))
                  end do
                  inside = InOrOutReal(x=xvec(:), xmax=x_max(:), xmin=x_min(:), DimNum=size(xvec))
                  if (inside .eqv. .false.) then
                     cycle
                  end if
                  !
                  if (.not. allocated(center)) then
                     allocate (center(size(this%mesh%nodcoord, 2)))
                  end if
                  if (.not. allocated(x)) then
                     allocate (x(size(this%mesh%nodcoord, 2)))
                  end if
                  if (.not. allocated(dx)) then
                     allocate (dx(size(this%mesh%nodcoord, 2)))
                  end if
                  if (.not. allocated(gzi)) then
                     allocate (gzi(size(this%mesh%nodcoord, 2)))
                  end if
                  if (.not. allocated(dgzi)) then
                     allocate (dgzi(size(this%mesh%nodcoord, 2)))
                  end if
                  center(:) = 0.0d0
                  do k = 1, size(this%mesh%elemnod, 2)
                     center(:) = center(:) + this%mesh%nodcoord(this%mesh%elemnod(j, k), :)
                  end do
                  center(:) = 1.0d0/dble(size(this%mesh%elemnod, 2))*center(:)
                  x(:) = domain%mesh%nodcoord(i, :)
                  dx(:) = x(:) - center(:)
                  call inverse_rank_2(Jmat, J_inv)
                  dgzi = matmul(J_inv, dx)
                  if (maxval(dgzi) <= 1.0d0 .and. minval(dgzi) >= -1.0d0) then
                     ElemID(i) = j
                     LocalCoord(i, :) = dgzi(:)
                     exit
                  else
                     cycle
                  end if
               end do
               if (present(debug)) then
                  if (debug .eqv. .true.) then
                     if (i == int(dble(size(domain%mesh%nodcoord, 1))/4.0d0)) then
                        print *, "[--] projectionFEMDomain :: local coordinate 25 % done."
                     end if
                     if (i == int(dble(size(domain%mesh%nodcoord, 1))/2.0d0)) then
                        print *, "[--] projectionFEMDomain :: local coordinate 50 % done."
                     end if
                     if (i == int(3.0d0*dble(size(domain%mesh%nodcoord, 1))/4.0d0)) then
                        print *, "[--] projectionFEMDomain :: local coordinate 75 % done."
                     end if
                     if (i == size(domain%mesh%nodcoord, 1)) then
                        print *, "[ok] projectionFEMDomain :: local coordinate 100 % done."
                     end if
                  end if
               end if
            end do

            ! for mpi acceralation
!                                ! merge data
!                                if(present(mpid) )then
!                                        call mpid%Barrier()
!                                        do i=1,size(ElemID)
!                                                n =ElemID(i)
!                                                from_rank = mpid%start_end_id(i)-1
!                                                call mpid%Bcast(From=from_rank,val=n)
!                                                ElemID(i)=n
!
!
!                                                do j=1,size(LocalCoord,2)
!                                                        val = LocalCoord(i,j)
!                                                        call mpid%Bcast(From=from_rank,val=val)
!                                                        LocalCoord(i,j)=val
!                                                enddo
!                                        enddo
!                                endif
!

            ! projection先の節点番号iに対応したprojection元の要素ID:ElemID(i)
            ! projection先の節点番号iに対応したprojection元の要素局所座標:LocalCoord(i,1:3)@3D

            ! projection
            field_id = domain%getLayerID(name=PhysicalField)
            if (domain%getLayerAttribute(name=PhysicalField) == 1) then
               ! scalar
               ! for each element
               do i = 1, size(this%mesh%nodcoord, 1)
                  ! 節点ごとの値 node-by-node
                  if (elemid(i) == -1) then
                     ! 対応する要素なし
                     cycle
                  end if

                  ! local coordinate

                  shapefunc%gzi(:) = localCoord(i, :)

                  call GetShapeFunction(shapefunc)

                  ! 要素を構成する節点値sに乗っている値
                  if (.not. allocated(nodvalue)) then
                     allocate (nodvalue(size(shapefunc%Nmat, 1)))
                     nodvalue(:) = 0.0d0
                  end if
                  do k = 1, size(this%mesh%elemnod, 2)
                     n = this%mesh%elemnod(elemid(i), k)
                     nodvalue(k) = this%PhysicalField(field_id)%scalar(n)
                  end do
                  ! 節点値の計算
                  scalar = dot_product(shapefunc%Nmat, nodvalue)
                  domain%PhysicalField(field_id)%scalar(i) = scalar
                  !if(.not.allocated(nodvalue) )then
                  !        allocate(nodvalue(size(shapefunc%Nmat,1)))
                  !        nodvalue(:) = scalar*shapefunc%Nmat(:)
                  !        nodvalue(:) = scalar!*shapefunc%Nmat(:)
                  !        ! ここ、要注意、アルゴリズムに大幅な近似あり。
                  !        ! 単に一方の領域の節点値を他方の要素の節点値全体に適用している。
                  !        ! 局所座標gziは使っていない。
                  !
                  !        ! obj => domainのプロジェクションの場合、
                  !        ! objの要素ごとに、domainの節点が入っているかを調査し、
                  !        ! objの要素に対するdomain節点の局所座標を確定し、
                  !        ! その後、objの接点値に形状関数をかけてdomainの節点値とすべき。
                  !        ! 要精査
                  !endif
                  !do k=1,size(domain%mesh%elemnod,2)
                  !        n = domain%mesh%elemnod(elemid(i) ,k)
                  !        domain%PhysicalField(field_id)%scalar(n)=nodvalue(k)
                  !enddo

               end do
            else
               print *, "ERROR now coding >> projectionFEMDomain"
               stop
            end if

         case ("<=", "<-")
            ! project domain-side field to => obj

            allocate (ElemID(size(this%mesh%nodcoord, 1)))
            ElemID(:) = -1
            k = size(this%mesh%nodcoord, 2)
            allocate (LocalCoord(size(this%mesh%nodcoord, 1), k))
            LocalCoord(:, :) = 0.0d0
            shapefunc%ElemType = domain%Mesh%GetElemType()
            call SetShapeFuncType(shapefunc)

                                ! !call GetAllShapeFunc(shapefunc,elem_id=1,nod_coord=domain%Mesh%NodCoord,&
            !elem_nod=domain%Mesh%ElemNod,OptionalGpID=1)

            ! for mpi acceralation
            start_id = 1
            end_id = size(this%mesh%nodcoord, 1)
!                                if(present(mpid) )then
!                                        call mpid%initItr(end_id)
!                                        start_id = mpid%start_id
!                                        end_id = mpid%end_id
!                                endif

            do i = start_id, end_id ! for each node
               do j = 1, size(domain%mesh%elemnod, 1) ! for each element

                  ! get Jacobian matrix (dx/dgzi)
                  do k = 1, shapefunc%NumOfGP
                     call GetAllShapeFunc(shapefunc, elem_id=j, nod_coord=domain%Mesh%NodCoord, &
                                          elem_nod=domain%Mesh%ElemNod, OptionalGpID=k)
                     if (k == 1) then
                        Jmat = shapefunc%Jmat
                     else
                        Jmat = Jmat + shapefunc%Jmat
                     end if
                  end do
                  ! In-Or-out
                  xvec(:) = this%mesh%nodcoord(i, :)
                  do k = 1, dim_num
                     x_max(k) = maxval(shapefunc%elemcoord(:, k))
                     x_min(k) = minval(shapefunc%elemcoord(:, k))
                  end do
                  inside = InOrOutReal(x=xvec(:), xmax=x_max(:), xmin=x_min(:), DimNum=size(xvec))
                  if (inside .eqv. .false.) then
                     cycle
                  end if
                  !
                  if (.not. allocated(center)) then
                     allocate (center(size(domain%mesh%nodcoord, 2)))
                  end if
                  if (.not. allocated(x)) then
                     allocate (x(size(domain%mesh%nodcoord, 2)))
                  end if
                  if (.not. allocated(dx)) then
                     allocate (dx(size(domain%mesh%nodcoord, 2)))
                  end if
                  if (.not. allocated(gzi)) then
                     allocate (gzi(size(domain%mesh%nodcoord, 2)))
                  end if
                  if (.not. allocated(dgzi)) then
                     allocate (dgzi(size(domain%mesh%nodcoord, 2)))
                  end if
                  center(:) = 0.0d0
                  do k = 1, size(domain%mesh%elemnod, 2)
                     center(:) = center(:) + domain%mesh%nodcoord(domain%mesh%elemnod(j, k), :)
                  end do
                  center(:) = 1.0d0/dble(size(domain%mesh%elemnod, 2))*center(:)
                  x(:) = this%mesh%nodcoord(i, :)
                  dx(:) = x(:) - center(:)
                  call inverse_rank_2(Jmat, J_inv)
                  dgzi = matmul(J_inv, dx)
                  if (maxval(dgzi) <= 1.0d0 .and. minval(dgzi) >= -1.0d0) then
                     ElemID(i) = j
                     LocalCoord(i, :) = dgzi(:)
                     exit
                  else
                     cycle
                  end if
               end do
               if (present(debug)) then
                  if (debug .eqv. .true.) then
                     if (i == int(dble(size(this%mesh%nodcoord, 1))/4.0d0)) then
                        print *, "[--] projectionFEMDomain :: local coordinate 25 % done."
                     end if
                     if (i == int(dble(size(this%mesh%nodcoord, 1))/2.0d0)) then
                        print *, "[--] projectionFEMDomain :: local coordinate 50 % done."
                     end if
                     if (i == int(3.0d0*dble(size(this%mesh%nodcoord, 1))/4.0d0)) then
                        print *, "[--] projectionFEMDomain :: local coordinate 75 % done."
                     end if
                     if (i == size(this%mesh%nodcoord, 1)) then
                        print *, "[ok] projectionFEMDomain :: local coordinate 100 % done."
                     end if
                  end if
               end if
            end do

            ! for mpi acceralation
            ! merge data
!                                if(present(mpid) )then
!                                        call mpid%Barrier()
!                                        do i=1,size(ElemID)
!                                                n =ElemID(i)
!                                                from_rank = mpid%start_end_id(i)-1
!                                                call mpid%Bcast(From=from_rank,val=n)
!                                                ElemID(i)=n
!
!
!                                                do j=1,size(LocalCoord,2)
!                                                        val = LocalCoord(i,j)
!                                                        call mpid%Bcast(From=from_rank,val=val)
!                                                        LocalCoord(i,j)=val
!                                                enddo
!                                        enddo
!                                endif
!

            ! projection先の節点番号iに対応したprojection元の要素ID:ElemID(i)
            ! projection先の節点番号iに対応したprojection元の要素局所座標:LocalCoord(i,1:3)@3D

            ! projection
            field_id = domain%getLayerID(name=PhysicalField)
            if (domain%getLayerAttribute(name=PhysicalField) == 1) then
               ! scalar
               ! for each element
               do i = 1, size(this%mesh%nodcoord, 1)
                  ! 節点ごとの値 node-by-node
                  if (elemid(i) == -1) then
                     ! 対応する要素なし
                     cycle
                  end if

                  ! local coordinate

                  shapefunc%gzi(:) = localCoord(i, :)

                  call GetShapeFunction(shapefunc)

                  ! 要素を構成する節点値sに乗っている値
                  if (.not. allocated(nodvalue)) then
                     allocate (nodvalue(size(shapefunc%Nmat, 1)))
                     nodvalue(:) = 0.0d0
                  end if
                  do k = 1, size(this%mesh%elemnod, 2)
                     n = this%mesh%elemnod(elemid(i), k)
                     nodvalue(k) = this%PhysicalField(field_id)%scalar(n)
                  end do
                  ! 節点値の計算
                  scalar = dot_product(shapefunc%Nmat, nodvalue)
                  domain%PhysicalField(field_id)%scalar(i) = scalar
                  !if(.not.allocated(nodvalue) )then
                  !        allocate(nodvalue(size(shapefunc%Nmat,1)))
                  !        nodvalue(:) = scalar*shapefunc%Nmat(:)
                  !        nodvalue(:) = scalar!*shapefunc%Nmat(:)
                  !        ! ここ、要注意、アルゴリズムに大幅な近似あり。
                  !        ! 単に一方の領域の節点値を他方の要素の節点値全体に適用している。
                  !        ! 局所座標gziは使っていない。
                  !
                  !        ! obj => domainのプロジェクションの場合、
                  !        ! objの要素ごとに、domainの節点が入っているかを調査し、
                  !        ! objの要素に対するdomain節点の局所座標を確定し、
                  !        ! その後、objの接点値に形状関数をかけてdomainの節点値とすべき。
                  !        ! 要精査
                  !endif
                  !do k=1,size(domain%mesh%elemnod,2)
                  !        n = domain%mesh%elemnod(elemid(i) ,k)
                  !        domain%PhysicalField(field_id)%scalar(n)=nodvalue(k)
                  !enddo

               end do
            else
               print *, "ERROR now coding >> projectionFEMDomain"
               stop
            end if

         end select
      end if

   end subroutine
! ######################################################################

! ######################################################################
   function centerPositionFEMDomain(this, ElementID, max, min) result(ret)
      class(FEMDomain_), intent(in) :: this
      integer(int32), optional, intent(in) :: ElementID
      logical, optional, intent(in) :: max, min
      real(real64), allocatable :: ret(:)
      integer(int32) :: i

      ! get center coordinate of the element
      ret = zeros(this%nd())
      if (present(ElementID)) then

         if (present(max)) then
            if (max) then
               ret = zeros(this%nn())
               do i = 1, this%nn()
                  ret(i) = maxval(this%mesh%nodcoord(this%mesh%elemnod(ElementID, :), i))
               end do
               return
            end if
         elseif (present(min)) then
            if (min) then
               ret = zeros(this%nn())
               do i = 1, this%nn()
                  ret(i) = minval(this%mesh%nodcoord(this%mesh%elemnod(ElementID, :), i))
               end do
               return
            end if
         end if

         do i = 1, this%nne()
            ret = ret + this%mesh%nodcoord(this%mesh%elemnod(ElementID, i), :)
         end do
         ret = 1.0d0/dble(this%nne())*ret

      else

         if (present(max)) then
            if (max) then
               ret = zeros(this%nn())
               do i = 1, this%nn()
                  ret(i) = maxval(this%mesh%nodcoord(:, i))
               end do
               return
            end if
         elseif (present(min)) then
            if (min) then
               ret = zeros(this%nn())
               do i = 1, this%nn()
                  ret(i) = minval(this%mesh%nodcoord(:, i))
               end do
               return
            end if
         end if

         do i = 1, this%nd()
            ret(i) = sum(this%mesh%nodcoord(:, i))/dble(this%nn())
         end do

      end if

   end function
! ######################################################################

   function centerPositionByNodeListFEMD(this, nodelist) result(ret)
      class(FEMDomain_), intent(in) :: this
      integer(int32), intent(in) :: nodelist(:)
      real(real64), allocatable :: ret(:)
      integer(int32) :: i

      ret = zeros(this%nd())
      do i = 1, size(nodelist)
         ret = ret + this%mesh%nodcoord(nodelist(i), :)
      end do
      ret = ret/dble(size(nodelist))

   end function

! ######################################################################
   function getGlobalPositionOfGaussPointFEMDomain(this, ElementID, GaussPointID) result(ret)
      class(FEMDomain_), intent(inout) :: this
      integer(int32), intent(in) :: ElementID, GaussPointID
      real(real64), allocatable :: ret(:), center(:)
      integer(int32) :: i
      type(ShapeFunction_) :: sf
      ! get center coordinate of the element
      center = this%centerPosition(ElementID)

      sf = this%mesh%getShapeFunction(ElementID, GaussPointID)

      ret = zeros(size(center))
      ret(:) = matmul(transpose(sf%elemcoord), sf%nmat) !+ center(:)

   end function
! ######################################################################

! ######################################################################
   recursive function getShapeFunctionFEMDomain(this, ElementID, GaussPointID, ReducedIntegration, Position) result(sobj)
      class(FEMDomain_), intent(inout)::this
      integer(int32), optional, intent(in) :: GaussPointID, ElementID
      logical, optional, intent(in) :: ReducedIntegration
      real(real64), optional, intent(in) :: position(:)
      type(ShapeFunction_) ::sobj
      character(:), allocatable :: ElemType
      integer(int32) :: i, j, n, m, gpid, elemID
      real(real64) :: x, y, z

      if (.not. present(position)) then
         sobj = this%mesh%getShapeFunction(ElementID, GaussPointID, ReducedIntegration)
      else
         ! search nearest element

         ! import coordinate
         x = 0.0d0
         y = 0.0d0
         z = 0.0d0
         if (size(Position) >= 1) then
            x = Position(1)
         end if
         if (size(Position) >= 2) then
            y = Position(2)
         end if

         if (size(Position) >= 3) then
            z = Position(3)
         end if

         ! get the nearest element's ID
         sobj%ElementID = -1
         sobj%ElementID = this%mesh%getNearestElementID(x=x, y=y, z=z)
         if (sobj%ElementID == -1) then
            sobj%Empty = .true.
            print *, "[Caution]:: getShapeFunctionFEMDomain >> sobj%elementID = -1 , no such element"
            return
         end if

         ! 4点セット
         sobj%NumOfNode = this%nne() !ok
         sobj%NumOfDim = this%nd()  !ok
         sobj%gzi = this%getLocalCoordinate(ElementID=sobj%ElementID, x=x, y=y, z=z)
         sobj%Nmat = zeros(this%nne())  !ok
         sobj%ElemCoord = zeros(this%nne(), this%nd())

         call sobj%getOnlyNvec() !ok
         do i = 1, this%nne()
            sobj%ElemCoord(i, 1:this%nd()) = this%mesh%nodcoord(this%mesh%elemnod(sobj%elementID, i), 1:this%nd())
         end do
      end if
   end function
! ######################################################################

! ######################################################################
   function getLocalCoordinateFEMDomain(this, ElementID, x, y, z) result(xi)
      class(FEMDomain_), intent(inout) :: this
      type(ShapeFunction_) :: shapefunc
      integer(int32), intent(in) :: ElementID
      real(real64), intent(in) ::  x, y, z
      real(real32), allocatable :: jmat32(:, :), j_inv32(:, :)
      real(real64), allocatable :: xcoord(:), jmat(:, :), j_inv(:, :), center(:)
      real(real64), allocatable :: xi(:)
      integer(int32) :: i, j, n

      Jmat = zeros(this%nd(), this%nd())
      allocate (xcoord(this%nd()))
      allocate (xi(this%nd()))
      allocate (center(this%nd()))
      xcoord(:) = 0.0d0
      xi(:) = 0.0d0
      center(:) = 0.0d0
      ! only for 2D 4-node/ 3D 8node- isoparametric elements
      if (this%nne() == 4 .and. this%nd() == 2) then
         do i = 1, 4 ! 4-gauss points
            shapefunc = this%mesh%getShapeFunction(ElementID=ElementID, GaussPointID=i)
            jmat(:, :) = jmat(:, :) + shapefunc%jmat(:, :)
         end do
         jmat(:, :) = 0.250d0*jmat(:, :)
         xcoord(1) = x
         xcoord(2) = y
         do i = 1, size(shapefunc%elemcoord, 1)
            center(:) = center(:) + shapefunc%elemcoord(i, :)
         end do
         center(:) = 0.250d0*center(:)
      elseif (this%nne() == 8 .and. this%nd() == 3) then
         do i = 1, 8 ! 8-gauss points
            shapefunc = this%mesh%getShapeFunction(ElementID=ElementID, GaussPointID=i)
            jmat(:, :) = jmat(:, :) + shapefunc%jmat(:, :)
         end do
         jmat(:, :) = 0.1250d0*jmat(:, :)
         xcoord(1) = x
         xcoord(2) = y
         xcoord(3) = z
         do i = 1, size(shapefunc%elemcoord, 1)
            center(:) = center(:) + shapefunc%elemcoord(i, :)
         end do
         center(:) = 0.1250d0*center(:)
      else
         print *, "ERROR :: getLocalCoordinateFEMDomain, only for 2D 4-node/ 3D 8node- isoparametric elements"
         stop
      end if

      ! xcoord

      ! xi(:) = J_inv x(:)
      xcoord(:) = xcoord(:) - center(:)
      !jmat32 = jmat
      !jmat = dble(jmat32)
      J_inv = inverse(jmat)
      !j_inv32 = J_inv
      !J_inv = dble(j_inv32)
      xi = matmul(J_inv, xcoord)

      ! ok
      !allocate(xi( this%nd()*this%nne() ) )
      !n=0
      !do i=1,this%nne()
      !        do j=1,this%nd()
      !                n=n+1
      !                xi(n) = shapefunc%elemcoord(i,j)
      !        enddo
      !enddo

!        allocate(xi(12) )
!        xi(1) = Jmat(1,1)
!        xi(2) = Jmat(1,2)
!        xi(3) = Jmat(1,3)
!        xi(4) = Jmat(2,1)
!        xi(5) = Jmat(2,2)
!        xi(6) = Jmat(2,3)
!        xi(7) = Jmat(3,1)
!        xi(8) = Jmat(3,2)
!        xi(9) = Jmat(3,3)
!        xi(10)= center(1)
!        xi(11)= center(2)
!        xi(12)= center(3)

   end function
! ######################################################################

! ######################################################################
   pure function nnFEMDomain(this) result(ret)
      class(FEMDomain_), intent(in) :: this
      integer(int32) :: ret

      if (this%empty()) then
         ret = 0
         return
      end if
      ret = size(this%mesh%nodcoord, 1)

   end function
! ######################################################################
! ######################################################################
   pure function ndFEMDomain(this) result(ret)
      class(FEMDomain_), intent(in) :: this
      integer(int32) :: ret

      if (this%empty()) then
         ret = 0
         return
      end if
      ret = size(this%mesh%nodcoord, 2)

   end function
! ######################################################################
! ######################################################################
   pure function neFEMDomain(this) result(ret)
      class(FEMDomain_), intent(in) :: this
      integer(int32) :: ret

      if (this%empty()) then
         ret = 0
         return
      end if

      if (.not. allocated(this%mesh%ElemNod)) then
         ret = 0
         return
      end if
      ret = size(this%mesh%ElemNod, 1)

   end function
! ######################################################################

! ######################################################################
   pure function nneFEMDomain(this) result(ret)
      class(FEMDomain_), intent(in) :: this
      integer(int32) :: ret

      if (this%empty()) then
         ret = 0
         return
      end if

      ret = size(this%mesh%ElemNod, 2)

   end function
! ######################################################################

! ######################################################################
   function ngpFEMDomain(this) result(ret)
      class(FEMDomain_), intent(inout) :: this
      type(ShapeFunction_) :: sf
      integer(int32) :: ret

      if (this%empty()) then
         ret = 0
         return
      end if

      sf = this%mesh%getShapeFunction(ElementID=1, GaussPointID=1)
      ret = sf%NumOfGP

!        red = input(default=.false.,option=reduction)
!
!        if(this%nd()==1 )then
!                if(this%nne()==2 )then
!                        ! 1st order 1-D line element
!                        if(reduction)then
!                                ret = 1
!                        else
!                                ret = 2
!                        endif
!                elseif(this%nne()==3 )then
!                        ! 2nd order 1-D line element
!                        if(reduction)then
!                                ret = 2
!                        else
!                                ret = 3
!                        endif
!                else
!                        print *, "ERROR :: ngpFEMDomain >> this%nne() should be 2 or 3 for 1D"
!                        ret = -1
!                endif
!        elseif(this%nd()==2 )then
!                if(this%nne()==3 )then
!                        ! 1st order 2-D triangle element
!                        if(reduction)then
!                                ret = 1
!                        else
!                                ret = 3
!                        endif
!                elseif(this%nne()==6 )then
!                        ! 2nd order 2-D triangle element
!                        if(reduction)then
!                                ret = 3
!                        else
!                                ret = 6
!                        endif
!                elseif(this%nne()==4 )then
!                        ! 1st order 2-D rectangle element
!                        if(reduction)then
!                                ret = 1
!                        else
!                                ret = 4
!                        endif
!
!                elseif(this%nne()==8 .or. this%nne()==9 )then
!                        ! 2nd order 2-D rectangle element
!                        if(reduction)then
!                                ret = 4
!                        else
!                                ret = 9
!                        endif
!                else
!                        print *, "ERROR :: ngpFEMDomain >> this%nne() should be 3, 4, or 9 for 2-D"
!                        ret = -1
!                endif
!
!        elseif(this%nd()==3 )then
!
!                if(this%nne()==4 )then
!                        ! 1st order 3-D tetra element
!                        if(reduction)then
!                                ret = 1
!                        else
!                                ret = 4
!                        endif
!                elseif(this%nne()==8 )then
!                        ! 1st order 2-D rectangle element
!                        if(reduction)then
!                                ret = 1
!                        else
!                                ret = 8
!                        endif
!
!                else
!                        print *, "ERROR :: ngpFEMDomain >> this%nne() should be 4, 8 for 3-D"
!                        ret = -1
!                endif
!        else
!                print *, "ERROR :: ngpFEMDomain >> this%nd() should be 1, 2 or 3."
!                ret = -1
!        endif

   end function
! ######################################################################

   subroutine editFEMDomain(this, x, altitude)
      class(FEMDomain_), intent(inout) :: this
      real(real64), optional, intent(in) :: x(:), altitude(:)

      call this%mesh%edit(x, altitude)
   end subroutine

! ######################################################################
   function getNearestNodeIDFEMDomain(this, x, y, z, except, exceptlist) result(node_id)
      class(FEMDomain_), intent(inout) :: this
      real(real64), optional, intent(in) :: x, y, z ! coordinate
      integer(int32), optional, intent(in) :: except ! excepted node id
      integer(int32), optional, intent(in) :: exceptlist(:) ! excepted node id
      integer(int32) :: node_id, i

      node_id = this%mesh%getNearestNodeID(x=x, y=y, z=z, except=except, exceptlist=exceptlist)
   end function
! ######################################################################

! ##########################################################################
   function positionFEMDomain(this, id) result(x)
      class(FEMDomain_), intent(in) :: this
      integer(int32), optional, intent(in) :: id ! node_id
      real(real64) :: x(3)
      integer(int32) :: dim_num, i

      if (present(id)) then
         dim_num = size(this%mesh%nodcoord, 2)
         do i = 1, dim_num
            x(i) = this%mesh%nodcoord(id, i)
         end do
      else

         x = zeros(this%nd())
         do i = 1, this%nd()
            x(i) = sum(this%mesh%nodcoord(:, i))/dble(this%nn())
         end do

      end if
   end function
! ##########################################################################

! ##########################################################################
   function position_xFEMDomain(this, id) result(x)
      class(FEMDomain_), intent(in) :: this
      integer(int32), optional, intent(in) :: id ! node_id
      real(real64) :: x

      if (present(id)) then
         x = this%mesh%nodcoord(id, 1)
      else
         x = sum(this%mesh%nodcoord(:, 1))/dble(this%nn())
      end if

   end function
! ##########################################################################

! ##########################################################################
   function position_yFEMDomain(this, id) result(x)
      class(FEMDomain_), intent(in) :: this
      integer(int32), optional, intent(in) :: id ! node_id
      real(real64) :: x

      if (present(id)) then
         x = this%mesh%nodcoord(id, 2)
      else
         x = sum(this%mesh%nodcoord(:, 2))/dble(this%nn())
      end if

   end function
! ##########################################################################

! ##########################################################################
   function position_zFEMDomain(this, id) result(x)
      class(FEMDomain_), intent(in) :: this
      integer(int32), optional, intent(in) :: id ! node_id
      real(real64) :: x

      if (present(id)) then
         x = this%mesh%nodcoord(id, 3)
      else
         x = sum(this%mesh%nodcoord(:, 3))/dble(this%nn())
      end if

   end function
! ##########################################################################

! Basic matrices and vectors
! ##########################################################################
   function MassMatrix_as_CRS_FEMDomain(this, Density, DOF, omp) result(MassMatrix)
      class(FEMDomain_), intent(inout) :: this
      real(real64), intent(in) :: Density(:)
      integer(int32), optional, intent(in) :: DOF
      logical, optional, intent(in) :: omp

      type(CRS_) :: MassMatrix
      type(COO_) :: COO
      integer(int32) :: ElementID, LE1, LE2, ni1, ni2, &
                        pid_1, pid_2, DOF_1, DOF_2, loc_pid_1, loc_pid_2, i, col_id
      real(real64), allocatable :: EDM(:, :), val(:)
      real(real64) :: Length, entry_val

      ! >>>>>>>> FOR 1-D case >>>>>>>>
      if (this%nne() == 2) then
         ! stiffness matrix for 1-D
         call coo%init(this%nn())
         do ElementID = 1, this%ne()
            Length = norm(this%mesh%nodcoord(this%mesh%elemnod(ElementID, 1), :) &
                          - this%mesh%nodcoord(this%mesh%elemnod(ElementID, 2), :))
            entry_val = Density(ElementID)*Length
            call coo%add(this%mesh%elemnod(ElementID, 1), this%mesh%elemnod(ElementID, 1), entry_val/3.0d0)
            call coo%add(this%mesh%elemnod(ElementID, 1), this%mesh%elemnod(ElementID, 2), entry_val/6.0d0)
            call coo%add(this%mesh%elemnod(ElementID, 2), this%mesh%elemnod(ElementID, 1), entry_val/6.0d0)
            call coo%add(this%mesh%elemnod(ElementID, 2), this%mesh%elemnod(ElementID, 2), entry_val/3.0d0)
         end do
         MassMatrix = coo%to_crs()
         return
      end if
      ! <<<<<<<< FOR 1-D case <<<<<<<<

      if (.not. present(DOF)) then
         print *, "ERROR >> MassMatrix_as_CRS_FEMDomain should have arg [DOF]"
         stop
      end if

      if (present(omp)) then
         if (.not. omp) then
            MassMatrix = this%ZeroMatrix(DOF=DOF)
            do ElementID = 1, this%ne()
               EDM = this%MassMatrix( &
                     ElementID=ElementID, &
                     Density=Density(ElementID), &
                     DOF=DOF &
                     )
               do LE1 = 1, this%nne()
                  do LE2 = 1, this%nne()
                     do DOF_1 = 1, DOF
                        do DOF_2 = 1, DOF
                           ni1 = this%mesh%elemnod(ElementID, LE1)
                           ni2 = this%mesh%elemnod(ElementID, LE2)
                           pid_1 = DOF*(ni1 - 1) + DOF_1
                           pid_2 = DOF*(ni2 - 1) + DOF_2
                           loc_pid_1 = DOF*(LE1 - 1) + DOF_1
                           loc_pid_2 = DOF*(LE2 - 1) + DOF_2
                           call MassMatrix%add(pid_1, pid_2, EDM(loc_pid_1, loc_pid_2))
                        end do
                     end do
                  end do
               end do
            end do
            return
         end if
      end if

      !call COO%init(this%nn()*DOF)

      MassMatrix = this%ZeroMatrix(DOF=DOF)
      val = MassMatrix%val
      !$OMP parallel do private(EDM,LE1,LE2,ni1,col_id,i,pid_1,pid_2,loc_pid_1,loc_pid_2,DOF_1,DOF_2)
      do ElementID = 1, this%ne()
         EDM = this%MassMatrix( &
               ElementID=ElementID, &
               Density=Density(ElementID), &
               DOF=DOF &
               )
         do LE1 = 1, this%nne()
            do LE2 = 1, this%nne()
               do DOF_1 = 1, DOF
                  do DOF_2 = 1, DOF
                     ni1 = this%mesh%elemnod(ElementID, LE1)
                     pid_1 = DOF*(ni1 - 1) + DOF_1
                     ni1 = this%mesh%elemnod(ElementID, LE2)
                     pid_2 = DOF*(ni1 - 1) + DOF_2
                     loc_pid_1 = DOF*(LE1 - 1) + DOF_1
                     loc_pid_2 = DOF*(LE2 - 1) + DOF_2
                     !call COO%add(pid_1,pid_2,EDM(loc_pid_1,loc_pid_2)  )

                     do i = MassMatrix%row_ptr(pid_1), MassMatrix%row_ptr(pid_1 + 1) - 1
                        if (MassMatrix%col_idx(i) == pid_2) then
                           val(i) = val(i) + EDM(loc_pid_1, loc_pid_2)
                           exit
                        end if
                     end do

                  end do
               end do
            end do
         end do
      end do
      !$OMP end parallel do
      MassMatrix%val = val

   end function

! ##########################################################################

! ##########################################################################
   subroutine setMassMatrix_as_CRS_FEMDomain(this, Density, DOF, omp, MassMatrix)
      class(FEMDomain_), intent(inout) :: this
      real(real64), intent(in) :: Density(:)
      integer(int32), optional, intent(in) :: DOF
      logical, optional, intent(in) :: omp

      type(CRS_),intent(inout) :: MassMatrix
      type(COO_) :: COO
      integer(int32) :: ElementID, LE1, LE2, ni1, ni2, &
                        pid_1, pid_2, DOF_1, DOF_2, loc_pid_1, loc_pid_2, i, col_id
      real(real64), allocatable :: EDM(:, :), val(:)
      real(real64) :: Length, entry_val

      ! >>>>>>>> FOR 1-D case >>>>>>>>
      if (this%nne() == 2) then
         ! stiffness matrix for 1-D
         call coo%init(this%nn())
         do ElementID = 1, this%ne()
            Length = norm(this%mesh%nodcoord(this%mesh%elemnod(ElementID, 1), :) &
                          - this%mesh%nodcoord(this%mesh%elemnod(ElementID, 2), :))
            entry_val = Density(ElementID)*Length
            call coo%add(this%mesh%elemnod(ElementID, 1), this%mesh%elemnod(ElementID, 1), entry_val/3.0d0)
            call coo%add(this%mesh%elemnod(ElementID, 1), this%mesh%elemnod(ElementID, 2), entry_val/6.0d0)
            call coo%add(this%mesh%elemnod(ElementID, 2), this%mesh%elemnod(ElementID, 1), entry_val/6.0d0)
            call coo%add(this%mesh%elemnod(ElementID, 2), this%mesh%elemnod(ElementID, 2), entry_val/3.0d0)
         end do
         MassMatrix = coo%to_crs()
         return
      end if
      ! <<<<<<<< FOR 1-D case <<<<<<<<

      if (.not. present(DOF)) then
         print *, "ERROR >> MassMatrix_as_CRS_FEMDomain should have arg [DOF]"
         stop
      end if

      if (present(omp)) then
         if (.not. omp) then
            MassMatrix = this%ZeroMatrix(DOF=DOF)
            do ElementID = 1, this%ne()
               EDM = this%MassMatrix( &
                     ElementID=ElementID, &
                     Density=Density(ElementID), &
                     DOF=DOF &
                     )
               do LE1 = 1, this%nne()
                  do LE2 = 1, this%nne()
                     do DOF_1 = 1, DOF
                        do DOF_2 = 1, DOF
                           ni1 = this%mesh%elemnod(ElementID, LE1)
                           ni2 = this%mesh%elemnod(ElementID, LE2)
                           pid_1 = DOF*(ni1 - 1) + DOF_1
                           pid_2 = DOF*(ni2 - 1) + DOF_2
                           loc_pid_1 = DOF*(LE1 - 1) + DOF_1
                           loc_pid_2 = DOF*(LE2 - 1) + DOF_2
                           call MassMatrix%add(pid_1, pid_2, EDM(loc_pid_1, loc_pid_2))
                        end do
                     end do
                  end do
               end do
            end do
            return
         end if
      end if

      !call COO%init(this%nn()*DOF)

      MassMatrix = this%ZeroMatrix(DOF=DOF)
      val = MassMatrix%val
      !$OMP parallel do private(EDM,LE1,LE2,ni1,col_id,i,pid_1,pid_2,loc_pid_1,loc_pid_2,DOF_1,DOF_2)
      do ElementID = 1, this%ne()
         EDM = this%MassMatrix( &
               ElementID=ElementID, &
               Density=Density(ElementID), &
               DOF=DOF &
               )
         do LE1 = 1, this%nne()
            do LE2 = 1, this%nne()
               do DOF_1 = 1, DOF
                  do DOF_2 = 1, DOF
                     ni1 = this%mesh%elemnod(ElementID, LE1)
                     pid_1 = DOF*(ni1 - 1) + DOF_1
                     ni1 = this%mesh%elemnod(ElementID, LE2)
                     pid_2 = DOF*(ni1 - 1) + DOF_2
                     loc_pid_1 = DOF*(LE1 - 1) + DOF_1
                     loc_pid_2 = DOF*(LE2 - 1) + DOF_2
                     !call COO%add(pid_1,pid_2,EDM(loc_pid_1,loc_pid_2)  )

                     do i = MassMatrix%row_ptr(pid_1), MassMatrix%row_ptr(pid_1 + 1) - 1
                        if (MassMatrix%col_idx(i) == pid_2) then
                           val(i) = val(i) + EDM(loc_pid_1, loc_pid_2)
                           exit
                        end if
                     end do

                  end do
               end do
            end do
         end do
      end do
      !$OMP end parallel do
      MassMatrix%val = val

   end subroutine

! ##########################################################################


! ##########################################################################
   recursive function ZeroMatrix_as_CRS_FEMDomain(this, DOF, regacy) result(ZeroMatrix)
      class(FEMDomain_), intent(inout) :: this
      integer(int32), intent(in) :: DOF
      type(CRS_) :: ZeroMatrix
      type(COO_) :: COO
      integer(int32) :: ElementID, LocElemID_1, LocElemID_2, nodeid_1, nodeid_2, &
                        pid_1, pid_2, DOF_1, DOF_2, loc_pid_1, loc_pid_2, DOF_as_1
      integer(int32) :: i, j, k, l, n, thread_num, m
      integer(int32), allocatable :: count_appear(:), ELL_col_idx(:, :), nonzero_idx(:), &
                                     ELL_elem(:, :), col_idx(:)
      integer(int64), allocatable ::row_ptr(:)

      logical, optional, intent(in) :: regacy

      ! Segfo error

      if (present(regacy)) then
         if (regacy) then

            DOF_as_1 = 1
            call COO%init(this%nn()*DOF_as_1)
            do ElementID = 1, this%ne()
               do LocElemID_1 = 1, this%nne()
                  do LocElemID_2 = 1, this%nne()
                     do DOF_1 = 1, DOF_as_1
                        do DOF_2 = 1, DOF_as_1
                           nodeid_1 = this%mesh%elemnod(ElementID, LocElemID_1)
                           nodeid_2 = this%mesh%elemnod(ElementID, LocElemID_2)
                           pid_1 = DOF_as_1*(nodeid_1 - 1) + DOF_1
                           pid_2 = DOF_as_1*(nodeid_2 - 1) + DOF_2
                           loc_pid_1 = DOF_as_1*(LocElemID_1 - 1) + DOF_1
                           loc_pid_2 = DOF_as_1*(LocElemID_2 - 1) + DOF_2
                           call COO%add(pid_1, pid_2, 0.0d0)
                        end do
                     end do
                  end do
               end do
            end do
            ZeroMatrix = COO%to_CRS()
            call COO%remove()

            if (DOF > 1) then
               ! extend!
               row_ptr = ZeroMatrix%row_ptr
               col_idx = ZeroMatrix%col_idx
               ZeroMatrix%row_ptr = int(zeros((size(row_ptr) - 1)*DOF + 1))

               ZeroMatrix%row_ptr(1) = 1
               do i = 1, size(row_ptr) - 1
                  do j = 1, DOF
                     ZeroMatrix%row_ptr(DOF*(i - 1) + j + 1) = ZeroMatrix%row_ptr(DOF*(i - 1) + j) &
                                                               + DOF*(row_ptr(i + 1) - row_ptr(i))
                  end do
               end do
               ZeroMatrix%col_idx = int(zeros((ZeroMatrix%row_ptr(size(ZeroMatrix%row_ptr))) - 1))

               m = 0
               do i = 1, size(row_ptr) - 1
                  do k = 1, DOF
                     do j = row_ptr(i), row_ptr(i + 1) - 1
                        n = row_ptr(i + 1) - row_ptr(i)
                        do l = 1, DOF
                           m = m + 1
                           ZeroMatrix%col_idx(m) = DOF*(col_idx(j) - 1) + l
                        end do
                     end do
                  end do
               end do
               ZeroMatrix%val = zeros(size(ZeroMatrix%col_idx))
            end if

            return
         end if

      end if

      ! bugs exist from here

      !if(DOF/=1)then
      !        ZeroMatrix = this%ZeroMatrix(DOF=DOF,regacy=.true.)
      !        return
      !endif
      ! DOF=3とかに対応できるよう，以下を変更

      !(i) count max-connect
      count_appear = int(zeros(this%nn()))
      !$OMP parallel do reduction(+:count_appear)
      do i = 1, this%ne()
         count_appear(this%mesh%elemnod(i, :)) = count_appear(this%mesh%elemnod(i, :)) + 1
      end do
      !$OMP end parallel do
      ELL_elem = int(zeros(this%nn(), maxval(count_appear)))
      count_appear = count_appear*this%nne()

      !(ii) Create ELL format
      ! ここを並列化！！
      ! NodeID vs ElementID
      ELL_col_idx = int(zeros(this%nn(), maxval(count_appear)))
      count_appear(:) = 0
      do i = 1, this%ne()
         do j = 1, this%nne()
            count_appear(this%mesh%elemnod(i, j)) = count_appear(this%mesh%elemnod(i, j)) + 1
            ELL_elem(this%mesh%elemnod(i, j), count_appear(this%mesh%elemnod(i, j))) &
               = i
         end do
      end do

      count_appear(:) = 0
      !$OMP parallel do private(j,k) reduction(+:count_appear)
      do i = 1, size(ELL_elem, 1)
         do j = 1, size(ELL_elem, 2)
            if (ELL_elem(i, j) == 0) exit
            do k = 1, this%nne()
               count_appear(i) = count_appear(i) + 1
               ELL_col_idx(i, count_appear(i)) = this%mesh%elemnod(ELL_elem(i, j), k)
            end do
         end do
      end do
      !$OMP end parallel do

      !(iii) overlap should be 0
      nonzero_idx = int(zeros(size(ELL_col_idx, 2)))
      !$OMP parallel do private(j,k)
      do i = 1, size(ELL_col_idx, 1)
         do j = 1, count_appear(i)
            if (ELL_col_idx(i, j) == 0) then
               cycle
            else
               do k = j + 1, count_appear(i)
                  if (ELL_col_idx(i, j) == ELL_col_idx(i, k)) then
                     ELL_col_idx(i, k) = 0
                  end if
               end do
            end if
         end do

      end do
      !$OMP end parallel do

      !(iv) shift zero to right
      !count_appear(:) = 0
      !$OMP parallel do private(j,k,nonzero_idx)
      do i = 1, size(ELL_col_idx, 1)
         nonzero_idx(:) = 0
         k = 0
         do j = 1, count_appear(i)
            if (ELL_col_idx(i, j) /= 0) then
               k = k + 1
               nonzero_idx(k) = ELL_col_idx(i, j)
            end if
         end do
         ELL_col_idx(i, :) = nonzero_idx(:)
      end do
      !$OMP end parallel do

      !print *, "v"
      !(v) count non-zero
      count_appear(:) = 0
      !$OMP parallel do private(j) reduction(+:count_appear)
      do i = 1, size(ELL_col_idx, 1)
         do j = 1, size(ELL_col_idx, 2)
            if (ELL_col_idx(i, j) /= 0) then

               count_appear(i) = count_appear(i) + 1
            end if
         end do
      end do
      !$OMP end parallel do

      !ZeroMatrix%row_ptr = int(zeros(this%nn()+1))
      allocate (ZeroMatrix%row_ptr(this%nn() + 1))
      ZeroMatrix%row_ptr(:) = 0

      !ZeroMatrix%col_idx = int(zeros(sum(count_appear) ))
      allocate (ZeroMatrix%col_idx(sum(count_appear)))
      ZeroMatrix%col_idx(:) = 0

      !print *, "vi"
      ! (vi) create row_ptr
      ZeroMatrix%row_ptr(1) = 1
      do i = 1, size(ELL_col_idx, 1)
         ZeroMatrix%row_ptr(i + 1) = ZeroMatrix%row_ptr(i) + count_appear(i)
      end do

      !$OMP parallel do private(j,k)
      do i = 1, size(ZeroMatrix%row_ptr) - 1
         k = 0
         do j = ZeroMatrix%row_ptr(i), ZeroMatrix%row_ptr(i + 1) - 1
            k = k + 1
            ZeroMatrix%col_idx(j) = ELL_col_idx(i, k)
         end do
      end do
      !$OMP end parallel do
      deallocate (ELL_col_idx, ELL_elem, count_appear, nonzero_idx)

      ! ZeroMatrix%val = zeros(size(ZeroMatrix%col_idx) )
      allocate (ZeroMatrix%val(size(ZeroMatrix%col_idx)))
      ZeroMatrix%val(:) = 0.0d0

      if (DOF > 1) then

         ! extend!
         row_ptr = ZeroMatrix%row_ptr
         col_idx = ZeroMatrix%col_idx
         !ZeroMatrix%row_ptr = int(zeros( (size(row_ptr)-1)*DOF + 1 ) )
         if (allocated(ZeroMatrix%row_ptr)) deallocate (ZeroMatrix%row_ptr)
         allocate (ZeroMatrix%row_ptr((size(row_ptr) - 1)*DOF + 1))
         ZeroMatrix%row_ptr(:) = 0

         ! update row-pointers
         ZeroMatrix%row_ptr(1) = 1
         do i = 1, size(row_ptr) - 1
            do j = 1, DOF
               if (size(ZeroMatrix%row_ptr) < DOF*(i - 1) + j + 1) then
                  print *, "ERROR femdomain%zeromatrix >> if(size(ZeroMatrix%col_idx)>m ) then"
                  stop
               end if
               ZeroMatrix%row_ptr(DOF*(i - 1) + j + 1) = ZeroMatrix%row_ptr(DOF*(i - 1) + j) &
                                                         + DOF*(row_ptr(i + 1) - row_ptr(i))
            end do
         end do
         !ZeroMatrix%col_idx = int(zeros( ( ZeroMatrix%row_ptr(size(ZeroMatrix%row_ptr) ) )-1 ))
         if (allocated(ZeroMatrix%col_idx)) deallocate (ZeroMatrix%col_idx)
         allocate (ZeroMatrix%col_idx((ZeroMatrix%row_ptr(size(ZeroMatrix%row_ptr))) - 1))
         ZeroMatrix%col_idx(:) = 0

         !return

         ! update column-indices
         m = 0
         do i = 1, size(row_ptr) - 1
            do k = 1, DOF
               do j = row_ptr(i), row_ptr(i + 1) - 1
                  n = row_ptr(i + 1) - row_ptr(i)
                  do l = 1, DOF
                     m = m + 1
                     if (size(ZeroMatrix%col_idx) < m) then
                        print *, "ERROR femdomain%zeromatrix >> if(size(ZeroMatrix%col_idx)>m ) then"
                        stop
                     end if
                     if (size(col_idx) < j) then
                        print *, "ERROR femdomain%zeromatrix >> if(size(ZeroMatrix%col_idx)>m ) then"
                        stop
                     end if
                     ZeroMatrix%col_idx(m) = DOF*(col_idx(j) - 1) + l
                  end do
               end do
            end do
         end do

         m = size(ZeroMatrix%col_idx)
         ZeroMatrix%val = zeros(m)

         !return

      end if

      ZeroMatrix%val(:) = 0.0d0

   end function

! ##########################################################################
   function ZeroMatrix_as_COO_FEMDomain(this, DOF) result(ZeroMatrix)
      class(FEMDomain_), intent(inout) :: this
      integer(int32), intent(in) :: DOF
      type(COO_) :: ZeroMatrix
      integer(int32) :: ElementID, LocElemID_1, LocElemID_2, nodeid_1, nodeid_2, &
                        pid_1, pid_2, DOF_1, DOF_2, loc_pid_1, loc_pid_2
      real(real64), allocatable :: eDiffMat(:, :)

      call ZeroMatrix%init(this%nn()*DOF)
      do ElementID = 1, this%ne()
         do LocElemID_1 = 1, this%nne()
            do LocElemID_2 = 1, this%nne()
               do DOF_1 = 1, DOF
                  do DOF_2 = 1, DOF
                     nodeid_1 = this%mesh%elemnod(ElementID, LocElemID_1)
                     nodeid_2 = this%mesh%elemnod(ElementID, LocElemID_2)
                     pid_1 = DOF*(nodeid_1 - 1) + DOF_1
                     pid_2 = DOF*(nodeid_2 - 1) + DOF_2
                     loc_pid_1 = DOF*(LocElemID_1 - 1) + DOF_1
                     loc_pid_2 = DOF*(LocElemID_2 - 1) + DOF_2
                     call ZeroMatrix%add(pid_1, pid_2, 0.0d0)
                  end do
               end do
            end do
         end do
      end do

   end function
! ##########################################################################

! ##########################################################################
   function MassMatrixFEMDomain(this, ElementID, Density, DOF, Lumped) result(MassMatrix)
      class(FEMDomain_), intent(inout) :: this
      type(ShapeFunction_) :: shapefunc
      integer(int32), intent(in) :: ElementID
      real(real64), optional, intent(in) :: Density
      real(real64), allocatable :: MassMatrix(:, :), Nmat(:, :)
      integer(int32), optional, intent(in) :: DOF
      real(real64) :: rho, center_mass
      integeR(int32) :: i, n, j, k, node_DOF
      logical, optional, intent(in) :: Lumped

      rho = input(default=1.0d0, option=Density)
      node_DOF = input(default=1, option=DOF)
      ! For Element ID = ElementID, create Mass Matrix and return it
      ! Number of Gauss Point = number of node per element, as default.
      ! initialize shape-function object

      call shapefunc%SetType(NumOfDim=this%nd(), NumOfNodePerElem=this%nne(), NumOfGp=this%mesh%getNumOfGp())

      do i = 1, shapefunc%NumOfGp
         call getAllShapeFunc(shapefunc, elem_id=ElementID, &
                              nod_coord=this%Mesh%NodCoord, &
                              elem_nod=this%Mesh%ElemNod, OptionalGpID=i)

         n = size(shapefunc%dNdgzi, 2)*node_DOF

         if (.not. allocated(MassMatrix)) then
            allocate (MassMatrix(n, n))
            MassMatrix(:, :) = 0.0d0
         end if
         if (size(MassMatrix, 1) /= n .or. size(MassMatrix, 2) /= n) then
            if (allocated(MassMatrix)) then
               deallocate (MassMatrix)
            end if
            allocate (MassMatrix(n, n))
         end if
         if (.not. allocated(Nmat)) then
            allocate (Nmat(node_DOF*size(shapefunc%Nmat), node_DOF))
         end if

         Nmat(:, :) = 0.0d0
         do j = 1, size(shapefunc%Nmat)
            do k = 1, node_DOF
               Nmat((j - 1)*node_DOF + k, k) = shapefunc%Nmat(j)

               ! in case node_DOF=3,
               ! N_(1)    0     0
               ! 0      N_(1)   0
               ! 0        0    N_(1)
               ! N_(2)    0     0
               ! 0      N_(2)   0
               ! 0        0    N_(2)
               ! N_(3)    0     0
               ! 0      N_(3)   0
               ! 0        0    N_(3)
               ! ...

            end do
         end do

         MassMatrix(:, :) = MassMatrix(:, :) + &
                            matmul(Nmat, transpose(Nmat)) &
                            *det_mat(shapefunc%Jmat, size(shapefunc%Jmat, 1))

      end do

      MassMatrix = rho*MassMatrix

      if (present(Lumped)) then
         if (Lumped) then
            do i = 1, size(MassMatrix, 1)
               center_mass = sum(MassMatrix(i, :))
               MassMatrix(i, :) = 0.0d0
               MassMatrix(i, i) = center_mass
            end do
         end if
      end if

   end function
! ##########################################################################

!######################## Get Flow-vector ##########################
   function FlowVectorFEMDomain(this, pressure, Permiability, ElementID) result(FlowVector)
      !class(DiffusionEq_),intent(inout)::obj
      class(FEMDomain_), intent(inout) :: this
      real(real64), intent(in) :: Pressure(:), Permiability
      integer(int32), intent(in) :: ElementID
      real(real64), allocatable :: Flowvector(:), p_elem_nodes(:), dNdx(:, :)
      type(ShapeFunction_) :: shapefunc

      integer(int32) ::  i, j, k, n, m

      Flowvector = zeros(this%nd())

      p_elem_nodes = this%ElementVector(ElementID=ElementID, GlobalVector=Pressure, DOF=1)
      call shapefunc%SetType(NumOfDim=this%nd(), NumOfNodePerElem=this%nne(), NumOfGp=this%mesh%getNumOfGp())

      do j = 1, shapefunc%NumOfGp
         call getAllShapeFunc(shapefunc, elem_id=ElementID, &
                              nod_coord=this%Mesh%NodCoord, &
                              elem_nod=this%Mesh%ElemNod, OptionalGpID=j)

         call GetAllShapeFunc(this%ShapeFunction, elem_id=ElementID, nod_coord=this%Mesh%NodCoord, &
                              elem_nod=this%Mesh%ElemNod, OptionalGpID=j)

         dNdx = matmul(transpose(this%ShapeFunction%dNdgzi), this%ShapeFunction%JmatInv)* &
                this%ShapeFunction%detJ*this%ShapeFunction%GaussIntegWei(j)

         FlowVector(:) = FlowVector(:) - Permiability* &
                         matmul( &
                         transpose(dNdx), &
                         p_elem_nodes(:))

      end do

   end function
!######################## Get Flow-vector ##########################

! ##########################################################################
   function MassVectorFEMDomain(this, ElementID, Density, DOF, Accel) result(MassVector)
      class(FEMDomain_), intent(inout) :: this
      type(ShapeFunction_) :: shapefunc
      integer(int32), intent(in) :: ElementID
      real(real64), optional, intent(in) :: Density, Accel(:)
      real(real64), allocatable :: MassVector(:), accel_vec(:)
      integer(int32), optional, intent(in) :: DOF
      real(real64) :: rho
      integer(int32) :: i, j, k, n, node_DOF, dim_num
      real(real64), allocatable :: Nmat(:, :)

      ! density :: (unit: t/m^3)
      ! accelerator :: m/s/s
      dim_num = size(this%mesh%nodcoord, 2)
      rho = input(default=1.0d0, option=Density)
      node_DOF = input(default=1, option=DOF)
      if (present(accel)) then
         accel_vec = accel
      else
         allocate (accel_vec(dim_num))
         accel_vec(:) = 0.0d0
      end if

      ! For Element ID = ElementID, create Mass Matrix and return it
      ! Number of Gauss Point = number of node per element, as default.

      ! initialize shape-function object
      !this%ShapeFunction%ElemType=this%Mesh%ElemType

      call shapefunc%SetType(NumOfDim=this%nd(), NumOfNodePerElem=this%nne(), NumOfGp=this%mesh%getNumOfGp())

      do i = 1, shapefunc%NumOfGp
         call getAllShapeFunc(shapefunc, elem_id=ElementID, &
                              nod_coord=this%Mesh%NodCoord, &
                              elem_nod=this%Mesh%ElemNod, OptionalGpID=i)

         n = size(shapefunc%dNdgzi, 2)*node_DOF

         if (.not. allocated(MassVector)) then
            allocate (MassVector(n))
            MassVector(:) = 0.0d0
         end if

         if (size(MassVector, 1) /= n) then
            if (allocated(MassVector)) then
               deallocate (MassVector)
            end if
            allocate (MassVector(n))
         end if

         if (.not. allocated(Nmat)) then
            allocate (Nmat(node_DOF*size(shapefunc%Nmat), node_DOF))
         end if

         Nmat(:, :) = 0.0d0
         do j = 1, size(shapefunc%Nmat)
            do k = 1, node_DOF
               Nmat((j - 1)*node_DOF + k, k) = shapefunc%Nmat(j)
               ! in case node_DOF=3,
               ! N_(1)    0     0
               ! 0      N_(1)   0
               ! 0        0    N_(1)
               ! N_(2)    0     0
               ! 0      N_(2)   0
               ! 0        0    N_(2)
               ! N_(3)    0     0
               ! 0      N_(3)   0
               ! 0        0    N_(3)
               ! ...

            end do
         end do

         MassVector(:) = MassVector(:) + matmul(Nmat, accel_vec) &
                         *det_mat(shapefunc%Jmat, size(shapefunc%Jmat, 1))

      end do

      MassVector = rho*MassVector

   end function
! ##########################################################################

! ##########################################################################
   function PressureVectorFEMDomain(this, ElementID, Pressure) result(PressureVector)
      class(FEMDomain_), intent(inout) :: this
      integer(int32), intent(in) :: ElementID
      real(real64), intent(in) :: pressure ! internal pressure (kPa)

      type(ShapeFunction_) :: shapefunc
      real(real64), allocatable :: PressureVector(:), internal_stress(:)
      integer(int32) :: i, j, k, n, node_DOF, dim_num
      real(real64), allocatable :: Bmat(:, :)

      ! density :: (unit: t/m^3)
      ! accelerator :: m/s/s
      dim_num = size(this%mesh%nodcoord, 2)
      node_DOF = this%nd()

      ! For Element ID = ElementID, create Mass Matrix and return it
      ! Number of Gauss Point = number of node per element, as default.

      ! initialize shape-function object
      !this%ShapeFunction%ElemType=this%Mesh%ElemType

      call shapefunc%SetType(NumOfDim=this%nd(), NumOfNodePerElem=this%nne(), NumOfGp=this%mesh%getNumOfGp())

      n = this%nne()*node_DOF
      allocate (PressureVector(n))
      PressureVector(:) = 0.0d0

      do i = 1, shapefunc%NumOfGp
         call getAllShapeFunc(shapefunc, elem_id=ElementID, &
                              nod_coord=this%Mesh%NodCoord, &
                              elem_nod=this%Mesh%ElemNod, OptionalGpID=i)

         Bmat = this%Bmatrix(shapefunc)
         internal_stress = zeros(size(Bmat, 1))
         internal_stress(1:this%nd()) = pressure

         PressureVector(:) = PressureVector(:) + matmul(transpose(Bmat), internal_stress) &
                             *det_mat(shapefunc%Jmat, size(shapefunc%Jmat, 1))

      end do

   end function
! ##########################################################################

! ##########################################################################

   function StiffnessMatrix_as_CRS_FEMDomain(this, YoungModulus, PoissonRatio, omp) result(StiffnessMatrix)
      class(FEMDomain_), intent(inout) :: this
      real(real64), intent(in) :: YoungModulus(:)
      real(real64), optional, intent(in) :: PoissonRatio(:)
      logical, optional, intent(in) :: omp
      type(CRS_) :: StiffnessMatrix
      type(COO_) :: COO
      integer(int32) :: ElementID, LocElemID_1, LocElemID_2, nodeid_1, nodeid_2, &
                        pid_1, pid_2, DOF_1, DOF_2, DOF, loc_pid_1, loc_pid_2, i, col_id
      real(real64) :: Length, entry_val
      real(real64), allocatable :: val(:)
      real(real64), allocatable :: eDiffMat(:, :)

      ! >>>>>>>> FOR 1-D case >>>>>>>>
      if (this%nne() == 2) then
         ! stiffness matrix for 1-D
         call coo%init(this%nn())
         do ElementID = 1, this%ne()
            Length = norm(this%mesh%nodcoord(this%mesh%elemnod(ElementID, 1), :) &
                          - this%mesh%nodcoord(this%mesh%elemnod(ElementID, 2), :))
            entry_val = YoungModulus(ElementID)/Length
            call coo%add(this%mesh%elemnod(ElementID, 1), this%mesh%elemnod(ElementID, 1), entry_val)
            call coo%add(this%mesh%elemnod(ElementID, 1), this%mesh%elemnod(ElementID, 2), -entry_val)
            call coo%add(this%mesh%elemnod(ElementID, 2), this%mesh%elemnod(ElementID, 1), -entry_val)
            call coo%add(this%mesh%elemnod(ElementID, 2), this%mesh%elemnod(ElementID, 2), entry_val)
         end do
         StiffnessMatrix = coo%to_crs()
         return
      end if
      ! <<<<<<<< FOR 1-D case <<<<<<<<

      if (.not. present(PoissonRatio)) then
         print *, "ERROR >> MassMatrix_as_CRS_FEMDomain should have arg [DOF]"
         stop
      end if

      if (present(omp)) then
         if (.not. omp) then
            DOF = this%nd()
            call COO%init(this%nn()*DOF)
            do ElementID = 1, this%ne()
               eDiffMat = this%StiffnessMatrix( &
                          ElementID=ElementID, &
                          E=YoungModulus(ElementID), &
                          v=PoissonRatio(ElementID) &
                          )
               do LocElemID_1 = 1, this%nne()
                  do LocElemID_2 = 1, this%nne()
                     do DOF_1 = 1, DOF
                        do DOF_2 = 1, DOF
                           nodeid_1 = this%mesh%elemnod(ElementID, LocElemID_1)
                           nodeid_2 = this%mesh%elemnod(ElementID, LocElemID_2)
                           pid_1 = DOF*(nodeid_1 - 1) + DOF_1
                           pid_2 = DOF*(nodeid_2 - 1) + DOF_2
                           loc_pid_1 = DOF*(LocElemID_1 - 1) + DOF_1
                           loc_pid_2 = DOF*(LocElemID_2 - 1) + DOF_2
                           call COO%add(pid_1, pid_2, eDiffMat(loc_pid_1, loc_pid_2))
                        end do
                     end do
                  end do
               end do
            end do
            StiffnessMatrix = COO%to_CRS()
            return
         end if
      end if

      DOF = this%nd()
      !call COO%init(this%nn()*DOF)
      !COO = this%ZeroMatrix_as_COO(DOF=DOF)
      StiffnessMatrix = this%ZeroMatrix(DOF=DOF)
      val = StiffnessMatrix%val
      !$OMP parallel do &
      !$OMP private(eDiffMat,LocElemID_1,LocElemID_2,nodeid_1,nodeid_2,col_id,i,&
      !$OMP pid_1,pid_2,loc_pid_1,loc_pid_2,DOF_1,DOF_2)&
      !$OMP  reduction(+:val)
      do ElementID = 1, this%ne()
         eDiffMat = this%StiffnessMatrix( &
                    ElementID=ElementID, &
                    E=YoungModulus(ElementID), &
                    v=PoissonRatio(ElementID) &
                    )
         do LocElemID_1 = 1, this%nne()
            do LocElemID_2 = 1, this%nne()
               do DOF_1 = 1, DOF
                  do DOF_2 = 1, DOF
                     nodeid_1 = this%mesh%elemnod(ElementID, LocElemID_1)
                     nodeid_2 = this%mesh%elemnod(ElementID, LocElemID_2)
                     pid_1 = DOF*(nodeid_1 - 1) + DOF_1
                     pid_2 = DOF*(nodeid_2 - 1) + DOF_2
                     loc_pid_1 = DOF*(LocElemID_1 - 1) + DOF_1
                     loc_pid_2 = DOF*(LocElemID_2 - 1) + DOF_2
                     !call COO%add(pid_1,pid_2,eDiffMat(loc_pid_1,loc_pid_2)  )

                     do i = StiffnessMatrix%row_ptr(pid_1), StiffnessMatrix%row_ptr(pid_1 + 1) - 1
                        if (StiffnessMatrix%col_idx(i) == pid_2) then
                           val(i) = val(i) + eDiffMat(loc_pid_1, loc_pid_2)
                           exit
                        end if
                     end do

                  end do
               end do
            end do
         end do
      end do
      !$OMP end parallel do
      StiffnessMatrix%val = val

   end function

! ##########################################################################
! ##########################################################################

   subroutine setStiffnessMatrix_as_CRS_FEMDomain(this, YoungModulus, PoissonRatio, omp, StiffnessMatrix) 
      class(FEMDomain_), intent(inout) :: this
      real(real64), intent(in) :: YoungModulus(:)
      real(real64), optional, intent(in) :: PoissonRatio(:)
      logical, optional, intent(in) :: omp
      type(CRS_),intent(inout) :: StiffnessMatrix
      type(COO_) :: COO
      integer(int32) :: ElementID, LocElemID_1, LocElemID_2, nodeid_1, nodeid_2, &
                        pid_1, pid_2, DOF_1, DOF_2, DOF, loc_pid_1, loc_pid_2, i, col_id
      real(real64) :: Length, entry_val
      real(real64), allocatable :: val(:)
      real(real64), allocatable :: eDiffMat(:, :)

      ! >>>>>>>> FOR 1-D case >>>>>>>>
      if (this%nne() == 2) then
         ! stiffness matrix for 1-D
         call coo%init(this%nn())
         do ElementID = 1, this%ne()
            Length = norm(this%mesh%nodcoord(this%mesh%elemnod(ElementID, 1), :) &
                          - this%mesh%nodcoord(this%mesh%elemnod(ElementID, 2), :))
            entry_val = YoungModulus(ElementID)/Length
            call coo%add(this%mesh%elemnod(ElementID, 1), this%mesh%elemnod(ElementID, 1), entry_val)
            call coo%add(this%mesh%elemnod(ElementID, 1), this%mesh%elemnod(ElementID, 2), -entry_val)
            call coo%add(this%mesh%elemnod(ElementID, 2), this%mesh%elemnod(ElementID, 1), -entry_val)
            call coo%add(this%mesh%elemnod(ElementID, 2), this%mesh%elemnod(ElementID, 2), entry_val)
         end do
         StiffnessMatrix = coo%to_crs()
         return
      end if
      ! <<<<<<<< FOR 1-D case <<<<<<<<

      if (.not. present(PoissonRatio)) then
         print *, "ERROR >> MassMatrix_as_CRS_FEMDomain should have arg [DOF]"
         stop
      end if

      if (present(omp)) then
         if (.not. omp) then
            DOF = this%nd()
            call COO%init(this%nn()*DOF)
            do ElementID = 1, this%ne()
               eDiffMat = this%StiffnessMatrix( &
                          ElementID=ElementID, &
                          E=YoungModulus(ElementID), &
                          v=PoissonRatio(ElementID) &
                          )
               do LocElemID_1 = 1, this%nne()
                  do LocElemID_2 = 1, this%nne()
                     do DOF_1 = 1, DOF
                        do DOF_2 = 1, DOF
                           nodeid_1 = this%mesh%elemnod(ElementID, LocElemID_1)
                           nodeid_2 = this%mesh%elemnod(ElementID, LocElemID_2)
                           pid_1 = DOF*(nodeid_1 - 1) + DOF_1
                           pid_2 = DOF*(nodeid_2 - 1) + DOF_2
                           loc_pid_1 = DOF*(LocElemID_1 - 1) + DOF_1
                           loc_pid_2 = DOF*(LocElemID_2 - 1) + DOF_2
                           call COO%add(pid_1, pid_2, eDiffMat(loc_pid_1, loc_pid_2))
                        end do
                     end do
                  end do
               end do
            end do
            StiffnessMatrix = COO%to_CRS(remove_coo=True)
            return
         end if
      end if

      DOF = this%nd()
      !call COO%init(this%nn()*DOF)
      !COO = this%ZeroMatrix_as_COO(DOF=DOF)
      StiffnessMatrix = this%ZeroMatrix(DOF=DOF)
      val = StiffnessMatrix%val
      deallocate(StiffnessMatrix%val)
      
      !$OMP parallel do &
      !$OMP private(eDiffMat,LocElemID_1,LocElemID_2,nodeid_1,nodeid_2,col_id,i,&
      !$OMP pid_1,pid_2,loc_pid_1,loc_pid_2,DOF_1,DOF_2)&
      !$OMP  shared(val) 
      ! !$OMP  reduction(+:val) 
      do ElementID = 1, this%ne()
         eDiffMat = this%StiffnessMatrix( &
                    ElementID=ElementID, &
                    E=YoungModulus(ElementID), &
                    v=PoissonRatio(ElementID) &
                    )
         do LocElemID_1 = 1, this%nne()
            do LocElemID_2 = 1, this%nne()
               do DOF_1 = 1, DOF
                  do DOF_2 = 1, DOF
                     nodeid_1 = this%mesh%elemnod(ElementID, LocElemID_1)
                     nodeid_2 = this%mesh%elemnod(ElementID, LocElemID_2)
                     pid_1 = DOF*(nodeid_1 - 1) + DOF_1
                     pid_2 = DOF*(nodeid_2 - 1) + DOF_2
                     loc_pid_1 = DOF*(LocElemID_1 - 1) + DOF_1
                     loc_pid_2 = DOF*(LocElemID_2 - 1) + DOF_2
                     !call COO%add(pid_1,pid_2,eDiffMat(loc_pid_1,loc_pid_2)  )

                     do i = StiffnessMatrix%row_ptr(pid_1), StiffnessMatrix%row_ptr(pid_1 + 1) - 1
                        if (StiffnessMatrix%col_idx(i) == pid_2) then
                           !$OMP atomic
                           val(i) = val(i) + eDiffMat(loc_pid_1, loc_pid_2)
                           exit
                        end if
                     end do

                  end do
               end do
            end do
         end do
      end do
      !$OMP end parallel do

      StiffnessMatrix%val = val
      deallocate(val)

   end subroutine

! ##########################################################################

   function StiffnessMatrix_g_as_CRS_FEMDomain(this, YoungModulus, PoissonRatio, omp) result(StiffnessMatrix)
      class(FEMDomain_), intent(inout) :: this
      real(real64), intent(in) :: YoungModulus(:, :) ! NumElem x 6 (E1,E2,E3,G12,G23,G31)
      real(real64), intent(in) :: PoissonRatio(:, :)! NumElem x 6 (v12,v13,v21,v23,v31,v32)
      logical, optional, intent(in) :: omp
      type(CRS_) :: StiffnessMatrix
      type(COO_) :: COO
      integer(int32) :: ElementID, LocElemID_1, LocElemID_2, nodeid_1, nodeid_2, &
                        pid_1, pid_2, DOF_1, DOF_2, DOF, loc_pid_1, loc_pid_2, i, col_id
      real(real64) :: Length, entry_val
      real(real64), allocatable :: val(:)
      real(real64), allocatable :: eDiffMat(:, :)

      ! >>>>>>>> FOR non-3D case >>>>>>>>
      if (this%nd() /= 3) then
         ! stiffness matrix for non-3D
         call coo%init(this%nn())
         ! DO NOTHING!
         StiffnessMatrix = coo%to_crs()
         return
      end if
      ! <<<<<<<< FOR non-3D case <<<<<<<<

      if (present(omp)) then
         if (.not. omp) then
            DOF = this%nd()
            call COO%init(this%nn()*DOF)
            do ElementID = 1, this%ne()
               eDiffMat = this%StiffnessMatrix( &
                          ElementID=ElementID, &
                          E=YoungModulus(ElementID, 1:6), &
                          v=PoissonRatio(ElementID, 1:6) &
                          )
               do LocElemID_1 = 1, this%nne()
                  do LocElemID_2 = 1, this%nne()
                     do DOF_1 = 1, DOF
                        do DOF_2 = 1, DOF
                           nodeid_1 = this%mesh%elemnod(ElementID, LocElemID_1)
                           nodeid_2 = this%mesh%elemnod(ElementID, LocElemID_2)
                           pid_1 = DOF*(nodeid_1 - 1) + DOF_1
                           pid_2 = DOF*(nodeid_2 - 1) + DOF_2
                           loc_pid_1 = DOF*(LocElemID_1 - 1) + DOF_1
                           loc_pid_2 = DOF*(LocElemID_2 - 1) + DOF_2
                           call COO%add(pid_1, pid_2, eDiffMat(loc_pid_1, loc_pid_2))
                        end do
                     end do
                  end do
               end do
            end do
            StiffnessMatrix = COO%to_CRS()
            return
         end if
      end if

      DOF = this%nd()
      !call COO%init(this%nn()*DOF)
      !COO = this%ZeroMatrix_as_COO(DOF=DOF)
      StiffnessMatrix = this%ZeroMatrix(DOF=DOF)
      val = StiffnessMatrix%val
      !$OMP parallel do &
      !$OMP private(eDiffMat,LocElemID_1,LocElemID_2,nodeid_1,nodeid_2,col_id,i,&
      !$OMP pid_1,pid_2,loc_pid_1,loc_pid_2,DOF_1,DOF_2)&
      !$OMP  reduction(+:val)
      do ElementID = 1, this%ne()
         eDiffMat = this%StiffnessMatrix( &
                    ElementID=ElementID, &
                    E=YoungModulus(ElementID, 1:6), &
                    v=PoissonRatio(ElementID, 1:6) &
                    )
         do LocElemID_1 = 1, this%nne()
            do LocElemID_2 = 1, this%nne()
               do DOF_1 = 1, DOF
                  do DOF_2 = 1, DOF
                     nodeid_1 = this%mesh%elemnod(ElementID, LocElemID_1)
                     nodeid_2 = this%mesh%elemnod(ElementID, LocElemID_2)
                     pid_1 = DOF*(nodeid_1 - 1) + DOF_1
                     pid_2 = DOF*(nodeid_2 - 1) + DOF_2
                     loc_pid_1 = DOF*(LocElemID_1 - 1) + DOF_1
                     loc_pid_2 = DOF*(LocElemID_2 - 1) + DOF_2
                     !call COO%add(pid_1,pid_2,eDiffMat(loc_pid_1,loc_pid_2)  )

                     do i = StiffnessMatrix%row_ptr(pid_1), StiffnessMatrix%row_ptr(pid_1 + 1) - 1
                        if (StiffnessMatrix%col_idx(i) == pid_2) then
                           val(i) = val(i) + eDiffMat(loc_pid_1, loc_pid_2)
                           exit
                        end if
                     end do

                  end do
               end do
            end do
         end do
      end do
      !$OMP end parallel do
      StiffnessMatrix%val = val

   end function

! ##########################################################################

! ##########################################################################
   function StiffnessMatrixFEMDomain(this, ElementID, E, v) result(StiffnessMatrix)
      class(FEMDomain_), intent(inout) :: this
      type(Shapefunction_) :: shapefunc
      integer(int32), intent(in) :: ElementID
      real(real64), intent(in) :: E, v ! Young's modulus and Poisson ratio
      real(real64), allocatable :: StiffnessMatrix(:, :), Bmat(:, :), Dmat(:, :)
      real(real64) :: rho
      integer(int32) :: node_DOF, i, j, n

      ! 線形弾性微小ひずみにおける要素剛性マトリクス
      ! For Element ID = ElementID, create Stiffness Matrix
      ! in terms of small-strain and return it
      ! Number of Gauss Point = number of node per element, as default.

      node_DOF = this%nd() ! Degree of freedom/node = dimension of space

      ! For Element ID = ElementID, create Mass Matrix and return it
      ! Number of Gauss Point = number of node per element, as default.

      ! initialize shape-function object

      call shapefunc%SetType(NumOfDim=this%nd(), NumOfNodePerElem=this%nne(), NumOfGp=this%mesh%getNumOfGp())

      do i = 1, shapefunc%NumOfGp
         call getAllShapeFunc(shapefunc, elem_id=ElementID, &
                              nod_coord=this%Mesh%NodCoord, &
                              elem_nod=this%Mesh%ElemNod, OptionalGpID=i)

         n = size(shapefunc%dNdgzi, 2)*node_DOF

         if (.not. allocated(StiffnessMatrix)) then
            allocate (StiffnessMatrix(n, n))
            StiffnessMatrix(:, :) = 0.0d0
         end if
         if (size(StiffnessMatrix, 1) /= n .or. size(StiffnessMatrix, 2) /= n) then
            if (allocated(StiffnessMatrix)) then
               deallocate (StiffnessMatrix)
            end if
            allocate (StiffnessMatrix(n, n))
         end if

         ! get so-called B-matrix
         Bmat = this%Bmatrix(shapefunc)

         ! get D-matrix
         Dmat = this%Dmatrix(E=E, v=v)

         if (i == 1) then
            StiffnessMatrix = matmul(matmul(transpose(Bmat), Dmat), Bmat)
            StiffnessMatrix = StiffnessMatrix*det_mat(shapefunc%Jmat, size(shapefunc%Jmat, 1))
         else
            StiffnessMatrix = StiffnessMatrix + &
                              matmul(matmul(transpose(Bmat), Dmat), Bmat) &
                              *det_mat(shapefunc%Jmat, size(shapefunc%Jmat, 1))
         end if

      end do

   end function
! ##########################################################################

! ##########################################################################
   function StiffnessMatrix_generic_FEMDomain(this, ElementID, E, v, rot_angles) result(StiffnessMatrix)
      class(FEMDomain_), intent(inout) :: this
      type(Shapefunction_) :: shapefunc
      integer(int32), intent(in) :: ElementID
      real(real64), intent(in) :: E(:), v(:) ! Young's modulus(E1,E2,E3,G12,G23,G31),
      ! Poisson ratio(v12,v13,v21,v23,v31,v32)
      real(real64), optional, intent(in) :: rot_angles(:)
      real(real64), allocatable :: StiffnessMatrix(:, :), Bmat(:, :), Dmat(:, :), Q(:, :), G(:)
      real(real64) :: rho
      integer(int32) :: node_DOF, i, j, n

      ! 線形弾性微小ひずみにおける要素剛性マトリクス
      ! For Element ID = ElementID, create Stiffness Matrix
      ! in terms of small-strain and return it
      ! Number of Gauss Point = number of node per element, as default.

      node_DOF = this%nd() ! Degree of freedom/node = dimension of space

      ! For Element ID = ElementID, create Mass Matrix and return it
      ! Number of Gauss Point = number of node per element, as default.

      ! initialize shape-function object

      call shapefunc%SetType(NumOfDim=this%nd(), NumOfNodePerElem=this%nne(), NumOfGp=this%mesh%getNumOfGp())

      do i = 1, shapefunc%NumOfGp
         call getAllShapeFunc(shapefunc, elem_id=ElementID, &
                              nod_coord=this%Mesh%NodCoord, &
                              elem_nod=this%Mesh%ElemNod, OptionalGpID=i)

         n = size(shapefunc%dNdgzi, 2)*node_DOF

         if (.not. allocated(StiffnessMatrix)) then
            allocate (StiffnessMatrix(n, n))
            StiffnessMatrix(:, :) = 0.0d0
         end if
         if (size(StiffnessMatrix, 1) /= n .or. size(StiffnessMatrix, 2) /= n) then
            if (allocated(StiffnessMatrix)) then
               deallocate (StiffnessMatrix)
            end if
            allocate (StiffnessMatrix(n, n))
         end if

         ! get so-called B-matrix
         Bmat = this%Bmatrix(shapefunc)

         ! get D-matrix
         Dmat = this%Dmatrix(E=E, v=v)

         ! これで正しいか吟味が必要
         Q = rotate_3x3_matrix( &
             x=rot_angles(1), &
             y=rot_angles(2), &
             z=rot_angles(3) &
             )
         Dmat(1:3, 1:3) = abs(matmul(transpose(Q), matmul(Dmat(1:3, 1:3), Q)))

         G = zeros(3)
         G(1) = Dmat(4, 4)
         G(2) = Dmat(5, 5)
         G(3) = Dmat(6, 6)
         G = matmul(transpose(Q), G)
         Dmat(4, 4) = abs(G(1))
         Dmat(5, 5) = abs(G(2))
         Dmat(6, 6) = abs(G(3))

         if (i == 1) then
            StiffnessMatrix = matmul(matmul(transpose(Bmat), Dmat), Bmat)
            StiffnessMatrix = StiffnessMatrix*det_mat(shapefunc%Jmat, size(shapefunc%Jmat, 1))
         else
            StiffnessMatrix = StiffnessMatrix + &
                              matmul(matmul(transpose(Bmat), Dmat), Bmat) &
                              *det_mat(shapefunc%Jmat, size(shapefunc%Jmat, 1))
         end if

      end do

   end function
! ##########################################################################

! ##########################################################################
   function DMatrixFEMDomain(this, E, v) result(Dmat)
      class(FEMDomain_), intent(inout) :: this
      real(real64), intent(in) :: E, v
      real(real64), allocatable :: Dmat(:, :)
      real(real64) :: mu, lambda

      ! Caution! this is for
      ! isotropic stiffness matrix
      mu = E/2.0d0/(1.0d0 + v)
      lambda = v*E/(1.0d0 + v)/(1.0d0 - 2.0d0*v)

      if (this%nd() == 1) then
         Dmat = zeros(1, 1)
         Dmat(:, :) = E
         return
      elseif (this%nd() == 2) then
         ! s_11, s_22, s_12
         Dmat = zeros(3, 3)
         Dmat(1, 1) = (1.0d0 - v)*E/((1.0d0 + v)*(1.0d0 - 2.0d0*v))
         Dmat(2, 2) = (1.0d0 - v)*E/((1.0d0 + v)*(1.0d0 - 2.0d0*v))
         Dmat(3, 3) = E/(2.0d0*(1.0d0 + v))
         Dmat(1, 2) = v*E/((1.0d0 + v)*(1.0d0 - 2.0d0*v))
         Dmat(2, 1) = v*E/((1.0d0 + v)*(1.0d0 - 2.0d0*v))
      elseif (this%nd() == 3) then
         Dmat = zeros(6, 6)
         Dmat(1, 1) = 2.0d0*mu + lambda
         Dmat(1, 2) = lambda
         Dmat(1, 3) = lambda
         Dmat(2, 1) = lambda
         Dmat(2, 2) = 2.0d0*mu + lambda
         Dmat(2, 3) = lambda
         Dmat(3, 1) = lambda
         Dmat(3, 2) = lambda
         Dmat(3, 3) = 2.0d0*mu + lambda
         Dmat(4, 4) = mu
         Dmat(5, 5) = mu
         Dmat(6, 6) = mu
      else
         print *, "Error :: DMatrixFEMDomain >> number of dimension should be 1-3. Now ", this%nd()
         stop
      end if
   end function
! ##########################################################################

! ##########################################################################
   function DMatrix_generic_FEMDomain(this, E, v) result(Dmat)
      class(FEMDomain_), intent(inout) :: this
      real(real64), intent(in) :: E(1:6), v(1:6)
      real(real64), allocatable :: Dmat(:, :)
      real(real64) :: v_12, v_13, v_21, v_23, v_31, v_32
      real(real64) :: E_1, E_2, E_3
      real(real64) :: G_12, G_23, G_31, delta
      real(real64) :: mu, lambda

      ! https://www.frontistr.com/seminar/140730/orthotropic_elastic_material.pdf
      v_12 = v(1)
      v_13 = v(2)
      v_21 = v(3)
      v_23 = v(4)
      v_31 = v(5)
      v_32 = v(6)

      E_1 = E(1)
      E_2 = E(2)
      E_3 = E(3)

      G_12 = E(4)
      G_23 = E(5)
      G_31 = E(6)

      ! Dmatrix for generic (orthotropic elastic material)
      ! Caution! this is for 3D
      delta = 1.0d0 - v_12*v_21 - v_23*v_32 - v_31*v_13 - 2.0d0*v_21*v_32*v_13

      if (this%nd() /= 3) then
         Dmat = zeros(1, 1)
         return
      else
         Dmat = zeros(6, 6)
         Dmat(1, 1) = E_1*(1.0d0 - v_23*v_32)/delta
         Dmat(1, 2) = E_1*(v_31*v_23 + v_21)/delta
         Dmat(1, 3) = E_1*(v_21*v_32 + v_31)/delta

         Dmat(2, 1) = Dmat(1, 2)
         Dmat(2, 2) = E_2*(1.0d0 - v_13*v_31)/delta
         Dmat(2, 3) = E_2*(v_12*v_31 + v_32)/delta

         Dmat(3, 1) = Dmat(1, 3)
         Dmat(3, 2) = Dmat(2, 3)
         Dmat(3, 3) = E_3*(1.0d0 - v_12*v_21)/delta

         Dmat(4, 4) = 2.0d0*G_12
         Dmat(5, 5) = 2.0d0*G_23
         Dmat(6, 6) = 2.0d0*G_31
      end if
   end function
! ##########################################################################

! ##########################################################################
   function StrainMatrixFEMDomain(this, ElementID, GaussPoint, disp) result(StrainMatrix)
      class(FEMDomain_), intent(inout) :: this
      type(Shapefunction_) :: shapefunc
      integer(int32), intent(in) :: ElementID
      integer(int32), optional, intent(in) :: GaussPoint

      real(real64), intent(in) :: disp(:, :)
      real(real64), allocatable :: StrainMatrix(:, :), Bmat(:, :), Dmat(:, :), ElemDisp(:), Strainvec(:)
      real(real64) :: rho
      integer(int32) :: node_DOF, i, j, n, ns

      ! 線形弾性微小ひずみにおける要素剛性マトリクス
      ! For Element ID = ElementID, create Stiffness Matrix
      ! in terms of small-strain and return it
      ! Number of Gauss Point = number of node per element, as default.

      node_DOF = this%nd() ! Degree of freedom/node = dimension of space

      ! For Element ID = ElementID, create Mass Matrix and return it
      ! Number of Gauss Point = number of node per element, as default.

      ! initialize shape-function object
      call shapefunc%SetType(NumOfDim=this%nd(), NumOfNodePerElem=this%nne(), NumOfGp=this%mesh%getNumOfGp())

      ElemDisp = zeros(size(this%mesh%elemnod, 2)*node_DOF)
      do i = 1, this%nne()
         do j = 1, node_DOF
            ElemDisp(node_DOF*(i - 1) + j) = Disp(i, j)
         end do
      end do

      if (present(gausspoint)) then
         call getAllShapeFunc(shapefunc, elem_id=ElementID, &
                              nod_coord=this%Mesh%NodCoord, &
                              elem_nod=this%Mesh%ElemNod, OptionalGpID=gausspoint)

         n = size(shapefunc%dNdgzi, 2)*node_DOF

         ns = node_DOF ! For 3D, 3-by-3 matrix.
         if (.not. allocated(StrainMatrix)) then
            allocate (StrainMatrix(ns, ns))
            StrainMatrix(:, :) = 0.0d0
         end if
         if (size(StrainMatrix, 1) /= ns .or. size(StrainMatrix, 2) /= ns) then
            if (allocated(StrainMatrix)) then
               deallocate (StrainMatrix)
            end if
            allocate (StrainMatrix(ns, ns))
         end if

         ! get so-called B-matrix
         Bmat = this%Bmatrix(shapefunc)

         strainvec = matmul(Bmat, ElemDisp)

         if (node_DOF == 3) then
            strainMatrix(1, 1) = strainMatrix(1, 1) + strainvec(1)
            strainMatrix(2, 2) = strainMatrix(2, 2) + strainvec(2)
            strainMatrix(3, 3) = strainMatrix(3, 3) + strainvec(3)
            strainMatrix(1, 2) = strainMatrix(1, 2) + strainvec(4)
            strainMatrix(2, 3) = strainMatrix(2, 3) + strainvec(5)
            strainMatrix(1, 3) = strainMatrix(1, 3) + strainvec(6)
            strainMatrix(2, 1) = strainMatrix(2, 1) + strainvec(4)
            strainMatrix(3, 2) = strainMatrix(3, 2) + strainvec(5)
            strainMatrix(3, 1) = strainMatrix(3, 1) + strainvec(6)
         elseif (node_DOF == 2) then
            strainMatrix(1, 1) = strainMatrix(1, 1) + strainvec(1)
            strainMatrix(2, 2) = strainMatrix(2, 2) + strainvec(2)
            strainMatrix(1, 2) = strainMatrix(1, 2) + strainvec(3)
            strainMatrix(2, 1) = strainMatrix(2, 1) + strainvec(3)
         else
            print *, "ERROR :: StrainMatrixFEMDomain >> invalid nodeal DOF", node_DOF
         end if
      else
         do i = 1, shapefunc%NumOfGp
            call getAllShapeFunc(shapefunc, elem_id=ElementID, &
                                 nod_coord=this%Mesh%NodCoord, &
                                 elem_nod=this%Mesh%ElemNod, OptionalGpID=i)

            n = size(shapefunc%dNdgzi, 2)*node_DOF

            ns = node_DOF ! For 3D, 3-by-3 matrix.
            if (.not. allocated(StrainMatrix)) then
               allocate (StrainMatrix(ns, ns))
               StrainMatrix(:, :) = 0.0d0
            end if
            if (size(StrainMatrix, 1) /= ns .or. size(StrainMatrix, 2) /= ns) then
               if (allocated(StrainMatrix)) then
                  deallocate (StrainMatrix)
               end if
               allocate (StrainMatrix(ns, ns))
            end if

            ! get so-called B-matrix
            Bmat = this%Bmatrix(shapefunc)

            strainvec = matmul(Bmat, ElemDisp)
            if (node_DOF == 3) then
               strainMatrix(1, 1) = strainMatrix(1, 1) + strainvec(1)
               strainMatrix(2, 2) = strainMatrix(2, 2) + strainvec(2)
               strainMatrix(3, 3) = strainMatrix(3, 3) + strainvec(3)
               strainMatrix(1, 2) = strainMatrix(1, 2) + strainvec(4)
               strainMatrix(2, 3) = strainMatrix(2, 3) + strainvec(5)
               strainMatrix(1, 3) = strainMatrix(1, 3) + strainvec(6)
               strainMatrix(2, 1) = strainMatrix(2, 1) + strainvec(4)
               strainMatrix(3, 2) = strainMatrix(3, 2) + strainvec(5)
               strainMatrix(3, 1) = strainMatrix(3, 1) + strainvec(6)
            elseif (node_DOF == 2) then
               strainMatrix(1, 1) = strainMatrix(1, 1) + strainvec(1)
               strainMatrix(2, 2) = strainMatrix(2, 2) + strainvec(2)
               strainMatrix(1, 2) = strainMatrix(1, 2) + strainvec(3)
               strainMatrix(2, 1) = strainMatrix(2, 1) + strainvec(3)
            else
               print *, "ERROR :: StrainMatrixFEMDomain >> invalid nodeal DOF", node_DOF
            end if

         end do
      end if
   end function
! ##########################################################################

! ##########################################################################
   function StrainVectorFEMDomain(this, ElementID, GaussPoint, disp) result(StrainVec)
      class(FEMDomain_), intent(inout) :: this
      type(Shapefunction_) :: shapefunc
      integer(int32), intent(in) :: ElementID
      integer(int32), optional, intent(in) :: GaussPoint

      real(real64), intent(in) :: disp(:, :)
      real(real64), allocatable :: StrainMatrix(:, :), Bmat(:, :), Dmat(:, :), ElemDisp(:), Strainvec(:)
      real(real64) :: rho
      integer(int32) :: node_DOF, i, j, n, ns, vectorsize

      ! 線形弾性微小ひずみにおける要素剛性マトリクス
      ! For Element ID = ElementID, create Stiffness Matrix
      ! in terms of small-strain and return it
      ! Number of Gauss Point = number of node per element, as default.

      node_DOF = this%nd() ! Degree of freedom/node = dimension of space

      ! For Element ID = ElementID, create Mass Matrix and return it
      ! Number of Gauss Point = number of node per element, as default.
      vectorsize = this%nd()
      do i = 1, this%nd() - 1
         do j = i + 1, this%nd()
            vectorsize = vectorsize + 1
         end do
      end do
      strainvec = zeros(vectorsize)
      ! initialize shape-function object
      call shapefunc%SetType(NumOfDim=this%nd(), NumOfNodePerElem=this%nne(), NumOfGp=this%mesh%getNumOfGp())

      ElemDisp = zeros(size(this%mesh%elemnod, 2)*node_DOF)
      do i = 1, this%nne()
         do j = 1, node_DOF
            ElemDisp(node_DOF*(i - 1) + j) = Disp(i, j)
         end do
      end do

      if (present(gausspoint)) then
         call getAllShapeFunc(shapefunc, elem_id=ElementID, &
                              nod_coord=this%Mesh%NodCoord, &
                              elem_nod=this%Mesh%ElemNod, OptionalGpID=gausspoint)

         n = size(shapefunc%dNdgzi, 2)*node_DOF

         ns = node_DOF ! For 3D, 3-by-3 matrix.
         if (.not. allocated(StrainMatrix)) then
            allocate (StrainMatrix(ns, ns))
            StrainMatrix(:, :) = 0.0d0
         end if
         if (size(StrainMatrix, 1) /= ns .or. size(StrainMatrix, 2) /= ns) then
            if (allocated(StrainMatrix)) then
               deallocate (StrainMatrix)
            end if
            allocate (StrainMatrix(ns, ns))
         end if

         ! get so-called B-matrix
         Bmat = this%Bmatrix(shapefunc)

         strainvec = strainvec + matmul(Bmat, ElemDisp)
      else
         do i = 1, shapefunc%NumOfGp
            call getAllShapeFunc(shapefunc, elem_id=ElementID, &
                                 nod_coord=this%Mesh%NodCoord, &
                                 elem_nod=this%Mesh%ElemNod, OptionalGpID=i)

            n = size(shapefunc%dNdgzi, 2)*node_DOF

            ns = node_DOF ! For 3D, 3-by-3 matrix.
            if (.not. allocated(StrainMatrix)) then
               allocate (StrainMatrix(ns, ns))
               StrainMatrix(:, :) = 0.0d0
            end if
            if (size(StrainMatrix, 1) /= ns .or. size(StrainMatrix, 2) /= ns) then
               if (allocated(StrainMatrix)) then
                  deallocate (StrainMatrix)
               end if
               allocate (StrainMatrix(ns, ns))
            end if

            ! get so-called B-matrix
            Bmat = this%Bmatrix(shapefunc)

            strainvec = strainvec + matmul(Bmat, ElemDisp)

         end do
      end if
   end function
! ##########################################################################

! ##########################################################################
   function StressMatrixFEMDomain(this, ElementID, GaussPoint, disp, E, v) result(StressMatrix)
      class(FEMDomain_), intent(inout) :: this
      type(Shapefunction_) :: shapefunc
      integer(int32), intent(in) :: ElementID
      integer(int32), optional, intent(in) :: GaussPoint

      real(real64), intent(in) :: disp(:, :), E, v
      real(real64), allocatable :: StressMatrix(:, :), Bmat(:, :), Dmat(:, :), ElemDisp(:), Stressvec(:)
      real(real64) :: rho
      integer(int32) :: node_DOF, i, j, n, ns

      ! 線形弾性微小ひずみにおける要素剛性マトリクス
      ! For Element ID = ElementID, create Stiffness Matrix
      ! in terms of small-strain and return it
      ! Number of Gauss Point = number of node per element, as default.

      node_DOF = this%nd() ! Degree of freedom/node = dimension of space

      ! For Element ID = ElementID, create Mass Matrix and return it
      ! Number of Gauss Point = number of node per element, as default.

      ! initialize shape-function object
      call shapefunc%SetType(NumOfDim=this%nd(), NumOfNodePerElem=this%nne(), NumOfGp=this%mesh%getNumOfGp())

      ElemDisp = zeros(size(this%mesh%elemnod, 2)*node_DOF)
      do i = 1, this%nne()
         do j = 1, node_DOF
            ElemDisp(node_DOF*(i - 1) + j) = Disp(this%mesh%elemnod(ElementID, i), j)
         end do
      end do

      if (present(gausspoint)) then
         call getAllShapeFunc(shapefunc, elem_id=ElementID, &
                              nod_coord=this%Mesh%NodCoord, &
                              elem_nod=this%Mesh%ElemNod, OptionalGpID=gausspoint)

         n = size(shapefunc%dNdgzi, 2)*node_DOF

         ns = node_DOF ! For 3D, 3-by-3 matrix.
         if (.not. allocated(StressMatrix)) then
            allocate (StressMatrix(ns, ns))
            StressMatrix(:, :) = 0.0d0
         end if
         if (size(StressMatrix, 1) /= ns .or. size(StressMatrix, 2) /= ns) then
            if (allocated(StressMatrix)) then
               deallocate (StressMatrix)
            end if
            allocate (StressMatrix(ns, ns))
         end if

         ! get so-called B-matrix
         Dmat = this%Dmatrix(E, v)
         Bmat = this%Bmatrix(shapefunc)

         Stressvec = matmul(Dmat, matmul(Bmat, ElemDisp))

         if (node_DOF == 3) then
            StressMatrix(1, 1) = StressMatrix(1, 1) + Stressvec(1)
            StressMatrix(2, 2) = StressMatrix(2, 2) + Stressvec(2)
            StressMatrix(3, 3) = StressMatrix(3, 3) + Stressvec(3)
            StressMatrix(1, 2) = StressMatrix(1, 2) + Stressvec(4)
            StressMatrix(2, 3) = StressMatrix(2, 3) + Stressvec(5)
            StressMatrix(1, 3) = StressMatrix(1, 3) + Stressvec(6)
            StressMatrix(2, 1) = StressMatrix(2, 1) + Stressvec(4)
            StressMatrix(3, 2) = StressMatrix(3, 2) + Stressvec(5)
            StressMatrix(3, 1) = StressMatrix(3, 1) + Stressvec(6)
         elseif (node_DOF == 2) then
            StressMatrix(1, 1) = StressMatrix(1, 1) + Stressvec(1)
            StressMatrix(2, 2) = StressMatrix(2, 2) + Stressvec(2)
            StressMatrix(1, 2) = StressMatrix(1, 2) + Stressvec(3)
            StressMatrix(2, 1) = StressMatrix(2, 1) + Stressvec(3)
         else
            print *, "ERROR :: StressMatrixFEMDomain >> invalid nodeal DOF", node_DOF
         end if
      else
         do i = 1, shapefunc%NumOfGp
            call getAllShapeFunc(shapefunc, elem_id=ElementID, &
                                 nod_coord=this%Mesh%NodCoord, &
                                 elem_nod=this%Mesh%ElemNod, OptionalGpID=i)

            n = size(shapefunc%dNdgzi, 2)*node_DOF

            ns = node_DOF ! For 3D, 3-by-3 matrix.
            if (.not. allocated(StressMatrix)) then
               allocate (StressMatrix(ns, ns))
               StressMatrix(:, :) = 0.0d0
            end if
            if (size(StressMatrix, 1) /= ns .or. size(StressMatrix, 2) /= ns) then
               if (allocated(StressMatrix)) then
                  deallocate (StressMatrix)
               end if
               allocate (StressMatrix(ns, ns))
            end if

            ! get so-called B-matrix
            Bmat = this%Bmatrix(shapefunc)
            Dmat = this%Dmatrix(E, v)
            Stressvec = matmul(Dmat, matmul(Bmat, ElemDisp))
            if (node_DOF == 3) then
               StressMatrix(1, 1) = StressMatrix(1, 1) + Stressvec(1)
               StressMatrix(2, 2) = StressMatrix(2, 2) + Stressvec(2)
               StressMatrix(3, 3) = StressMatrix(3, 3) + Stressvec(3)
               StressMatrix(1, 2) = StressMatrix(1, 2) + Stressvec(4)
               StressMatrix(2, 3) = StressMatrix(2, 3) + Stressvec(5)
               StressMatrix(1, 3) = StressMatrix(1, 3) + Stressvec(6)
               StressMatrix(2, 1) = StressMatrix(2, 1) + Stressvec(4)
               StressMatrix(3, 2) = StressMatrix(3, 2) + Stressvec(5)
               StressMatrix(3, 1) = StressMatrix(3, 1) + Stressvec(6)
            elseif (node_DOF == 2) then
               StressMatrix(1, 1) = StressMatrix(1, 1) + Stressvec(1)
               StressMatrix(2, 2) = StressMatrix(2, 2) + Stressvec(2)
               StressMatrix(1, 2) = StressMatrix(1, 2) + Stressvec(3)
               StressMatrix(2, 1) = StressMatrix(2, 1) + Stressvec(3)
            else
               print *, "ERROR :: StressMatrixFEMDomain >> invalid nodeal DOF", node_DOF
            end if

         end do
         ! cell-averaged
         StressMatrix = StressMatrix/dble(shapefunc%NumOfGp)
      end if

   end function
! ##########################################################################

! ##########################################################################
   function StressVectorFEMDomain(this, ElementID, GaussPoint, disp, E, v) result(StressVec)
      class(FEMDomain_), intent(inout) :: this
      type(Shapefunction_) :: shapefunc
      integer(int32), intent(in) :: ElementID
      integer(int32), optional, intent(in) :: GaussPoint

      real(real64), intent(in) :: disp(:, :), E, v
      real(real64), allocatable :: StressMatrix(:, :), Bmat(:, :), Dmat(:, :), ElemDisp_m(:, :), ElemDisp(:), Stressvec(:)
      real(real64) :: rho
      integer(int32) :: node_DOF, i, j, n, ns, vectorsize

      ! [CAUTION]
      ! disp is local displacement matrix (nne by nd )

      ! 線形弾性微小ひずみにおける要素剛性マトリクス
      ! For Element ID = ElementID, create Stiffness Matrix
      ! in terms of small-strain and return it
      ! Number of Gauss Point = number of node per element, as default.

      node_DOF = this%nd() ! Degree of freedom/node = dimension of space
      ! vector size
      ! if nd == 3 => vectorsize = 6
      vectorsize = this%nd()
      do i = 1, this%nd() - 1
         do j = i + 1, this%nd()
            vectorsize = vectorsize + 1
         end do
      end do
      StressVec = zeros(vectorsize)
      ! For Element ID = ElementID, create Mass Matrix and return it
      ! Number of Gauss Point = number of node per element, as default.

      ! initialize shape-function object
      !call shapefunc%SetType(NumOfDim=this%nd(),NumOfNodePerElem=this%nne() ,NumOfGp=this%mesh%getNumOfGp())

      !ElemDisp = zeros(  size( this%mesh%elemnod,2 ) *node_DOF)
      if (size(disp, 1) /= this%nne()) then
         print *, "[ERROR] StressVectorFEM :: Wrong Argument :: disp"
         print *, "[ERROR] >> size(disp,1) should be equal to this%nne()"
         stop
      end if
      ElemDisp_m = reshape(transpose(Disp), [size(Disp, 1)*size(Disp, 2), 1])
      ElemDisp = ElemDisp_m(:, 1)
      !do i=1,this%nne()
      !        do j=1,node_DOF
      !                ElemDisp( node_DOF*(i-1) + j ) = Disp(i,j)
      !        enddo
      !enddo

      if (present(gausspoint)) then
         !call getAllShapeFunc(shapefunc,elem_id=ElementID,&
         !nod_coord=this%Mesh%NodCoord,&
         !elem_nod=this%Mesh%ElemNod,OptionalGpID=gausspoint)

         shapefunc = this%getShapeFunction( &
                     ElementID=ElementID, GaussPointID=GaussPoint)

         !n=size(shapefunc%dNdgzi,2)*node_DOF

         !ns = node_DOF ! For 3D, 3-by-3 matrix.

         ! get so-called B-matrix
         Dmat = this%Dmatrix(E, v)
         Bmat = this%Bmatrix(shapefunc)

         Stressvec = matmul(Dmat, matmul(Bmat, ElemDisp))
      else
         do i = 1, shapefunc%NumOfGp

            shapefunc = this%getShapeFunction( &
                        ElementID=ElementID, GaussPointID=i)

            n = size(shapefunc%dNdgzi, 2)*node_DOF

            ns = node_DOF ! For 3D, 3-by-3 matrix.

            ! get so-called B-matrix
            !Bmat = this%Bmatrix(shapefunc)
            !Stressvec = Stressvec + matmul(Bmat,ElemDisp)

            Dmat = this%Dmatrix(E, v)
            Bmat = this%Bmatrix(shapefunc)

            Stressvec = Stressvec + matmul(Dmat, matmul(Bmat, ElemDisp))
         end do
      end if

   end function
! ##########################################################################

! ##########################################################################
   function ViscousBoundaryForceFEMDomain(this, u, v, spring, damper, NodeList, Direction) result(ret)
      class(FEMDomain_), intent(in) :: this
      real(real64), intent(in) :: u(:), v(:), spring, damper
      integer(int32), intent(in) :: NodeList(:)
      character(*), intent(in) :: Direction
      integer(int32) :: NodeListIdx, Idx
      real(real64), allocatable :: ret(:)
      integer(int32) :: DOF

      DOF = size(this%mesh%nodcoord, 2)

      ret = 0.0d0*u

      if ((index(Direction, "X")) + (index(Direction, "x")) /= 0) then
         do NodeListIdx = 1, size(NodeList)
            idx = DOF*(NodeList(NodeListIdx) - 1) + 1
            ret(idx) = -spring*u(idx) - damper*v(idx)
         end do
      end if

      if ((index(Direction, "Y")) + (index(Direction, "y")) /= 0) then
         do NodeListIdx = 1, size(NodeList)
            idx = DOF*(NodeList(NodeListIdx) - 1) + 2
            ret(idx) = -spring*u(idx) - damper*v(idx)
         end do
      end if

      if ((index(Direction, "Z")) + (index(Direction, "z")) /= 0) then
         do NodeListIdx = 1, size(NodeList)
            idx = DOF*(NodeList(NodeListIdx) - 1) + 3
            ret(idx) = -spring*u(idx) - damper*v(idx)
         end do
      end if
   end function
! ##########################################################################

! ##########################################################################
   recursive function BMatrixFEMDomain(this, shapefunction, ElementID) result(Bmat)
      class(FEMDomain_), intent(inout) :: this
      integer(int32), optional, intent(in) :: ElementID
      type(ShapeFunction_), optional, intent(in) :: shapefunction
      real(real64), allocatable :: Psymat(:, :), Jmat(:, :), detJ
      real(real64), allocatable :: Bmat(:, :)
      integer(int32)::dim_num
      real(real64), allocatable :: JPsy(:, :), Jin(:, :)
      integer(int32) k, l, m, n, a, b, p, mm, i, j, q

      type(ShapeFunction_) :: sf

      if (present(shapefunction)) then

         dim_num = this%nd()
         mm = this%nne()*2
         Psymat = ShapeFunction%dNdgzi
         Jmat = ShapeFunction%Jmat
         detJ = det_mat(Jmat, dim_num)

         if (dim_num == 2) then
            k = 3
         elseif (dim_num == 3) then
            k = 6
         else
            stop "B_mat >> dim_num = tobe 2 or 3 "
         end if

         ! J:Psymat�̌v�Z
         if (this%nd() == 2 .and. this%nne() == 4) then

            if (detJ == 0.0d0) stop "Bmat,detJ=0"
            Jin = inverse(Jmat)
            !Jin(1,1) = (1.0d0 / detJ) * Jmat(2,2)
            !Jin(2,2) = (1.0d0 / detJ) * Jmat(1,1)
            !Jin(1,2) = (-1.0d0 / detJ) * Jmat(1,2)
            !Jin(2,1) = (-1.0d0 / detJ) * Jmat(2,1)
            JPsy = matmul(Jin, Psymat)
            Bmat = zeros(3, 8)
            Bmat(1, 1) = JPsy(1, 1)
            Bmat(1, 2) = 0.0d0
            Bmat(1, 3) = JPsy(1, 2)
            Bmat(1, 4) = 0.0d0
            Bmat(1, 5) = JPsy(1, 3)
            Bmat(1, 6) = 0.0d0
            Bmat(1, 7) = JPsy(1, 4)
            Bmat(1, 8) = 0.0d0
            Bmat(2, 1) = 0.0d0
            Bmat(2, 2) = JPsy(2, 1)
            Bmat(2, 3) = 0.0d0
            Bmat(2, 4) = JPsy(2, 2)
            Bmat(2, 5) = 0.0d0
            Bmat(2, 6) = JPsy(2, 3)
            Bmat(2, 7) = 0.0d0
            Bmat(2, 8) = JPsy(2, 4)
            Bmat(3, 1) = Bmat(2, 2)
            Bmat(3, 2) = Bmat(1, 1)
            Bmat(3, 3) = Bmat(2, 4)
            Bmat(3, 4) = Bmat(1, 3)
            Bmat(3, 5) = Bmat(2, 6)
            Bmat(3, 6) = Bmat(1, 5)
            Bmat(3, 7) = Bmat(2, 8)
            Bmat(3, 8) = Bmat(1, 7)

         elseif (this%nd() == 2 .and. this%nne() == 8) then
            Jin = inverse(Jmat)
            JPsy(:, :) = matmul(Jin, Psymat)

            Bmat = zeros(3, 16)
            Bmat(1, 1) = -JPsy(1, 1)
            Bmat(1, 2) = 0.0d0
            Bmat(1, 3) = JPsy(1, 2)
            Bmat(1, 4) = 0.0d0
            Bmat(1, 5) = JPsy(1, 3)
            Bmat(1, 6) = 0.0d0
            Bmat(1, 7) = JPsy(1, 4)
            Bmat(1, 8) = 0.0d0
            Bmat(1, 9) = JPsy(1, 5)
            Bmat(1, 10) = 0.0d0
            Bmat(1, 11) = JPsy(1, 6)
            Bmat(1, 12) = 0.0d0
            Bmat(1, 13) = JPsy(1, 7)
            Bmat(1, 14) = 0.0d0
            Bmat(1, 15) = JPsy(1, 8)
            Bmat(1, 16) = 0.0d0
            Bmat(2, 1) = 0.0d0
            Bmat(2, 2) = JPsy(2, 1)
            Bmat(2, 3) = 0.0d0
            Bmat(2, 4) = JPsy(2, 2)
            Bmat(2, 5) = 0.0d0
            Bmat(2, 6) = JPsy(2, 3)
            Bmat(2, 7) = 0.0d0
            Bmat(2, 8) = JPsy(2, 4)
            Bmat(2, 9) = 0.0d0
            Bmat(2, 10) = JPsy(2, 5)
            Bmat(2, 11) = 0.0d0
            Bmat(2, 12) = JPsy(2, 6)
            Bmat(2, 13) = 0.0d0
            Bmat(2, 14) = JPsy(2, 7)
            Bmat(2, 15) = 0.0d0
            Bmat(2, 16) = JPsy(2, 8)
            Bmat(3, 1) = Bmat(2, 2)
            Bmat(3, 2) = Bmat(1, 1)
            Bmat(3, 3) = Bmat(2, 4)
            Bmat(3, 4) = Bmat(1, 3)
            Bmat(3, 5) = Bmat(2, 6)
            Bmat(3, 6) = Bmat(1, 5)
            Bmat(3, 7) = Bmat(2, 8)
            Bmat(3, 8) = Bmat(1, 7)
            Bmat(3, 9) = Bmat(2, 10)
            Bmat(3, 10) = Bmat(1, 9)
            Bmat(3, 11) = Bmat(2, 12)
            Bmat(3, 12) = Bmat(1, 11)
            Bmat(3, 13) = Bmat(2, 14)
            Bmat(3, 14) = Bmat(1, 13)
            Bmat(3, 15) = Bmat(2, 16)
            Bmat(3, 16) = Bmat(1, 15)
         elseif (this%nd() == 3) then

            if (detJ == 0.0d0) stop "Bmat,detJ=0"

            call inverse_rank_2(Jmat, Jin)

            JPsy = transpose(matmul(transpose(Psymat), Jin)) !dNdgzi* dgzidx
            Bmat = zeros(6, this%nne()*3)
            do q = 1, size(JPsy, 2) ! = nne
               do p = 1, dim_num
                  Bmat(p, dim_num*(q - 1) + p) = JPsy(p, q)
               end do
               
               Bmat(4, dim_num*(q - 1) + 1) = JPsy(2, q); 
               Bmat(4, dim_num*(q - 1) + 2) = JPsy(1, q); 
               Bmat(4, dim_num*(q - 1) + 3) = 0.0d0; 

               Bmat(5, dim_num*(q - 1) + 1) = 0.0d0; 
               Bmat(5, dim_num*(q - 1) + 2) = JPsy(3, q); 
               Bmat(5, dim_num*(q - 1) + 3) = JPsy(2, q); 

               Bmat(6, dim_num*(q - 1) + 1) = JPsy(3, q); 
               Bmat(6, dim_num*(q - 1) + 2) = 0.0d0; 
               Bmat(6, dim_num*(q - 1) + 3) = JPsy(1, q); 
            end do

            !Bmat(4:6,:)=0.50d0*Bmat(4:6,:)

         else
            stop "Bmat >> The element is not supported."
         end if

      else
         ! take sum for all gauss-points
         if (.not. present(ElementID)) then
            print *, "BmatrixFEMDOmain >> ERROR >> at least, arg:ElementID or arg:shapefunction is necessary."
            stop
         end if
         call sf%SetType(NumOfDim=this%nd(), NumOfNodePerElem=this%nne(), NumOfGp=this%mesh%getNumOfGp())

         do i = 1, sf%NumOfGp
            call getAllShapeFunc(sf, elem_id=ElementID, &
                                 nod_coord=this%Mesh%NodCoord, &
                                 elem_nod=this%Mesh%ElemNod, OptionalGpID=i)

            if (i == 1) then
               Bmat = this%Bmatrix(sf, ElementID)
            else
               Bmat = Bmat + this%Bmatrix(sf, ElementID)
            end if
         end do
         return

      end if
   end function
! ##########################################################################

   ! ##########################################################################
   recursive function WMatrixFEMDomain(this, shapefunction, ElementID) result(Wmat)
      class(FEMDomain_), intent(inout) :: this
      integer(int32), optional, intent(in) :: ElementID
      type(ShapeFunction_), optional, intent(in) :: shapefunction
      real(real64), allocatable :: Psymat(:, :), Jmat(:, :), detJ
      real(real64), allocatable :: Wmat(:, :)
      integer(int32)::dim_num
      real(real64), allocatable :: JPsy(:, :), Jin(:, :)
      integer(int32) k, l, m, n, a, b, p, mm, i, j, q

      type(ShapeFunction_) :: sf

      if (present(shapefunction)) then

         dim_num = this%nd()
         mm = this%nne()*2
         Psymat = ShapeFunction%dNdgzi
         Jmat = ShapeFunction%Jmat
         detJ = det_mat(Jmat, dim_num)

         if (dim_num == 2) then
            k = 3
         elseif (dim_num == 3) then
            k = 6
         else
            stop "B_mat >> dim_num = tobe 2 or 3 "
         end if

         ! J:Psymat�̌v�Z
         if (this%nd() == 2 .and. this%nne() == 4) then

            if (detJ == 0.0d0) stop "Wmat,detJ=0"
            Jin = inverse(Jmat)
            !Jin(1,1) = (1.0d0 / detJ) * Jmat(2,2)
            !Jin(2,2) = (1.0d0 / detJ) * Jmat(1,1)
            !Jin(1,2) = (-1.0d0 / detJ) * Jmat(1,2)
            !Jin(2,1) = (-1.0d0 / detJ) * Jmat(2,1)
            JPsy = matmul(Jin, Psymat)
            Wmat = zeros(3, 8)
            Wmat(1, 1) = 0.0d0 !JPsy(1, 1) ! dN_{1}/dx_{1}
            Wmat(1, 2) = 0.0d0
            Wmat(1, 3) = 0.0d0 !JPsy(1, 2) ! dN_{2}/dx_{1}
            Wmat(1, 4) = 0.0d0
            Wmat(1, 5) = 0.0d0 !JPsy(1, 3) ! dN_{3}/dx_{1}
            Wmat(1, 6) = 0.0d0
            Wmat(1, 7) = 0.0d0 !JPsy(1, 4) ! dN_{4}/dx_{1}
            Wmat(1, 8) = 0.0d0
            Wmat(2, 1) = 0.0d0
            Wmat(2, 2) = 0.0d0 !JPsy(2, 1) ! dN_{1}/dx_{2}
            Wmat(2, 3) = 0.0d0
            Wmat(2, 4) = 0.0d0 !JPsy(2, 2) ! dN_{2}/dx_{2}
            Wmat(2, 5) = 0.0d0
            Wmat(2, 6) = 0.0d0 !JPsy(2, 3) ! dN_{3}/dx_{2}
            Wmat(2, 7) = 0.0d0
            Wmat(2, 8) = 0.0d0 !JPsy(2, 4) ! dN_{4}/dx_{2}
            Wmat(3, 1) = - JPsy(2, 1) ! Wmat(2, 2) ! - dN_{1}/dx_{2}
            Wmat(3, 2) =   JPsy(1, 1) ! Wmat(1, 1) !   dN_{1}/dx_{1}
            Wmat(3, 3) = - JPsy(2, 2) ! Wmat(2, 4) ! - dN_{2}/dx_{2}
            Wmat(3, 4) =   JPsy(1, 2) ! Wmat(1, 3) !   dN_{2}/dx_{1}
            Wmat(3, 5) = - JPsy(2, 3) ! Wmat(2, 6) ! - dN_{3}/dx_{2}
            Wmat(3, 6) =   JPsy(1, 3) ! Wmat(1, 5) !   dN_{3}/dx_{1}
            Wmat(3, 7) = - JPsy(2, 4) ! Wmat(2, 8) ! - dN_{4}/dx_{2}
            Wmat(3, 8) =   JPsy(1, 4) ! Wmat(1, 7) !   dN_{4}/dx_{1}

            Wmat(:,:) = 1.0d0/2.0d0*Wmat(:,:)

         elseif (this%nd() == 2 .and. this%nne() == 8) then
            Jin = inverse(Jmat)
            JPsy(:, :) = matmul(Jin, Psymat)

            Wmat = zeros(3, 16)
            Wmat(1, 1 ) = 0.0d0 ! -JPsy(1, 1)
            Wmat(1, 2 ) = 0.0d0 ! 0.0d0
            Wmat(1, 3 ) = 0.0d0 ! JPsy(1, 2)
            Wmat(1, 4 ) = 0.0d0 ! 0.0d0
            Wmat(1, 5 ) = 0.0d0 ! JPsy(1, 3)
            Wmat(1, 6 ) = 0.0d0 ! 0.0d0
            Wmat(1, 7 ) = 0.0d0 ! JPsy(1, 4)
            Wmat(1, 8 ) = 0.0d0 ! 0.0d0
            Wmat(1, 9 ) = 0.0d0 ! JPsy(1, 5)
            Wmat(1, 10) = 0.0d0 ! 0.0d0
            Wmat(1, 11) = 0.0d0 ! JPsy(1, 6)
            Wmat(1, 12) = 0.0d0 ! 0.0d0
            Wmat(1, 13) = 0.0d0 ! JPsy(1, 7)
            Wmat(1, 14) = 0.0d0 ! 0.0d0
            Wmat(1, 15) = 0.0d0 ! JPsy(1, 8)
            Wmat(1, 16) = 0.0d0 ! 0.0d0
            Wmat(2, 1)  = 0.0d0 ! 0.0d0
            Wmat(2, 2)  = 0.0d0 ! JPsy(2, 1)
            Wmat(2, 3)  = 0.0d0 ! 0.0d0
            Wmat(2, 4)  = 0.0d0 ! JPsy(2, 2)
            Wmat(2, 5)  = 0.0d0 ! 0.0d0
            Wmat(2, 6)  = 0.0d0 ! JPsy(2, 3)
            Wmat(2, 7)  = 0.0d0 ! 0.0d0
            Wmat(2, 8)  = 0.0d0 ! JPsy(2, 4)
            Wmat(2, 9)  = 0.0d0 ! 0.0d0
            Wmat(2, 10) = 0.0d0 ! JPsy(2, 5)
            Wmat(2, 11) = 0.0d0 ! 0.0d0
            Wmat(2, 12) = 0.0d0 ! JPsy(2, 6)
            Wmat(2, 13) = 0.0d0 ! 0.0d0
            Wmat(2, 14) = 0.0d0 ! JPsy(2, 7)
            Wmat(2, 15) = 0.0d0 ! 0.0d0
            Wmat(2, 16) = 0.0d0 ! JPsy(2, 8)
            Wmat(3, 1)  = - JPsy( 2, 1 ) ! Wmat(2, 2)
            Wmat(3, 2)  =   JPsy( 1, 1 ) ! Wmat(1, 1)
            Wmat(3, 3)  = - JPsy( 2, 2 ) ! Wmat(2, 4)
            Wmat(3, 4)  =   JPsy( 1, 2 ) ! Wmat(1, 3)
            Wmat(3, 5)  = - JPsy( 2, 3 ) ! Wmat(2, 6)
            Wmat(3, 6)  =   JPsy( 1, 3 ) ! Wmat(1, 5)
            Wmat(3, 7)  = - JPsy( 2, 4 ) ! Wmat(2, 8)
            Wmat(3, 8)  =   JPsy( 1, 4 ) ! Wmat(1, 7)
            Wmat(3, 9)  = - JPsy( 2, 5 ) ! Wmat(2, 10)
            Wmat(3, 10) =   JPsy( 1, 5 ) ! Wmat(1, 9)
            Wmat(3, 11) = - JPsy( 2, 6) ! Wmat(2, 12)
            Wmat(3, 12) =   JPsy( 1, 6) ! Wmat(1, 11)
            Wmat(3, 13) = - JPsy( 2, 7) ! Wmat(2, 14)
            Wmat(3, 14) =   JPsy( 1, 7) ! Wmat(1, 13)
            Wmat(3, 15) = - JPsy( 2, 8) ! Wmat(2, 16)
            Wmat(3, 16) =   JPsy( 1, 8) ! Wmat(1, 15)

            Wmat(:,: ) = 1.0d0/2.0d0*Wmat(:,:)
         elseif (this%nd() == 3) then

            if (detJ == 0.0d0) stop "Wmat,detJ=0"

            call inverse_rank_2(Jmat, Jin)

            JPsy = transpose(matmul(transpose(Psymat), Jin)) !dNdgzi* dgzidx
            Wmat = zeros(6, this%nne()*3)
            do q = 1, size(JPsy, 2)
               do p = 1, dim_num
                  Wmat(p, dim_num*(q - 1) + p) = 0.0d0 ! JPsy(p, q)
               end do
               Wmat(4, dim_num*(q - 1) + 1) = - JPsy(2, q); ! JPsy(2, q); 
               Wmat(4, dim_num*(q - 1) + 2) =   JPsy(1, q); ! JPsy(1, q); 
               Wmat(4, dim_num*(q - 1) + 3) =   0.0d0;      ! 0.0d0;     
               Wmat(5, dim_num*(q - 1) + 1) =   0.0d0;      ! 0.0d0;     
               Wmat(5, dim_num*(q - 1) + 2) = - JPsy(3, q); ! JPsy(3, q); 
               Wmat(5, dim_num*(q - 1) + 3) =   JPsy(2, q); ! JPsy(2, q); 
               Wmat(6, dim_num*(q - 1) + 1) =   JPsy(3, q); ! JPsy(3, q); 
               Wmat(6, dim_num*(q - 1) + 2) =   0.0d0;      ! 0.0d0;     
               Wmat(6, dim_num*(q - 1) + 3) = - JPsy(1, q); ! JPsy(1, q); 
            end do

            Wmat(:,:) = 1.0d0/2.0d0*Wmat(:,:)
            !Wmat(4:6,:)=0.50d0*Wmat(4:6,:)

         else
            stop "Wmat >> The element is not supported."
         end if

      else
         ! take sum for all gauss-points
         if (.not. present(ElementID)) then
            print *, "BmatrixFEMDOmain >> ERROR >> at least, arg:ElementID or arg:shapefunction is necessary."
            stop
         end if
         call sf%SetType(NumOfDim=this%nd(), NumOfNodePerElem=this%nne(), NumOfGp=this%mesh%getNumOfGp())

         do i = 1, sf%NumOfGp
            call getAllShapeFunc(sf, elem_id=ElementID, &
                                 nod_coord=this%Mesh%NodCoord, &
                                 elem_nod=this%Mesh%ElemNod, OptionalGpID=i)

            if (i == 1) then
               Wmat = this%Wmatrix(sf, ElementID)
            else
               Wmat = Wmat + this%Wmatrix(sf, ElementID)
            end if
         end do
         return

      end if
   end function
! ##########################################################################


   ! ##########################################################################
   recursive function LMatrixFEMDomain(this, shapefunction, ElementID) result(Lmat)
      class(FEMDomain_), intent(inout) :: this
      integer(int32), optional, intent(in) :: ElementID
      type(ShapeFunction_), optional, intent(in) :: shapefunction
      real(real64), allocatable :: Psymat(:, :), Jmat(:, :), detJ
      real(real64), allocatable :: Lmat(:, :)
      integer(int32)::dim_num
      real(real64), allocatable :: JPsy(:, :), Jin(:, :)
      integer(int32) k, l, m, n, a, b, p, mm, i, j, q, r

      type(ShapeFunction_) :: sf

      if (present(shapefunction)) then

         dim_num = this%nd()
         mm = this%nne()*2
         Psymat = ShapeFunction%dNdgzi
         Jmat = ShapeFunction%Jmat
         detJ = det_mat(Jmat, dim_num)

         if (detJ == 0.0d0) stop "Lmat,detJ=0"
         call inverse_rank_2(Jmat, Jin)
         JPsy = transpose(matmul(transpose(Psymat), Jin)) !dNdgzi* dgzidx
         Lmat = zeros(9, this%nne()*3)
         ! \cfrac{\partial v_1}{\partial x_1}
         ! \cfrac{\partial v_1}{\partial x_2}
         ! \cfrac{\partial v_1}{\partial x_3}
         ! \cfrac{\partial v_2}{\partial x_1}
         ! \cfrac{\partial v_2}{\partial x_2}
         ! \cfrac{\partial v_2}{\partial x_3}
         ! \cfrac{\partial v_3}{\partial x_1}
         ! \cfrac{\partial v_3}{\partial x_2}
         ! \cfrac{\partial v_3}{\partial x_3}
         do q = 1, size(JPsy, 2) ! q: Shape function iterator
            do p = 1, dim_num    ! p: Dimension iterator
               do r=1, dim_num   
                  Lmat( dim_num*(p-1) + r, dim_num*(q - 1) + p) = JPsy(r, q) ! JPsy(p, q)
               enddo
            end do
         end do
      else
         ! take sum for all gauss-points
         if (.not. present(ElementID)) then
            print *, "BmatrixFEMDOmain >> ERROR >> at least, arg:ElementID or arg:shapefunction is necessary."
            stop
         end if
         call sf%SetType(NumOfDim=this%nd(), NumOfNodePerElem=this%nne(), NumOfGp=this%mesh%getNumOfGp())

         do i = 1, sf%NumOfGp
            call getAllShapeFunc(sf, elem_id=ElementID, &
                                 nod_coord=this%Mesh%NodCoord, &
                                 elem_nod=this%Mesh%ElemNod, OptionalGpID=i)

            if (i == 1) then
               Lmat = this%Lmatrix(sf, ElementID)
            else
               Lmat = Lmat + this%Lmatrix(sf, ElementID)
            end if
         end do
         return

      end if
   end function
! ##########################################################################

   function DiffusionMatrix_as_CRS_FEMDomain(this, Coefficient, omp) result(DiffusionMatrix)
      class(FEMDomain_), intent(inout) :: this
      real(real64), intent(in) :: Coefficient(:)
      type(CRS_) :: DiffusionMatrix
      type(COO_) :: COO
      logical, optional, intent(in) :: omp
      integer(int32) :: ElementID, LocElemID_1, LocElemID_2, nodeid_1, nodeid_2, i, col_id
      real(real64), allocatable :: val(:)
      real(real64), allocatable :: eDiffMat(:, :)

      if (present(omp)) then
         if (.not. omp) then
            call COO%init(this%nn())
            do ElementID = 1, this%ne()
               eDiffMat = this%DiffusionMatrix( &
                          ElementID=ElementID, &
                          D=coefficient(ElementID) &
                          )
               do LocElemID_1 = 1, this%nne()
                  do LocElemID_2 = 1, this%nne()
                     nodeid_1 = this%mesh%elemnod(ElementID, LocElemID_1)
                     nodeid_2 = this%mesh%elemnod(ElementID, LocElemID_2)
                     call COO%add(nodeid_1, nodeid_2, eDiffMat(LocElemID_1, LocElemID_2))
                  end do
               end do
            end do
            DiffusionMatrix = COO%to_CRS()
            return
         end if
      end if

      ! parallelized

      DiffusionMatrix = this%ZeroMatrix(DOF=1)
      val = DiffusionMatrix%val
      !$OMP parallel do private(eDiffMat,LocElemID_1,LocElemID_2,nodeid_1,nodeid_2,col_id,i) reduction(+:val)
      do ElementID = 1, this%ne()
         eDiffMat = this%DiffusionMatrix( &
                    ElementID=ElementID, &
                    D=coefficient(ElementID) &
                    )
         do LocElemID_1 = 1, this%nne()
            do LocElemID_2 = 1, this%nne()
               nodeid_1 = this%mesh%elemnod(ElementID, LocElemID_1)
               nodeid_2 = this%mesh%elemnod(ElementID, LocElemID_2)
               ! COO%add
               do i = DiffusionMatrix%row_ptr(nodeid_1), DiffusionMatrix%row_ptr(nodeid_1 + 1) - 1
                  if (DiffusionMatrix%col_idx(i) == nodeid_2) then
                     val(i) = val(i) + eDiffMat(LocElemID_1, LocElemID_2)
                     exit
                  end if
               end do
            end do
         end do
      end do
      !$OMP end parallel do
      DiffusionMatrix%val = val

   end function

! ##########################################################################
   function DiffusionMatrixFEMDomain(this, ElementID, D) result(DiffusionMatrix)
      ! 拡散係数マトリクス
      ! For Element ID = ElementID, create Diffusion Matrix
      ! in terms of small-strain and return it
      ! Number of Gauss Point = number of node per element, as default.
      class(FEMDomain_), intent(inout) :: this
      type(ShapeFunction_) :: shapefunc
      integer(int32), intent(in) :: ElementID
      real(real64), optional, intent(in) :: D ! diffusion matrix
      real(real64)::diff_coeff
      real(real64)::        err = dble(1.0e-14)
      real(real64), allocatable :: DiffusionMatrix(:, :)
      integeR(int32) :: i, j, n

      diff_coeff = input(default=1.0d0, option=D)
      ! For Element ID = ElementID, create Mass Matrix and return it
      ! Number of Gauss Point = number of node per element, as default.

      ! initialize shape-function object
      !this%ShapeFunction%ElemType=this%Mesh%ElemType

      call shapefunc%SetType(NumOfDim=this%nd(), NumOfNodePerElem=this%nne(), NumOfGp=this%mesh%getNumOfGp())

      do i = 1, shapefunc%NumOfGp
         call getAllShapeFunc(shapefunc, elem_id=ElementID, &
                              nod_coord=this%Mesh%NodCoord, &
                              elem_nod=this%Mesh%ElemNod, OptionalGpID=i)

         n = size(shapefunc%dNdgzi, 2)
         if (.not. allocated(DiffusionMatrix)) then
            allocate (DiffusionMatrix(n, n))
            DiffusionMatrix(:, :) = 0.0d0
         end if

         if (size(DiffusionMatrix, 1) /= n .or. size(DiffusionMatrix, 2) /= n) then
            if (allocated(DiffusionMatrix)) then
               deallocate (DiffusionMatrix)
            end if
            allocate (DiffusionMatrix(n, n))
         end if

         if (det_mat(shapefunc%Jmat, size(shapefunc%Jmat, 1)) < 0.0d0) then
            print *, "STOP DiffusionMatrixFEMDomain>>mesh is inversed!"
         end if
         DiffusionMatrix(:, :) = DiffusionMatrix(:, :) + &
                                 matmul(transpose(matmul(shapefunc%JmatInv, shapefunc%dNdgzi)), &
                                        matmul(shapefunc%JmatInv, shapefunc%dNdgzi)) &
                                 *diff_coeff &
                                 *det_mat(shapefunc%Jmat, size(shapefunc%Jmat, 1))! it was JmatInv, but should be Jmat, revised @ 20221201

         !DiffusionMatrix(:,:)=DiffusionMatrix(:,:)+&
         !matmul( transpose(shapefunc%dNdgzi),&
         !shapefunc%dNdgzi)&
         !*diff_coeff &
         !*det_mat(shapefunc%Jmatinv,size(shapefunc%Jmatinv,1) )! it was JmatInv, but should be Jmat, revised @ 20221201
      end do

      ! if Rounding error >> fix 0
      do i = 1, size(DiffusionMatrix, 1)
         do j = 1, size(DiffusionMatrix, 1)
            if (abs(DiffusionMatrix(i, j)) < err*abs(maxval(DiffusionMatrix))) then
               DiffusionMatrix(i, j) = 0.0d0
            end if
         end do
      end do
   end function
! ##########################################################################

! ##########################################################################
!function GradMatrixFEMDomain(this,ElementID,DOF) result(GradMatrix)
!        ! This matrix G_{A B}
!
!        ! \int_{\omega_e} N_A \frac{\partial N_B}{\partial x_i} d \Omega_e
!        ! \int_{\omega_e} N_A  d N_B/d xi  (d xi/d x) det(d x/d Xi) d \Xi
!
!        class(FEMDomain_),intent(inout) :: this
!        type(ShapeFunction_) :: shapefunc
!        integer(int32),intent(in) :: ElementID,DOF
!
!        real(real64)::        err = dble(1.0e-14)
!        real(real64),allocatable :: GradMatrix(:,:)
!        integeR(int32) :: i,j,n
!
!        ! For Element ID = ElementID, create Mass Matrix and return it
!        ! Number of Gauss Point = number of node per element, as default.
!
!        ! initialize shape-function object
!    !this%ShapeFunction%ElemType=this%Mesh%ElemType
!
!        call shapefunc%SetType(NumOfDim=this%nd(),NumOfNodePerElem=this%nne() ,NumOfGp=this%mesh%getNumOfGp())
!        n = this%nne()
!        GradMatrix = zeros(n,n*DOF)
!        do i=1, shapefunc%NumOfGp
!                call getAllShapeFunc(shapefunc,elem_id=ElementID,&
!                nod_coord=this%Mesh%NodCoord,&
!                elem_nod=this%Mesh%ElemNod,OptionalGpID=i)
!
!            n=size(shapefunc%dNdgzi,2)
!
!            GradMatrix(:,:)=GradMatrix(:,:)+&
!                matmul( transpose(matmul(shapefunc%JmatInv,shapefunc%dNdgzi)),&
!                )&
!                *det_mat(shapefunc%Jmat,size(shapefunc%Jmat,1) )
!
!        enddo
!
!        ! if Rounding error >> fix 0
!        do i=1,size(GradMatrix,1)
!                do j=1,size(GradMatrix,1)
!                        if(abs(GradMatrix(i,j)) < err*abs(maxval(GradMatrix)))then
!                                GradMatrix(i,j) = 0.0d0
!                        endif
!                enddo
!        enddo
!end function
! ##########################################################################

! ##########################################################################
   function ElementVectorFEMDomain(this, ElementID, GlobalVector, DOF) result(ElementVector)
      class(FEMDomain_), intent(inout) :: this
      integer(int32), intent(in) :: ElementID
      real(real64), intent(in) :: GlobalVector(:) ! size = number_of_node
      real(real64), allocatable :: ElementVector(:)
      integer(int32), optional, intent(in) :: DOF
      integer(int32) :: i, j, num_node_per_elem, num_dim, nodal_DOF, node_id

      ! For Element ID = ElementID, create ElementVector and return it
      ! Number of Gauss Point = number of node per element, as default.
      num_node_per_elem = this%nne()
      nodal_DOF = input(default=1, option=DOF)
      allocate (ElementVector(num_node_per_elem*nodal_DOF))
      ElementVector(:) = 0.0d0

      ! (x1, y1, z1, x2, y2, z2 ...)
      do i = 1, num_node_per_elem
         do j = 1, nodal_DOF
            node_id = this%mesh%elemnod(ElementID, i)
            ElementVector((i - 1)*nodal_DOF + j) = &
               GlobalVector((node_id - 1)*nodal_DOF + j)
         end do
      end do

   end function
! ##########################################################################

! ##########################################################################
   subroutine GlobalVectorFEMDomain(this, ElementID, ElementVector, DOF, Replace, Reset, GlobalVector)
      class(FEMDomain_), intent(inout) :: this
      integer(int32), intent(in) :: ElementID
      real(real64), intent(in) :: ElementVector(:)
      real(real64), allocatable, intent(inout) :: GlobalVector(:)! size = number_of_node*DOF
      integer(int32), optional, intent(in) :: DOF
      logical, optional, intent(in) :: Replace, Reset
      integer(int32) :: i, j, k, num_node_per_elem, num_dim, nodal_DOF, node_id

      ! For Element ID = ElementID, create ElementVector and return it
      ! Number of Gauss Point = number of node per element, as default.

      num_node_per_elem = this%nne()
      nodal_DOF = input(default=1, option=DOF)

      if (.not. allocated(GlobalVector)) then
         GlobalVector = zeros(this%nn()*nodal_DOF)
      end if

      if (present(Replace)) then
         if (Replace) then
            GlobalVector = zeros(this%nn()*nodal_DOF)
         end if
      end if

      if (present(Reset)) then
         if (Reset) then
            GlobalVector = zeros(this%nn()*nodal_DOF)
         end if
      end if

      do j = 1, this%nne() ! NNE : Number of Node per Element
         do k = 1, nodal_DOF
            GlobalVector((this%NodeID(ElementID, j) - 1)*nodal_DOF + k) = &
               ElementVector((j - 1)*nodal_DOF + k)
         end do
      end do

   end subroutine
! ##########################################################################

! ##########################################################################
   function connectivityFEMDomain(this, ElementID) result(ret)
      class(FEMDomain_), intent(in) :: this
      integer(int32), intent(in) :: ElementID
      integer(int32), allocatable :: ret(:)

      allocate (ret(size(this%mesh%elemnod, 2)))
      ret(:) = this%mesh%elemnod(ElementID, :)

   end function
! ##########################################################################

! ##########################################################################
   function allconnectivityFEMDomain(this) result(ret)
      class(FEMDomain_), intent(in) :: this
      integer(int32), allocatable :: ret(:, :)

      ret = this%mesh%elemnod(:, :)

   end function
! ##########################################################################

   function selectFEMDomain(this, x_min, x_max, y_min, y_max, z_min, z_max, center, radius_range) result(NodeList)
      class(FEMDomain_), intent(in) :: this
      real(real64), optional, intent(in) :: x_min, x_max, y_min, y_max, z_min, z_max, center(:), radius_range(1:2)
      real(real64) :: x(3), xmax(3), xmin(3), r
      integer(int32), allocatable :: NodeList(:), CheckList(:)
      logical :: InOut
      integer(int32) :: i, j, n

      CheckList = int(zeros(this%nn()))
      xmin(1) = input(default=dble(-1.0e14), option=x_min)
      xmin(2) = input(default=dble(-1.0e14), option=y_min)
      xmin(3) = input(default=dble(-1.0e14), option=z_min)

      xmax(1) = input(default=dble(1.0e14), option=x_max)
      xmax(2) = input(default=dble(1.0e14), option=y_max)
      xmax(3) = input(default=dble(1.0e14), option=z_max)

      n = 0

      do i = 1, this%nn()
         x(:) = this%mesh%nodcoord(i, :)

         if (present(center) .and. present(radius_range)) then
            if (size(center) == 2) then
               !cylindrical
               r = norm(x(1:2) - center(1:2))
               if (radius_range(1) <= r .and. r <= radius_range(2)) then
                  if (xmin(3) <= x(3) .and. x(3) <= xmax(3)) then
                     CheckList(i) = 1
                  end if
               end if
            else
               !spherical
               r = norm(x - center)
               r = norm(x(1:2) - center(1:2))
               if (radius_range(1) <= r .and. r <= radius_range(2)) then
                  CheckList(i) = 1
               end if
            end if
         else
            InOut = InOrOut(x=x, xmax=xmax, xmin=xmin, DimNum=this%nd())
            if (InOut) then
               ! inside
               CheckList(i) = 1
               !n=n+1
            end if
         end if
      end do
      n = sum(CheckList)

      NodeList = int(zeros(n))

      if (n == 0) return

      n = 0
      do i = 1, size(CheckList)
         if (CheckList(i) == 1) then
            n = n + 1
            NodeList(n) = i
         end if
      end do

   end function
! ##########################################################################

! ##########################################################################
   function NodeIDFEMDomain(this, ElementID, LocalNodeID) result(NodeID)
      class(FEMDomain_), intent(inout) :: this
      integer(int32), intent(in) :: ElementID, LocalNodeID
      integer(int32) :: NodeID

      NodeID = this%mesh%elemnod(ElementID, LocalNodeID)

   end function
! ##########################################################################

   subroutine killElementFEMDomain(this, blacklist, flag)
      class(FEMDomain_), intent(inout) :: this
      real(real64), allocatable :: new_nod_coord(:, :)
      integer(int32), allocatable :: elemnod_old(:, :), non_remove_node(:), new_node_id(:)
      integer(int32), optional, intent(in) :: blacklist(:), flag

      integer(int32) :: i, J, n, m, k
      logical :: survive

      ! if(blacklist(i) == flag ) => kill ethe element
      elemnod_old = this%mesh%elemnod

      m = size(this%mesh%elemnod, 2)
      k = size(this%mesh%elemnod, 1)

      if (size(blacklist) /= k) then
         print *, "ERROR :: killElementFEMDomain >> should be size(blacklist)==k"
         return
      end if

      n = 0
      do i = 1, size(blacklist)
         if (blacklist(i) == flag) then
            n = n + 1
         end if
      end do

      if (n == 0) then
         return
      end if

      deallocate (this%mesh%elemnod)
      allocate (this%mesh%elemnod(k - n, m))
      this%mesh%elemnod(:, :) = 0
      n = 0
      do i = 1, size(elemnod_old, 1)

         if (blacklist(i) == flag) then
            cycle
         else
            n = n + 1
            this%mesh%elemnod(n, :) = elemnod_old(i, :)
         end if
      end do

      ! if there are uncounted nodes, kill nodes
      non_remove_node = zeros(this%nn())
      new_node_id = zeros(this%nn())
      do i = 1, this%ne()
         do j = 1, this%nne()
            non_remove_node(this%mesh%elemnod(i, j)) = 1
         end do
      end do

      if (non_remove_node(1) == 1) then
         new_node_id(1) = 1
      else
         new_node_id(1) = 0
      end if

      do i = 2, this%nn()
         new_node_id(i) = new_node_id(i - 1) + non_remove_node(i)
      end do

      new_nod_coord = zeros(sum(non_remove_node), this%nd())
      j = 0
      do i = 1, size(new_node_id)
         if (non_remove_node(i) == 1) then
            j = j + 1
            new_nod_coord(j, :) = this%mesh%nodcoord(i, :)
         end if
      end do

      do i = 1, this%ne()
         do j = 1, this%nne()
            this%mesh%elemnod(i, j) = new_node_id(this%mesh%elemnod(i, j))
         end do
      end do
      this%mesh%nodcoord = new_nod_coord

   end subroutine
! ###################################################################

! ###################################################################
   function ConnectMatrixFEMDomain(this, position, DOF, shapefunction, strict) result(connectMatrix)
      class(FEMDomain_), intent(inout) :: this
      type(ShapeFunction_), optional, intent(in) :: shapefunction
      type(ShapeFunction_) :: sobj
      real(real64), intent(in) :: position(:)
      integer(int32), intent(in) :: DOF
      logical, optional, intent(in) :: strict
      real(real64), allocatable :: connectMatrix(:, :), cm_DOF1(:, :), Rcvec(:), Bc(:, :)
      integer(int32) :: i, j, n

      if (present(shapefunction)) then
         ! Gauss-Point Projection
         ! shapefunction=domain1: for 1 gauss point
         ! obj = domain#2, nodes
         ! sobj = domain#2, shape function
         ! position : domain#1 gauss point

         !

         ! domain#2
         sobj = this%getShapeFunction(position=position)

         n = (this%nne() + size(shapefunction%nmat, 1))*DOF

         if (sobj%elementid == -1) then
            ! no contact
            connectMatrix = zeros(n, n)
            return
         end if

         Bc = zeros(DOF, n)

         !do i=1,DOF
         !        BC(i,i) = 1.0d0
         !enddo

         !allocate(Rcvec(n) )
         ! <    Domain #1    > <    Domain #2    >
         ! (N1 0  0 N2 0  0 ... -N1 0  0 -N2 0  0 ...   )
         ! (0  N1 0 0  N2 0 ... 0  -N1 0 0  -N2 0 ...   )
         ! (0  0 N1 0  0 N2 ... 0  0 -N1 0  0 -N2 ...   )
         if (present(strict)) then
            if (strict) then
               if (maxval(shapefunction%nmat(:)) > 1.0d0 .or. minval(shapefunction%nmat(:)) < -1.0d0) then
                  print *, "connectMatrix ERROR :::strict shape function is out of range"
                  stop
               end if
            end if
         end if

         if (present(strict)) then
            if (strict) then
               if (maxval(sobj%nmat(:)) > 1.0d0 .or. minval(sobj%nmat(:)) < -1.0d0) then
                  print *, "connectMatrix ERROR :::strict shape function is out of range"
                  stop
               end if
            end if
         end if

         ! \epsilon \int_{x_e} Bc^T Bc detJ d x_e = 0
         do i = 1, size(shapefunction%nmat)
            do j = 1, DOF
               Bc(j, (i - 1)*DOF + j) = Bc(j, (i - 1)*DOF + j) + shapefunction%nmat(i)
            end do
         end do

         do i = 1, size(sobj%nmat)
            do j = 1, DOF
               Bc(j, size(shapefunction%nmat)*DOF + (i - 1)*DOF + j) = &
                  Bc(j, size(shapefunction%nmat)*DOF + (i - 1)*DOF + j) - sobj%nmat(i)
            end do
         end do
         !print *, "position"
         !print *, position
         !print *, "shapefunction #1"
         !print *,shapefunction%nmat(:)
         !call print(shapefunction%ElemCoord)
         !call print(matmul(transpose(shapefunction%ElemCoord),shapefunction%nmat))

         !print *, "sobj #2"
         !print *,sobj%nmat(:)
         !call print(sobj%ElemCoord)
         !call print(matmul(transpose(sobj%ElemCoord),sobj%nmat))

         connectMatrix = matmul(transpose(Bc), Bc)*shapefunction%detJ

         return

      else
         ! P2P
         sobj = this%getShapeFunction(position=position)
         n = (this%nne() + 1)*DOF

         if (sobj%elementid == -1) then
            ! no contact
            connectMatrix = zeros(n, n)
            return
         end if

         n = (size(sobj%nmat) + 1)*DOF
         Bc = zeros(DOF, n)
         do i = 1, DOF
            BC(i, i) = 1.0d0
         end do
         !allocate(Rcvec(n) )
         !Rcvec(1:DOF) = 1.0d0
         do i = 1, size(sobj%nmat)
            do j = 1, DOF
               !Rcvec(DOF+ (i-1)*DOF + j) = - sobj%nmat(i)
               Bc(j, i*DOF + j) = -sobj%nmat(i)
            end do
         end do
         connectMatrix = matmul(transpose(Bc), Bc)
         return
      end if

   end function
! ##################################################################

! ###################################################################
   function ConnectVectorFEMDomain(this, position, DOF, shapefunction, strict) result(Connectvector)
      class(FEMDomain_), intent(inout) :: this
      type(ShapeFunction_), optional, intent(in) :: shapefunction
      type(ShapeFunction_) :: sobj
      real(real64), intent(in) :: position(:)
      integer(int32), intent(in) :: DOF
      logical, optional, intent(in) :: strict
      real(real64), allocatable :: Connectvector(:), cm_DOF1(:, :), Rcvec(:), Bc(:, :)
      integer(int32) :: i, j, n

      if (present(shapefunction)) then
         ! Gauss-Point Projection
         ! shapefunction=domain1: for 1 gauss point
         ! obj = domain#2, nodes
         ! sobj = domain#2, shape function
         ! position : domain#1 gauss point

         !

         ! domain#2
         sobj = this%getShapeFunction(position=position)

         n = (this%nne() + size(shapefunction%nmat, 1))*DOF

         if (sobj%elementid == -1) then
            ! no contact
            Connectvector = zeros(n)
            return
         end if

         Bc = zeros(DOF, n)

         !do i=1,DOF
         !        BC(i,i) = 1.0d0
         !enddo

         !allocate(Rcvec(n) )
         ! <    Domain #1    > <    Domain #2    >
         ! (N1 0  0 N2 0  0 ... -N1 0  0 -N2 0  0 ...   )
         ! (0  N1 0 0  N2 0 ... 0  -N1 0 0  -N2 0 ...   )
         ! (0  0 N1 0  0 N2 ... 0  0 -N1 0  0 -N2 ...   )
         if (present(strict)) then
            if (strict) then
               if (maxval(shapefunction%nmat(:)) > 1.0d0 .or. minval(shapefunction%nmat(:)) < -1.0d0) then
                  print *, "Connectvector ERROR :::strict shape function is out of range"
                  stop
               end if
            end if
         end if

         if (present(strict)) then
            if (strict) then
               if (maxval(sobj%nmat(:)) > 1.0d0 .or. minval(sobj%nmat(:)) < -1.0d0) then
                  print *, "Connectvector ERROR :::strict shape function is out of range"
                  stop
               end if
            end if
         end if

         ! \epsilon \int_{x_e} Bc^T Bc detJ d x_e = 0
         do i = 1, size(shapefunction%nmat)
            do j = 1, DOF
               Bc(j, (i - 1)*DOF + j) = Bc(j, (i - 1)*DOF + j) + shapefunction%nmat(i)
            end do
         end do

         do i = 1, size(sobj%nmat)
            do j = 1, DOF
               Bc(j, size(shapefunction%nmat)*DOF + (i - 1)*DOF + j) = &
                  Bc(j, size(shapefunction%nmat)*DOF + (i - 1)*DOF + j) - sobj%nmat(i)
            end do
         end do
         !print *, "position"
         !print *, position
         !print *, "shapefunction #1"
         !print *,shapefunction%nmat(:)
         !call print(shapefunction%ElemCoord)
         !call print(matmul(transpose(shapefunction%ElemCoord),shapefunction%nmat))

         !print *, "sobj #2"
         !print *,sobj%nmat(:)
         !call print(sobj%ElemCoord)
         !call print(matmul(transpose(sobj%ElemCoord),sobj%nmat))

         Connectvector = reshape(Bc, [size(Bc, 1)*size(Bc, 2)])*shapefunction%detJ

         return

      else
         ! P2P
         sobj = this%getShapeFunction(position=position)
         n = (this%nne() + 1)*DOF

         if (sobj%elementid == -1) then
            ! no contact
            Connectvector = zeros(n)
            return
         end if

         n = (size(sobj%nmat) + 1)*DOF
         Bc = zeros(DOF, n)
         do i = 1, DOF
            BC(i, i) = 1.0d0
         end do
         !allocate(Rcvec(n) )
         !Rcvec(1:DOF) = 1.0d0
         do i = 1, size(sobj%nmat)
            do j = 1, DOF
               !Rcvec(DOF+ (i-1)*DOF + j) = - sobj%nmat(i)
               Bc(j, i*DOF + j) = -sobj%nmat(i)
            end do
         end do
         Connectvector = reshape(Bc, [size(Bc, 1)*size(Bc, 2)])
         return
      end if

   end function
! ##################################################################

! ##################################################################
   subroutine ImportVTKFileFEMDomain(this, name)
      class(FEMDomain_), intent(inout) :: this
      character(*), intent(in) :: name
      type(IO_) :: f
      character(len=:), allocatable :: fullname, line, fieldname
      integer(int32) :: i, j, k, n, from, to, m, numnode, numline, POINT_DATA
      integer(int32), allocatable :: CELLS(:), CELL_TYPES(:)
      logical :: ASCII = .false.
      logical :: UNSTRUCTURED_GRID = .false.

      ! Only for POINTS, CELLS, CELL_TYPES, VECTORS, TENSORS, SCALARS

      call this%remove()

      if (index(name, ".vtk") == 0 .and. index(name, ".VTK") == 0) then
         fullname = name//".vtk"
      else
         fullname = name
      end if

      call f%open(fullname)

      ! read settings
      do
         if (f%EOF) exit
         line = f%readline()
         line = adjustl(line)
         if (index(line(1:1), "#") /= 0) cycle

         if (index(line, "ASCII") /= 0) then
            ASCII = .true.
            cycle
         end if

         if (index(line, "DATASET") /= 0) then
            if (index(line, "UNSTRUCTURED_GRID") /= 0) then
               UNSTRUCTURED_GRID = .true.
            end if
            cycle
         end if
         if (index(line, "POINTS") /= 0) then
            exit
         end if

         if (index(line, "CELLS") /= 0 .or. index(line, "cells") /= 0) then
            exit
         end if

         if (index(line, "VECTOR") /= 0 .or. index(line, "vector") /= 0) then
            exit
         end if

         if (index(line, "TENSOR") /= 0 .or. index(line, "tensor") /= 0) then
            exit
         end if

         if (index(line, "SCALAR") /= 0 .or. index(line, "scalar") /= 0) then
            exit
         end if
      end do

      ! check vtk file
      if (ASCII) then
         if (this%debug_mode) then
            print *, "[ok] ASCII format."
         end if
      else
         print *, "ERROR :: importVTKFile >> here, vtk file should be ASCII format."
         stop
      end if

      if (UNSTRUCTURED_GRID) then
         if (this%debug_mode) then
            print *, "[ok] UNSTRUCTURED_GRID"
         end if
      else
         print *, "ERROR :: importVTKFile >> here, DATASET should be UNSTRUCTURED_GRID"
         stop
      end if

      if (f%EOF) then
         print *, "ERROR ;; importVTKFile >> no readable found in the file!"
         stop
      end if

      do
         if (f%EOF) exit
         if (index(line, "POINTS") /= 0) then
            from = index(line, "POINTS") + 6
            read (line(from:), *) n
            allocate (this%mesh%nodcoord(n, 3))
            do i = 1, n
               line = f%readline()
               read (line, *) this%mesh%nodcoord(i, :)
            end do
         end if

         if (index(line, "CELLS") /= 0) then
            from = index(line, "CELLS") + 5
            read (line(from:), *) n, m
            allocate (CELLS(m))
            numline = 0
            do i = 1, n
               line = f%readline()
               read (line, *) numnode
               read (line, *) CELLS(numline + 1:numline + numnode + 1)
               CELLS(numline + 2:numline + numnode + 1) = CELLS(numline + 2:numline + numnode + 1) + 1
               numline = numline + numnode + 1
            end do
         end if

         if (index(line, "CELL_TYPES") /= 0) then
            from = index(line, "CELL_TYPES") + 10
            read (line(from:), *) n
            if (.not. allocated(CELLS)) then
               print *, "ERROR :: importVTKFile >> no CELLS are found before CELL_TYPES."
               stop
            end if
            allocate (CELL_TYPES(n))
            do i = 1, n
               line = f%readline()
               read (line, *) CELL_TYPES(i)
            end do

            ! cannot use mixed mesh for PlantFEM

            if (maxval(CELL_TYPES) /= minval(CELL_TYPES)) then
               print *, "[Caution] :: importVTKFile >> cannot use mixed mesh for PlantFEM"
               print *, "Only CELL_TYPES = ", maxval(CELL_TYPES), "will be imported."
               n = 0
               do i = 1, size(CELL_TYPES)
                  if (CELL_TYPES(i) == maxval(CELL_TYPES)) then
                     n = n + 1
                  end if
               end do
            else
               n = size(CELL_TYPES)
            end if

            m = maxval(CELL_TYPES)
            select case (m)
            case (VTK_VERTEX)
               numnode = 1
            case (VTK_POLY_VERTEX)
               numnode = 1
            case (VTK_LINE)
               numnode = 2
            case (VTK_TRIANGLE)
               numnode = 3
            case (VTK_PIXEL)
               numnode = 4
            case (VTK_QUAD)
               numnode = 4
            case (VTK_TETRA)
               numnode = 4
            case (VTK_VOXEL)
               numnode = 8
            case (VTK_HEXAHEDRON)
               numnode = 8
            case (VTK_WEDGE)
               numnode = 6
            case (VTK_QUADRATIC_EDGE)
               numnode = 3
            case (VTK_QUADRATIC_TRIANGLE)
               numnode = 6
            case (VTK_QUADRATIC_QUAD)
               numnode = 8
            case (VTK_QUADRATIC_TETRA)
               numnode = 10
            case (VTK_QUADRATIC_HEXAHEDRON)
               numnode = 16

            end select

            allocate (this%mesh%elemnod(n, numnode))

            this%mesh%elemnod(:, :) = 0
            n = 0
            do i = 1, this%ne()
               do
                  if (n + 1 > size(CELLS)) exit
                  if (CELLS(n + 1) == numnode) then
                     this%mesh%elemnod(i, 1:numnode) = CELLS(n + 2:n + numnode + 1)
                     n = n + 1 + numnode
                     exit
                  else
                     n = n + 1 + numnode
                     cycle
                  end if
               end do
            end do

         end if

         if (index(line, "POINT_DATA") /= 0) then
            from = index(line, "POINT_DATA") + 10
            read (line(from:), *) POINT_DATA
         end if

         if (index(line, "CELL_DATA") /= 0) then
            from = index(line, "CELL_DATA") + 10
            read (line(from:), *) POINT_DATA
         end if

         if (index(line, "SCALARS") /= 0) then
            from = index(line, "SCALARS") + 7
            to = index(line(from + 1:), " ")
            fieldname = line(from:to + 7)
            if (.not. allocated(this%PhysicalField)) then
               allocate (this%PhysicalField(1))
               do i = 1, size(this%physicalfield)
                  this%PhysicalField(i)%name = "untitled"
               end do
            end if
            ! read "LOOKUP_TABLE default"
            line = f%readline()

            do i = 1, size(this%PhysicalField)
               if (allocated(this%PhysicalField(i)%scalar)) then
                  cycle
               elseif (allocated(this%PhysicalField(i)%vector)) then
                  cycle
               elseif (allocated(this%PhysicalField(i)%tensor)) then
                  cycle
               else
                  allocate (this%PhysicalField(i)%scalar(POINT_DATA))
                  this%PhysicalField(i)%name = fieldname
                  this%PhysicalField(i)%scalar(:) = 0.0d0
                  do j = 1, POINT_DATA
                     line = f%readline()
                     read (line, *) this%PhysicalField(i)%scalar(j)
                  end do
                  if (this%debug_mode) then
                     print *, "[ok] Read SCALAR field"
                  end if
               end if
            end do
         end if

         if (index(line, "VECTORS") /= 0) then
            from = index(line, "VECTORS") + 7
            to = index(line(from + 1:), " ")
            fieldname = line(from:to + 7)
            if (.not. allocated(this%PhysicalField)) then
               allocate (this%PhysicalField(1))
               do i = 1, size(this%physicalfield)
                  this%PhysicalField(i)%name = "untitled"
               end do
            end if
            ! read "LOOKUP_TABLE default"
            line = f%readline()

            do i = 1, size(this%PhysicalField)
               if (allocated(this%PhysicalField(i)%scalar)) then
                  cycle
               elseif (allocated(this%PhysicalField(i)%vector)) then
                  cycle
               elseif (allocated(this%PhysicalField(i)%tensor)) then
                  cycle
               else
                  allocate (this%PhysicalField(i)%vector(POINT_DATA, 3))
                  this%PhysicalField(i)%name = fieldname
                  this%PhysicalField(i)%vector(:, :) = 0.0d0
                  do j = 1, POINT_DATA
                     line = f%readline()
                     read (line, *) this%PhysicalField(i)%vector(j, :)

                  end do
                  exit
               end if
            end do
         end if

         if (index(line, "TENSORS") /= 0) then
            from = index(line, "TENSORS") + 7
            to = index(line(from + 1:), " ")
            fieldname = line(from:to + 7)
            if (.not. allocated(this%PhysicalField)) then
               allocate (this%PhysicalField(100))
               do i = 1, size(this%physicalfield)
                  this%PhysicalField(i)%name = "untitled"
               end do
            end if
            ! read "LOOKUP_TABLE default"
            line = f%readline()

            do i = 1, size(this%PhysicalField)
               if (allocated(this%PhysicalField(i)%scalar)) then
                  cycle
               elseif (allocated(this%PhysicalField(i)%vector)) then
                  cycle
               elseif (allocated(this%PhysicalField(i)%tensor)) then
                  cycle
               else
                  allocate (this%PhysicalField(i)%tensor(POINT_DATA, 3, 3))
                  this%PhysicalField(i)%name = fieldname
                  this%PhysicalField(i)%tensor(:, :, :) = 0.0d0
                  do j = 1, POINT_DATA
                     do k = 1, 3
                        line = f%readline()
                        read (line, *) this%PhysicalField(i)%tensor(j, k, :)
                     end do
                  end do

               end if
               exit
            end do
         end if

         line = f%readline()
      end do
      call f%close()

   end subroutine
! ##################################################################

   function getElementFEMDOmain(this, ElementID) result(element)
      class(FEMDomain_), intent(in) :: this
      type(FEMDomain_) :: element
      integer(int32), intent(in) :: ElementID

      element%mesh = this%mesh%getelement(ElementID)

   end function
! ##################################################################

! ##################################################################
   subroutine Delaunay3DFEMDomain(this)
      class(FEMDomain_), intent(inout) :: this

      if (.not. allocated(this%mesh%nodcoord)) then
         print *, "ERROR :: Delauney3DFEMDomain >> no nodes are found in femdomain%mesh%nodcoord(:,:)"
      end if
      call this%mesh%meshing(mode=3)

   end subroutine
! ##################################################################

! ##################################################################
   subroutine Delaunay2DFEMDomain(this)
      class(FEMDomain_), intent(inout) :: this

      if (.not. allocated(this%mesh%nodcoord)) then
         print *, "ERROR :: Delauney3DFEMDomain >> no nodes are found in femdomain%mesh%nodcoord(:,:)"
      end if
      call this%mesh%meshing(delaunay2d=.true.)

   end subroutine
! ##################################################################

! ##################################################################
   function xFEMDomain(this) result(ret)
      class(FEMDomain_), intent(in) :: this
      real(real64), allocatable :: ret(:)

      if (this%mesh%empty()) then
         ret = zeros(1)
      else
         allocate (ret(this%nn()))
         ret(:) = this%mesh%nodcoord(:, 1)
      end if

   end function
! ##################################################################

! ##################################################################
   function yFEMDomain(this) result(ret)
      class(FEMDomain_), intent(in) :: this
      real(real64), allocatable :: ret(:)

      if (this%mesh%empty()) then
         ret = zeros(1)
      else
         allocate (ret(this%nn()))
         ret(:) = this%mesh%nodcoord(:, 2)
      end if

   end function
! ##################################################################

! ##################################################################
   function zFEMDomain(this) result(ret)
      class(FEMDomain_), intent(in) :: this
      real(real64), allocatable :: ret(:)

      if (this%mesh%empty()) then
         ret = zeros(1)
      else
         allocate (ret(this%nn()))
         ret(:) = this%mesh%nodcoord(:, 3)
      end if

   end function
! ##################################################################

   function TractionVectorFEMDomain(this, displacement, YoungModulus, PoissonRatio, debug_elementID) result(Traction)
      class(FEMDomain_), intent(inout) :: this
      real(real64), intent(in) :: displacement(:), YoungModulus(:), PoissonRatio(:)
      real(real64), allocatable :: Traction(:)
      real(real64), allocatable :: Dmat(:, :), Bmat(:, :), Te(:), Teg(:), ElemDisp(:, :), Tem(:, :), Disp_vec(:, :)
      real(real64), allocatable :: StressVector(:)
      integer(int32), optional, intent(in) :: debug_elementID
      type(ShapeFunction_) :: sf
      type(IO_) :: f
      integer(int32) :: i, j

      if (this%mesh%empty()) then
         return
      end if

      Traction = zeros(this%nn()*this%nd())

      ElemDisp = zeros(this%nne(), this%nd())

      ! For each element
      do i = 1, this%ne()
         if (present(debug_elementID)) then
            if (debug_elementID == i) then
               call f%open("TractionVector___debug_msg.txt")
            end if
         end if
         ! For each integration point
         do j = 1, this%ngp()
            ! Compute traction vector
            ! (1) get shape function
            sf = this%getShapeFunction( &
                 ElementID=i, GaussPointID=j)
            ! get B-matrix
            Bmat = this%BMatrix( &
                   shapefunction=sf, ElementID=i)
            ! get Element-wise displacement vector
            ElemDisp = selectRow( &
                       Matrix=reshape(Displacement, this%nn(), this%nd()), &
                       RowIDs=this%connectivity(ElementID=i))

            ! get Stress vector
!  <<<<bug>>>>>
            StressVector = this%StressVector( &
                           ElementID=i, GaussPoint=j, disp=ElemDisp, &
                           E=YoungModulus(i), v=PoissonRatio(i))
            ! get elemental traction vector
!  <<<<bug>>>>>
            !Tem = matmul(transpose(Bmat),matmul(this%Dmatrix(E = YoungModulus(i),v=PoissonRatio(i)),&
            !matmul(Bmat,reshape(transpose(ElemDisp),[size(ElemDisp,1)*size(ElemDisp,2),1] )  )))*sf%detJ

            Te = matmul(transpose(Bmat), StressVector)*sf%detJ
            !Te = reshape(Tem,[size(Tem,1)*size(Tem,2)])

            ! add to global vector
            Traction = Traction + this%asGlobalVector(LocalVector=Te, ElementID=i, DOF=this%nd())
            if (present(debug_elementID)) then
               if (debug_elementID == i) then

                  write (f%fh, *) "TractionVector >> debug mode:"
                  write (f%fh, *) "ElementID, GaussPointID", i, j
                  write (f%fh, *) "ElemDisp"
                  call f%write(ElemDisp)
                  write (f%fh, *) "ElemDisp(vector form)"
                  Disp_vec = reshape(transpose(ElemDisp), [size(ElemDisp, 1)*size(ElemDisp, 2), 1])
                  call f%write(Disp_vec)
                  write (f%fh, *) "Bmat"
                  call f%write(Bmat)
                  write (f%fh, *) "StressVector"
                  call f%write(StressVector)
                  write (f%fh, *) "%StressVector"
                  call f%write(this%StressVector( &
                               ElementID=i, GaussPoint=j, disp=ElemDisp, &
                               E=YoungModulus(i), v=PoissonRatio(i)))
                  write (f%fh, *) "Tem"
                  call f%write(Tem)
                  call f%write("Dmat")
                  call f%write(this%Dmatrix(E=YoungModulus(i), v=PoissonRatio(i)))
                  write (f%fh, *) "Traction(element)"
                  call f%write(Te)

                  write (f%fh, *) "*matmul(Bmat,ElemDisp)"
                  call f%write(matmul(Bmat, Disp_vec))

                  write (f%fh, *) "*matmul(Dmat,matmul(Bmat,ElemDisp))"
                  call f%write(matmul(this%Dmatrix(E=YoungModulus(i), v=PoissonRatio(i)), &
                                      matmul(Bmat, Disp_vec)))

                  write (f%fh, *) "*sf%detJ*matmul(Dmat,matmul(Bmat,ElemDisp))"
                  call f%write(sf%detJ*matmul(this%Dmatrix(E=YoungModulus(i), v=PoissonRatio(i)), &
                                              matmul(Bmat, Disp_vec)))
               end if
            end if

         end do
         if (present(debug_elementID)) then
            if (debug_elementID == i) then
               call f%close()
            end if
         end if
      end do

   end function
! ##################################################################

!pure function SymmetryMatrixToVector(symmetryMatrix) result(vec)
!        real(real64),intent(in) :: SymmetryMatrix(:,:)
!        real(real64),allocatable :: vec(:)
!        integer(int32) :: dim_mat, dim_vec,k
!
!   [Caution] DO NOT USE THIS
!        ! A11  A12  A13
!        ! A12  A22  A23
!        ! A13  A23  A33
!        ! =>
!        ! A11
!        ! A22
!        ! A33
!        ! A12
!        ! A13
!        ! A23
!        dim_mat = size(SymmetryMatrix,1)
!        dim_vec = dim_mat
!        do i=dim_mat-1,1,-1
!                dim_vec = dim_vec+1
!        enddo
!
!        vec     = zeros(dim_vec)
!        do i=1,dim_mat
!                vec(i) = SymmetriMatrix(i,i)
!        enddo
!        k=0
!        do i=1,dim_mat-1
!                do j=i+1,dim_mat
!                        k = k+1
!                        vec(dim_mat+k) = SymmetriMatrix(i,i)
!                enddo
!        enddo
!
!
!
!end function
   function asGlobalVectorFEMDomain(this, LocalVector, ElementID, DOF) result(globalvec)
      class(FEMDomain_), intent(in) :: this
      real(real64), intent(in):: LocalVector(:)
      integer(int32), intent(in) :: ElementID, DOF
      real(real64), allocatable :: globalvec(:)
      integer(int32) :: i, j, n, ng
      integer(int32), allocatable :: connectivity(:)

      n = this%nn()*DOF
      globalvec = zeros(n)

      ! globalvec = (A1x, A1y, A1z, A2x, A2y, A2z, ...  )

      connectivity = this%connectivity(ElementID=ElementID)
      do i = 1, this%nne()
         do j = 1, DOF
            n = DOF*(i - 1) + j
            ng = DOF*(connectivity(i) - 1) + j
            globalvec(ng) = globalvec(ng) + LocalVector(n)
         end do
      end do

   end function
! #########################################################################

! #########################################################################
   function getNodeListFEMDomain(this, BoundingBox, xmin, xmax, ymin, ymax, zmin, zmax) result(NodeList)
      class(FEMDomain_), intent(inout) :: this
      type(FEMDomain_), optional, intent(inout) :: BoundingBox
      real(real64), optional, intent(in) :: xmin, xmax, ymin, ymax, zmin, zmax
      integer(int32), allocatable :: NodeList(:)

      NodeList = this%mesh%getNodeList(BoundingBox=BoundingBox%mesh &
                                       , xmin=xmin &
                                       , xmax=xmax &
                                       , ymin=ymin &
                                       , ymax=ymax &
                                       , zmin=zmin &
                                       , zmax=zmax)

   end function
! #########################################################################

! #########################################################################
   function getFacetListFEMDomain(this, NodeID) result(FacetList)
      class(FEMDomain_), intent(inout) :: this
      integer(int32), intent(in) :: NodeID
      integer(int32), allocatable :: FacetList(:, :) ! Node-ID =  FacetList(FacetID, LocalNodeID )

      FacetList = this%mesh%getFacetList(NodeID=NodeID)

   end function
! #########################################################################

   ! #########################################################################
   function getFacetList_by_range(this, range) result(FacetList)
      class(FEMDomain_), intent(inout) :: this
      type(Range_), intent(in) :: range
      integer(int32), allocatable :: FacetList(:, :) ! Node-ID = FacetList(FacetID, LocalNodeID )
      integer(int32) :: FacetIdx,i
      integer(int32),allocatable :: inside_is_1(:)
      real(real64) :: center(1:3)

      call this%getSurface()

      allocate(inside_is_1(size(this%mesh%FacetElemNod,1)) )
      do FacetIdx=1,size(this%mesh%FacetElemNod,1)
         do i=1,size(this%mesh%FacetElemNod,2)
            center(:) = center(:) + this%mesh%nodcoord(this%mesh%FacetElemNod(FacetIdx,i) ,:)
         enddo
         center(:) = center(:)/dble(size(this%mesh%FacetElemNod,2))
         if(center .in. range)then
            inside_is_1(FacetIdx)=1
         else
            inside_is_1(FacetIdx)=0
         endif
      enddo

      allocate(FacetList(sum(inside_is_1),size(this%mesh%FacetElemNod,2) ))
      i = 0
      do FacetIdx=1,size(inside_is_1)
         if(inside_is_1(i)==1)then
            i = i + 1
            FacetList(i,:) = this%mesh%FacetElemNod(FacetIdx,:)
         else
            cycle
         endif
      enddo
      

   end function
! #########################################################################



   ! #########################################################################
   function getFacetList_as_Idx_by_range(this, range) result(FacetList)
      class(FEMDomain_), intent(inout) :: this
      type(Range_), intent(in) :: range
      integer(int32), allocatable :: FacetList(:) 
      integer(int32) :: FacetIdx,i
      integer(int32),allocatable :: inside_is_1(:)
      real(real64) :: center(1:3)

      call this%getSurface()

      allocate(inside_is_1(size(this%mesh%FacetElemNod,1)) )
      inside_is_1(:)=0
      do FacetIdx=1,size(this%mesh%FacetElemNod,1)
         center(:) = 0.0d0
         do i=1,size(this%mesh%FacetElemNod,2)
            center(:) = center(:) + this%mesh%nodcoord(this%mesh%FacetElemNod(FacetIdx,i) ,:)
         enddo
         center(:) = center(:)/dble(size(this%mesh%FacetElemNod,2))
         
         if(center .in. range)then
            inside_is_1(FacetIdx)=1
         endif
      enddo


      allocate(FacetList(sum(inside_is_1)))
      i = 0
      do FacetIdx=1,size(inside_is_1)
         if(inside_is_1(FacetIdx)==1)then
            i = i + 1
            FacetList(i) = FacetIdx
         else
            cycle
         endif
      enddo
      

   end function
! #########################################################################

   function getElementListFEMDomain(this, BoundingBox, xmin, xmax, ymin, ymax, zmin, zmax, NodeID) result(ElementList)
      class(FEMDomain_), intent(inout) :: this
      type(FEMDomain_), optional, intent(inout) :: BoundingBox
      real(real64), optional, intent(in) :: xmin, xmax, ymin, ymax, zmin, zmax
      integer(int32), optional, intent(in) :: NodeID
      integer(int32), allocatable :: NodeList(:)
      integer(int32), allocatable :: ElementList(:)

      ElementList = this%mesh%getElementList(BoundingBox=BoundingBox%mesh &
                                             , xmin=xmin &
                                             , xmax=xmax &
                                             , ymin=ymin &
                                             , ymax=ymax &
                                             , zmin=zmin &
                                             , zmax=zmax &
                                             , NodeID=NodeID)

   end function
! #########################################################################

   function getElementList_by_radiusFEMDomain(this, center, radius, zmin, zmax) result(ElementList)
      class(FEMDomain_), intent(inout) :: this
      real(real64), intent(in) :: center(1:2), radius, zmin, zmax
      real(real64), allocatable :: elem_center(:)

      integer(int32), allocatable :: checklist(:)
      integer(int32), allocatable :: ElementList(:)
      integer(int32) :: i, j, k

      CheckList = int(zeros(this%ne()))
      do i = 1, this%ne()
         elem_center = this%centerPosition(i)
         if (norm(elem_center(1:2) - center(1:2)) <= radius) then
            if (zmin <= elem_center(3) .and. elem_center(3) <= zmax) then
               CheckList(i) = 1
            end if
         end if
      end do

      ElementList = int(zeros(sum(CheckList)))
      k = 0
      do i = 1, size(checklist)
         if (checklist(i) == 1) then
            k = k + 1
            ElementList(k) = i
         else
            cycle
         end if
      end do

   end function

! #########################################################################

   pure function selectRow(Matrix, RowIDs) result(SelectedRows)
      real(real64), intent(in) :: Matrix(:, :)
      integer(int32), intent(in) :: RowIDs(:)
      real(real64), allocatable :: SelectedRows(:, :)
      integer(int32) :: i

      ! get rows from Matrix by rowIDs
      SelectedRows = zeros(size(RowIDs), size(Matrix, 2))

      do concurrent(i=1:size(RowIDs))
         SelectedRows(i, :) = Matrix(RowIDs(i), :)
      end do

   end function

! ########################################

   pure function emptyFEMDomain(this) result(FEMDomain_is_empty)
      class(FEMDomain_), intent(in) :: this
      logical :: FEMDomain_is_empty

      FEMDomain_is_empty = this%mesh%empty()

   end function
! ########################################

! ########################################
   function appendfemdomain(x, y) result(z)
      class(FEMDomain_), intent(in) :: x, y
      type(FEMDomain_) :: z
      integer(int32) :: n, m

      if (x%empty()) then
         z = y
      elseif (y%empty()) then
         z = x
      else
         ! add members
         ! F**kin supid algorithm

         n = x%nn() + y%nn()
         m = maxval([x%nd(), y%nd()])
         z%mesh%nodcoord = zeros(n, m)
         z%mesh%nodcoord(1:x%nn(), :) = x%mesh%nodcoord(1:x%nn(), :)
         z%mesh%nodcoord(x%nn() + 1:x%nn() + y%nn(), :) = y%mesh%nodcoord(1:y%nn(), :)

         n = x%ne() + y%ne()
         m = maxval([x%nne(), y%nne()])
         z%mesh%elemnod = zeros(n, m)
         z%mesh%elemnod(1:x%ne(), :) = x%mesh%elemnod(1:x%ne(), :)
         z%mesh%elemnod(x%ne() + 1:x%ne() + y%ne(), :) = y%mesh%elemnod(1:y%ne(), :) + x%nn()

      end if

   end function appendFEMDomain
! ########################################

   subroutine fixReversedElementsFEMDomain(this)
      class(FEMDomain_), intent(inout) :: this
      real(real64) :: volume
      integer(int32) :: i, j
      integer(int32), allocatable :: elemnod(:)

      if (this%mesh%empty()) then
         return
      else
         ! fix reversed elements
                ! !$OMP parallel do default(shared) private(elemnod,volume)
         do i = 1, this%mesh%ne()
            volume = this%getVolume(elem=i)
            if (volume < 0.0d0) then
               elemnod = this%mesh%elemnod(i, :)

               if (this%nne() == 8 .and. this%nd() == 3) then
                  this%mesh%elemnod(i, 1) = elemnod(4)
                  this%mesh%elemnod(i, 2) = elemnod(3)
                  this%mesh%elemnod(i, 3) = elemnod(2)
                  this%mesh%elemnod(i, 4) = elemnod(1)
                  this%mesh%elemnod(i, 5) = elemnod(8)
                  this%mesh%elemnod(i, 6) = elemnod(7)
                  this%mesh%elemnod(i, 7) = elemnod(6)
                  this%mesh%elemnod(i, 8) = elemnod(5)
               elseif (this%nne() == 4 .and. this%nd() == 3) then
                  this%mesh%elemnod(i, 1) = elemnod(3)
                  this%mesh%elemnod(i, 2) = elemnod(2)
                  this%mesh%elemnod(i, 3) = elemnod(1)
                  this%mesh%elemnod(i, 4) = elemnod(4)
               elseif (this%nne() == 4 .and. this%nd() == 2) then
                  this%mesh%elemnod(i, 1) = elemnod(4)
                  this%mesh%elemnod(i, 2) = elemnod(3)
                  this%mesh%elemnod(i, 3) = elemnod(2)
                  this%mesh%elemnod(i, 4) = elemnod(1)
               elseif (this%nne() == 3 .and. this%nd() == 2) then
                  this%mesh%elemnod(i, 1) = elemnod(3)
                  this%mesh%elemnod(i, 2) = elemnod(2)
                  this%mesh%elemnod(i, 3) = elemnod(1)
               else
                  print *, "[ERROR] >> fixReversedElementsFEMDomain"
                  print *, "Element with ", this%nne(), "nne and", this%nd(), "this%nd()"
                  print *, "is not impremented yet."
                  stop
               end if
            end if
         end do
                ! !OMP end parallel do
      end if
   end subroutine

!function getNumberOfPointFEMDomain(this,xmin,) result(ret)
!        class(FEMDomain_),intent(in) :: this
!end function

   subroutine syncFEMDomain(this, from, mpid)
      class(FEMDomain_), intent(inout) :: this
      integer(int32), intent(in) :: from
      type(MPI_), intent(inout) :: mpid

      call this%mesh%sync(from=from, mpid=mpid)
   end subroutine

   subroutine syncFEMDomainVector(this, from, mpid)
      type(FEMDomain_), allocatable, intent(inout) :: this(:)
      integer(int32), intent(in) :: from
      type(MPI_), intent(inout) :: mpid
      integer(int32) :: vec_size, i

      vec_size = 0
      if (mpid%myrank == from) then
         if (.not. allocated(this)) then
            vec_size = -1
         end if
      end if
      call mpid%bcast(from=from, val=vec_size)
      if (vec_size < 1) then
         return
      end if

      if (from /= mpid%myrank) then
         if (allocated(this)) then
            deallocate (this)
         end if
         allocate (this(vec_size))
      end if

      do i = 1, vec_size
         call this(i)%mesh%sync(from=from, mpid=mpid)
      end do

   end subroutine

! ###################################################################
   function getScalarFieldFEMDomain(this, xr, yr, zr, entryvalue, default) result(ScalarField)
      class(FEMDomain_), intent(in) :: this
      real(real64), intent(in) :: xr(2), yr(2), zr(2), default(:), entryvalue
      real(real64), allocatable:: ScalarField(:)
      real(real64) :: x(3)
      integer(int32) :: i, j, n
      logical :: empty_field

      n = size(default)
      if (n == this%nn()) then
         ! node-wise
         ScalarField = default
         do i = 1, this%nn()
            if (xr(1) <= this%position_x(i) .and. this%position_x(i) <= xr(2)) then
               if (yr(1) <= this%position_y(i) .and. this%position_y(i) <= yr(2)) then
                  if (zr(1) <= this%position_z(i) .and. this%position_z(i) <= zr(2)) then
                     ScalarField(i) = entryvalue
                  end if
               end if
            end if
         end do
      elseif (n == this%ne()) then
         ! element-wise

         ScalarField = default
         do i = 1, this%ne()
            x = this%centerPosition(i)
            if (xr(1) <= x(1) .and. x(1) <= xr(2)) then
               if (yr(1) <= x(2) .and. x(2) <= yr(2)) then
                  if (zr(1) <= x(3) .and. x(3) <= zr(2)) then
                     ScalarField(i) = entryvalue
                  end if
               end if
            end if
         end do
      else
         ! none of above
         print *, "ERROR :: getScalarFieldFEMDomain >>"
         print *, "size(default) should be femdomain%ne() or femdomain%nn()"
         return
      end if

   end function
! ###################################################################

   function getE2EconnectivityFEMDomain(this) result(E2Econnect)
      class(FEMDomain_), intent(in) :: this
      integer(int32), allocatable :: E2Econnect(:, :), elemnodid(:), GroupID(:, :), element_id_list(:)
      integer(int32) :: i, j, k, efacet_id(6, 4), gfacet_id(6, 4), l
      integer(int32) :: exists_count
      ! Element-to-Element connectivity
      ! only for 3-D cube elements

      integer(int32) :: group_id, num_elem, ii, jj

      if (this%mesh%empty()) then
         return
      end if

      ! O(1025*1025*NlogN) algorithm
      allocate (E2Econnect(this%ne(), 6))
      E2Econnect(:, :) = -1
      elemnodid = zeros(this%nne())

      ! only for 8-node isoparametric element
      efacet_id(1, 1:4) = [1, 2, 6, 5]
      efacet_id(2, 1:4) = [2, 3, 7, 6]
      efacet_id(3, 1:4) = [3, 4, 8, 7]
      efacet_id(4, 1:4) = [4, 1, 5, 8]
      efacet_id(5, 1:4) = [1, 2, 3, 4]
      efacet_id(6, 1:4) = [5, 6, 7, 8]

      GroupID = this%mesh%BinaryTreeSearch(old_GroupID=GroupID, min_elem_num=2000)
      ! for each group IDs

      do group_id = 1, size(GroupID, 1)
         num_elem = 0
         do i = 1, size(GroupID, 2)
            if (GroupID(group_id, i) < 1) then
               exit
            else
               num_elem = num_elem + 1
            end if
         end do
         if (num_elem <= 1) then
            cycle
         end if
         element_id_list = int(zeros(num_elem))
         element_id_list(1:num_elem) = GroupID(group_id, 1:num_elem)

         do ii = 1, size(element_id_list)
            i = element_id_list(ii)
            elemnodid = this%mesh%elemnod(i, :)

            do j = 1, 6
               do k = 1, 4
                  gfacet_id(j, k) = this%mesh%elemnod(i, efacet_id(j, k))
               end do
            end do

            do jj = 1, size(element_id_list)
               j = element_id_list(jj)

               if (i == j) cycle

               if (minval(this%mesh%elemnod(j, :)) > maxval(gfacet_id)) cycle
               if (maxval(this%mesh%elemnod(j, :)) < minval(gfacet_id)) cycle

               do k = 1, size(gfacet_id, 1)
                  exists_count = 0
                  do l = 1, size(gfacet_id, 2)
                     if (exists(vector=this%mesh%elemnod(j, :), val=gfacet_id(k, l))) then
                        exists_count = exists_count + 1
                     end if
                  end do
                  if (exists_count == 4) then
                     E2Econnect(i, k) = j
                  else
                     cycle
                  end if
               end do

            end do

         end do
      end do

   end function
! ###################################################################

! ###################################################################
   function MovingAverageFilterFEMDomain(this, inScalarField, ignore_top_and_bottom) result(outScalarField)
      class(FEMDomain_), intent(in) :: this
      real(real64), intent(in) :: inScalarField(:)
      real(real64), allocatable:: outScalarField(:), neighborvalue(:)
      logical, optional, intent(in) :: ignore_top_and_bottom
      integer(int32), allocatable :: E2Econnect(:, :), buf(:, :)
      integer(int32) :: i, j

      integer(int32) :: count_zero

      if (this%mesh%empty()) then
         return
      end if

      if (this%ne() /= size(inScalarField)) then
         !print *, "ERROR :: MovingAverageFilterFEMDomain >> only for element-wise scalar fields"
         return
      end if

      E2Econnect = this%getE2Econnectivity()
      !Element_Groups = this%mesh%BinaryTreeSearch(old_GroupID=GroupID,min_elem_num=10000)

      if (present(ignore_top_and_bottom)) then
         if (ignore_top_and_bottom) then
            buf = E2Econnect
            deallocate (E2Econnect)
            E2Econnect = buf(:, 1:4)
         end if
      end if
      neighborvalue = zeros(size(E2Econnect, 2))
      outScalarField = inScalarField

      !移動平均フィルタ

      do i = 1, this%ne()
         count_zero = 0
         neighborvalue = 0.0d0
         do j = 1, size(E2Econnect, 2)
            if (E2Econnect(i, j) < 1) then
               count_zero = count_zero + 1
               cycle
            end if
            neighborvalue(j) = inScalarField(E2Econnect(i, j))
         end do
         outScalarField(i) = (sum(neighborvalue) + inScalarField(i)) &
                             /dble(size(neighborvalue) + 1 - count_zero)

      end do

   end function
! ###################################################################

! #########################################################
   pure function xminFEMDomain(this) result(ret)
      class(FEMDomain_), intent(in) :: this
      real(real64) :: ret

      ret = minval(this%mesh%nodcoord(:, 1))

   end function
! #########################################################

! #########################################################
   pure function xmaxFEMDomain(this) result(ret)
      class(FEMDomain_), intent(in) :: this
      real(real64) :: ret

      ret = maxval(this%mesh%nodcoord(:, 1))

   end function
! #########################################################

! #########################################################
   pure function yminFEMDomain(this) result(ret)
      class(FEMDomain_), intent(in) :: this
      real(real64) :: ret

      ret = minval(this%mesh%nodcoord(:, 2))

   end function
! #########################################################

! #########################################################
   pure function ymaxFEMDomain(this) result(ret)
      class(FEMDomain_), intent(in) :: this
      real(real64) :: ret

      ret = maxval(this%mesh%nodcoord(:, 2))

   end function
! #########################################################

! #########################################################
   pure function zminFEMDomain(this) result(ret)
      class(FEMDomain_), intent(in) :: this
      real(real64) :: ret

      ret = minval(this%mesh%nodcoord(:, 3))

   end function
! #########################################################

! #########################################################
   function zmaxFEMDomain(this, x, y, debug) result(ret)
      class(FEMDomain_), intent(in) :: this
      real(real64), optional, intent(in) :: x, y
      real(real64) :: ret
      integer(int32) :: i
      real(real64), allocatable :: z_coord(:), xy_minmax(:, :)
      real(real64) :: z_min
      logical, allocatable :: inside(:)
      logical, optional, intent(in) :: debug
      logical :: debug_mode = .true.

      debug_mode = input(default=.false., option=debug)
      if (present(x) .and. (present(y))) then
         xy_minmax = zeros(this%ne(), 4) !xmin,ymin,xmax,ymax
         z_coord = zeros(this%ne())
         allocate (inside(this%ne()))
         inside(:) = .false.
         z_min = this%zmin()

         if (debug_mode) then
            print *, "[0] zmax >> started"
         end if
         !$OMP parallel default(shared)
         !$OMP do
         do i = 1, this%ne()
            xy_minmax(i, 1) = minval(this%mesh%nodcoord(this%mesh%elemnod(i, :), 1))!xmin
            xy_minmax(i, 2) = minval(this%mesh%nodcoord(this%mesh%elemnod(i, :), 2))!ymin
            xy_minmax(i, 3) = maxval(this%mesh%nodcoord(this%mesh%elemnod(i, :), 1))!xmax
            xy_minmax(i, 4) = maxval(this%mesh%nodcoord(this%mesh%elemnod(i, :), 2))!ymax
            z_coord(i) = maxval(this%mesh%nodcoord(this%mesh%elemnod(i, :), 3))!ymax
         end do
         !$OMP end do
         !$OMP end parallel

         if (debug_mode) then
            print *, "[1] zmax >> xy_minmax solved."
         end if
         !$OMP parallel default(shared)
         !$OMP do
         do i = 1, this%ne()
            if (xy_minmax(i, 1) <= x .and. x <= xy_minmax(i, 3)) then
               if (xy_minmax(i, 2) <= y .and. y <= xy_minmax(i, 4)) then
                  inside(i) = .true.
               end if
            end if
         end do
         !$OMP end do
         !$OMP end parallel

         if (debug_mode) then
            print *, "[2] zmax >> inside solved."
         end if

         !$OMP parallel
         !$OMP do
         do i = 1, this%ne()
            if (.not. inside(i)) then
               z_coord(i) = z_min
            end if
         end do
         !$OMP end do
         !$OMP end parallel

         if (debug_mode) then
            print *, "[3] zmax >> z_coord solved."
         end if
         ret = maxval(z_coord)

      else
         ret = maxval(this%mesh%nodcoord(:, 3))
      end if

   end function
! #########################################################

! #########################################################
   function getElevationFEMDomain(this, x_num, y_num, x_len, y_len) result(ret)
      class(FEMDomain_), intent(in) :: this
      integer(int32), intent(in) :: x_num, y_num
      real(real64), intent(in) :: x_len, y_len
      real(real64) :: ret(x_num + 1, y_num + 1), dx, dy
      integer(int32) :: i

      ret(:, :) = this%zmin()
      dx = x_len/x_num
      dy = y_len/y_num
      do i = 1, this%nn()
         ret(int(this%position_x(i)/dx + 1), int(this%position_y(i)/dy + 1)) = &
            maxval([ret(int(this%position_x(i)/dx + 1), int(this%position_y(i)/dy + 1)), &
                    this%position_z(i)])
      end do

   end function
! #########################################################
   subroutine deformFEMDomain(this, disp, velocity, accel, dt)
      class(FEMDomain_), intent(inout) :: this
      real(real64), optional, intent(in) :: disp(:), velocity(:), accel(:), dt

      if (this%mesh%empty()) then
         print *, "ERROR :: no mesh is imported."
         return
      else
         if (present(disp)) then
            this%mesh%nodcoord(:, :) = this%mesh%nodcoord(:, :) + reshape(disp, this%nn(), this%nd())
         end if
         if (present(velocity)) then
            if (.not. present(dt)) then
               print *, "ERROR :: dt shuold be imported."
               stop
            end if
            this%mesh%nodcoord(:, :) = this%mesh%nodcoord(:, :) + reshape(velocity, this%nn(), this%nd())*dt
         end if
         if (present(accel)) then
            if (.not. present(dt)) then
               print *, "ERROR :: dt shuold be imported."
               stop
            end if
            this%mesh%nodcoord(:, :) = this%mesh%nodcoord(:, :) + 0.50d0*reshape(accel, this%nn(), this%nd())*dt*dt
         end if

      end if

   end subroutine
! ####################################################################

   function getMyIDFEMDomain(this, FEMDomains) result(id)
      class(FEMDOmain_), intent(in) :: this
      type(FEMDOmain_), intent(in) :: FEMDomains(:)
      integer(int32) :: id, i

      id = 0
      do i = 1, size(FEMDomains)
         if (FEMDomains(i)%uuid == this%uuid) then
            if (id /= 0) then
               id = -1 ! Crushed!
            else
               id = i
            end if
         end if
      end do

   end function

   function getMyIDFEMDomainp(this, FEMDomainp) result(id)
      class(FEMDOmainp_), intent(in) :: this
      type(FEMDOmainp_), intent(in) :: femdomainp(:)
      integer(int32) :: id, i

      id = 0
      do i = 1, size(femdomainp)
         if (femdomainp(i)%femdomainp%uuid == this%femdomainp%uuid) then
            if (id /= 0) then
               id = -1 ! Crushed!
            else
               id = i
            end if
         end if
      end do

   end function

   subroutine overset_FEMDomainp(this, FEMDomainp, to, by, debug)
      class(FEMDomainp_), intent(inout) :: this
      type(FEMDomainp_), intent(inout) :: femdomainp(:)
      integer(int32), intent(in) :: to
      character(*), intent(in) :: by
      integer(int32) :: from, MyID, algorithm
      logical, optional, intent(in) :: debug

      myID = this%getMyID(femdomainp)
      select case (by)
      case default
         algorithm = FEMDomain_Overset_GPP
      case ("GPP", "gpp")
         algorithm = FEMDomain_Overset_GPP
      case ("P2P", "PP", "p2p", "PointToPoint")
         algorithm = FEMDomain_Overset_P2P
      end select

      if (MyID == 0) then
         print *, "[ERROR] oversetFEMDomain >> 404 Not Found."
         return
      end if

      if (MyID == -1) then
         print *, "[ERROR] oversetFEMDomain >> uuids are crushed!"
         return
      end if

      call femdomainp(MyID)%femdomainp%overset(femdomainp(to)%femdomainp, DomainID=to, &
                                               algorithm=algorithm, MyDomainID=MyID, debug=debug)

   end subroutine

   subroutine oversetFEMDomains(this, FEMDomains, to, by, debug)
      class(FEMDomain_), intent(inout) :: this
      type(FEMDomain_), intent(inout) :: FEMDomains(:)
      integer(int32), intent(in) :: to
      character(*), intent(in) :: by
      integer(int32) :: from, MyID, algorithm
      logical, optional, intent(in) :: debug

      myID = this%getMyID(FEMDomains)
      select case (by)
      case default
         algorithm = FEMDomain_Overset_GPP
      case ("GPP", "gpp")
         algorithm = FEMDomain_Overset_GPP
      case ("P2P", "PP", "p2p", "PointToPoint")
         algorithm = FEMDomain_Overset_P2P
      end select

      if (MyID == 0) then
         print *, "[ERROR] oversetFEMDomain >> 404 Not Found."
         return
      end if

      if (MyID == -1) then
         print *, "[ERROR] oversetFEMDomain >> uuids are crushed!"
         return
      end if

      call FEMDomains(MyID)%overset(femdomains(to), DomainID=to, &
                                    algorithm=algorithm, MyDomainID=MyID, debug=debug)

   end subroutine

   subroutine oversetFEMDomain(this, FEMDomain, DomainID, algorithm, MyDomainID, debug)
      class(FEMDomain_), intent(inout) :: this
      type(FEMDomain_), intent(inout) :: FEMDomain
      integer(int32), intent(in) :: DomainID, algorithm
      integer(int32), optional, intent(in) :: MyDomainID

      integer(int32) :: ElementID, GaussPointID, NodeID, MyElementID
      real(real64), allocatable :: position(:)
      integer(int32), allocatable :: InterConnect(:), DomainIDs12(:), ElementIDList(:)
      logical, allocatable :: InsideElement(:)
      type(OversetConnect_), allocatable :: buf_oversetConnect(:)
      logical, optional, intent(in) :: debug
      integer(int32) :: kk

      if (.not. allocated(this%OversetConnect)) then
         allocate (this%OversetConnect(300))
      end if
      position = zeros(this%nd())

      if (algorithm == FEMDomain_Overset_GPP) then

         if (.not. allocated(this%OversetExists)) then
            this%OversetExists = int(zeros(this%ne(), this%ngp()))
         end if

         InterConnect = int(zeros(this%nne() + femdomain%nne()))

         DomainIDs12 = int(zeros(this%nne() + femdomain%nne()))
         DomainIDs12(1:this%nne()) = input(default=1, option=MyDomainID)
         DomainIDs12(this%nne() + 1:) = DomainID

         if (present(debug)) then
            if (debug) then
               print *, "FEMDomain%overset >> "
            end if
         end if

         ! ElementIDList
         ElementIDList = this%getElementList( &
                         xmin=FEMDomain%x_min(), &
                         ymin=FEMDomain%y_min(), &
                         zmin=FEMDomain%z_min(), &
                         xmax=FEMDomain%x_max(), &
                         ymax=FEMDomain%y_max(), &
                         zmax=FEMDomain%z_max())

         do kk = 1, size(ElementIDList)
            ElementID = ElementIDList(kk)
            if (present(debug)) then
               if (debug) then
                  print *, "Elem", kk, "/", size(ElementIDList)
               end if
            end if
            MyElementID = ElementIDList(kk)
            do GaussPointID = 1, this%ngp()
               ! For 1st element, create stiffness matrix
               ! set global coordinate
               position = this%GlobalPositionOfGaussPoint(ElementID, GaussPointID)
               if (femdomain%mesh%nearestElementID(x=position(1), y=position(2), z=position(3)) <= 0) then
                  cycle
               else
                  this%OversetExists(ElementID, GaussPointID) = this%OversetExists(ElementID, GaussPointID) + 1
               end if

               if (this%num_oversetconnect + 1 > size(this%OversetConnect)) then
                  buf_oversetConnect = this%OversetConnect
                  deallocate (this%OversetConnect)
                  allocate (this%OversetConnect(size(buf_oversetConnect)*2))
                  this%OversetConnect(1:size(buf_oversetConnect)) = buf_oversetConnect(1:size(buf_oversetConnect))
                  deallocate (buf_oversetConnect)
               end if

               this%num_oversetconnect = this%num_oversetconnect + 1

               InterConnect(1:this%nne()) = this%connectivity(ElementID)
               InterConnect(this%nne() + 1:) &
                  = femdomain%connectivity(femdomain%mesh%nearestElementID(x=position(1), y=position(2), z=position(3)))

               this%OversetConnect(this%num_oversetconnect)%projection = FEMDomain_Overset_GPP
               this%OversetConnect(this%num_oversetconnect)%position = position
               this%OversetConnect(this%num_oversetconnect)%ElementID = ElementID
               this%OversetConnect(this%num_oversetconnect)%MyElementID = MyElementID
               this%OversetConnect(this%num_oversetconnect)%GaussPointID = GaussPointID
               this%OversetConnect(this%num_oversetconnect)%InterConnect = InterConnect
               this%OversetConnect(this%num_oversetconnect)%DomainIDs12 = DomainIDs12
               this%OversetConnect(this%num_oversetconnect)%active = .true.
               ! 何を記憶して，何はもう一度計算するか．

            end do
         end do

      elseif (algorithm == FEMDomain_Overset_P2P) then

         if (.not. allocated(this%OversetExists)) then
            this%OversetExists = int(zeros(this%nn(), 1))
         end if

         allocate (DomainIDs12(femdomain%nne() + 1))
         allocate (InterConnect(femdomain%nne() + 1))

         do NodeID = 1, this%nn()
            ! For 1st element, create stiffness matrix
            ! set global coordinate
            position(:) = this%mesh%nodcoord(NodeID, :)
            ElementID = femdomain%mesh%nearestElementID(x=position(1), y=position(2), z=position(3))
            MyElementID = this%mesh%nearestElementID(x=position(1), y=position(2), z=position(3))
            if (ElementID <= 0) then
               cycle
            else
               this%OversetExists(NodeID, 1) = this%OversetExists(NodeID, 1) + 1
            end if

            if (this%num_oversetconnect + 1 > size(this%OversetConnect)) then
               buf_oversetConnect = this%OversetConnect
               deallocate (this%OversetConnect)
               allocate (this%OversetConnect(size(buf_oversetConnect)*2))
               this%OversetConnect(1:size(buf_oversetConnect)) = buf_oversetConnect(1:size(buf_oversetConnect))
               deallocate (buf_oversetConnect)
            end if
            this%num_oversetconnect = this%num_oversetconnect + 1

            InterConnect(1) = NodeID
            InterConnect(2:) = femdomain%connectivity(femdomain%mesh%nearestElementID(x=position(1), y=position(2), z=position(3)))
            DomainIDs12(1) = input(default=1, option=myDomainID)
            DomainIDs12(2:) = DomainID

            this%OversetConnect(this%num_oversetconnect)%projection = FEMDomain_Overset_P2P
            this%OversetConnect(this%num_oversetconnect)%position = position
            this%OversetConnect(this%num_oversetconnect)%ElementID = ElementID
            this%OversetConnect(this%num_oversetconnect)%MyElementID = MyElementID
            this%OversetConnect(this%num_oversetconnect)%GaussPointID = 0 ! ignore
            this%OversetConnect(this%num_oversetconnect)%InterConnect = InterConnect
            this%OversetConnect(this%num_oversetconnect)%DomainIDs12 = DomainIDs12
            this%OversetConnect(this%num_oversetconnect)%active = .true.

            !A_ij = penalty*femdomain%ConnectMatrix(position,DOF=femdomain%nd() )
                        ! ! assemble them
            !call this%solver%assemble(&
            !        connectivity=InterConnect,&
            !        DOF=femdomain%nd() ,&
            !        eMatrix=A_ij,&
            !        DomainIDs=DomainIDs12)
         end do
      else
         ! invalid
         print *, "oversetFEMDomain :: invalid algroithm "
         stop
      end if

   end subroutine

! #############################################################
   pure function NumOversetElementsFEMDomain(this) result(ret)
      class(FEMDomain_), intent(in) :: this
      integer(int32) :: ret

      ret = this%num_oversetconnect

   end function
! #############################################################

! #############################################################
   subroutine refineFEMDomain(this, ElementID, success)
      class(FEMDomain_), intent(inout) :: this
      integer(int32), intent(in) :: ElementID
      real(real64), allocatable :: NodCoord_main(:, :)
      real(real64), allocatable :: NodCoord_buf(:, :)

      integer(int32), allocatable :: ElemNod_buf(:, :)
      integer(int32), allocatable :: cross_pairing(:, :), new_pairing(:, :), main_new_pairing(:, :)
      real(real64) :: theta
      integer(int32) :: i, j, nn
      logical, optional, intent(inout):: success

      if (present(success)) then
         success = .true.
      end if

      if (ElementID > this%ne()) then
         if (present(success)) then
            success = .false.
         end if
         return
      end if
      ! Only for 8-node isoparametric element
      if (this%nne() /= 8) then
         print *, "[ERROR] refineFEMDomain is only for 8-node isoparametric elements."
         if (present(success)) then
            success = .false.
         end if
         stop
      else
         NodCoord_buf = zeros(this%nne(), 3)
         ElemNod_buf = int(zeros(7, this%nne()))
         NodCoord_buf = this%mesh%NodCoord(this%mesh%ElemNod(ElementID, :), :)

         nn = this%nn()

         ![1,7]
         ![2,8]
         ![3,5]
         ![4,6]
         ![5,3]
         ![6,4]
         ![7,1]
         ![8,2]
         cross_pairing = int(zeros(this%nne(), 2))
         cross_pairing(1, 1:2) = [1, 7]
         cross_pairing(2, 1:2) = [2, 8]
         cross_pairing(3, 1:2) = [3, 5]
         cross_pairing(4, 1:2) = [4, 6]
         cross_pairing(5, 1:2) = [5, 3]
         cross_pairing(6, 1:2) = [6, 4]
         cross_pairing(7, 1:2) = [7, 1]
         cross_pairing(8, 1:2) = [8, 2]

         theta = 1.0d0/4.0d0

         do i = 1, size(cross_pairing, 1)
            do j = 1, size(cross_pairing, 2)
               cross_pairing(i, j) = this%mesh%elemnod(ElementID, cross_pairing(i, j))
            end do
         end do

         ! 1/3 method
         do i = 1, size(cross_pairing, 1)
            NodCoord_buf(i, 1:3) = (1.0d0 - theta)*this%mesh%nodcoord( &
                                   cross_pairing(i, 1), 1:3) &
                                   + (theta)*this%mesh%nodcoord( &
                                   cross_pairing(i, 2), 1:3)
         end do

         ! connectivity

         ElemNod_buf(1, 1) = this%mesh%elemnod(ElementID, 1)
         ElemNod_buf(1, 2) = this%mesh%elemnod(ElementID, 2)
         ElemNod_buf(1, 3) = this%mesh%elemnod(ElementID, 3)
         ElemNod_buf(1, 4) = this%mesh%elemnod(ElementID, 4)
         ElemNod_buf(1, 5) = nn + 1
         ElemNod_buf(1, 6) = nn + 2
         ElemNod_buf(1, 7) = nn + 3
         ElemNod_buf(1, 8) = nn + 4

         ElemNod_buf(2, 1) = this%mesh%elemnod(ElementID, 1)
         ElemNod_buf(2, 2) = this%mesh%elemnod(ElementID, 5)
         ElemNod_buf(2, 3) = this%mesh%elemnod(ElementID, 6)
         ElemNod_buf(2, 4) = this%mesh%elemnod(ElementID, 2)
         ElemNod_buf(2, 5) = nn + 1
         ElemNod_buf(2, 6) = nn + 5
         ElemNod_buf(2, 7) = nn + 6
         ElemNod_buf(2, 8) = nn + 2

         ElemNod_buf(3, 1) = this%mesh%elemnod(ElementID, 2)
         ElemNod_buf(3, 2) = this%mesh%elemnod(ElementID, 6)
         ElemNod_buf(3, 3) = this%mesh%elemnod(ElementID, 7)
         ElemNod_buf(3, 4) = this%mesh%elemnod(ElementID, 3)
         ElemNod_buf(3, 5) = nn + 2
         ElemNod_buf(3, 6) = nn + 6
         ElemNod_buf(3, 7) = nn + 7
         ElemNod_buf(3, 8) = nn + 3

         ElemNod_buf(4, 1) = this%mesh%elemnod(ElementID, 3)
         ElemNod_buf(4, 2) = this%mesh%elemnod(ElementID, 7)
         ElemNod_buf(4, 3) = this%mesh%elemnod(ElementID, 8)
         ElemNod_buf(4, 4) = this%mesh%elemnod(ElementID, 4)
         ElemNod_buf(4, 5) = nn + 3
         ElemNod_buf(4, 6) = nn + 7
         ElemNod_buf(4, 7) = nn + 8
         ElemNod_buf(4, 8) = nn + 4

         ElemNod_buf(5, 1) = this%mesh%elemnod(ElementID, 4)
         ElemNod_buf(5, 2) = this%mesh%elemnod(ElementID, 8)
         ElemNod_buf(5, 3) = this%mesh%elemnod(ElementID, 5)
         ElemNod_buf(5, 4) = this%mesh%elemnod(ElementID, 1)
         ElemNod_buf(5, 5) = nn + 4
         ElemNod_buf(5, 6) = nn + 8
         ElemNod_buf(5, 7) = nn + 5
         ElemNod_buf(5, 8) = nn + 1

         ElemNod_buf(6, 1) = this%mesh%elemnod(ElementID, 8)
         ElemNod_buf(6, 2) = this%mesh%elemnod(ElementID, 7)
         ElemNod_buf(6, 3) = this%mesh%elemnod(ElementID, 6)
         ElemNod_buf(6, 4) = this%mesh%elemnod(ElementID, 5)
         ElemNod_buf(6, 5) = nn + 8
         ElemNod_buf(6, 6) = nn + 7
         ElemNod_buf(6, 7) = nn + 6
         ElemNod_buf(6, 8) = nn + 5

         ElemNod_buf(7, 1) = nn + 1
         ElemNod_buf(7, 2) = nn + 2
         ElemNod_buf(7, 3) = nn + 3
         ElemNod_buf(7, 4) = nn + 4
         ElemNod_buf(7, 5) = nn + 5
         ElemNod_buf(7, 6) = nn + 6
         ElemNod_buf(7, 7) = nn + 7
         ElemNod_buf(7, 8) = nn + 8

         this%mesh%nodcoord = this%mesh%nodcoord.v.NodCoord_buf

         if (ElementID == 1) then
            if (this%ne() == 1) then
               this%mesh%elemnod = ElemNod_buf
            else
               this%mesh%elemnod = ElemNod_buf.v.this%mesh%elemnod(2:, :)
            end if
         elseif (ElementID == this%ne()) then
            this%mesh%elemnod = this%mesh%elemnod(:this%ne() - 1, :) .v.ElemNod_buf
         else
            this%mesh%elemnod = this%mesh%elemnod(:ElementID - 1, :) .v.ElemNod_buf &
                                .v.this%mesh%elemnod(ElementID + 1:, :)
         end if
      end if

   end subroutine
! #############################################################

! #############################################################
   subroutine refine_elementsFEMDomain(this, ElementID)
      class(FEMDomain_), intent(inout) :: this
      integer(int32), intent(in) :: ElementID(:)
      real(real64), allocatable :: NodCoord_main(:, :)
      real(real64), allocatable :: NodCoord_buf(:, :)

      integer(int32), allocatable :: ElemNod_buf(:, :)
      integer(int32), allocatable :: cross_pairing(:, :), new_pairing(:, :), main_new_pairing(:, :)
      real(real64) :: theta
      integer(int32) :: i, j, nn
      integer(int32), allocatable :: ElementList(:)
      logical :: success

      ElementList = ElementID
      call heapsort(size(ElementList), ElementList)

      do i = 1, size(ElementList)
         call this%refine(ElementID=ElementList(i), success=success)
         if (success) then
            do j = i + 1, size(ElementList)
               if (ElementList(j) > ElementList(i)) then
                  ElementList(j) = ElementList(j) - 1 + 7
               end if
            end do
         end if
      end do

   end subroutine
! #############################################################

! #############################################################
   subroutine csvFEMDomain(this, name)
      ! export as point cloud
      class(FEMDomain_), intent(in) :: this
      character(*), intent(in) :: name
      integer(int32) :: i, j
      type(IO_) :: f

      if (this%empty()) stop "ERROR :: csvFEMDomain >> no data"

      call f%open(name//".csv", "w")
      do i = 1, this%nn()
         write (f%fh, *) this%mesh%nodcoord(i, 1), ",", this%mesh%nodcoord(i, 2), ",", this%mesh%nodcoord(i, 3), ","
      end do
      call f%close()

   end subroutine

   subroutine fitFEMDomain(this, x, y, z, debug)
      class(FEMDomain_), intent(inout) :: this
      real(real64), intent(in) :: x(:), y(:), z(:)
      logical, optional, intent(in) :: debug
      real(real64), allocatable :: center(:), min_xyz(:), max_xyz(:), this_center(:), &
                                   cov_mat(:, :), W(:), WORK(:), xyz(:, :), v1(:), v2(:), v3(:)
      character :: JOBZ, UPLO
      real(real64) :: v_per_v0
      integer(int32) :: i, j, n, itr, INFO, LDA, LWORK

      n = this%nd()

      if (n == 3) then
         center = zeros(n)

         center(1) = sum(x)/size(x)
         center(2) = sum(y)/size(y)
         center(3) = sum(z)/size(z)

         this_center = this%centerPosition()

         call this%move( &
            x=-this_center(1) + center(1), &
            y=-this_center(2) + center(2), &
            z=-this_center(3) + center(3) &
            )

         xyz = zeros(3, size(x))
         xyz(1, :) = x(:)
         xyz(2, :) = y(:)
         xyz(3, :) = z(:)
         ! long-side finder
         ! by PCA
         ! 3 dimensions, 20 samples
         cov_mat = covarianceMatrix(xyz, xyz, n=3)

         WORK = zeros(3*3 - 1)
         W = zeros(3)
         JOBZ = 'V'
         UPLO = 'U'
         LWORK = 3*3 - 1
         N = 3
         LDA = 3
         W = zeros(3)
         call dsyev(JOBZ, &
                    UPLO, &
                    N, &
                    cov_mat, &
                    LDA, &
                    W, &
                    WORK, &
                    LWORK, &
                    INFO)
!
         ! eigenvalues
         ! w(1:3)

         ! eigenvectors
         v1 = cov_mat(:, 1)
         v2 = cov_mat(:, 2)
         v3 = cov_mat(:, 3)
         v1 = v1(:)/norm(v1)
         v2 = v2(:)/norm(v2)
         v3 = v3(:)/norm(v3)
         cov_mat(:, 1) = v1*sqrt(w(1))
         cov_mat(:, 2) = v2*sqrt(w(2))
         cov_mat(:, 3) = v3*sqrt(w(3))
         ! x -> v1, times(w(1))
         ! y -> v2
         ! z -> v3
         !$OMP parallel do
         do i = 1, this%nn()
            this%mesh%nodcoord(i, :) = matmul(cov_mat, this%mesh%nodcoord(i, :))
         end do
         !$OMP end parallel do
         v_per_v0 = &
            (maxval(x) - minval(x))/(this%xmax() - this%xmin())/3.0d0 &
            + (maxval(y) - minval(y))/(this%ymax() - this%ymin())/3.0d0 &
            + (maxval(z) - minval(z))/(this%zmax() - this%zmin())/3.0d0

         this%mesh%nodcoord(:, 1) = this%mesh%nodcoord(:, 1)*v_per_v0
         this%mesh%nodcoord(:, 2) = this%mesh%nodcoord(:, 2)*v_per_v0
         this%mesh%nodcoord(:, 3) = this%mesh%nodcoord(:, 3)*v_per_v0

         if (present(debug)) then
            if (debug) then
               call print(">>> eigenvalue >>>")
               call print(w)
               call print(">>> eigenvector >>>")
               call print(cov_mat)
            end if
         end if

         center = zeros(n)

         center(1) = sum(x)/size(x)
         center(2) = sum(y)/size(y)
         center(3) = sum(z)/size(z)

         this_center = this%centerPosition()

         call this%move( &
            x=-this_center(1) + center(1), &
            y=-this_center(2) + center(2), &
            z=-this_center(3) + center(3) &
            )

      else
         print *, "fitFEMDomain >> only size(point_cloud,2)==3 is implemented. "
         stop
      end if

   end subroutine

   subroutine randomDanceFEMDomain(this, move, rotate, resize)
      class(FEMDomain_), intent(inout) :: this
      ! 1st and 2nd moment
      real(real64), optional, intent(in) :: move(1:2), rotate(1:2), resize(1:2)
      type(Random_) :: random
      real(real64) :: rot_angle(1:3), center(1:3)
      if (present(resize)) then

         rot_angle = this%total_rotation
         center(1) = this%Position_x()
         center(2) = this%Position_y()
         center(3) = this%Position_z()

         call this%move( &
            x=-center(1), &
            y=-center(2), &
            z=-center(3) &
            )

         call this%rotate( &
            x=-rot_angle(1), &
            y=-rot_angle(2), &
            z=-rot_angle(3) &
            )

         call this%resize( &
            x_rate=random%gauss(mu=resize(1), sigma=resize(2)), &
            y_rate=random%gauss(mu=resize(1), sigma=resize(2)), &
            z_rate=random%gauss(mu=resize(1), sigma=resize(2)) &
            )

         call this%rotate( &
            x=rot_angle(1), &
            y=rot_angle(2), &
            z=rot_angle(3) &
            )
         call this%move( &
            x=center(1), &
            y=center(2), &
            z=center(3) &
            )
      end if

      if (present(rotate)) then
         center(1) = this%Position_x()
         center(2) = this%Position_y()
         center(3) = this%Position_z()
         call this%move( &
            x=-center(1), &
            y=-center(2), &
            z=-center(3) &
            )
         call this%rotate( &
            x=random%gauss(mu=rotate(1), sigma=rotate(2)), &
            y=random%gauss(mu=rotate(1), sigma=rotate(2)), &
            z=random%gauss(mu=rotate(1), sigma=rotate(2)) &
            )
         call this%move( &
            x=center(1), &
            y=center(2), &
            z=center(3) &
            )
      end if

      if (present(move)) then
         call this%move( &
            x=random%gauss(mu=move(1), sigma=move(2)), &
            y=random%gauss(mu=move(1), sigma=move(2)), &
            z=random%gauss(mu=move(1), sigma=move(2)) &
            )
      end if

   end subroutine

   function PCAvectorFEMDomain(this, eigen_values) result(vectors)
      class(FEMDomain_), intent(inout) :: this
      real(real64), optional, allocatable, intent(inout) :: eigen_values(:)
      real(real64), allocatable :: vectors(:, :), center(:), A(:, :)

      !>>>>>>>>>>>>>> INPUT
      integer(int32) :: ITYPE = 1   ! A*x = (lambda)*B*x
      character(1) :: JOBZ = 'V' ! Compute eigenvalues and eigenvectors.
      character(1) :: UPLO = 'U' ! Upper triangles of A and B are stored;
      !<<<<<<<<<<<<<< INPUT

      integer(int32) :: N = 3 ! order of matrix
      real(real64), allocatable :: AP(:)
      real(real64), allocatable :: BP(:)
      real(real64), allocatable :: W(:)
      real(real64), allocatable :: Z(:, :), M(:)
      real(real64), allocatable :: WORK(:), ID(:)

      integer(int32), allocatable :: IWORK(:), IDS(:)
      integer(int32) :: LDZ
      integer(int32) :: LWORK
      integer(int32) :: LIWORK
      integer(int32) :: INFO

      center = this%position()
      call this%move( &
         x=-center(1), &
         y=-center(2), &
         z=-center(3))

      A = matmul(transpose(this%mesh%nodcoord), this%mesh%nodcoord)
      A = A/dble(this%nn() - 1)

      !>>>>>>>>>>>>>> INPUT
      N = 3
      LDZ = 3
      LWORK = 1 + 6*N + 2*N**2
      LIWORK = 3 + 5*N
      !<<<<<<<<<<<<<< INPUT

      !>>>>>>>>>>>>>>  INPUT/OUTPUT
      AP = zeros(N*(N + 1)/2)
      BP = zeros(N*(N + 1)/2)
      ! Upper triangle matrix
      AP = [A(1, 1), A(1, 2), A(2, 2), A(1, 3), A(2, 3), A(3, 3)]
      BP = [1.0d0, 0.0d0, 1.0d0, 0.0d0, 0.0d0, 1.0d0]
      !<<<<<<<<<<<<<< INPUT/OUTPUT

      !>>>>>>>>>>>>>>  OUTPUT
      W = zeros(N)
      Z = zeros(LDZ, N)
      WORK = zeros(LWORK)
      IWORK = zeros(LIWORK)
      INFO = 0
      !<<<<<<<<<<<<<< OUTPUT

      call DSPGVD(ITYPE, JOBZ, UPLO, N, AP, BP, W, Z, LDZ, WORK, &
                  LWORK, IWORK, LIWORK, INFO)

      vectors = Z
      if (present(eigen_values)) then
         eigen_values = W
      end if

      call this%move( &
         x=center(1), &
         y=center(2), &
         z=center(3))

   end function

   function getElementCauchyStressFEMDomain(this, displacement, E, v, i, j, option) result(sigma)
      class(FEMDomain_), intent(inout) :: this
      real(real64), intent(in) :: displacement(:)
      real(real64), intent(in) :: E(:), v(:)
      real(real64), allocatable :: sigma(:), sigma_tensor(:, :)
      integer(int32), optional, intent(in) :: i, j
      character(*), optional, intent(in) :: option

      real(real64) :: YM, PR
      integer(int32) :: n, m

      if (present(i) .and. present(j)) then

         ! get cell-avaraged Cauchy stress \sigma(i,j)
         sigma = zeros(this%ne())
         do n = 1, this%ne()
            if (size(E) == 1) then
               YM = E(1)
            elseif (size(E) == this%ne()) then
               YM = E(n)
            else
               print *, "ERROR :: getElementCauchyStressFEMDomain >> Invalid vector size of E(:)"
               print *, "size(E) should be 1 or number_of_element  "
               stop
            end if
            if (size(v) == 1) then
               PR = v(1)
            elseif (size(v) == this%ne()) then
               PR = v(n)
            else
               print *, "ERROR :: getElementCauchyStressFEMDomain >> Invalid vector size of v(:)"
               print *, "size(v) should be 1 or number_of_element  "
               stop
            end if

            sigma_tensor = this%StressMatrix(ElementID=n, &
                                             disp=reshape(displacement, this%nn(), this%nd()), E=YM, v=PR)
            sigma(n) = sigma_tensor(i, j)

         end do
      elseif (present(option)) then
         sigma = zeros(this%ne())
         !$OMP parallel default(shared) private(YM,PR,sigma_tensor)
         !$OMP do
         do n = 1, this%ne()
            if (size(E) == 1) then
               YM = E(1)
            elseif (size(E) == this%ne()) then
               YM = E(n)
            else
               print *, "ERROR :: getElementCauchyStressFEMDomain >> Invalid vector size of E(:)"
               print *, "size(E) should be 1 or number_of_element  "
               stop
            end if
            if (size(v) == 1) then
               PR = v(1)
            elseif (size(v) == this%ne()) then
               PR = v(n)
            else
               print *, "ERROR :: getElementCauchyStressFEMDomain >> Invalid vector size of v(:)"
               print *, "size(v) should be 1 or number_of_element  "
               stop
            end if

            sigma_tensor = this%StressMatrix(ElementID=n, &
                                             disp=reshape(displacement, this%nn(), this%nd()), E=YM, v=PR)

            select case (option)

            case ("p", "P")
               sigma(n) = trace(sigma_tensor)/3.0d0

            case ("I", 'I1', "i1", "trace", "tr", "TRACE", "TR")
               sigma(n) = trace(sigma_tensor)

            case ("II", "I2", "i2", "ii")
               sigma(n) = (trace(sigma_tensor)*trace(sigma_tensor) &
                           - trace(matmul(sigma_tensor, sigma_tensor)))*0.50d0

            case ("III", "I3", "i3", "iii")
               sigma(n) = det_mat(sigma_tensor, n=size(sigma_tensor, 1))

            case ("J", 'J1', "j1", "j")
               sigma_tensor = sigma_tensor &
                              - trace(sigma_tensor)/3.0d0*eyes(size(sigma_tensor, 1), size(sigma_tensor, 2))
               sigma(n) = trace(sigma_tensor)

            case ("JJ", "J2", "j2", "jj")
               sigma_tensor = sigma_tensor &
                              - trace(sigma_tensor)/3.0d0*eyes(size(sigma_tensor, 1), size(sigma_tensor, 2))
               sigma(n) = (trace(sigma_tensor)*trace(sigma_tensor) &
                           - trace(matmul(sigma_tensor, sigma_tensor)))*0.50d0

            case ("JJJ", "J3", "j3", "jjj")
               sigma_tensor = sigma_tensor &
                              - trace(sigma_tensor)/3.0d0*eyes(size(sigma_tensor, 1), size(sigma_tensor, 2))
               sigma(n) = det_mat(sigma_tensor, n=size(sigma_tensor, 1))

            case ("1,1", "(1,1)", "_{1,1}")
               sigma(n) = sigma_tensor(1, 1)

            case ("2,2", "(2,2)", "_{2,2}")
               sigma(n) = sigma_tensor(2, 2)

            case ("3,3", "(3,3)", "_{3,3}")
               sigma(n) = sigma_tensor(3, 3)

            case ("1,2", "(1,2)", "_{1,2}", "2,1", "(2,1)", "_{2,1}")
               sigma(n) = sigma_tensor(1, 2)

            case ("1,3", "(1,3)", "_{1,3}", "3,1", "(3,1)", "_{3,1}")
               sigma(n) = sigma_tensor(1, 3)

            case ("3,2", "(3,2)", "_{3,2}", "2,3", "(2,3)", "_{2,3}")
               sigma(n) = sigma_tensor(2, 3)

            end select

         end do
         !$OMP end do
         !$OMP end parallel

      end if

   end function

   subroutine loadPointsFEMDomain(this, x, y, z)
      class(FEMDomain_), intent(inout) :: this
      real(real64), intent(in) :: x(:), y(:), z(:)

      if (.not. allocated(this%mesh%nodcoord)) then
         this%mesh%nodcoord = zeros(size(x), 3)
      end if
      this%mesh%nodcoord(:, 1) = x(:)
      this%mesh%nodcoord(:, 2) = y(:)
      this%mesh%nodcoord(:, 3) = z(:)

   end subroutine

   subroutine particlesFEMDomain(this, name)
      class(FEMDomain_), intent(inout) :: this
      character(*), intent(in) :: name
      type(IO_) :: f
      integer(int32) :: i

      if (.not. allocated(this%mesh%nodcoord)) then
         print *, "[Warning] no point is loaded."
         return
      end if

      call f%open(name + ".particles", "w")
      do i = 1, size(this%mesh%nodcoord, 1)
         write (f%fh, *) this%mesh%nodcoord(i, 1), "," &
            , this%mesh%nodcoord(i, 2), ",", this%mesh%nodcoord(i, 3)
      end do
      call f%close()

   end subroutine

   subroutine BooleanFEMDomain(this, object, difference)
      class(FEMDomain_), intent(inout) :: this
      type(FEMDomain_), intent(in)  :: object
      logical, optional, intent(in) :: difference
      integer(int32), allocatable  :: removed_nodes(:), buf(:)
      integer(int32) :: i, j, k, num_zeros, ElementID, NodeID
      logical :: inside

      if (present(difference)) then
         if (difference) then
            ! default = keep all nodes
            removed_nodes = int(zeros(this%nn()))

            !$OMP parallel do
            do i = 1, this%nn()
               ! detect in or out
               if (object%x_min() <= this%position_x(i) &
                   .and. this%position_x(i) <= object%x_max()) then
                  if (object%y_min() <= this%position_y(i) &
                      .and. this%position_y(i) <= object%y_max()) then
                     if (object%z_min() <= this%position_z(i) &
                         .and. this%position_z(i) <= object%z_max()) then
                        removed_nodes(i) = 1
                     end if
                  end if
               end if
            end do
            !$OMP end parallel do

            buf = removed_nodes
            deallocate (removed_nodes)
            allocate (removed_nodes(sum(buf)))
            if (sum(buf) == 0) then
               return
            end if
            j = 0
            do i = 1, size(buf)
               if (buf(i) == 1) then
                  j = j + 1
                  removed_nodes(j) = i
               end if
            end do
            deallocate (buf)

            num_zeros = 0
            do ElementID = 1, object%ne()
               inside = .false.
               do NodeID = 1, size(removed_nodes)
                  if (object%inside_of_element(point=this%position(NodeID), ElementID=ElementID)) then
                     inside = .true.
                     exit
                  end if
               end do
               if (.not. inside) then
                  removed_nodes(NodeID) = 0 ! remove
                  num_zeros = num_zeros + 1
               end if
            end do

            buf = removed_nodes
            deallocate (removed_nodes)
            allocate (removed_nodes(size(buf, 1) - num_zeros))

            j = 0
            do i = 1, size(buf)
               if (buf(i) /= 0) then
                  j = j + 1
                  removed_nodes(j) = buf(i)
               end if
            end do

            call this%killNodes(NodeList=removed_nodes)

         end if
      end if

   end subroutine
! ##################################################################
   function hasFEMDomain(this, position) result(inside)
      class(FEMDomain_), intent(in) :: this
      real(real64), intent(in)::position(:)
      real(real64) :: min_max_x(3, 1:2)
      logical :: inside
      integer(int32) :: counter, i

      min_max_x(1, 1:2) = [this%xmin(), this%xmax()]
      min_max_x(2, 1:2) = [this%ymin(), this%ymax()]
      min_max_x(3, 1:2) = [this%zmin(), this%zmax()]

      counter = 0
      do i = 1, size(position)
         if ((min_max_x(i, 1) <= position(i)) .and. (position(i) <= min_max_x(i, 2))) then
            counter = counter + 1
         end if
      end do
      inside = (counter == size(position))

   end function

! ##################################################################
   function inside_of_elementFEMDomain(this, point, ElementID) result(inside)
      class(FEMDomain_), intent(in) :: this
      real(real64), intent(in)::point(:)
      real(real64)::a1(3), a2(3), n(3)
      integer(int32), intent(in)::ElementID
      integer(int32), allocatable :: facet(:, :)
      integer(int32) :: i
      logical :: inside

      ! get facet
      facet = this%getSingleFacetNodeID(ElementID)
      do i = 1, size(facet, 1)
         a1(1:3) = this%position(facet(i, 2)) - this%position(facet(i, 1))
         a2(1:3) = this%position(facet(i, 4)) - this%position(facet(i, 1))
         n = cross_product(a1, a2)
         ! compute outer-nomal n
         if (dot_product(n, point) > 0.0d0) then
            inside = .false.
            return
         else
            cycle
         end if
      end do

      inside = .true.

      ! for all facet,dot_product(n,point)<=0 >> inside
      ! otherwise :: inside=.false.

   end function

   subroutine killNodesFEMDomain(this, NodeList)
      class(FEMDomain_), intent(inout)::this
      integer(int32), intent(in) :: NodeList(:)
      integer(int32), allocatable:: Kill_or_not(:), new_Node_ID(:)
      real(real64), allocatable :: rebuf(:, :)
      integer(int32), allocatable :: intbuf(:, :)
      integer(int32) :: i, j, n_remove_elem

      !e.g. [1, 3, 6]
      Kill_or_not = int(zeros(this%nn()))

      ![0,0,0,0,0,0]
      new_node_id = int(zeros(this%nn()))

      ![1,0,1,0,0,1]
      do i = 1, size(NodeList)
         Kill_or_not(NodeList(i)) = 1
      end do

      if (Kill_or_not(1) == 1) then
         new_node_id(1) = 0
      else
         new_node_id(1) = 1
      end if
      do i = 1, size(new_node_id) - 1
         new_node_id(i + 1) = new_node_id(i) + 1 - Kill_or_not(i + 1)
      end do
      !>> [0,1,1,2,3,3]

      rebuf = this%mesh%nodcoord

      deallocate (this%mesh%nodcoord)

      this%mesh%nodcoord = zeros(size(rebuf, 1) - sum(Kill_or_not), size(rebuf, 2))

      j = 0
      do i = 1, size(rebuf, 1)
         if (Kill_or_not(i) == 0) then
            j = j + 1
            this%mesh%nodcoord(j, :) = rebuf(i, :)
         end if
      end do

      deallocate (rebuf)

      n_remove_elem = 0
      do i = 1, size(this%mesh%elemnod, 1)
         do j = 1, size(this%mesh%elemnod, 2)
            if (kill_or_not(this%mesh%elemnod(i, j)) == 1) then
               this%mesh%elemnod(i, :) = 0
               n_remove_elem = n_remove_elem + 1
               exit
            end if
         end do
      end do

      intbuf = this%mesh%elemnod
      this%mesh%elemnod = int(zeros(size(intbuf, 1) - n_remove_elem, size(intbuf, 2)))

      j = 0
      do i = 1, size(intbuf, 1)
         if (intbuf(i, 1) /= 0) then
            j = j + 1
            this%mesh%elemnod(j, :) = intbuf(i, :)
         end if
      end do

      do i = 1, size(this%mesh%elemnod, 1)
         do j = 1, size(this%mesh%elemnod, 2)
            this%mesh%elemnod(i, j) = new_node_id(this%mesh%elemnod(i, j))
         end do
      end do

   end subroutine

   function clipVectorFEMDomain(this, vector, femdomains, DomainID) result(ret_vec)
      class(FEMDomain_), intent(in) :: this
      type(FEMDomain_), intent(in) :: femdomains(:)
      real(real64), intent(in) :: vector(:)
      real(real64), allocatable :: ret_vec(:)
      integer(int32), intent(in) :: DomainID
      integer(int32) :: i, j, k, DOF, n, total_nn

      ! Assuming vector(:) is a set of
      ! node-wise value
      total_nn = 0
      do i = 1, size(femdomains)
         total_nn = total_nn + femdomains(i)%nn()
      end do

      DOF = size(vector)/total_nn

      total_nn = 0
      do i = 1, DomainID - 1
         total_nn = total_nn + femdomains(i)%nn()
      end do

      ret_vec = zeros(this%nn()*DOF)
      ret_vec(:) = vector(total_nn*DOF + 1:total_nn*DOF + this%nn()*DOF)

   end function

   function getElementIDFEMDomain(this, x, debug, info) result(ElementID)
      class(FEMDomain_), intent(in) :: this
      real(real64), intent(in) :: x(:)
      logical, optional, intent(in) :: debug
      integer(int32), optional, allocatable, intent(inout) :: info(:)
      integer(int32) :: ElementID

      ElementID = this%mesh%getElementID(x=x, debug=debug, info=info)

   end function

! ##########################################################
   function getValueFEMDomain(this, scalar_field, position) result(retval)
      class(FEMDomain_), intent(inout) :: this
      real(real64), intent(in) :: scalar_field(:), position(1:3)
      real(real64) :: retval, localCoord(1:3)
      type(ShapeFunction_) :: sf
      integer(int32) :: ElementID, i

      ElementID = this%getElementID(x=position)

      if (ElementID <= 0) then
         print *, "getValueFEMDomain >> invalid element position"
         print *, "ERROR code: ", ElementID
         stop
      end if

      sf = this%getShapeFunction(ElementID=ElementID, position=position)
      retval = 0.0d0
      do i = 1, this%nne()
         retval = retval + sf%Nmat(i)*scalar_field(this%mesh%elemnod(ElementID, i))
      end do

   end function

!## physical operator

! ! ####################################################
!subroutine grubFEMDomain(this,x_min,x_max,y_min,y_max,z_min,z_max)
!        class(FEMDomain_),intent(in) :: this
!        real(real64),optional,intent(in) :: x_min,x_max,y_min,y_max,z_min,z_max
!
!
!        if(allocated(this%grub_NodeList) )then
!                this%grub_NodeList = this%select(x_min,x_max,y_min,y_max,z_min,z_max)
!        else
!                this%grub_NodeList = this%grub_NodeList // this%select(x_min,x_max,y_min,y_max,z_min,z_max)
!        endif
!
!end subroutine
! ! ####################################################
!
!
! ! ####################################################
!subroutine fixFEMDomain(this)
!        class(FEMDomain_),intent(in) :: this
!
!        if(allocated(this%grub_NodeList) )then
!                deallocate(this%grub_NodeList)
!        endif
!
!end subroutine
! ! ####################################################
!
!
! ! ####################################################
!subroutine releaseFEMDomain(this)
!        class(FEMDomain_),intent(in) :: this
!
!        if(allocated(this%grub_NodeList) )then
!                deallocate(this%grub_NodeList)
!        endif
!
!end subroutine
! ! ####################################################
   subroutine ImportSTLFileFEMDomain(this, name)
      class(FEMDomain_), intent(inout) :: this
      character(*), intent(in) :: name
      type(STL_) :: stl
      integer(int32) :: num_facet, num_point, num_dim, i, j, k

      if (.not. this%empty()) then
         call this%remove()
      end if

      call stl%import(name)
      num_facet = size(stl%facet, 1)
      num_point = size(stl%facet, 2)
      num_dim = size(stl%facet, 3)

      this%mesh%nodcoord = zeros(num_facet*num_point, num_dim)
      this%mesh%elemnod = zeros(num_facet, 8)
      do i = 1, num_facet
         do j = 1, num_point
            this%mesh%nodcoord((i - 1)*num_point + j, 1:num_dim) = stl%facet(i, j, 1:num_dim)
         end do
      end do

      do i = 1, num_facet
         do j = 1, num_point
            this%mesh%elemnod(i, j) = (i - 1)*num_point + j
         end do
         do j = num_point + 1, 8
            this%mesh%elemnod(i, j) = (i - 1)*num_point + num_point
         end do
      end do

   end subroutine

! ###################################################################
   function xyzFEMDomain(this) result(nodcoord)
      class(FEMDOmain_), intent(in) :: this
      real(real64), allocatable :: nodcoord(:, :)

      nodcoord = this%mesh%nodcoord

   end function
! ###################################################################

! ###################################################################
   function getStrainTensorFEMDomain(this, displacement, ElementID, GaussPointID, debug) result(StrainTensor)
      class(FEMDomain_), intent(inout) :: this
      real(real64), intent(in)   :: displacement(:, :)
      integer(int32), intent(in) :: ElementID, GaussPointID
      logical, optional, intent(in) :: debug
      real(real64), allocatable :: StrainTensor(:, :), Bmat(:, :), ElemDisp(:), StrainVector(:)
      type(ShapeFunction_) :: shapefunc
      integer(int32) :: i, j
      StrainTensor = zeros(3, 3)

      ! SOMETHING IS WRONG >> NEED DEBUG

      call shapefunc%SetType(NumOfDim=this%nd(), NumOfNodePerElem=this%nne(), NumOfGp=this%mesh%getNumOfGp())

      call getAllShapeFunc(shapefunc, elem_id=ElementID, &
                           nod_coord=this%Mesh%NodCoord, &
                           elem_nod=this%Mesh%ElemNod, OptionalGpID=GaussPointID)

      ElemDisp = zeros(size(this%mesh%elemnod, 2)*3)
      do i = 1, this%nne()
         do j = 1, 3
            ElemDisp(3*(i - 1) + j) = &
               Displacement(this%mesh%elemnod(ElementID, i), j)
         end do
      end do
      Bmat = this%Bmatrix(shapefunc)

      StrainVector = matmul(Bmat, ElemDisp)
      StrainTensor(1, 1) = StrainVector(1)
      StrainTensor(2, 2) = StrainVector(2)
      StrainTensor(3, 3) = StrainVector(3)
      StrainTensor(1, 2) = StrainVector(4)
      StrainTensor(2, 3) = StrainVector(5)
      StrainTensor(1, 3) = StrainVector(6)
      StrainTensor(2, 1) = StrainVector(4)
      StrainTensor(3, 2) = StrainVector(5)
      StrainTensor(3, 1) = StrainVector(6)

      if (present(debug)) then
         print *, "StrainVector"
         call print(StrainVector)
         print *, "Bmat"
         call print(Bmat)
         print *, "ElemDisp"
         call print(ElemDisp)
      end if

   end function

! ###################################################################

! ###################################################################
   function getVelocityGradientFEMDomain(this, velocity, ElementID, GaussPointID, debug) result(VelocityGradient)
      class(FEMDomain_), intent(inout) :: this
      real(real64), intent(in)   :: velocity(:, :)
      integer(int32), intent(in) :: ElementID, GaussPointID
      logical, optional, intent(in) :: debug
      real(real64), allocatable :: VelocityGradient(:, :), Lmat(:, :), ElemVelocity(:), StrainVector(:)
      type(ShapeFunction_) :: shapefunc
      integer(int32) :: i, j
      VelocityGradient = zeros(3, 3)


      call shapefunc%SetType(NumOfDim=this%nd(), NumOfNodePerElem=this%nne(), NumOfGp=this%mesh%getNumOfGp())

      call getAllShapeFunc(shapefunc, elem_id=ElementID, &
                           nod_coord=this%Mesh%NodCoord, &
                           elem_nod=this%Mesh%ElemNod, OptionalGpID=GaussPointID)

      ElemVelocity = zeros(size(this%mesh%elemnod, 2)*3)
      do i = 1, this%nne()
         do j = 1, 3
            ElemVelocity(3*(i - 1) + j) = &
               velocity(this%mesh%elemnod(ElementID, i), j)
         end do
      end do
      Lmat = this%Lmatrix(shapefunc)

      ! \cfrac{\partial v}{\partial x}

      StrainVector = matmul(Lmat, ElemVelocity)

      
      VelocityGradient(1, 1) = StrainVector(1)
      VelocityGradient(1, 2) = StrainVector(2)
      VelocityGradient(1, 3) = StrainVector(3)
      VelocityGradient(2, 1) = StrainVector(4)
      VelocityGradient(2, 2) = StrainVector(5)
      VelocityGradient(2, 3) = StrainVector(6)
      VelocityGradient(3, 1) = StrainVector(7)
      VelocityGradient(3, 2) = StrainVector(8)
      VelocityGradient(3, 3) = StrainVector(9)

      if (present(debug)) then
         print *, "StrainVector"
         call print(StrainVector)
         print *, "Lmat"
         call print(Lmat)
         print *, "ElemVelocity"
         call print(ElemVelocity)
      end if

   end function

   ! ###################################################################

   function getSpinTensorFEMDomain(this, velocity, ElementID, GaussPointID, debug) result(SpinTensor)
      class(FEMDomain_), intent(inout) :: this
      real(real64), intent(in)   :: velocity(:, :)
      integer(int32), intent(in) :: ElementID, GaussPointID
      logical, optional, intent(in) :: debug
      real(real64), allocatable :: SpinTensor(:, :), Wmat(:, :), ElemDisp(:), StrainVector(:)
      type(ShapeFunction_) :: shapefunc
      integer(int32) :: i, j
      SpinTensor = zeros(3, 3)

      call shapefunc%SetType(NumOfDim=this%nd(), NumOfNodePerElem=this%nne(), NumOfGp=this%mesh%getNumOfGp())

      call getAllShapeFunc(shapefunc, elem_id=ElementID, &
                           nod_coord=this%Mesh%NodCoord, &
                           elem_nod=this%Mesh%ElemNod, OptionalGpID=GaussPointID)

      ElemDisp = zeros(size(this%mesh%elemnod, 2)*3)
      do i = 1, this%nne()
         do j = 1, 3
            ElemDisp(3*(i - 1) + j) = &
               velocity(this%mesh%elemnod(ElementID, i), j)
         end do
      end do
      Wmat = this%Wmatrix(shapefunc)
      

      StrainVector = matmul(Wmat, ElemDisp)
      SpinTensor(1, 1) = StrainVector(1)
      SpinTensor(2, 2) = StrainVector(2)
      SpinTensor(3, 3) = StrainVector(3)
      SpinTensor(1, 2) = StrainVector(4)
      SpinTensor(2, 3) = StrainVector(5)
      SpinTensor(1, 3) = StrainVector(6)
      SpinTensor(2, 1) = - StrainVector(4)
      SpinTensor(3, 2) = - StrainVector(5)
      SpinTensor(3, 1) = - StrainVector(6)

      if (present(debug)) then
         print *, "StrainVector"
         call print(StrainVector)
         print *, "Wmat"
         call print(Wmat)
         print *, "ElemDisp"
         call print(ElemDisp)
      end if

   end function
! ###################################################################

   function getNumberOfOversetForElementFEMDomain(this) result(ret)
      class(FEMDomain_), intent(in) :: this
      integer(int32), allocatable :: ret(:)
      integer(int32) :: i, n

      if (this%empty()) then
         allocate (ret(0))
         return
      end if
      ret = int(zeros(this%ne()))

      if (.not. allocated(this%OversetConnect)) then
         ret(:) = 0
         return
      end if

      do i = 1, this%num_oversetconnect
         if (this%OversetConnect(i)%MyElementID < 0) cycle
         ret(this%OversetConnect(i)%MyElementID) = ret(this%OversetConnect(i)%MyElementID) + 1
      end do

   end function

   function ElementID2NodeIDFEMDomain(this, ElementID) result(NodeID)
      class(FEMDomain_), intent(in) :: this
      integeR(int32), intent(in) :: ElementID(:)
      integeR(int32), allocatable :: NodeID(:), nodecount(:)
      integeR(int32) :: i, j
      nodecount = int(zeros(this%nn()))

      do i = 1, size(ElementID)
         do j = 1, this%nne()
            nodecount(this%mesh%elemnod(ElementID(i), j)) = 1
         end do
      end do

      NodeID = getIDx(nodecount, equal_to=1)

   end function

! ###############################################################
   function fullFEMDomain(this, func, params) result(scalar_field)
      class(FEMDomain_), intent(in) :: this
      interface
         function func(x, params) result(scalar_value)
            use iso_fortran_env
            real(real64), intent(in) :: x(:)
            real(real64), optional, intent(in) :: params(:)
            real(real64) :: scalar_value
         end function
      end interface
      real(real64), optional, intent(in) :: params(:)
      real(real64), allocatable :: scalar_field(:)
      real(real64) :: x(1:3)
      integer(int32) :: NodeID

      scalar_field = zeros(this%nn())
      do NodeID = 1, this%nn()
         x = [this%position_x(NodeID), this%position_y(NodeID), this%position_z(NodeID)]
         scalar_field(NodeID) = func(x=x, params=params)
      end do

   end function

!#################################################################
   function ZeroMatrix_as_CRS_FEMDomains(femdomains, DOF) result(ret)
      type(FEMDomain_), intent(inout) :: femdomains(:)
      integer(int32), intent(in) :: DOF
      type(CRS_) :: ret, buf
      integer(int32) :: i, n, ncol

      !n = 0
      !do i=1,size(femdomains)
      !        n = n + femdomains(i)%nn()*DOF
      !enddo
      ! ignore overlap
      do i = 1, size(femdomains)
         buf = femdomains(i)%ZeroMatrix(DOF=DOF)
         if (i == 1) then
            ret%row_ptr = buf%row_ptr
            ret%col_idx = buf%col_idx
            ret%val = buf%val
            n = size(ret%row_ptr) - 1
            ncol = maxval(buf%row_ptr) - 1
         else
            buf%row_ptr(:) = buf%row_ptr(:) + ncol
            buf%col_idx(:) = buf%col_idx(:) + n

            ret%row_ptr = ret%row_ptr(:)//buf%row_ptr(2:)
            ret%col_idx = ret%col_idx(:)//buf%col_idx(:)
            ret%val = ret%val//buf%val
            n = size(ret%row_ptr) - 1
            ncol = maxval(buf%row_ptr) - 1
         end if
      end do

   end function
! #####################################################
   subroutine spanFEMDomain(this, p1, p2)
      class(FEMDomain_), intent(inout) :: this
      real(real64), intent(in) :: p1(:), p2(:)
      real(real64) :: center(1:3), this_center(1:3), X(3, 3), xbuf(1:3)
      real(real64) :: angle(1:3) = 0.0d0
      real(real64) :: z(1:3) = [0.0d0, 0.0d0, 1.0d0]
      real(real64) :: length, alpha, beta, gamma, n(1:3)
      integer(int32) :: i
      type(Random_) :: random

      center = 0.50d0*p1 + 0.50d0*p2
      this_center = this%centerPosition()
      length = norm(p1 - p2)
      call this%move( &
         x=-this_center(1), &
         y=-this_center(2), &
         z=-this_center(3) &
         )
      X(:, 1) = p2 - p1
      X(:, 2) = random%randn(3)
      X(:, 3) = random%randn(3)
      X(:, 1) = X(:, 1)/norm(X(:, 1))
      X(:, 2) = X(:, 2)/norm(X(:, 2))
      X(:, 3) = X(:, 3)/norm(X(:, 3))
      call GramSchmidt(X, size(X, 1), size(X, 2), X)
      xbuf(:) = X(:, 1)
      X(:, 1) = X(:, 3)
      X(:, 2) = X(:, 2)
      X(:, 3) = xbuf(:)

      call this%resize(z=length)

      if (norm(p1 - p2) == 0.0d0) return

      do i = 1, this%nn()
         this%mesh%nodcoord(i, :) = &
            this%mesh%nodcoord(i, 1)*X(:, 1) &
            + this%mesh%nodcoord(i, 2)*X(:, 2) &
            + this%mesh%nodcoord(i, 3)*X(:, 3)
      end do
      call this%move( &
         x=center(1), &
         y=center(2), &
         z=center(3) &
         )

   end subroutine

! #################################################
   subroutine to_HollowTube_FEMDomain(this, r_num, theta_num, z_num, thickness, radius, length)
      class(FEMDomain_), intent(inout) :: this
      integer(int32), optional, intent(in) :: r_num, z_num, theta_num
      real(real64), optional, intent(in) :: thickness, radius, length

      call this%mesh%to_HollowTube(r_num=r_num, &
                                   theta_num=theta_num, &
                                   z_num=z_num, &
                                   thickness=thickness, &
                                   radius=radius, &
                                   length=length)
   end subroutine
! #################################################

! #################################################
   subroutine to_culm_FEMDomain(this, r_num, theta_num, z_num, thickness, radius, length, &
                                node_thickness)
      class(FEMDomain_), intent(inout) :: this
      integer(int32), optional, intent(in) :: r_num, z_num, theta_num
      real(real64), optional, intent(in) :: thickness, radius, length, node_thickness

      call this%mesh%to_culm(r_num=r_num, &
                             theta_num=theta_num, &
                             z_num=z_num, &
                             thickness=thickness, &
                             radius=radius, &
                             length=length, &
                             node_thickness=node_thickness)
   end subroutine
! #################################################

! #################################################
   subroutine to_multi_culm_FEMDomain(this, r_num, theta_num, z_num, thickness, radius, length, &
                                      node_thickness, n)
      class(FEMDomain_), intent(inout) :: this
      type(FEMDomain_) :: single_culm
      integer(int32), optional, intent(in) :: r_num, z_num, theta_num
      real(real64), optional, intent(in) :: thickness, radius, length, node_thickness
      integer(int32), intent(in) :: n
      integer(int32) :: i
      real(real64) :: L

      call single_culm%mesh%to_culm(r_num=r_num, &
                                    theta_num=theta_num, &
                                    z_num=z_num, &
                                    thickness=thickness, &
                                    radius=radius, &
                                    length=length, &
                                    node_thickness=node_thickness)

      ! copy and joint
      L = single_culm%zmax() - single_culm%zmin()
      do i = 1, n
         if (i == 1) then
            this%mesh%nodcoord = single_culm%mesh%nodcoord
            this%mesh%elemnod = single_culm%mesh%elemnod
            this%mesh%elemmat = single_culm%mesh%elemmat
         else
            single_culm%mesh%nodcoord(:, 3) = single_culm%mesh%nodcoord(:, 3) + L
            this%mesh%nodcoord = this%mesh%nodcoord.v.single_culm%mesh%nodcoord
            this%mesh%elemnod = this%mesh%elemnod.v. (single_culm%mesh%elemnod + single_culm%nn()*(i - 1))
            this%mesh%elemmat = this%mesh%elemmat//single_culm%mesh%elemmat
         end if
      end do

      ! kill overlap nodes
      
      call this%remove_duplication()

   end subroutine
! #################################################

! #################################################
   subroutine to_cylinder_FEMDomain(this, x_num, y_num, z_num, radius, length)
      class(FEMDomain_), intent(inout) :: this
      integer(int32), optional, intent(in) :: x_num, z_num, y_num
      real(real64), optional, intent(in) :: radius(1:2), length
      real(real64) :: r(1:2), l
      integer(int32) :: xn, yn, zn

      r = input(default=[1.0d0, 1.0d0], option=radius)
      l = input(default=1.0d0, option=length)
      xn = input(default=20, option=x_num)
      yn = input(default=20, option=y_num)
      zn = input(default=20, option=z_num)

!call this%create("Cylinder3D",x_num=x_num,y_num=y_num,division=z_num,&
!        thickness=l,x_len=r(1),y_len=r(2) )

      call this%mesh%create(meshtype="Circle2D", &
                            x_num=x_num, y_num=y_num, x_len=1.0d0, y_len=1.0d0)
      call this%mesh%convert2Dto3D(thickness=l, division=z_num)
      call this%mesh%clean()

   end subroutine
! #################################################


! #################################################
   subroutine remove_duplication_FEMDomain(this,epsilon,debug)
      class(FEMDomain_), intent(inout) :: this
      logical,optional,intent(in) :: debug
      integer(int32), allocatable :: same_node_as(:), kill_node_list(:),order(:),buf(:,:),&
         dupulicated_node_is_one(:),groupIdx(:),dup_node_list(:),dup_n(:),new_node_idx(:)
      real(real64),allocatable :: new_nodcoord(:,:)
      real(real64),optional,intent(in) :: epsilon
      integer(int32) :: i, j, n, last_i,k
      type(Time_) :: time

      ! remove duplicated points
      same_node_as = int(zeros(this%nn()))
      n = 0
      if(present(debug) )then
         if(debug)then
            print *, "[ok] remove_duplication_FEMDomain >> started!@parallel"
         endif
      endif

      ! new algorithm
      ! Quadtree :: "getDuplicatedNodeList()" has bug
      
      dup_node_list = this%getDuplicatedNodeList(groupIdx,epsilon)
      
      if(size(dup_node_list)<1 .or. .not.allocated(dup_node_list))then
         
         if(present(debug) )then
            if(debug)then
               print *, "[ok] remove_duplication_FEMDomain >> no dupulication of nodes"
            endif
         endif
         return
      endif

      allocate(kill_node_list(size(dup_node_list) - groupIdx(size(groupIdx))))
      

      n = 0
      last_i = 0
      new_node_idx = int(zeros(this%nn()) )
      do i=1,size(dup_node_list)
         if(i==size(dup_node_list))then
            last_i = last_i + 1
            
            do j=last_i+1,i
               new_node_idx(dup_node_list(j))=-dup_node_list(last_i)
            enddo
            exit
         endif
         if(groupIdx(i+1)==groupIdx(i) )then
            n = n + 1
            kill_node_list(n)=dup_node_list(i+1)
         else
            ! groupIdx(i+1)/=groupIdx(i)
            last_i = last_i + 1
            
            do j=last_i+1,i
               new_node_idx(dup_node_list(j))=-dup_node_list(last_i)
            enddo
            last_i = i
            cycle
         endif
         
      enddo

      ! remove non-listed nodes and create new_node_idx(:)
      n = 0
      k = 0
      do i=1,size(new_node_idx)
         if(new_node_idx(i)<0 )then
            cycle 
         else
            n = n + 1
            new_node_idx(i) = n
         endif
      enddo

      do i=1,size(new_node_idx)
         if(new_node_idx(i)<0 )then
            new_node_idx(i) = new_node_idx(abs(new_node_idx(i)))
         else
            cycle
         endif
      enddo
      
      do i=1,this%ne()
         do j=1,this%nne()   
            this%mesh%elemnod(i,j) = new_node_idx(this%mesh%elemnod(i,j))
         enddo
      enddo

      !call this%killNodes(kill_node_list)
      new_nodcoord = zeros(maxval(new_node_idx),this%nd()) 
      do i=1,size(new_node_idx)
         new_nodcoord(new_node_idx(i),: ) = this%mesh%nodcoord(i,:)
      enddo
      this%mesh%nodcoord = new_nodcoord
      return

      ! (1) sort coordinate & remove duplication
      !order = [(i,i=1,this%nn())]
      !buf = this%mesh%nodcoord
      !print *, "sort and dup"
      !call sort_and_remove_duplication(buf,order)
      !deallocate(buf)
      !allocate(dupulicated_node_is_one(this%nn()) )
      !dupulicated_node_is_one(:) = 1
      !dupulicated_node_is_one(order(:)) = 0
      !allocate(kill_node_list(sum(dupulicated_node_is_one)) )
      !j = 0
      !do i=1,this%nn()
      !   if(dupulicated_node_is_one(i)==1)then
      !      j = j + 1
      !      kill_node_list(j) = i
      !   endif
      !enddo
      !print *, "kill-elem"
      !call this%killNodes(NodeList=kill_node_list)
      !return

      ! following algorithm is slow.


!      do i = 1, this%nn()
!         if (same_node_as(i) >= 1) cycle
!         do j = i + 1, this%nn()
!            if (same_node_as(j) >= 1) cycle
!            if (norm(this%mesh%nodcoord(i, :) - this%mesh%nodcoord(j, :)) <= 1.0e-18) then
!               same_node_as(j) = i
!               n = n + 1
!               cycle
!            end if
!         end do
!      end do
!      
!      if (n == 0) then
!         print *, "no duplicated nodes"
!         return
!      end if
!
!
!      if(present(debug) )then
!         if(debug)then
!            print *, "[ok] remove_duplication_FEMDomain >> searched"
!         endif
!      endif
!
!      ! remove nodes
!      do i = 1, this%ne()
!         do j = 1, this%nne()
!            if (same_node_as(this%mesh%elemnod(i, j)) == 0) then
!               cycle
!            else
!               this%mesh%elemnod(i, j) = same_node_as(this%mesh%elemnod(i, j))
!            end if
!         end do
!      end do
!
!
!      if(present(debug) )then
!         if(debug)then
!            print *, "[ok] remove_duplication_FEMDomain >> killed node selected"
!         endif
!      endif
!
!      allocate (kill_node_list(n))
!      kill_node_list(:) = 0
!      n = 0
!      do i = 1, size(same_node_as)
!         if (same_node_as(i) /= 0) then
!            n = n + 1
!            kill_node_list(n) = i
!         end if
!      end do
!
!
!      call this%killNodes(NodeList=kill_node_list)
!
!
!      if(present(debug) )then
!         if(debug)then
!            print *, "[ok] remove_duplication_FEMDomain >> finished"
!         endif
!      endif
!      
   end subroutine
! #################################################
   subroutine cubeFEMDomain(this, x_num, y_num, z_num, &
                            x_axis, y_axis, z_axis)
      class(FEMDomain_), intent(inout) :: this
      integer(int32), optional, intent(in) :: x_num, y_num, z_num
      real(real64), optional, intent(in) :: x_axis(:), y_axis(:), z_axis(:)

      call this%create("Cube3D", x_num=x_num, y_num=y_num, z_num=z_num, &
                       x_axis=x_axis, y_axis=y_axis, z_axis=z_axis)
   end subroutine

! #################################################

! #################################################
   function getNeighboringElementListFEMDomain(this, ElementID) result(ret)
      class(FEMDomain_), intent(in) :: this
      integer(int32), intent(in) :: ElementID

      integer(int32), allocatable :: ret(:)
      integer(int32), allocatable :: node_list(:)
      integer(int32), allocatable :: element_list(:)

      node_list = this%mesh%elemnod(ElementID, :)
      ret = this%to_ElementID(node_list)

   end function
! #################################################

   function to_ElementIDFEMDomain(this, NodeList) result(ret)
      class(FEMDomain_), intent(in) :: this
      integer(int32), intent(in) :: NodeList(:)
      logical, allocatable :: ElementList(:)
      integer(int32), allocatable :: ret(:)
      integer(int32) :: elemid, enodid, i, n

      allocate (ElementList(this%ne()))

      ElementList(:) = .false.

      !$OMP parallel do private(enodid,i) reduction(.or.:ElementList)
      do elemid = 1, this%ne()
         do enodid = 1, this%nne()
            do i = 1, size(NodeList)
               if (this%mesh%elemnod(elemid, enodid) == NodeList(i)) then
                  ElementList(elemid) = ElementList(elemid) .or. .true.
                  exit
               end if
            end do
         end do
      end do
      !$OMP end parallel do

      n = 0
      !$OMP parallel do reduction(+:n)
      do i = 1, size(ElementList)
         if (ElementList(i)) then
            n = n + 1
         end if
      end do
      !$OMP end parallel do

      allocate (ret(n))
      n = 0
      do i = 1, size(ElementList)
         if (ElementList(i)) then
            n = n + 1
            ret(n) = i
         end if
      end do

   end function
! ######################################################

! ######################################################
   function mpi_matmulFEMDomain(this, A, x, mpid) result(ret)
      class(FEMDomain_), intent(inout) :: this
      type(CRS_), optional, intent(in) :: A
      real(real64), intent(in)  :: x(:)
      type(MPI_), intent(inout) :: mpid
      real(real64), allocatable :: ret(:), val(:), val_buf(:)
      !integer(int32),allocatable :: send_req(:),recv_req(:)
      integer(int32) :: send_req, recv_req
      integer(int32) :: proc_idx, i, node_idx, DOF

      ret = A%matmul(x)
      DOF = size(ret)/this%nn()

      if (mpid%petot == 1) return

      ! sync
      val = zeros(DOF*size(this%mpi_shared_node_info, 1))
      val_buf = zeros(DOF)
      send_req = 0!int(zeros(DOF))
      recv_req = 0!int(zeros(DOF))
      do i = 1, size(this%mpi_shared_node_info, 1)
         node_idx = this%mpi_shared_node_info(i, 1)
         val_buf(:) = 0.0d0
         call mpid%irecv( &
            from=this%mpi_shared_node_info(i, 2), &
            val=val_buf(1:DOF), &
            req=recv_req, &
            tag=this%mpi_shared_node_info(i, 1))

         call mpid%isend( &
            to=this%mpi_shared_node_info(i, 2), &
            val=ret(DOF*(node_idx - 1) + 1:DOF*(node_idx - 1) + DOF), &
            req=send_req, &
            tag=this%mpi_shared_node_info(i, 3))

         call mpid%WaitAll(send_req=send_req, recv_req=recv_req)

         val(DOF*(i - 1) + 1:DOF*(i - 1) + DOF) = val(DOF*(i - 1) + 1:DOF*(i - 1) + DOF) + val_buf(1:DOF)
         val_buf = 0.0d0
      end do

      do i = 1, size(this%mpi_shared_node_info, 1)
         node_idx = this%mpi_shared_node_info(i, 1)
         ret(DOF*(node_idx - 1) + 1:DOF*(node_idx - 1) + DOF) = ret(DOF*(node_idx - 1) + 1:DOF*(node_idx - 1) + DOF) &
                                                                + val(DOF*(i - 1) + 1:DOF*(i - 1) + DOF)
      end do

   end function
! ######################################################

   subroutine read_mpi_propertyFEMDomain(this, name, num_division)
      class(FEMDomain_), intent(inout) :: this
      character(*), intent(in) :: name
      integer(int32), optional, intent(inout) :: num_division
      character(1) :: line
      integer(int32) :: buf, num_glo_node, num_loc_node, num_shared_node, &
                        num_div, i, idx, val
      integer(int32) :: buf_vec(3)
      type(IO_) :: f

      call f%open(name, "r")
      read (f%fh, *) line
      read (f%fh, *) num_glo_node, num_loc_node, num_shared_node, num_div
      this%mpi_global_node_idx = int(zeros(num_loc_node))
      this%mpi_shared_node_info = int(zeros(num_shared_node, 3))
      read (f%fh, *) line
      do i = 1, num_loc_node
         read (f%fh, *) idx, val
         this%mpi_global_node_idx(idx) = val
      end do
      read (f%fh, *) line
      do i = 1, num_shared_node
         read (f%fh, *) buf_vec(1:3)
         this%mpi_shared_node_info(i, 1:3) = buf_vec(1:3)
      end do
      call f%close()

      if (present(num_division)) then
         num_division = num_div
      end if
   end subroutine

! #######################################################
   subroutine read_vtk_domain_decomposed_FEMDOmain(this, name, myrank)
      class(FEMDomain_), intent(inout) :: this
      character(*), intent(in) :: name
      integer(int32), intent(in) :: myrank

      call this%read("Cube3D_"+zfill(myrank, 6) + ".vtk")
      call this%read_mpi_property("Cube3D_"+zfill(myrank, 6) + ".csv")

   end subroutine
! #######################################################

! #######################################################
   function M_inv_K_Matrix_CRS_FEMDomain(this, Density, YoungModulus, PoissonRatio) result(ret)
      class(FEMDomain_), intent(inout) :: this
      real(real64), intent(in) :: Density(:), YoungModulus(:)
      real(real64), optional, intent(in) :: PoissonRatio(:)
      real(real64), allocatable :: v(:)
      type(CRS_) :: K, M, ret
      integer(int32) :: dof

      K = this%StiffnessMatrix( &
          YoungModulus=YoungModulus, &
          PoissonRatio=PoissonRatio)

      dof = K%size()/this%nn()

      M = this%MassMatrix( &
          Density=Density, &
          DOF=dof)

      v = M%lumped()

      ret = K%divide_by(v)

   end function
! #######################################################

! #######################################################
   subroutine set_xFEMDomain(this, idx, coord)
      class(FEMDOmain_), intent(inout) :: this
      integer(int32), intent(in) :: idx
      real(real64), intent(in) :: coord

      this%mesh%nodcoord(idx, 1) = coord

   end subroutine
! #######################################################

! #######################################################
   subroutine set_yFEMDomain(this, idx, coord)
      class(FEMDOmain_), intent(inout) :: this
      integer(int32), intent(in) :: idx
      real(real64), intent(in) :: coord

      this%mesh%nodcoord(idx, 2) = coord

   end subroutine
! #######################################################

! #######################################################
   subroutine set_zFEMDomain(this, idx, coord)
      class(FEMDOmain_), intent(inout) :: this
      integer(int32), intent(in) :: idx
      real(real64), intent(in) :: coord

      this%mesh%nodcoord(idx, 3) = coord

   end subroutine
! #######################################################

! #######################################################
   function getPoint_xFEMDomain(this, idx) result(coord)
      class(FEMDOmain_), intent(inout) :: this
      integer(int32), intent(in) :: idx
      real(real64) :: coord

      coord = this%mesh%nodcoord(idx, 1)

   end function
! #######################################################

! #######################################################
   function getPoint_yFEMDomain(this, idx) result(coord)
      class(FEMDOmain_), intent(inout) :: this
      integer(int32), intent(in) :: idx
      real(real64) :: coord

      coord = this%mesh%nodcoord(idx, 2)

   end function
! #######################################################

! #######################################################
   function getPoint_zFEMDomain(this, idx) result(coord)
      class(FEMDOmain_), intent(inout) :: this
      integer(int32), intent(in) :: idx
      real(real64) :: coord

      coord = this%mesh%nodcoord(idx, 3)

   end function
! #######################################################

! #######################################################
   function to_composite_beam_FEMDomain(length, width, angle_x, angle_z, division) result(this)
      type(FEMDomain_) :: this
      real(real64), intent(in) :: length(:), width(:)
      integer(int32), optional, intent(in) :: division(:)
      real(real64), optional, intent(in) :: angle_x(:), angle_z

      real(real64), allocatable :: x_axis(:), y_axis(:), z_axis(:)
      real(real64), allocatable :: x_axis_r(:), y_axis_r(:), z_axis_r(:)
      integer(int32) :: i, j, n, internode_idx(1:2), a, b, comp_mode
      integer(int32), allocatable :: nodelist(:)
      real(real64) :: r, x, y, z, w_a, w_b, theta, p(1:2), c(1:2), dc(1:2), psi_z, z_n
      real(real64) :: w, YY, rt, r0, eps
      type(Math_) :: math
      !type(IO_) :: f

      eps = 1.0e-8

      x_axis = [-1.0d0, 0.0d0, 1.0d0]
      y_axis = [-1.0d0, 0.0d0, 1.0d0]
      z_axis = prefix_sum(length)
      x_axis_r = x_axis
      y_axis_r = y_axis
      z_axis_r = z_axis

      if (present(division)) then

         if (size(division) >= 1) then

            call refine(x_axis_r, division(1))
         end if

         if (size(division) >= 2) then
            call refine(y_axis_r, division(2))
         end if

         if (size(division) >= 3) then
            call refine(z_axis_r, division(3))
         end if

      end if

      call this%create("Cube3D", x_axis=x_axis_r, y_axis=y_axis_r, z_axis=z_axis_r)

      !call f%open("debug.txt","w")

      do i = 1, this%nn()
         x = this%getPoint_x(i)
         y = this%getPoint_y(i)
         z = this%getPoint_z(i)
         internode_idx = find_section(z_axis, z)
         a = internode_idx(1)
         b = internode_idx(2)

         if (a == 0) then
            w_a = width(1)
         else
            w_a = width(a)
         end if

         if (a == size(width, 1)) then
            w_b = width(size(width, 1))
         else
            w_b = width(b)
         end if

         if (a == 0) then
            theta = 0.0d0
         elseif (a == size(z_axis)) then
            theta = 0.0d0
         else
            theta = (z - z_axis(internode_idx(1))) &
                    /(z_axis(internode_idx(2)) - z_axis(internode_idx(1)))
         end if
         w = (1.0d0 - theta)*w_a + theta*w_b
         x = (x/1.0d0)*abs(w/2.0d0)
         y = (y/1.0d0)*abs(w/2.0d0)

         theta = atan2(y, x)
         r = sqrt(x*x + y*y)
         theta = theta + math%pi

         if (x == 0) then
            comp_mode = 1
         elseif (abs(y/x) >= 1.0d0) then
            comp_mode = 1
         else
            comp_mode = 2
         end if

         if (comp_mode == 1) then
            if ((1.0d0 - (cos(theta))**2) /= 0.0d0) then
               rt = (0.50d0*w)/(sqrt(1.0d0 - (cos(theta))**2))
            else
               rt = 0.50d0*w
            end if
         else
            if (sqrt(1.0d0 - (sin(theta))**2) /= 0.0d0) then
               rt = (0.50d0*w)/(sqrt(1.0d0 - (sin(theta))**2))
            else
               rt = 0.50d0*w
            end if
         end if
         theta = atan2(y, x)
         r = sqrt(x*x + y*y)
         r = r*(0.50d0*w)/rt

         ! debug
         !x = r*cos(theta)
         !y = r*sin(theta)

         !call f%write(rt*cos(theta),rt*sin(theta) )
         !YY  = (0.50d0*w)/x*y
         !R   = sqrt( (0.50d0*w)**2 + YY**2 )

         !x   = (0.50d0*w)/(R) *x
         !y   = (0.50d0*w)/(R) *y

         call this%setPoint_x(idx=i, coord=x)
         call this%setPoint_y(idx=i, coord=y)
         call this%setPoint_z(idx=i, coord=z)

      end do

      if (present(angle_x)) then

         ! x = x + z/tan(0.50d0*math%pi-radian(angle_x(1)) )
         ! z = z - z*(1 - cos(0.50d0*math%pi-radian(angle_x(1)) ))
         !$OMP parallel do private(x,y,z)
         do i = 1, this%nn()
            x = this%getPoint_x(i)
            y = this%getPoint_y(i)
            z = this%getPoint_z(i)

            x = x + z/tan(0.50d0*math%pi - radian(angle_x(1)))
            z = z*cos(radian(angle_x(1)))

            call this%setPoint_x(i, x)
            call this%setPoint_y(i, y)
            call this%setPoint_z(i, z)

         end do
         !$OMP end parallel do

         do i = 2, min(size(z_axis), size(angle_x))

            do j = 1, this%nn()
               x = this%getPoint_x(j)
               y = this%getPoint_y(j)
               z = this%getPoint_z(j)

               if (z <= z_axis(i)) cycle

               x = x + (z - z_axis(i))/tan(0.50d0*math%pi - radian(angle_x(i)))
               z = (z - z_axis(i))*cos(radian(angle_x(i))) + z_axis(i)

               call this%setPoint_x(j, x)
               call this%setPoint_y(j, y)
               call this%setPoint_z(j, z)
            end do
         end do
      end if

      if (present(angle_z)) then
         call this%rotate(z=radian(angle_z))
      end if
      ! IMPLEMENTATION FAILED>
!        if(present(angle_z) )then
!
!                c(:) = 0.0d0
!                psi_z = 0.0d0
!                z_n = 0.0d0
!                do i=1,size(angle_z)
!
!                        do j=1,this%nn()
!                                x = this%getPoint_x(j)
!                                y = this%getPoint_y(j)
!                                z = this%getPoint_z(j)
!
!                                if(z<=z_n )cycle
!
!                                p(1:2) = [x,y]
!                                p = p - c
!                                p = matmul( rotationMatrix(radian(angle_z(i))),p )
!                                p = p + c
!                                x = p(1)
!                                y = p(2)
!
!                                call this%setPoint_x(j,x)
!                                call this%setPoint_y(j,y)
!                                call this%setPoint_z(j,z)
!                        enddo
!
!                        ! update rotation center
!                        !psi_z = psi_z + angle_z(i)
!                        z_n = z_n + length(i+1)*cos( radian(angle_x(i) ))
!                        c(1) = average( this%mesh%nodcoord( this%select(z_min=z_n-eps,z_max=z_n+eps) ,1)  )
!                        c(2) = average( this%mesh%nodcoord( this%select(z_min=z_n-eps,z_max=z_n+eps) ,2)  )
!                        !
!                enddo
!        endif
!
      !call f%close()

   end function
! #######################################################

! #######################################################
   subroutine add_pointFEMDomain(this, coord)
      class(FEMDomain_), intent(inout) :: this
      real(real64), intent(in) :: coord

   end subroutine
! #######################################################

!function select_by_functionFEMDomain(this,surface,params,sign) result(NodeList)
!
!        interface
!                function surface(x,params) result(ret)
!                        use iso_fortran_env
!                        real(real64),intent(in) :: x(:)
!                        real(real64),intent(in) :: params(:)
!                        real(real64) :: ret
!                end function
!        end interface
!
!        character(*),intent(in) :: sign
!        class(FEMDomain_),intent(in) :: this
!        real(real64),intent(in) :: params(:)
!        integer(int32),allocatable :: flags(:)
!        real(real64) :: ret
!        real(real64),allocatable :: x(:)
!        integer(int32) :: i
!        integer(int32),allocatable :: NodeList(:)
!
!        flags = int(zeros(this%nn() ) )
!        do i=1,this%nn()
!                x = this%mesh%nodcoord(i,:)
!                ret = surface(x ,params )
!                select case(sign)
!                        case(">=")
!
!                end select
!
!
!        enddo
!
!
!end function

   function getPointFEMDomain(this, pointIdx) result(ret)
      class(FEMDOmain_), intent(in) :: this
      integer(int32), intent(in) :: pointIdx
      real(real64), allocatable :: ret(:)

      ret = this%mesh%nodcoord(pointIdx, :)

   end function

   function PointForceVectorFEMDomain(this, NodeList, Direction, force) result(ret)
      class(FEMDomain_), intent(in) :: this
      integer(int32), intent(in) :: NodeList(:)
      character(*), intent(in) :: Direction
      real(real64), intent(in) :: force
      real(real64), allocatable :: ret(:)
      integer(int32) :: DOF

      DOF = this%nd()
      ret = zeros(this%nn()*this%nd())

      if (("X".in.Direction) .or. ("x".in.Direction)) then
         ret(DOF*(NodeList(:) - 1) + 1) = force
      end if
      if (("Y".in.Direction) .or. ("y".in.Direction)) then
         ret(DOF*(NodeList(:) - 1) + 2) = force
      end if
      if (("Z".in.Direction) .or. ("z".in.Direction)) then
         ret(DOF*(NodeList(:) - 1) + 3) = force
      end if

   end function

   subroutine read_SCALAR_FEMDomain(this, filename)
      class(FEMDomain_), intent(inout) :: this
      character(*), intent(in) :: filename
      type(IO_) :: f
      character(:), allocatable :: line, POINT_DATA
      integer(int32) :: i, n, num_pd

      if (allocated(this%mesh%nodcoord)) then
         POINT_DATA = "POINT_DATA"
         call f%search_line(filename, n)
         call f%open(filename, "r")
         do i = 1, n - 1
            read (f%fh, '()') ! 読み飛ばし
         end do
         read (f%fh, *) POINT_DATA, num_pd
         read (f%fh, '()')
         read (f%fh, '()')
         if (.not. allocated(this%physicalfield)) then
            allocate (this%physicalfield(1))
         end if

         this%physicalfield(1)%scalar = zeros(num_pd)
         do i = 1, num_pd
            read (f%fh, *) this%physicalfield(1)%scalar(i)
         end do
         call f%close()
      else
         call this%read(filename)
      end if

   end subroutine

   function elementType2VTKCellType(elementType) result(ret)
      integer(int32), intent(in) :: elementType(:)
      integer(int32) :: ret

      if (elementType(1) == 1) then
         ! 1-dimensional
         if (elementType(2) == 1) then
            ret = VTK_VERTEX
         elseif (elementType(2) == 2) then
            ret = VTK_LINE
         elseif (elementType(2) == 3) then
            ret = VTK_QUADRATIC_EDGE
         else
            ret = -1
         end if
      elseif (elementType(1) == 2) then
         ! 2-dimensional
         if (elementType(2) == 3) then
            ret = VTK_TRIANGLE
         elseif (elementType(2) == 4) then
            ret = VTK_QUAD
         elseif (elementType(2) == 6) then
            ret = VTK_QUADRATIC_TRIANGLE
         elseif (elementType(2) == 8) then
            ret = VTK_QUADRATIC_QUAD
         else
            ret = -1
         end if
      elseif (elementType(1) == 3) then
         ! 3-dimensional
         if (elementType(2) == 4) then
            ret = VTK_TETRA
         elseif (elementType(2) == 6) then
            ret = VTK_WEDGE
         elseif (elementType(2) == 8) then
            ret = VTK_HEXAHEDRON
         elseif (elementType(2) == 10) then
            ret = VTK_QUADRATIC_TETRA
         elseif (elementType(2) == 12) then
            ret = VTK_QUADRATIC_LINEAR_WEDGE
         elseif (elementType(2) == 20) then
            ret = VTK_QUADRATIC_HEXAHEDRON
         else
            ret = -1
         end if
      end if
   end function

   function to_vertexData_FEMDomain(this, vertexIDs, scalar) result(vertexData)
      class(FEMDomain_), intent(in) :: this
      integer(int32), intent(in) :: vertexIDs(:)
      real(real64), intent(in) :: scalar(:)
      real(real64), allocatable :: vertexData(:)

      allocate (vertexData(size(vertexIDs)))

      vertexData(:) = scalar(vertexIDs)

   end function

   subroutine vtk_file(name, vertices, vertexData)
      character(*), intent(in) :: name
      real(real64), intent(in) :: vertices(:), vertexData(:)
      character(:), allocatable :: vtk_filename
      type(IO_) :: f
      integer(int32) :: i

      if (".vtk".in.name) then
         vtk_filename = name
      else
         vtk_filename = name + ".vtk"
      end if

      call f%open(vtk_filename, "w")
      call f%write("# vtk DataFile Version 3.0")
      call f%write(vtk_filename)
      call f%write("ASCII")
      call f%write("DATASET UNSTRUCTURED_GRID")
      call f%write("POINTS "+str(size(vertices)/3) + " float")
      do i = 1, size(vertices)/3
         call f%write(vertices((i - 1)*3 + 1:(i - 1)*3 + 3))
      end do
      call f%write("CELL_TYPES "+str(size(vertices)/3))
      do i = 1, size(vertices)/3
         call f%write("1")
      end do
      call f%write("POINT_DATA "+str(size(vertexData)))
      call f%write("SCALARS radius float")
      call f%write("LOOKUP_TABLE default")
      do i = 1, size(vertexData)
         write (f%fh, *) vertexData(i)
      end do
      call f%close()
   end subroutine

! ########################################################
   function to_ptr_femdomain(femdomain) result(ret)
      type(femdomain_), target, intent(in) :: femdomain
      type(femdomainp_) :: ret

      ret%femdomainp => femdomain

   end function
! ########################################################

! ########################################################
   function to_ptr_femdomains(femdomains) result(ret)
      type(femdomain_), target, intent(in) :: femdomains(:)
      type(femdomainp_), allocatable :: ret(:)
      integer(int32) :: i

      allocate (ret(size(femdomains)))
      do i = 1, size(femdomains)
         ret(i)%femdomainp => femdomains(i)
      end do

   end function
! ########################################################

! ########################################################
   subroutine getLayer_scalarFEMDomain(this, name, ret)
      class(FEMDomain_), intent(inout) :: this
      character(*), intent(in) :: name
      real(real64), allocatable :: ret(:)

      ret = this%PhysicalField(this%getLayerID(name))%scalar

   end subroutine
! ########################################################

! ########################################################
   function get_element_idx_FEMDomainPointer(FEMDomainPointer, DomainID, ElementID) result(ret)
      type(FEMDomainp_), intent(in) :: FEMDomainPointer(:)
      integer(int32), intent(in) :: DomainID, ElementID
      integer(int32) :: ret, i

      ret = 0
      do i = 1, DomainID - 1
         ret = ret + FEMDomainPointer(i)%femdomainp%ne()
      end do
      ret = ret + ElementID

   end function
! ########################################################

! ########################################################
   function get_node_list_by_range_FEMDP(FEMDomainPointer, range) result(ret)
      type(FEMDomainp_), intent(in) :: FEMDomainPointer(:)
      type(Range_), intent(in) :: range
      integer(int32) :: i, offset
      integer(int32), allocatable :: ret(:), dret(:)

      offset = 0
      allocate (ret(0))
      do i = 1, size(FEMDomainPointer)
         dret = FEMDomainPointer(i)%femdomainp%select( &
                x_min=range%x_range(1), &
                y_min=range%y_range(1), &
                z_min=range%z_range(1), &
                x_max=range%x_range(2), &
                y_max=range%y_range(2), &
                z_max=range%z_range(2) &
                )
         dret(:) = dret(:) + offset
         ret = ret//dret
         offset = offset + FEMDomainPointer(i)%femdomainp%nn()
      end do

   end function
! ########################################################

! ########################################################
   function num_node_femdomain_pointers(FEMDomainPointer) result(ret)
      type(FEMDomainp_), intent(in) :: FEMDomainPointer(:)
      integer(int32) :: ret, i
      ret = 0
      do i = 1, size(FEMDomainPointer)
         ret = ret + FEMDomainPointer(i)%femdomainp%nn()
      end do

   end function
! ########################################################

! ########################################################
   function num_element_femdomain_pointers(FEMDomainPointer) result(ret)
      type(FEMDomainp_), intent(in) :: FEMDomainPointer(:)
      integer(int32) :: ret, i
      ret = 0
      do i = 1, size(FEMDomainPointer)
         ret = ret + FEMDomainPointer(i)%femdomainp%ne()
      end do

   end function
! ########################################################

! ########################################################
   subroutine export_vtk_FEMDomainPointer(FEMDomainPointer, name, field, displacement)
      type(FEMDomainp_), intent(in) :: FEMDomainPointer(:)
      character(*), intent(in) :: name
      real(real64), intent(in) :: field(:)
      real(real64), optional, intent(in) :: displacement(:)
      real(real64), allocatable :: vec(:), vf_array(:, :)
      integer(int32) :: DOF, offset, i, offset_nn

      if (mod(size(field), num_node(FEMDomainPointer)) == 0) then
         DOF = size(field)/num_node(FEMDomainPointer)
         ! node_wise value
         if (DOF == 1) then
            ! scalar field
            offset = 0
            do i = 1, size(FEMDomainPointer, 1)
               if (present(displacement)) then
                  call FEMDomainPointer(i)%femdomainp%vtk(name="domain_"+zfill(i, 5) + name, &
                                                        scalar=field(offset + 1:offset + DOF*FEMDomainPointer(i)%femdomainp%nn()), &
                                                        displacement=field(offset + 1:offset + FEMDomainPointer(i)%femdomainp%nd() &
                                                                             *FEMDomainPointer(i)%femdomainp%nn()))
               else
                  call FEMDomainPointer(i)%femdomainp%vtk(name="domain_"+zfill(i, 5) + name, &
                                                          scalar=field(offset + 1:offset + DOF*FEMDomainPointer(i)%femdomainp%nn()))
               end if
               offset = offset + DOF*FEMDomainPointer(i)%femdomainp%nn()
            end do
         elseif (DOF >= 2) then
            ! vector field
            offset = 0
            do i = 1, size(FEMDomainPointer, 1)
               vec = field(offset + 1:offset + DOF*FEMDomainPointer(i)%femdomainp%nn())
               vf_array = reshape(vec, [size(vec)/DOF, DOF])
               if (present(displacement)) then
                  call FEMDomainPointer(i)%femdomainp%vtk(name="domain_"+zfill(i, 5) + name, &
                                                          vector=vf_array, &
                                                        displacement=field(offset + 1:offset + FEMDomainPointer(i)%femdomainp%nd() &
                                                                             *FEMDomainPointer(i)%femdomainp%nn()))
               else
                  call FEMDomainPointer(i)%femdomainp%vtk(name="domain_"+zfill(i, 5) + name, &
                                                          vector=vf_array)
               end if
               offset = offset + DOF*FEMDomainPointer(i)%femdomainp%nn()
            end do
         end if
         return
      end if

      if (mod(size(field), num_element(FEMDomainPointer)) == 0) then
         DOF = size(field)/num_element(FEMDomainPointer)
         ! node_wise value
         if (DOF == 1) then
            ! scalar field
            offset = 0
            offset_nn = 0
            do i = 1, size(FEMDomainPointer, 1)
               if (present(displacement)) then
                  call FEMDomainPointer(i)%femdomainp%vtk(name=name + "_domain_"+zfill(i, 5), &
                                                        scalar=field(offset + 1:offset + DOF*FEMDomainPointer(i)%femdomainp%ne()), &
                                                  displacement=field(offset_nn + 1:offset_nn + FEMDomainPointer(i)%femdomainp%nd() &
                                                                             *FEMDomainPointer(i)%femdomainp%nn()))
               else
                  call FEMDomainPointer(i)%femdomainp%vtk(name=name + "_domain_"+zfill(i, 5), &
                                                          scalar=field(offset + 1:offset + DOF*FEMDomainPointer(i)%femdomainp%ne()))
               end if
               offset = offset + DOF*FEMDomainPointer(i)%femdomainp%ne()
               offset_nn = offset_nn + DOF*FEMDomainPointer(i)%femdomainp%nn()
            end do
         elseif (DOF >= 2) then
            ! vector field
            offset = 0
            offset_nn = 0
            do i = 1, size(FEMDomainPointer, 1)
               vec = field(offset + 1:offset + DOF*FEMDomainPointer(i)%femdomainp%ne())
               vf_array = reshape(vec, [size(vec)/DOF, DOF])
               if (present(displacement)) then
                  call FEMDomainPointer(i)%femdomainp%vtk(name=name + "_domain_"+zfill(i, 5), &
                                                          vector=vf_array, &
                                                  displacement=field(offset_nn + 1:offset_nn + FEMDomainPointer(i)%femdomainp%nd() &
                                                                             *FEMDomainPointer(i)%femdomainp%nn()))
               else
                  call FEMDomainPointer(i)%femdomainp%vtk(name=name + "_domain_"+zfill(i, 5), &
                                                          vector=vf_array)
               end if
               offset = offset + DOF*FEMDomainPointer(i)%femdomainp%ne()
               offset_nn = offset_nn + DOF*FEMDomainPointer(i)%femdomainp%nn()
            end do
         end if
         return
      end if
   end subroutine

! ############################################################################################
   function TractionVector_by_elemFEMDomain(this, ElementID, range, SurfacePressure) result(ret)
      class(FEMDOmain_), intent(in) :: this
      integer(int32), intent(in) :: ElementID
      type(Range_), intent(in) :: range
      real(real64), intent(in) :: SurfacePressure ! kPa
      integer(int32), allocatable :: nodeIdx(:)
      integer(int32), allocatable :: is_inside(:), target_facet(:), Facet(:, :), buf(:)
      integer(int32) :: i, j
      real(real64), allocatable :: ret(:), nvec(:), force(:), weights(:), A(:), B(:), C(:), D(:)
      real(real64):: area
      type(IO_)::debug
      nodeIdx = this%mesh%elemnod(ElementID, :)
      allocate (is_inside(size(nodeidx)))
      is_inside(:) = 0

      ret = zeros(this%nd()*this%nn())

      do i = 1, size(nodeIdx)
         if (range%inside(this%mesh%nodcoord(nodeIdx(i), :))) then
            is_inside(i) = 1
         end if
      end do

      Facet = this%getFacetLocalNodeID() ! local Idx

      target_facet = 0*Facet(:, 1)
      do i = 1, size(Facet, 1) ! Facetごとにループ
         do j = 1, size(Facet, 2)
            if (is_inside(Facet(i, j)) == 1) then
               ! inside
               target_facet(i) = target_facet(i) + 1 ! 領域内にあるFacetには1，そうでないFacetは0

            end if
         end do
      end do

      if (maxval(target_facet) < size(Facet, 2)) return !もしFacetの節点すべてがinsideであるようなFacetがないならreturn
      !call debug%open("debug.txt", "a")
      do i = 1, size(target_facet)

         if (target_facet(i) == size(Facet, 2)) then
            ! 表面力を計算すべきFacet
            ! 法線ベクトルと面積をかけてkNにしたうえで，節点に分配
            if (size(Facet, 2) == 3) then
               A = this%mesh%nodcoord(this%mesh%elemnod(ElementID, Facet(i, 1)), :)
               B = this%mesh%nodcoord(this%mesh%elemnod(ElementID, Facet(i, 2)), :)
               C = this%mesh%nodcoord(this%mesh%elemnod(ElementID, Facet(i, 3)), :)
               area = getTriangularArea_fromPoint( &
                      A=A, B=B, C=C)! 表面の面積
            elseif (size(Facet, 2) == 4) then
               A = this%mesh%nodcoord(this%mesh%elemnod(ElementID, Facet(i, 1)), :)
               B = this%mesh%nodcoord(this%mesh%elemnod(ElementID, Facet(i, 2)), :)
               C = this%mesh%nodcoord(this%mesh%elemnod(ElementID, Facet(i, 3)), :)
               D = this%mesh%nodcoord(this%mesh%elemnod(ElementID, Facet(i, 4)), :)
               area = getTriangularArea_fromPoint( &
                      A=A, B=B, C=C) + &
                      getTriangularArea_fromPoint( &
                      A=B, B=C, C=D)! 表面の面積
            else
               print *, "[ERROR] TractionVector_by_elemFEMDomain >> size(Facet,2) of 3 or 4 are available."
               stop
            end if

            nvec = cross_product(B - A, C - A)/norm(cross_product(B - A, C - A))! 表面の外向き法線ベクトル
            weights = 1.0d0/dble(size(Facet, 2))*ones(size(Facet, 2))! 表面節点ごとの重み．1次要素では等配分なのでこの実装．2次要素では修正．

            force = SurfacePressure*area*nvec

            if (sum(is_inside) == 0) cycle
            call debug%write("ElementID"+str(ElementID))
            call debug%write("FacetID"+str(i))
            call debug%write(force)
            call debug%write(target_facet)

            do j = 1, size(Facet, 2)
               ret((Facet(i, j) - 1)*(this%nd()) + 1:(Facet(i, j) - 1)*(this%nd()) + this%nd()) = &
                  ret((Facet(i, j) - 1)*(this%nd()) + 1:(Facet(i, j) - 1)*(this%nd()) + this%nd()) + weights(j)*force(:)
            end do
         end if
      end do
      call debug%close()

   end function

! ############################################
   function getTriangularArea_fromPoint(A, B, C) result(ret)
      real(real64), intent(in) :: A(:), B(:), C(:)
      real(real64) :: ret

      ret = 0.50d0*sqrt(dot_product(B - A, B - A)*dot_product(C - A, C - A) &
                        - dot_product(B - A, C - A)*dot_product(B - A, C - A))

   end function
! ############################################

   function rotate_3x3_matrix(x, y, z, inverse) result(ret)
      real(real64), intent(in) :: x, y, z
      logical, optional, intent(in) :: inverse
      real(real64), allocatable :: ret(:, :)
      real(real128), allocatable :: ret128(:, :), rotmat_x(:, :), rotmat_y(:, :), rotmat_z(:, :), &
                                    all_rotmat(:, :)
      integer(int32) :: i, j

      ! Euler angle:
      ! [ret] = [Rz][Ry][Rx]
      rotmat_x = eyes(3, 3)
      rotmat_y = eyes(3, 3)
      rotmat_z = eyes(3, 3)

      ret128 = eyes(3, 3)

      rotmat_x(1, 1) = 1.0d0; rotmat_x(1, 2) = 0.0d0; rotmat_x(1, 3) = 0.0d0; 
      rotmat_x(2, 1) = 0.0d0; rotmat_x(2, 2) = cos(x); rotmat_x(2, 3) = -sin(x); 
      rotmat_x(3, 1) = 0.0d0; rotmat_x(3, 2) = sin(x); rotmat_x(3, 3) = cos(x); 
      do i = 1, size(rotmat_x, 1)
         do j = 1, size(rotmat_x, 1)
            if (abs(rotmat_x(i, j)) < dble(1.0e-16)) then
               rotmat_x(i, j) = 0.0d0
            end if
         end do
      end do

      rotmat_y(1, 1) = cos(y); rotmat_y(1, 2) = 0.0d0; rotmat_y(1, 3) = sin(y); 
      rotmat_y(2, 1) = 0.0d0; rotmat_y(2, 2) = 1.0d0; rotmat_y(2, 3) = 0.0d0; 
      rotmat_y(3, 1) = -sin(y); rotmat_y(3, 2) = 0.0d0; rotmat_y(3, 3) = cos(y); 
      do i = 1, size(rotmat_y, 1)
         do j = 1, size(rotmat_y, 1)
            if (abs(rotmat_y(i, j)) < dble(1.0e-16)) then
               rotmat_y(i, j) = 0.0d0
            end if
         end do
      end do

      rotmat_z(1, 1) = cos(z); rotmat_z(1, 2) = -sin(z); rotmat_z(1, 3) = 0.0d0; 
      rotmat_z(2, 1) = sin(z); rotmat_z(2, 2) = cos(z); rotmat_z(2, 3) = 0.0d0; 
      rotmat_z(3, 1) = 0.0d0; rotmat_z(3, 2) = 0.0d0; rotmat_z(3, 3) = 1.0d0; 
      do i = 1, size(rotmat_z, 1)
         do j = 1, size(rotmat_z, 1)
            if (abs(rotmat_z(i, j)) < dble(1.0e-16)) then
               rotmat_z(i, j) = 0.0d0
            end if
         end do
      end do

      if (present(inverse)) then
         if (inverse) then
            ret128 = matmul(rotmat_z, ret128)
            ret128 = matmul(rotmat_y, ret128)
            ret128 = matmul(rotmat_x, ret128)
            return
         end if
      end if

      ret128 = matmul(rotmat_x, ret128)
      ret128 = matmul(rotmat_y, ret128)
      ret128 = matmul(rotmat_z, ret128)

      ret = dble(ret128)

   end function
! ############################################

subroutine extractFacetElementFEMDomain(this,SurfaceElements,repeat)
   class(FEMDomain_),intent(inout) :: this
   integer(int32),intent(in)    :: SurfaceElements(:,:),repeat
   type(Mesh_) :: newMesh 
   integer(int32) :: nnp,i,j,k,nodeIdx,elemIdx
   integer(int32),allocatable :: last_SurfaceElement(:)
   real(real64) :: unit_length,center(3),outer_normal(3),x1(3),x2(3),disp(3)

   nnp = size(SurfaceElements,1)*size(SurfaceElements,2)*repeat
   allocate(newMesh%nodcoord(nnp*repeat,this%nd()))
   allocate(newMesh%elemnod(size(SurfaceElements,1)*repeat,this%nne()))
   newMesh%nodcoord(:,:) = 0.0d0
   newMesh%elemnod(:,:) = -1
   ! まずrepeat=1のみ実装

   elemIdx = 0
   nodeIdx = this%nn()
   do i=1,size(SurfaceElements,1)
      ! compute outer normal vector
      ! compute unit length
      center(:) = 0.0d0
      do j=1,size(SurfaceElements,2)
         center = center &
            + this%mesh%nodcoord(SurfaceElements(i,j),:)/dble(size(SurfaceElements,2))
      end do
      ! とりあえず中心からの距離の2倍で．
      unit_length = norm(this%mesh%nodcoord(SurfaceElements(i,1),:)&
         -  this%mesh%nodcoord(SurfaceElements(i,2),:))
      ! 
      x1 = this%mesh%nodcoord(SurfaceElements(i,1),:)-center(:)
      x2 = this%mesh%nodcoord(SurfaceElements(i,2),:)-center(:)
      outer_normal = cross_product(x1,x2)
      disp = outer_normal/norm(outer_normal)*unit_length

      elemIdx = elemIdx + 1
      newMesh%elemnod(elemIdx,1:size(SurfaceElements,2)) = SurfaceElements(i,:)
      last_SurfaceElement = [(j, j=nodeIdx+1,nodeIdx+size(SurfaceElements,2))]
      newMesh%elemnod(elemIdx,size(SurfaceElements,2)+1:) = last_SurfaceElement(:)
      do j=1,size(SurfaceElements,2)
         nodeIdx = nodeIdx + 1
         newMesh%nodcoord(nodeIdx-this%nn(),:) &
            = this%mesh%nodcoord(SurfaceElements(i,j),:) + disp
      enddo

      if(repeat>=2)then
         do k = 2,repeat
            elemIdx = elemIdx + 1
            newMesh%elemnod(elemIdx,1:size(SurfaceElements,2)) = last_SurfaceElement(:)
            newMesh%elemnod(elemIdx,size(SurfaceElements,2)+1:) &
               = last_SurfaceElement(:) + size(SurfaceElements,2)
            last_SurfaceElement(:) = last_SurfaceElement(:) + size(SurfaceElements,2)
            do j=1,size(SurfaceElements,2)
               nodeIdx = nodeIdx + 1
               newMesh%nodcoord(nodeIdx-this%nn(),:) &
                  = this%mesh%nodcoord(SurfaceElements(i,j),:) + k*disp
            end do
         end do
      end if
      
   end do

   this%mesh%nodcoord = this%mesh%nodcoord .v. newMesh%nodcoord
   this%mesh%elemnod = this%mesh%elemnod .v. newMesh%elemnod
   !call this%remove_duplication()
end subroutine


! ############################################################
function getDuplicatedNodeListFEMDomain(this,groupIdx,epsilon) result(ret)
   class(FEMDomain_),intent(in) :: this
   integer(int32),allocatable,optional,intent(inout) :: groupIdx(:)
   real(real64),optional,intent(in) :: epsilon
   integer(int32),allocatable   :: ret(:),pointIdx(:)
   real(real64) :: eps
   real(real64):: xr(1:2),yr(1:2),zr(1:2)
   integeR(int32) :: i
   type(Time_) :: time


   eps = input(default=dble(1.0e-18),option=epsilon)
   ! find duplicated nodes by the binary search.
   pointIdx = [(i,i=1,this%nn())]
   
   
   ret = OcTreeSearch(this%mesh%nodcoord,pointIdx,eps)
   if(size(ret)<1) return
   if(present(groupIdx) )then
      allocate(groupIdx(size(ret)))
      groupIdx(1) = 1

      do i=1,size(ret)-1
         xr(1) = this%mesh%nodcoord(ret(i  ),1)
         yr(1) = this%mesh%nodcoord(ret(i  ),2)
         zr(1) = this%mesh%nodcoord(ret(i  ),3)
         xr(2) = this%mesh%nodcoord(ret(i+1),1)
         yr(2) = this%mesh%nodcoord(ret(i+1),2)
         zr(2) = this%mesh%nodcoord(ret(i+1),3)
         if(maxval([abs(xr(2)-xr(1)),abs(yr(2)-yr(1) ),abs(zr(2)-zr(1))] ) <= eps)then
            groupIdx(i+1) = groupIdx(i)
         else
            groupIdx(i+1) = groupIdx(i) + 1
         endif
      end do
   endif

end function
! ############################################################



! ############################################################
recursive function OcTreeSearch(Points,PointIdx,MinimumDist) result(ret)
   real(real64),intent(in) :: Points(:,:), MinimumDist
   integer(int32),intent(in) :: PointIdx(:)
   real(real64),allocatable :: miniPoints(:,:)
   integer(int32),allocatable :: point_category(:),idx(:)
   integer(int32),allocatable :: miniPointIdx(:),ret(:),dupPointIdx(:)
   type(IO_) :: f
   integer(int32) :: num_cat(1:8)
   real(real64):: xr(1:2),yr(1:2),zr(1:2),borders(1:3)
   integer(int32) :: i, j, k 

   xr(1) = minval(Points(:,1)); xr(2) = maxval(Points(:,1));
   yr(1) = minval(Points(:,2)); yr(2) = maxval(Points(:,2));
   zr(1) = minval(Points(:,3)); zr(2) = maxval(Points(:,3));
   borders(1) = average(xr)
   borders(2) = average(yr)
   borders(3) = average(zr)
   num_cat(:) = 0

   if(size(Points,1 )<=1) then
      allocate(ret(0))
      return
   endif
   
   
   if(maxval([abs(xr(2)-xr(1)),abs(yr(2)-yr(1) ),abs(zr(2)-zr(1))] ) <= MinimumDist ) then
      ret = PointIdx
      return
   else
      
   
      allocate(point_category(size(Points,1)) )   
      
      !$OMP parallel do reduction(+:num_cat)
      do i=1,size(Points,1)
         if(Points(i,1) < borders(1) )then
            if(Points(i,2) < borders(2) )then
               if(Points(i,3) < borders(3) )then
                  point_category(i) = 1
                  num_cat(1) = num_cat(1) + 1
               else
                  point_category(i) = 2
                  num_cat(2) = num_cat(2) + 1
               endif
            else
               if(Points(i,3) < borders(3) )then
                  point_category(i) = 3
                  num_cat(3) = num_cat(3) + 1
               else
                  point_category(i) = 4
                  num_cat(4) = num_cat(4) + 1
               endif
            endif
         else
            if(Points(i,2) < borders(2) )then
               if(Points(i,3) < borders(3) )then
                  point_category(i) = 5
                  num_cat(5) = num_cat(5) + 1
               else
                  point_category(i) = 6
                  num_cat(6) = num_cat(6) + 1
               endif
            else
               if(Points(i,3) < borders(3) )then
                  point_category(i) = 7
                  num_cat(7) = num_cat(7) + 1
               else
                  point_category(i) = 8
                  num_cat(8) = num_cat(8) + 1
               endif
            endif
         endif
      enddo
      !$OMP end parallel do



      do i=1,size(num_cat)
         if(num_cat(i)<=1 )then
            cycle
         endif
         Idx= int(zeros((num_cat(i))))

         k = 0
         do j=1, size(point_category)
            if(point_category(j)==i)then
               k = k + 1
               Idx(k) = j
            endif
         enddo

         miniPoints = Points(Idx(:),:)
         miniPointIdx = PointIdx(Idx(:))
         
         
         dupPointIdx = OcTreeSearch(&
            Points=miniPoints,PointIdx=miniPointIdx,MinimumDist=MinimumDist)

         if(size(dupPointIdx)==0) then
            ! duplicated!
            cycle
         else
            if(.not.allocated(ret) )then
               ret = dupPointIdx
            else
               if(size(ret)==0)then
                  ret = dupPointIdx
               else
                  ret = ret // dupPointIdx
               endif
            endif
            cycle
         endif
      enddo


   endif
   if(.not.allocated(ret))then
      allocate(ret(0))
   endif


end function


! ############################################################


subroutine bondFEMDomain(this,domain) 
   class(FEMDomain_),target,intent(inout) :: this
   type(FEMDomain_) ,target,intent(inout) :: domain
   type(FEMDomainp_) :: femdomain_pointers(1:2)
   integer(int32),allocatable :: this_segment_list(:),domain_segment_list(:),&
      kill_node_list(:)
   type(Range_) :: cross_section

   ! surface matching
   femdomain_pointers(1)%femdomainp => this
   femdomain_pointers(2)%femdomainp => domain
   cross_section = getCrossSection_FEMDomain(femdomain_pointers=femdomain_pointers)
   !call print(cross_section)
   this_segment_list   = this%getFacetList_as_Idx(range=cross_section)
   domain_segment_list = domain%getFacetList_as_Idx(range=cross_section)

   !call print(size(this_segment_list))
   !call print(size(domain_segment_list))

   call this%fitSegmentToSegment(&
         target_domain=domain,&
         this_segment_list=this_segment_list,&
         domain_segment_list=domain_segment_list, &
         kill_node_list=kill_node_list &
      )
   
   this%mesh%elemnod = this%mesh%elemnod .v. (domain%mesh%elemnod + this%nn())
   this%mesh%nodcoord = this%mesh%nodcoord .v. domain%mesh%nodcoord
   
   call this%remove_duplication()



end subroutine

! #############################################################
function getCrossSection_FEMDomain(femdomain_pointers) result(ret)
   type(FEMDomainp_),intent(in) :: femdomain_pointers(:)
   type(Range_),allocatable :: domain_rects(:)
   type(Range_) :: ret
   integer(int32) :: i
   
   allocate(domain_rects(size(femdomain_pointers)))

   do i=1,size(femdomain_pointers)
      domain_rects(i) = to_range(&
         x_min=minval(femdomain_pointers(i)%femdomainp%mesh%nodcoord(:,1)) ,&
         x_max=maxval(femdomain_pointers(i)%femdomainp%mesh%nodcoord(:,1))  ,&
         y_min=minval(femdomain_pointers(i)%femdomainp%mesh%nodcoord(:,2))  ,&
         y_max=maxval(femdomain_pointers(i)%femdomainp%mesh%nodcoord(:,2))  ,&
         z_min=minval(femdomain_pointers(i)%femdomainp%mesh%nodcoord(:,3))  ,&
         z_max=maxval(femdomain_pointers(i)%femdomainp%mesh%nodcoord(:,3))  &
      )
   enddo

   ret = domain_rects(1)
   do i=2,size(domain_rects)
      ret = ret .and. domain_rects(i)
   enddo

end function
! #############################################################

! #############################################################
subroutine fitSegmentToSegmentFEMDomain(this,target_domain,this_segment_list,domain_segment_list,kill_node_list)
   class(FEMDomain_),intent(in) :: this
   type(FEMDomain_),intent(inout) :: target_domain ! edit this one.
   integer(int32),intent(in) :: this_segment_list(:),domain_segment_list(:)
   integer,allocatable,intent(inout):: kill_node_list(:)
   integer(int32),allocatable :: pairing(:), pairing_order(:), IdxList(:)
   real(real64),allocatable :: this_facet_centers(:,:),domain_facet_centers(:,:),xd(:),xt(:),&
      dist_val(:)
   integer(int32) :: i,j,idx,t_node_idx,d_node_idx,itr
   logical,allocatable :: moved(:)

   type(IO_) :: f

   !call f%open("debug.txt","w")
   ! mode segment listed in "domain_segment_list" so that
   ! all segments fit to the corresponding "this_segment_list"
   
   !(1) get center coordinate
   this_facet_centers = zeros( size(this_segment_list), this%nd() )
   do i = 1, size(this_segment_list)
      do j=1,size(target_domain%mesh%FacetElemNod,2)
         idx = target_domain%mesh%FacetElemNod(domain_segment_list(i),j) !  20240915 changed from this_segment
         this_facet_centers(i,:) = this_facet_centers(i,:) + target_domain%mesh%nodcoord(idx,:)
      enddo
      this_facet_centers(i,:) = this_facet_centers(i,:)/dble(size(target_domain%mesh%FacetElemNod,2))
   enddo

   domain_facet_centers = zeros( size(domain_segment_list), this%nd() )
   do i = 1, size(domain_segment_list)
      do j=1,size(target_domain%mesh%FacetElemNod,2)
         idx = target_domain%mesh%FacetElemNod(domain_segment_list(i),j)
         domain_facet_centers(i,:) = domain_facet_centers(i,:) + target_domain%mesh%nodcoord(idx,:)
      enddo
      domain_facet_centers(i,:) = domain_facet_centers(i,:)/dble(size(target_domain%mesh%FacetElemNod,2))
   enddo

   !(2) find nearest segment for each segment in target domain
   pairing = int(zeros(size(domain_segment_list)) )
   dist_val = zeros(size(domain_segment_list))
   do i = 1, size(domain_segment_list)
      xd = domain_facet_centers(i,:)
      xt = this_facet_centers(1,:)
      pairing(i)  = this_segment_list(1)
      dist_val(i) = dot_product(xd-xt,xd-xt)
      do j=1,size(this_segment_list)
         xt = this_facet_centers(j,:)
         if(dot_product(xd-xt,xd-xt) < dist_val(i))then
            pairing(i)  = this_segment_list(j)
            dist_val(i) = dot_product(xd-xt,xd-xt)
         endif
      enddo
   enddo
   

   !(3) find order
   pairing_order = int(zeros(size(domain_segment_list)) )
   do i=1,size(domain_segment_list)
      pairing_order = find_facet_pairing_FEMDomain(&
         DomainA = target_domain,&
         DomainB = this,&
         FacetA  = target_domain%mesh%FacetElemNod(&
            domain_segment_list(i),: ) ,&
         FacetB  = this%mesh%FacetElemNod(&
            pairing(i),: ) )
   enddo


   !(4) Fit coordinates
   if(allocated(kill_node_list))then
      deallocate(kill_node_list)
   endif
   allocate(kill_node_list(size(domain_segment_list)*size(target_domain%mesh%FacetElemNod,2)))
   itr = 0
   do i=1,size(domain_segment_list)
      do j=1,size(target_domain%mesh%FacetElemNod,2)
         IdxList = target_domain%mesh%FacetElemNod(domain_segment_list(i),:)
         IdxList = cycle_vector(reverse(IdxList),pairing_order(i))
         d_node_idx = IdxList(j)
         t_node_idx = this%mesh%FacetElemNod(pairing(i),j)
         itr = itr + 1
         kill_node_list(itr) = d_node_idx
         target_domain%mesh%nodcoord(d_node_idx,:) = this%mesh%nodcoord(t_node_idx,:)
      enddo
   enddo

  


end subroutine
! #############################################################



! #############################################################
function cycle_vector(vec,n)  result(ret)
   integer(int32),intent(in)  :: vec(:)
   integer(int32),intent(in)  :: n
   integer(int32),allocatable :: ret(:)
   integer(int32) :: m,k

   if (n > 0) then
      m = mod(n,size(vec))
      if ( m == 0 ) then
         ret = vec
      else
         k = size(vec)
         ret = vec(m+1:k) // vec(1:m)
      endif
   else
      m = mod(abs(n),size(vec))
      m = 4 - m
      if ( m == 0 ) then
         ret = vec
      else
         k = size(vec)
         ret = vec(m+1:k) // vec(1:m)
      endif
   endif

end function cycle_vector
! #############################################################


! #############################################################
function find_facet_pairing_FEMDomain(DomainA,DomainB,FacetA,FacetB) result(ret)
   type(FEMDomain_),intent(in) :: DomainA,DomainB
   integer(int32),intent(in) :: FacetA(:),FacetB(:)
   real(real64),allocatable  :: dist_val(:),x(:)
   integer(int32),allocatable :: bufA(:),bufB(:)
   integer(int32) :: ret 
   integer(int32) :: i, j,AIdx,BIdx

   ! A: slab (not slave!)
   ! B: master

   dist_val = zeros(size(FacetA))
   do i=1,size(FacetA)
      bufA = cycle_vector(reverse(FacetA),i)
      bufB = FacetB
      do j=1,size(FacetA)
         AIdx = bufA(j)
         BIdx = bufB(j)
         x = DomainA%mesh%nodcoord(AIdx,:) - DomainA%mesh%nodcoord(BIdx,:) 
         dist_val(i) = dist_val(i) + dot_product(x,x)
      enddo
   enddo
   ret = minvalID(dist_val)
   
end function
! #############################################################

! #############################################################
!function getTangentialForceFEMDomain(this,range,force) result(ret)
!   class(FEMDomain_),intent(in) :: this
!   type(Range_),intent(in) :: range
!   real(real64),intent(in) :: force
!   real(real64),allocatable :: ret(:),UnitTangentialVector(:),&
!      nodalForce(:,:),UnitNormalVector(:)
!   integer(int32),allocatable :: FacetList(:,:),LocalNodeList(:)
!   integer(int32) :: LocalNodeID,FacetID,nd_ID
!
!   !> compute tangentical traction force vector
!
!   ![0] initialize tangential force vector
!   ret = zeros(this%nn()*this%nd())
!
!   ![1] get Surface Elements in the range
!   FacetList = this%getFacetList(range=range)
!
!   ![2] Compute Tangential vector for each element
!   UnitTangentialVector = zeros(this%nd())
!   do FacetID=1,size(FacetList,1)
!      ![2-1] get Node ID list for this facet
!      LocalNodeList = FacetList(FacetID,:)
!      ![2-2] compute tangential vector from LocalNodeList
!      UnitNormalVector = computeNormalVecFromFacet(FEMDomain=this,Facet=LocalNodeList)
!      UnitTangentialVector = computeTangentialVecFromFacet(FEMDomain=this,Facet=LocalNodeList)
!      ![2-3] compute nodal force for unit traction (1 kPa)
!      ! (Fx, Fy, Fz) = NodalForce(LocalNodeID,:)
!      NodalForce = computeUnitNodForceFromUnitTan(FEMDomain=this,UnitTangential=UnitTangentialVector)
!      ![2-4] add this local force to global force vector
!      do LocalNodeID=1,size(FacetList,2)
!         do nd_ID = 1, size(this%nd())
!            ret(  this%nd()*(FacetList(FacetID,LocalNodeID)-1)+nd_ID ) = &
!               ret(  this%nd()*(FacetList(FacetID,LocalNodeID)-1)+nd_ID ) + &
!               NodalForce(LocalNodeID,nd_ID)
!         enddo
!      enddo
!   enddo
!
!
!   ![3] Multiply force
!
!end function
! #############################################################


! ! #############################################################
!function getSubDomainFEMDomain(this,range) result(ret)
!   class(FEMDomain_),target,intent(in) :: this
!   type(Range_),intent(in) :: range
!   type(FEMDomain_),pointer :: ret
!
!
!
!end function
! ! #############################################################

!function computeNormalVecFromFacet(FEMDomain,Facet) result(ret)
!   type(FEMDomain_),intent(in) :: FEMDomain
!   integer(int32),intent(in)   :: Facet(:)
!   real(real64) :: ret(1:3),x1(1:3),x2(1:3)
!   
!   x1(:) = 0.0d0
!   x2(:) = 0.0d0
!   ret(:) = 0.0d0
!
!   x1(1:FEMDomain%nd()) = FEMDomain%mesh%nodcoord(Facet(3),:) - FEMDomain%mesh%nodcoord(Facet(2),:)
!   x2(1:FEMDomain%nd()) = FEMDomain%mesh%nodcoord(Facet(1),:) - FEMDomain%mesh%nodcoord(Facet(2),:)
!
!   ret = cross_product(x1,x2)
!
!   if (dot_product(ret,ret)==0.0d0)then
!      ! exception >> cross product is zero vector.
!      !ret(1) = 
!      stop
!   else
!      ret = ret / sqrt(dot_product(ret,ret))
!   endif
!
!end function


! ################################################################
function PointTorsionalForceFEMDomain(this,normal,center,NodeID) result(ret)
   class(FEMDomain_),intent(in) :: this
   !type(Range_),intent(in) :: range
   real(real64),intent(in) :: normal(:),center(:)
   integer(int32),intent(in) :: NodeID
   real(real64),allocatable :: x(:),ret(:)

   ! compute torsional force vector around
   ! normal vector with the center position
   x = this%mesh%nodcoord(NodeID,:) - center(:)
   
   ret = cross_product(x,normal)

   if (dot_product(ret,ret)==0.0d0 )then
      return
   else
      ret = ret/sqrt(dot_product(ret,ret))
   endif

end function
! ################################################################

! ################################################################
function TorsionalForceFEMDomain(this,normal,center,range) result(ret)
   class(FEMDomain_),intent(in) :: this
   type(Range_),intent(in) :: range
   real(real64),intent(in) :: normal(:),center(:)
   integer(int32) :: NodeID
   real(real64),allocatable :: x(:),ret(:)
   real(real64) :: radius

   ! compute torsional force vector around
   ! normal vector with the center position
   ret = zeros(this%nd()*this%nn())
   do NodeID=1,this%nn()
      x = this%mesh%nodcoord(NodeID,:)
      !radius = sqrt(abs(dot_product(x-center,this%PointTorsionalForce(normal,center,NodeID))))
      if (x .in. range)then
         ret( (NodeID-1)*this%nd() + 1 : (NodeID-1)*this%nd() + this%nd() ) = &  
            this%PointTorsionalForce(normal,center,NodeID)
      endif
   enddo

end function
! ################################################################

! ################################################################
subroutine setVectorValueFEMDomain(this,vector,dof,fillValue,range)
   class(FEMDomain_),intent(in) :: this
   real(real64),allocatable,intent(inout) :: vector(:)
   integer(int32),intent(in) :: DOF
   real(real64),intent(in) :: fillValue
   type(Range_),intent(in) :: range
   integer(int32) :: NodeID

   if(.not.allocated(vector))then
      vector = zeros(this%nn()*DOF)
   endif
   do NodeID=1,this%nn()
      if (this%mesh%nodcoord(NodeID,:) .in. range)then
         vector( (NodeID-1)*DOF + 1: (NodeID-1)*DOF + DOF) = fillValue
      endif
   enddo


end subroutine
! ################################################################


! ################################################################
subroutine ifcFEMDomain(this,name)
   class(FEMDomain_),intent(in) :: this
   character(*),intent(in) :: name
   character(:),allocatable :: full_name
   type(IO_) :: f
   
   if(".ifc" .in. name)then
      full_name = name
   else
      full_name = name+".ifc"
   endif
   call f%open(full_name,"w")

   call f%write("ISO-10303-21;")

   ! header
   call f%write("HEADER;")

   ! See
   ! https://standards.buildingsmart.org/documents/Implementation/ImplementationGuide_IFCHeaderData_Version_1.0.2.pdf
   call f%write("FILE_DESCRIPTION(('ViewDefinition [CoordinationView]'),'2;1');")
   call f%write("FILE_NAME( '"+full_name+"', '2011-11-07T18:00:00', ('plantFEM'), ('plantFEM'), 'plantFEM',&
       'plantFEM', 'IFC4 exporter of FEMDomain object in plantFEM');")
   call f%write("FILE_SCHEMA(('IFC4'));")
   call f%write("ENDSEC;")

   ! data
   call f%write("DATA;")
   call f%write("#100= IFCPROJECT ('"+this%uuid+"',#110,'plantFEM's FEMDomain object',$,$,$,$,(#201),#301);")
   call f%write("#201= IFCGEOMETRICREPRESENTATIONCONTEXT ($,'Model',3,1.0E-5,#210,$);")


   call f%write("#202= IFCGEOMETRICREPRESENTATIONSUBCONTEXT ('Body','Model',*,*,*,*,#201,$,.MODEL_VIEW.,$);")
   call f%write("#210= IFCAXIS2PLACEMENT3D (#901,$,$);")

   ! #301, #901
   call f%write("#301= IFCUNITASSIGNMENT ((#311,#312));")
   call f%write("#311= IFCSIUNIT (*,.LENGTHUNIT.,.MILLI.,.METRE.);")
   call f%write("#312= IFCCONVERSIONBASEDUNIT (#313,.PLANEANGLEUNIT.,'degree',#314);")
   call f%write("#313= IFCDIMENSIONALEXPONENTS (0,0,0,0,0,0,0);")
   call f%write("#314= IFCMEASUREWITHUNIT (IFCPLANEANGLEMEASURE(0.017453293),#315);")
   call f%write("#315= IFCSIUNIT (*,.PLANEANGLEUNIT.,$,.RADIAN.);")


   call f%write("#901= IFCCARTESIANPOINT ((0.,0.,0.));")
   call f%write("#902= IFCDIRECTION ((1.,0.,0.));")
   call f%write("#903= IFCDIRECTION ((0.,1.,0.));")
   call f%write("#904= IFCDIRECTION ((0.,0.,1.));")
   call f%write("#905= IFCDIRECTION ((-1.,0.,0.));")
   call f%write("#906= IFCDIRECTION ((0.,-1.,0.));")
   call f%write("#907= IFCDIRECTION ((0.,0.,-1.));")

   call f%write("")
   call f%write("")
   call f%write("")
   call f%write("")
   call f%write("")
   call f%write("")



   call f%write("ENDSEC;")

   
   call f%write("END-ISO-10303-21;")
   call f%close()

   print *, "STEP >> .ifc exporter is under implementation."
   stop
end subroutine
! ################################################################


! ################################################################
function diff_for_real_array(femdomains,diff_target) result(ret)
   type(FEMDomain_),intent(in) :: femdomains(1:2)
   real(real64),intent(in) :: diff_target(:,:)
   real(real64),allocatable :: ret(:,:)

   ! Taking diff on the target data table
   if( size(diff_target,1) == femdomains(1)%nn() .and. &
      size(diff_target,2) == femdomains(1)%nd() )then

      ! difference on the coordinate:
      ! both domain should have the same numNode and numDim.
      ret = femdomains(1)%mesh%nodcoord(:,:) - femdomains(2)%mesh%nodcoord(:,:)
   endif

end function
! ################################################################

end module FEMDomainClass
