[cig-commits] r14306 - in seismo/3D/SPECFEM3D_SESAME/trunk: . decompose_mesh_SCOTCH
dkomati1 at geodynamics.org
dkomati1 at geodynamics.org
Thu Mar 12 10:59:58 PDT 2009
Author: dkomati1
Date: 2009-03-12 10:59:58 -0700 (Thu, 12 Mar 2009)
New Revision: 14306
Added:
seismo/3D/SPECFEM3D_SESAME/trunk/check_mesh_quality_CUBIT_Abaqus/
seismo/3D/SPECFEM3D_SESAME/trunk/decompose_mesh_SCOTCH/
seismo/3D/SPECFEM3D_SESAME/trunk/decompose_mesh_SCOTCH/compile_all.csh
seismo/3D/SPECFEM3D_SESAME/trunk/decompose_mesh_SCOTCH/constants_decompose_mesh_SCOTCH.h
seismo/3D/SPECFEM3D_SESAME/trunk/decompose_mesh_SCOTCH/decompose_mesh_SCOTCH.f90
seismo/3D/SPECFEM3D_SESAME/trunk/decompose_mesh_SCOTCH/part_decompose_mesh_SCOTCH.f90
Removed:
seismo/3D/SPECFEM3D_SESAME/trunk/analyze_CUBIT_Abaqus_mesh/
seismo/3D/SPECFEM3D_SESAME/trunk/decompose_mesh/
seismo/3D/SPECFEM3D_SESAME/trunk/decompose_mesh_SCOTCH/compile_all.csh
seismo/3D/SPECFEM3D_SESAME/trunk/decompose_mesh_SCOTCH/constants_decompose_mesh.h
seismo/3D/SPECFEM3D_SESAME/trunk/decompose_mesh_SCOTCH/decompose_mesh.f90
seismo/3D/SPECFEM3D_SESAME/trunk/decompose_mesh_SCOTCH/part_decompose_mesh.f90
Log:
renamed two more directories
Copied: seismo/3D/SPECFEM3D_SESAME/trunk/check_mesh_quality_CUBIT_Abaqus (from rev 14304, seismo/3D/SPECFEM3D_SESAME/trunk/analyze_CUBIT_Abaqus_mesh)
Copied: seismo/3D/SPECFEM3D_SESAME/trunk/decompose_mesh_SCOTCH (from rev 14304, seismo/3D/SPECFEM3D_SESAME/trunk/decompose_mesh)
Deleted: seismo/3D/SPECFEM3D_SESAME/trunk/decompose_mesh_SCOTCH/compile_all.csh
===================================================================
--- seismo/3D/SPECFEM3D_SESAME/trunk/decompose_mesh/compile_all.csh 2009-03-12 17:51:40 UTC (rev 14304)
+++ seismo/3D/SPECFEM3D_SESAME/trunk/decompose_mesh_SCOTCH/compile_all.csh 2009-03-12 17:59:58 UTC (rev 14306)
@@ -1,13 +0,0 @@
-#!/bin/sh
-
-#. /opt/intel/fce/10.0.026/bin/ifortvars.sh
-# export FCFLAGS="-g -traceback -implicitnone -warn stderrors -warn truncated_source -warn argument_checking -warn unused -warn declarations -std95 -assume byterecl -C"
-
-rm *.o *.mod ./a.out
-
-gfortran -c part_decompose_mesh.f90
-gfortran -c decompose_mesh.f90
-#gfortran decompose_mesh.o part_decompose_mesh.o ~/utils/metis-4.0/libmetis.a
-#gfortran decompose_mesh.o part_decompose_mesh.o ~/utils/scotch_5.1/lib/libscotchmetis.a ~/utils/scotch_5.1/lib/libscotch.a ~/utils/scotch_5.1/lib/libscotcherr.a
-gfortran decompose_mesh.o part_decompose_mesh.o ~/utils/scotch_5.1/lib/libscotch.a ~/utils/scotch_5.1/lib/libscotcherr.a
-
Copied: seismo/3D/SPECFEM3D_SESAME/trunk/decompose_mesh_SCOTCH/compile_all.csh (from rev 14305, seismo/3D/SPECFEM3D_SESAME/trunk/decompose_mesh/compile_all.csh)
===================================================================
--- seismo/3D/SPECFEM3D_SESAME/trunk/decompose_mesh_SCOTCH/compile_all.csh (rev 0)
+++ seismo/3D/SPECFEM3D_SESAME/trunk/decompose_mesh_SCOTCH/compile_all.csh 2009-03-12 17:59:58 UTC (rev 14306)
@@ -0,0 +1,13 @@
+#!/bin/sh
+
+#. /opt/intel/fce/10.0.026/bin/ifortvars.sh
+# export FCFLAGS="-g -traceback -implicitnone -warn stderrors -warn truncated_source -warn argument_checking -warn unused -warn declarations -std95 -assume byterecl -C"
+
+rm *.o *.mod ./a.out
+
+gfortran -c part_decompose_mesh_SCOTCH.f90
+gfortran -c decompose_mesh_SCOTCH.f90
+#gfortran decompose_mesh_SCOTCH.o part_decompose_mesh_SCOTCH.o ~/utils/metis-4.0/libmetis.a
+#gfortran decompose_mesh_SCOTCH.o part_decompose_mesh_SCOTCH.o ~/utils/scotch_5.1/lib/libscotchmetis.a ~/utils/scotch_5.1/lib/libscotch.a ~/utils/scotch_5.1/lib/libscotcherr.a
+gfortran decompose_mesh_SCOTCH.o part_decompose_mesh_SCOTCH.o ~/utils/scotch_5.1/lib/libscotch.a ~/utils/scotch_5.1/lib/libscotcherr.a
+
Deleted: seismo/3D/SPECFEM3D_SESAME/trunk/decompose_mesh_SCOTCH/constants_decompose_mesh.h
===================================================================
--- seismo/3D/SPECFEM3D_SESAME/trunk/decompose_mesh/constants_decompose_mesh.h 2009-03-12 17:51:40 UTC (rev 14304)
+++ seismo/3D/SPECFEM3D_SESAME/trunk/decompose_mesh_SCOTCH/constants_decompose_mesh.h 2009-03-12 17:59:58 UTC (rev 14306)
@@ -1,11 +0,0 @@
-! Useful kind types
-integer ,parameter :: short = SELECTED_INT_KIND(4), long = SELECTED_INT_KIND(18)
-
-! Number of nodes per elements.
-integer, parameter :: ESIZE = 8
-
-! Number of faces per element.
-integer, parameter :: nfaces = 6
-
-! very large and very small values
- double precision, parameter :: HUGEVAL = 1.d+30,TINYVAL = 1.d-9
Copied: seismo/3D/SPECFEM3D_SESAME/trunk/decompose_mesh_SCOTCH/constants_decompose_mesh_SCOTCH.h (from rev 14305, seismo/3D/SPECFEM3D_SESAME/trunk/decompose_mesh/constants_decompose_mesh_SCOTCH.h)
===================================================================
--- seismo/3D/SPECFEM3D_SESAME/trunk/decompose_mesh_SCOTCH/constants_decompose_mesh_SCOTCH.h (rev 0)
+++ seismo/3D/SPECFEM3D_SESAME/trunk/decompose_mesh_SCOTCH/constants_decompose_mesh_SCOTCH.h 2009-03-12 17:59:58 UTC (rev 14306)
@@ -0,0 +1,11 @@
+! Useful kind types
+integer ,parameter :: short = SELECTED_INT_KIND(4), long = SELECTED_INT_KIND(18)
+
+! Number of nodes per elements.
+integer, parameter :: ESIZE = 8
+
+! Number of faces per element.
+integer, parameter :: nfaces = 6
+
+! very large and very small values
+ double precision, parameter :: HUGEVAL = 1.d+30,TINYVAL = 1.d-9
Deleted: seismo/3D/SPECFEM3D_SESAME/trunk/decompose_mesh_SCOTCH/decompose_mesh.f90
===================================================================
--- seismo/3D/SPECFEM3D_SESAME/trunk/decompose_mesh/decompose_mesh.f90 2009-03-12 17:51:40 UTC (rev 14304)
+++ seismo/3D/SPECFEM3D_SESAME/trunk/decompose_mesh_SCOTCH/decompose_mesh.f90 2009-03-12 17:59:58 UTC (rev 14306)
@@ -1,252 +0,0 @@
-
- program decompose_mesh
-
- use part_decompose_mesh
- implicit none
-
- include './constants_decompose_mesh.h'
- include "./scotchf.h"
-
- integer, parameter :: nparts = 8
-
- integer(long) :: nspec
- integer, dimension(:,:), allocatable :: elmnts
- integer, dimension(:), allocatable :: mat
- integer, dimension(:), allocatable :: part
-
- integer :: nnodes
- double precision, dimension(:,:), allocatable :: nodes_coords
-
- integer, dimension(:), allocatable :: xadj
- integer, dimension(:), allocatable :: adjncy
- integer, dimension(:), allocatable :: nnodes_elmnts
- integer, dimension(:), allocatable :: nodes_elmnts
-
- integer, dimension(:), allocatable :: vwgt
- integer, dimension(:), allocatable :: adjwgt
- integer, dimension(5) :: metis_options
-
- integer, dimension(:), pointer :: glob2loc_elmnts
- integer, dimension(:), pointer :: glob2loc_nodes_nparts
- integer, dimension(:), pointer :: glob2loc_nodes_parts
- integer, dimension(:), pointer :: glob2loc_nodes
-
- integer, dimension(:), pointer :: tab_size_interfaces, tab_interfaces
- integer, dimension(:), allocatable :: my_interfaces
- integer, dimension(:), allocatable :: my_nb_interfaces
- integer :: ninterfaces
- integer :: my_ninterface
-
- integer :: nb_materials
- double precision, dimension(:), allocatable :: cs
- integer, dimension(:), allocatable :: num_material
-
- integer(long) :: nsize ! Max number of elements that contain the same node.
- integer :: edgecut
- integer :: nb_edges
-
- integer :: ispec, inode
- integer :: wgtflag
- integer :: num_start
- integer :: ngnod
- integer :: max_neighbour ! Real maximum number of neighbours per element
- integer(long) :: sup_neighbour ! Majoration of the maximum number of neighbours per element
-
- integer :: ipart, nnodes_loc, nspec_loc
- character(len=256) :: prname
-
- logical, dimension(:), allocatable :: mask_nodes_elmnts
- integer, dimension(:), allocatable :: used_nodes_elmnts
-
-!!!! NL NL for SCOTCH partitioner
- double precision, dimension(SCOTCH_GRAPHDIM) :: scotchgraph
- double precision, dimension(SCOTCH_STRATDIM) :: scotchstrat
- character(len=256), parameter :: scotch_strategy='b{job=t,map=t,poli=S,sep=h{pass=30}}'
- integer :: ierr
-!!!! NL NL
-
-
- ngnod = esize
-
-! read the elements, material and nodes files
- open(unit=98, file='../model_asteroid_subdivide/mesh', status='old', form='formatted')
- read(98,*) nspec
- allocate(elmnts(esize,nspec))
- do ispec = 1, nspec
- read(98,*) elmnts(1,ispec), elmnts(2,ispec), elmnts(3,ispec), elmnts(4,ispec), &
- elmnts(5,ispec), elmnts(6,ispec), elmnts(7,ispec), elmnts(8,ispec)
- end do
- close(98)
-
- open(unit=98, file='../model_asteroid_subdivide/mat', status='old', form='formatted')
- allocate(mat(nspec))
- do ispec = 1, nspec
- read(98,*) mat(ispec)
- end do
- close(98)
-
- open(unit=98, file='../model_asteroid_subdivide/nodes_coords', status='old', form='formatted')
- read(98,*) nnodes
- allocate(nodes_coords(3,nnodes))
- do inode = 1, nnodes
- read(98,*) nodes_coords(1,inode), nodes_coords(2,inode), nodes_coords(3,inode)
- end do
- close(98)
-
- allocate(mask_nodes_elmnts(nnodes))
- allocate(used_nodes_elmnts(nnodes))
- mask_nodes_elmnts(:) = .false.
- used_nodes_elmnts(:) = 0
- do ispec = 1, nspec
- do inode = 1, ESIZE
- mask_nodes_elmnts(elmnts(inode,ispec)) = .true.
- used_nodes_elmnts(elmnts(inode,ispec)) = used_nodes_elmnts(elmnts(inode,ispec)) + 1
- enddo
- enddo
- nsize = maxval(used_nodes_elmnts(:))
- sup_neighbour = ngnod * nsize - (ngnod + (ngnod/2 - 1)*nfaces)
- print*, 'nsize = ',nsize, 'sup_neighbour = ', sup_neighbour
-
- do inode = 1, nnodes
- if (.not. mask_nodes_elmnts(inode)) then
- stop 'ERROR : nodes not used.'
- endif
- enddo
-! if (maxval(used_nodes_elmnts(:))>nsize) then
-! stop 'ERROR : increase nsize or modify the mesh.'
-! endif
-
- elmnts(:,:) = elmnts(:,:) - 1
-
- allocate(xadj(1:nspec+1))
- allocate(adjncy(1:sup_neighbour*nspec))
- allocate(nnodes_elmnts(1:nnodes))
- allocate(nodes_elmnts(1:nsize*nnodes))
-
- call mesh2dual_ncommonnodes(nspec, nnodes, nsize, sup_neighbour, elmnts, xadj, adjncy, nnodes_elmnts, &
- nodes_elmnts, max_neighbour, 1)
- print*, 'max_neighbour = ',max_neighbour
-
-
- ! elmnts(:,:) = elmnts(:,:) + 1
- ! adjncy(:) = adjncy(:) + 1
- ! xadj(:) = xadj(:) + 1
-! allocate(vwgt(0:nspec-1))
- nb_edges = xadj(nspec+1)
-! allocate(adjwgt(0:nb_edges-1))
-! vwgt(:) = 1
-! adjwgt(:) = 1
-
-! metis_options(1) = 0
-! metis_options(2) = 3
-! metis_options(3) = 1
-! metis_options(4) = 1
-! metis_options(5) = 0
-
-
-! num_start = 0
-! wgtflag = 0
-
- allocate(part(1:nspec))
-
-
-! Old metis partitioning
-! call METIS_PartGraphRecursive(nspec, xadj(1), adjncy(1), vwgt(0), adjwgt(0), wgtflag, num_start, nparts, &
-! metis_options, edgecut, part(1));
-
-! SCOTCH partitioning
- call scotchfstratinit (scotchstrat(1), ierr)
- if (ierr /= 0) then
- stop 'ERROR : MAIN : Cannot initialize strat'
- endif
-
- call scotchfstratgraphmap (scotchstrat(1), trim(scotch_strategy), ierr)
- if (ierr /= 0) then
- stop 'ERROR : MAIN : Cannot build strat'
- endif
-
- call scotchfgraphinit (scotchgraph (1), ierr)
- if (ierr /= 0) then
- stop 'ERROR : MAIN : Cannot initialize graph'
- endif
-
- call scotchfgraphbuild (scotchgraph (1), 0, nspec, xadj (1), xadj (1), &
- xadj (1), xadj (1), nb_edges, adjncy (1), adjncy (1), ierr)
- if (ierr /= 0) then
- stop 'ERROR : MAIN : Cannot build graph'
- endif
-
- call scotchfgraphcheck (scotchgraph (1), ierr)
- if (ierr /= 0) then
- stop 'ERROR : MAIN : Invalid check'
- endif
-
- call scotchfgraphpart (scotchgraph (1), nparts, scotchstrat(1),part(1),ierr)
- if (ierr /= 0) then
- stop 'ERROR : MAIN : Cannot part graph'
- endif
-
- call scotchfgraphexit (scotchgraph (1), ierr)
- if (ierr /= 0) then
- stop 'ERROR : MAIN : Cannot destroy graph'
- endif
-
- call scotchfstratexit (scotchstrat(1), ierr)
- if (ierr /= 0) then
- stop 'ERROR : MAIN : Cannot destroy strat'
- endif
-
-
-! local number of each element for each partition
- call Construct_glob2loc_elmnts(nspec, part, nparts, glob2loc_elmnts)
-
-! local number of each node for each partition
- call Construct_glob2loc_nodes(nspec, nnodes,nsize, nnodes_elmnts, nodes_elmnts, part, nparts, &
- glob2loc_nodes_nparts, glob2loc_nodes_parts, glob2loc_nodes)
-
- nb_materials = 1
- allocate(cs(nb_materials))
- allocate(num_material(nspec))
- cs(:) = 1000.d0
- num_material(:) = 1
-
- call Construct_interfaces(nspec, nparts, sup_neighbour, part, elmnts, xadj, adjncy, tab_interfaces, &
- tab_size_interfaces, ninterfaces, nb_materials, cs, num_material)
-
- allocate(my_interfaces(0:ninterfaces-1))
- allocate(my_nb_interfaces(0:ninterfaces-1))
-
-
-
- do ipart = 0, nparts-1
-
- !write(prname, "('/Database',i5.5)") ipart
- write(prname, "(i6.6,'_Database')") ipart
- open(unit=15,file='./OUTPUT_FILES/proc'//prname,status='unknown', action='write', form='formatted')
-
- call write_glob2loc_nodes_database(15, ipart, nnodes_loc, nodes_coords, glob2loc_nodes_nparts, glob2loc_nodes_parts, &
- glob2loc_nodes, nnodes, 1)
- call write_partition_database(15, ipart, nspec_loc, nspec, elmnts, glob2loc_elmnts, glob2loc_nodes_nparts, &
- glob2loc_nodes_parts, glob2loc_nodes, part, num_material, ngnod, 1)
-
- write(15,*) nnodes_loc
- call write_glob2loc_nodes_database(15, ipart, nnodes_loc, nodes_coords, glob2loc_nodes_nparts, glob2loc_nodes_parts, &
- glob2loc_nodes, nnodes, 2)
- write(15,*) nspec_loc
- call write_partition_database(15, ipart, nspec_loc, nspec, elmnts, glob2loc_elmnts, glob2loc_nodes_nparts, &
- glob2loc_nodes_parts, glob2loc_nodes, part, num_material, ngnod, 2)
-
- call Write_interfaces_database(15, tab_interfaces, tab_size_interfaces, nparts, ipart, ninterfaces, &
- my_ninterface, my_interfaces, my_nb_interfaces, glob2loc_elmnts, glob2loc_nodes_nparts, glob2loc_nodes_parts, &
- glob2loc_nodes, 1)
- write(15,*) my_ninterface, maxval(my_nb_interfaces)
- call Write_interfaces_database(15, tab_interfaces, tab_size_interfaces, nparts, ipart, ninterfaces, &
- my_ninterface, my_interfaces, my_nb_interfaces, glob2loc_elmnts, glob2loc_nodes_nparts, glob2loc_nodes_parts, &
- glob2loc_nodes, 2)
-
- close(15)
-
- enddo
-
- end program decompose_mesh
-
Copied: seismo/3D/SPECFEM3D_SESAME/trunk/decompose_mesh_SCOTCH/decompose_mesh_SCOTCH.f90 (from rev 14305, seismo/3D/SPECFEM3D_SESAME/trunk/decompose_mesh/decompose_mesh_SCOTCH.f90)
===================================================================
--- seismo/3D/SPECFEM3D_SESAME/trunk/decompose_mesh_SCOTCH/decompose_mesh_SCOTCH.f90 (rev 0)
+++ seismo/3D/SPECFEM3D_SESAME/trunk/decompose_mesh_SCOTCH/decompose_mesh_SCOTCH.f90 2009-03-12 17:59:58 UTC (rev 14306)
@@ -0,0 +1,252 @@
+
+ program decompose_mesh_SCOTCH
+
+ use part_decompose_mesh_SCOTCH
+ implicit none
+
+ include './constants_decompose_mesh_SCOTCH.h'
+ include "./scotchf.h"
+
+ integer, parameter :: nparts = 8
+
+ integer(long) :: nspec
+ integer, dimension(:,:), allocatable :: elmnts
+ integer, dimension(:), allocatable :: mat
+ integer, dimension(:), allocatable :: part
+
+ integer :: nnodes
+ double precision, dimension(:,:), allocatable :: nodes_coords
+
+ integer, dimension(:), allocatable :: xadj
+ integer, dimension(:), allocatable :: adjncy
+ integer, dimension(:), allocatable :: nnodes_elmnts
+ integer, dimension(:), allocatable :: nodes_elmnts
+
+ integer, dimension(:), allocatable :: vwgt
+ integer, dimension(:), allocatable :: adjwgt
+ integer, dimension(5) :: metis_options
+
+ integer, dimension(:), pointer :: glob2loc_elmnts
+ integer, dimension(:), pointer :: glob2loc_nodes_nparts
+ integer, dimension(:), pointer :: glob2loc_nodes_parts
+ integer, dimension(:), pointer :: glob2loc_nodes
+
+ integer, dimension(:), pointer :: tab_size_interfaces, tab_interfaces
+ integer, dimension(:), allocatable :: my_interfaces
+ integer, dimension(:), allocatable :: my_nb_interfaces
+ integer :: ninterfaces
+ integer :: my_ninterface
+
+ integer :: nb_materials
+ double precision, dimension(:), allocatable :: cs
+ integer, dimension(:), allocatable :: num_material
+
+ integer(long) :: nsize ! Max number of elements that contain the same node.
+ integer :: edgecut
+ integer :: nb_edges
+
+ integer :: ispec, inode
+ integer :: wgtflag
+ integer :: num_start
+ integer :: ngnod
+ integer :: max_neighbour ! Real maximum number of neighbours per element
+ integer(long) :: sup_neighbour ! Majoration of the maximum number of neighbours per element
+
+ integer :: ipart, nnodes_loc, nspec_loc
+ character(len=256) :: prname
+
+ logical, dimension(:), allocatable :: mask_nodes_elmnts
+ integer, dimension(:), allocatable :: used_nodes_elmnts
+
+!!!! NL NL for SCOTCH partitioner
+ double precision, dimension(SCOTCH_GRAPHDIM) :: scotchgraph
+ double precision, dimension(SCOTCH_STRATDIM) :: scotchstrat
+ character(len=256), parameter :: scotch_strategy='b{job=t,map=t,poli=S,sep=h{pass=30}}'
+ integer :: ierr
+!!!! NL NL
+
+
+ ngnod = esize
+
+! read the elements, material and nodes files
+ open(unit=98, file='../model_asteroid_subdivide/mesh', status='old', form='formatted')
+ read(98,*) nspec
+ allocate(elmnts(esize,nspec))
+ do ispec = 1, nspec
+ read(98,*) elmnts(1,ispec), elmnts(2,ispec), elmnts(3,ispec), elmnts(4,ispec), &
+ elmnts(5,ispec), elmnts(6,ispec), elmnts(7,ispec), elmnts(8,ispec)
+ end do
+ close(98)
+
+ open(unit=98, file='../model_asteroid_subdivide/mat', status='old', form='formatted')
+ allocate(mat(nspec))
+ do ispec = 1, nspec
+ read(98,*) mat(ispec)
+ end do
+ close(98)
+
+ open(unit=98, file='../model_asteroid_subdivide/nodes_coords', status='old', form='formatted')
+ read(98,*) nnodes
+ allocate(nodes_coords(3,nnodes))
+ do inode = 1, nnodes
+ read(98,*) nodes_coords(1,inode), nodes_coords(2,inode), nodes_coords(3,inode)
+ end do
+ close(98)
+
+ allocate(mask_nodes_elmnts(nnodes))
+ allocate(used_nodes_elmnts(nnodes))
+ mask_nodes_elmnts(:) = .false.
+ used_nodes_elmnts(:) = 0
+ do ispec = 1, nspec
+ do inode = 1, ESIZE
+ mask_nodes_elmnts(elmnts(inode,ispec)) = .true.
+ used_nodes_elmnts(elmnts(inode,ispec)) = used_nodes_elmnts(elmnts(inode,ispec)) + 1
+ enddo
+ enddo
+ nsize = maxval(used_nodes_elmnts(:))
+ sup_neighbour = ngnod * nsize - (ngnod + (ngnod/2 - 1)*nfaces)
+ print*, 'nsize = ',nsize, 'sup_neighbour = ', sup_neighbour
+
+ do inode = 1, nnodes
+ if (.not. mask_nodes_elmnts(inode)) then
+ stop 'ERROR : nodes not used.'
+ endif
+ enddo
+! if (maxval(used_nodes_elmnts(:))>nsize) then
+! stop 'ERROR : increase nsize or modify the mesh.'
+! endif
+
+ elmnts(:,:) = elmnts(:,:) - 1
+
+ allocate(xadj(1:nspec+1))
+ allocate(adjncy(1:sup_neighbour*nspec))
+ allocate(nnodes_elmnts(1:nnodes))
+ allocate(nodes_elmnts(1:nsize*nnodes))
+
+ call mesh2dual_ncommonnodes(nspec, nnodes, nsize, sup_neighbour, elmnts, xadj, adjncy, nnodes_elmnts, &
+ nodes_elmnts, max_neighbour, 1)
+ print*, 'max_neighbour = ',max_neighbour
+
+
+ ! elmnts(:,:) = elmnts(:,:) + 1
+ ! adjncy(:) = adjncy(:) + 1
+ ! xadj(:) = xadj(:) + 1
+! allocate(vwgt(0:nspec-1))
+ nb_edges = xadj(nspec+1)
+! allocate(adjwgt(0:nb_edges-1))
+! vwgt(:) = 1
+! adjwgt(:) = 1
+
+! metis_options(1) = 0
+! metis_options(2) = 3
+! metis_options(3) = 1
+! metis_options(4) = 1
+! metis_options(5) = 0
+
+
+! num_start = 0
+! wgtflag = 0
+
+ allocate(part(1:nspec))
+
+
+! Old metis partitioning
+! call METIS_PartGraphRecursive(nspec, xadj(1), adjncy(1), vwgt(0), adjwgt(0), wgtflag, num_start, nparts, &
+! metis_options, edgecut, part(1));
+
+! SCOTCH partitioning
+ call scotchfstratinit (scotchstrat(1), ierr)
+ if (ierr /= 0) then
+ stop 'ERROR : MAIN : Cannot initialize strat'
+ endif
+
+ call scotchfstratgraphmap (scotchstrat(1), trim(scotch_strategy), ierr)
+ if (ierr /= 0) then
+ stop 'ERROR : MAIN : Cannot build strat'
+ endif
+
+ call scotchfgraphinit (scotchgraph (1), ierr)
+ if (ierr /= 0) then
+ stop 'ERROR : MAIN : Cannot initialize graph'
+ endif
+
+ call scotchfgraphbuild (scotchgraph (1), 0, nspec, xadj (1), xadj (1), &
+ xadj (1), xadj (1), nb_edges, adjncy (1), adjncy (1), ierr)
+ if (ierr /= 0) then
+ stop 'ERROR : MAIN : Cannot build graph'
+ endif
+
+ call scotchfgraphcheck (scotchgraph (1), ierr)
+ if (ierr /= 0) then
+ stop 'ERROR : MAIN : Invalid check'
+ endif
+
+ call scotchfgraphpart (scotchgraph (1), nparts, scotchstrat(1),part(1),ierr)
+ if (ierr /= 0) then
+ stop 'ERROR : MAIN : Cannot part graph'
+ endif
+
+ call scotchfgraphexit (scotchgraph (1), ierr)
+ if (ierr /= 0) then
+ stop 'ERROR : MAIN : Cannot destroy graph'
+ endif
+
+ call scotchfstratexit (scotchstrat(1), ierr)
+ if (ierr /= 0) then
+ stop 'ERROR : MAIN : Cannot destroy strat'
+ endif
+
+
+! local number of each element for each partition
+ call Construct_glob2loc_elmnts(nspec, part, nparts, glob2loc_elmnts)
+
+! local number of each node for each partition
+ call Construct_glob2loc_nodes(nspec, nnodes,nsize, nnodes_elmnts, nodes_elmnts, part, nparts, &
+ glob2loc_nodes_nparts, glob2loc_nodes_parts, glob2loc_nodes)
+
+ nb_materials = 1
+ allocate(cs(nb_materials))
+ allocate(num_material(nspec))
+ cs(:) = 1000.d0
+ num_material(:) = 1
+
+ call Construct_interfaces(nspec, nparts, sup_neighbour, part, elmnts, xadj, adjncy, tab_interfaces, &
+ tab_size_interfaces, ninterfaces, nb_materials, cs, num_material)
+
+ allocate(my_interfaces(0:ninterfaces-1))
+ allocate(my_nb_interfaces(0:ninterfaces-1))
+
+
+
+ do ipart = 0, nparts-1
+
+ !write(prname, "('/Database',i5.5)") ipart
+ write(prname, "(i6.6,'_Database')") ipart
+ open(unit=15,file='./OUTPUT_FILES/proc'//prname,status='unknown', action='write', form='formatted')
+
+ call write_glob2loc_nodes_database(15, ipart, nnodes_loc, nodes_coords, glob2loc_nodes_nparts, glob2loc_nodes_parts, &
+ glob2loc_nodes, nnodes, 1)
+ call write_partition_database(15, ipart, nspec_loc, nspec, elmnts, glob2loc_elmnts, glob2loc_nodes_nparts, &
+ glob2loc_nodes_parts, glob2loc_nodes, part, num_material, ngnod, 1)
+
+ write(15,*) nnodes_loc
+ call write_glob2loc_nodes_database(15, ipart, nnodes_loc, nodes_coords, glob2loc_nodes_nparts, glob2loc_nodes_parts, &
+ glob2loc_nodes, nnodes, 2)
+ write(15,*) nspec_loc
+ call write_partition_database(15, ipart, nspec_loc, nspec, elmnts, glob2loc_elmnts, glob2loc_nodes_nparts, &
+ glob2loc_nodes_parts, glob2loc_nodes, part, num_material, ngnod, 2)
+
+ call Write_interfaces_database(15, tab_interfaces, tab_size_interfaces, nparts, ipart, ninterfaces, &
+ my_ninterface, my_interfaces, my_nb_interfaces, glob2loc_elmnts, glob2loc_nodes_nparts, glob2loc_nodes_parts, &
+ glob2loc_nodes, 1)
+ write(15,*) my_ninterface, maxval(my_nb_interfaces)
+ call Write_interfaces_database(15, tab_interfaces, tab_size_interfaces, nparts, ipart, ninterfaces, &
+ my_ninterface, my_interfaces, my_nb_interfaces, glob2loc_elmnts, glob2loc_nodes_nparts, glob2loc_nodes_parts, &
+ glob2loc_nodes, 2)
+
+ close(15)
+
+ enddo
+
+ end program decompose_mesh_SCOTCH
+
Deleted: seismo/3D/SPECFEM3D_SESAME/trunk/decompose_mesh_SCOTCH/part_decompose_mesh.f90
===================================================================
--- seismo/3D/SPECFEM3D_SESAME/trunk/decompose_mesh/part_decompose_mesh.f90 2009-03-12 17:51:40 UTC (rev 14304)
+++ seismo/3D/SPECFEM3D_SESAME/trunk/decompose_mesh_SCOTCH/part_decompose_mesh.f90 2009-03-12 17:59:58 UTC (rev 14306)
@@ -1,622 +0,0 @@
-module part_decompose_mesh
-
- implicit none
-
-contains
-
- !-----------------------------------------------
- ! Creating dual graph (adjacency is defined by 'ncommonnodes' between two elements).
- !-----------------------------------------------
- subroutine mesh2dual_ncommonnodes(nelmnts, nnodes, nsize, sup_neighbour, elmnts, xadj, adjncy, &
- nnodes_elmnts, nodes_elmnts, max_neighbour, ncommonnodes)
-
- include './constants_decompose_mesh.h'
-
- integer(long), intent(in) :: nelmnts
- integer, intent(in) :: nnodes
- integer(long), intent(in) :: nsize
- integer(long), intent(in) :: sup_neighbour
- integer, dimension(0:esize*nelmnts-1), intent(in) :: elmnts
- integer, dimension(0:nelmnts) :: xadj
- integer, dimension(0:sup_neighbour*nelmnts-1) :: adjncy
- integer, dimension(0:nnodes-1) :: nnodes_elmnts
- integer, dimension(0:nsize*nnodes-1) :: nodes_elmnts
- integer, intent(out) :: max_neighbour
- integer, intent(in) :: ncommonnodes
-
- integer :: i, j, k, l, m, nb_edges
- logical :: is_neighbour
- integer :: num_node, n
- integer :: elem_base, elem_target
- integer :: connectivity
-
-
- !allocate(xadj(0:nelmnts))
- xadj(:) = 0
- !allocate(adjncy(0:max_neighbour*nelmnts-1))
- adjncy(:) = 0
- !allocate(nnodes_elmnts(0:nnodes-1))
- nnodes_elmnts(:) = 0
- !allocate(nodes_elmnts(0:nsize*nnodes-1))
- nodes_elmnts(:) = 0
-
- nb_edges = 0
-
-
- ! list of elements per node
- do i = 0, esize*nelmnts-1
- nodes_elmnts(elmnts(i)*nsize+nnodes_elmnts(elmnts(i))) = i/esize
- nnodes_elmnts(elmnts(i)) = nnodes_elmnts(elmnts(i)) + 1
-
- end do
-
- !print *, 'nnodes_elmnts'
-
- ! checking which elements are neighbours ('ncommonnodes' criteria)
- do j = 0, nnodes-1
- do k = 0, nnodes_elmnts(j)-1
- do l = k+1, nnodes_elmnts(j)-1
-
- connectivity = 0
- elem_base = nodes_elmnts(k+j*nsize)
- elem_target = nodes_elmnts(l+j*nsize)
- do n = 1, esize
- num_node = elmnts(esize*elem_base+n-1)
- do m = 0, nnodes_elmnts(num_node)-1
- if ( nodes_elmnts(m+num_node*nsize) == elem_target ) then
- connectivity = connectivity + 1
- end if
- end do
- end do
-
- if ( connectivity >= ncommonnodes) then
-
- is_neighbour = .false.
-
- do m = 0, xadj(nodes_elmnts(k+j*nsize))
- if ( .not.is_neighbour ) then
- if ( adjncy(nodes_elmnts(k+j*nsize)*sup_neighbour+m) == nodes_elmnts(l+j*nsize) ) then
- is_neighbour = .true.
-
- end if
- end if
- end do
- if ( .not.is_neighbour ) then
- adjncy(nodes_elmnts(k+j*nsize)*sup_neighbour+xadj(nodes_elmnts(k+j*nsize))) = nodes_elmnts(l+j*nsize)
- xadj(nodes_elmnts(k+j*nsize)) = xadj(nodes_elmnts(k+j*nsize)) + 1
- if (xadj(nodes_elmnts(k+j*nsize))>sup_neighbour) stop 'ERROR : too much neighbours per element, modify the mesh.'
- adjncy(nodes_elmnts(l+j*nsize)*sup_neighbour+xadj(nodes_elmnts(l+j*nsize))) = nodes_elmnts(k+j*nsize)
- xadj(nodes_elmnts(l+j*nsize)) = xadj(nodes_elmnts(l+j*nsize)) + 1
- if (xadj(nodes_elmnts(l+j*nsize))>sup_neighbour) stop 'ERROR : too much neighbours per element, modify the mesh.'
- end if
- end if
- end do
- end do
- end do
-
- max_neighbour = maxval(xadj)
-
- ! making adjacency arrays compact (to be used for partitioning)
- do i = 0, nelmnts-1
- k = xadj(i)
- xadj(i) = nb_edges
- do j = 0, k-1
- adjncy(nb_edges) = adjncy(i*sup_neighbour+j)
- nb_edges = nb_edges + 1
- end do
- end do
-
- xadj(nelmnts) = nb_edges
-
-
- end subroutine mesh2dual_ncommonnodes
-
-
-
- !--------------------------------------------------
- ! construct local numbering for the elements in each partition
- !--------------------------------------------------
- subroutine Construct_glob2loc_elmnts(nelmnts, part, nparts, glob2loc_elmnts)
-
- include './constants_decompose_mesh.h'
-
- integer(long), intent(in) :: nelmnts
- integer, intent(in) :: nparts
- integer, dimension(0:nelmnts-1), intent(in) :: part
- integer, dimension(:), pointer :: glob2loc_elmnts
-
- integer :: num_glob, num_part
- integer, dimension(0:nparts-1) :: num_loc
-
-
- allocate(glob2loc_elmnts(0:nelmnts-1))
-
- do num_part = 0, nparts-1
- num_loc(num_part) = 0
-
- end do
-
- do num_glob = 0, nelmnts-1
- num_part = part(num_glob)
- glob2loc_elmnts(num_glob) = num_loc(num_part)
- num_loc(num_part) = num_loc(num_part) + 1
-
- end do
-
-
- end subroutine Construct_glob2loc_elmnts
-
-
-
- !--------------------------------------------------
- ! construct local numbering for the nodes in each partition
- !--------------------------------------------------
- subroutine Construct_glob2loc_nodes(nelmnts, nnodes, nsize, nnodes_elmnts, nodes_elmnts, part, nparts, &
- glob2loc_nodes_nparts, glob2loc_nodes_parts, glob2loc_nodes)
-
- include './constants_decompose_mesh.h'
-
- integer(long), intent(in) :: nelmnts, nsize
- integer, intent(in) :: nnodes, nparts
- integer, dimension(0:nelmnts-1), intent(in) :: part
- integer, dimension(0:nnodes-1), intent(in) :: nnodes_elmnts
- integer, dimension(0:nsize*nnodes-1), intent(in) :: nodes_elmnts
- integer, dimension(:), pointer :: glob2loc_nodes_nparts
- integer, dimension(:), pointer :: glob2loc_nodes_parts
- integer, dimension(:), pointer :: glob2loc_nodes
-
- integer :: num_node
- integer :: el
- integer :: num_part
- integer :: size_glob2loc_nodes
- integer, dimension(0:nparts-1) :: parts_node
- integer, dimension(0:nparts-1) :: num_parts
-
- allocate(glob2loc_nodes_nparts(0:nnodes))
-
- size_glob2loc_nodes = 0
-
- parts_node(:) = 0
-
-
- do num_node = 0, nnodes-1
- glob2loc_nodes_nparts(num_node) = size_glob2loc_nodes
- do el = 0, nnodes_elmnts(num_node)-1
- parts_node(part(nodes_elmnts(el+nsize*num_node))) = 1
-
- end do
-
- do num_part = 0, nparts-1
- if ( parts_node(num_part) == 1 ) then
- size_glob2loc_nodes = size_glob2loc_nodes + 1
- parts_node(num_part) = 0
-
- end if
- end do
-
- end do
-
- glob2loc_nodes_nparts(nnodes) = size_glob2loc_nodes
-
- allocate(glob2loc_nodes_parts(0:glob2loc_nodes_nparts(nnodes)-1))
- allocate(glob2loc_nodes(0:glob2loc_nodes_nparts(nnodes)-1))
-
- glob2loc_nodes(0) = 0
-
- parts_node(:) = 0
- num_parts(:) = 0
- size_glob2loc_nodes = 0
-
-
- do num_node = 0, nnodes-1
- do el = 0, nnodes_elmnts(num_node)-1
- parts_node(part(nodes_elmnts(el+nsize*num_node))) = 1
-
- end do
- do num_part = 0, nparts-1
-
- if ( parts_node(num_part) == 1 ) then
- glob2loc_nodes_parts(size_glob2loc_nodes) = num_part
- glob2loc_nodes(size_glob2loc_nodes) = num_parts(num_part)
- size_glob2loc_nodes = size_glob2loc_nodes + 1
- num_parts(num_part) = num_parts(num_part) + 1
- parts_node(num_part) = 0
- end if
-
- end do
- end do
-
-
- end subroutine Construct_glob2loc_nodes
-
-
-
- !--------------------------------------------------
- ! Construct interfaces between each partitions.
- ! Two adjacent elements in distinct partitions make an entry in array tab_interfaces :
- ! 1/ first element, 2/ second element, 3/ number of common nodes, 4/ first node,
- ! 5/ second node, if relevant.
- ! No interface between acoustic and elastic elements.
- !--------------------------------------------------
- subroutine Construct_interfaces(nelmnts, nparts, sup_neighbour, part, elmnts, xadj, adjncy, &
- tab_interfaces, tab_size_interfaces, ninterfaces, nb_materials, cs_material, num_material)
-
- include './constants_decompose_mesh.h'
-
- integer, intent(in) :: nparts
- integer(long), intent(in) :: nelmnts, sup_neighbour
- integer, dimension(0:nelmnts-1), intent(in) :: part
- integer, dimension(0:esize*nelmnts-1), intent(in) :: elmnts
- integer, dimension(0:nelmnts), intent(in) :: xadj
- integer, dimension(0:sup_neighbour*nelmnts-1), intent(in) :: adjncy
- integer, dimension(:),pointer :: tab_size_interfaces, tab_interfaces
- integer, intent(out) :: ninterfaces
- integer, dimension(1:nelmnts), intent(in) :: num_material
- double precision, dimension(1:nb_materials), intent(in) :: cs_material
- integer, intent(in) :: nb_materials
-
-
- integer :: num_part, num_part_bis, el, el_adj, num_interface, num_edge, ncommon_nodes, &
- num_node, num_node_bis
- integer :: i, j
- logical :: is_acoustic_el, is_acoustic_el_adj
-
- ninterfaces = 0
- do i = 0, nparts-1
- do j = i+1, nparts-1
- ninterfaces = ninterfaces + 1
- end do
- end do
-
- allocate(tab_size_interfaces(0:ninterfaces))
- tab_size_interfaces(:) = 0
-
- num_interface = 0
- num_edge = 0
-
- do num_part = 0, nparts-1
- do num_part_bis = num_part+1, nparts-1
- do el = 0, nelmnts-1
- if ( part(el) == num_part ) then
- if ( cs_material(num_material(el+1)) < TINYVAL) then
- is_acoustic_el = .true.
- else
- is_acoustic_el = .false.
- end if
- do el_adj = xadj(el), xadj(el+1)-1
- if ( cs_material(num_material(adjncy(el_adj)+1)) < TINYVAL) then
- is_acoustic_el_adj = .true.
- else
- is_acoustic_el_adj = .false.
- end if
- if ( (part(adjncy(el_adj)) == num_part_bis) .and. (is_acoustic_el .eqv. is_acoustic_el_adj) ) then
- num_edge = num_edge + 1
-
- end if
- end do
- end if
- end do
- tab_size_interfaces(num_interface+1) = tab_size_interfaces(num_interface) + num_edge
- num_edge = 0
- num_interface = num_interface + 1
-
- end do
- end do
-
- num_interface = 0
- num_edge = 0
-
- allocate(tab_interfaces(0:(tab_size_interfaces(ninterfaces)*7-1)))
- tab_interfaces(:) = 0
-
- do num_part = 0, nparts-1
- do num_part_bis = num_part+1, nparts-1
- do el = 0, nelmnts-1
- if ( part(el) == num_part ) then
- if ( cs_material(num_material(el+1)) < TINYVAL) then
- is_acoustic_el = .true.
- else
- is_acoustic_el = .false.
- end if
- do el_adj = xadj(el), xadj(el+1)-1
- if ( cs_material(num_material(adjncy(el_adj)+1)) < TINYVAL) then
- is_acoustic_el_adj = .true.
- else
- is_acoustic_el_adj = .false.
- end if
- if ( (part(adjncy(el_adj)) == num_part_bis) .and. (is_acoustic_el .eqv. is_acoustic_el_adj) ) then
- tab_interfaces(tab_size_interfaces(num_interface)*7+num_edge*7+0) = el
- tab_interfaces(tab_size_interfaces(num_interface)*7+num_edge*7+1) = adjncy(el_adj)
- ncommon_nodes = 0
- do num_node = 0, esize-1
- do num_node_bis = 0, esize-1
- if ( elmnts(el*esize+num_node) == elmnts(adjncy(el_adj)*esize+num_node_bis) ) then
- tab_interfaces(tab_size_interfaces(num_interface)*7+num_edge*7+3+ncommon_nodes) &
- = elmnts(el*esize+num_node)
- ncommon_nodes = ncommon_nodes + 1
- end if
- end do
- end do
- if ( ncommon_nodes > 0 ) then
- tab_interfaces(tab_size_interfaces(num_interface)*7+num_edge*7+2) = ncommon_nodes
- else
- print *, "Error while building interfaces!", ncommon_nodes
- end if
- num_edge = num_edge + 1
- end if
- end do
- end if
-
- end do
- num_edge = 0
- num_interface = num_interface + 1
- end do
- end do
-
-
- end subroutine Construct_interfaces
-
-
-
- !--------------------------------------------------
- ! Write nodes (their coordinates) pertaining to iproc partition in the corresponding Database
- !--------------------------------------------------
- subroutine write_glob2loc_nodes_database(IIN_database, iproc, npgeo, nodes_coords, glob2loc_nodes_nparts, glob2loc_nodes_parts, &
- glob2loc_nodes, nnodes, num_phase)
-
- integer, intent(in) :: IIN_database
- integer, intent(in) :: nnodes, iproc, num_phase
- integer, intent(inout) :: npgeo
-
- double precision, dimension(3,nnodes) :: nodes_coords
- integer, dimension(:), pointer :: glob2loc_nodes_nparts
- integer, dimension(:), pointer :: glob2loc_nodes_parts
- integer, dimension(:), pointer :: glob2loc_nodes
-
- integer :: i, j
-
- if ( num_phase == 1 ) then
- npgeo = 0
-
- do i = 0, nnodes-1
- do j = glob2loc_nodes_nparts(i), glob2loc_nodes_nparts(i+1)-1
- if ( glob2loc_nodes_parts(j) == iproc ) then
- npgeo = npgeo + 1
-
- end if
-
- end do
- end do
- else
- do i = 0, nnodes-1
- do j = glob2loc_nodes_nparts(i), glob2loc_nodes_nparts(i+1)-1
- if ( glob2loc_nodes_parts(j) == iproc ) then
- write(IIN_database,*) glob2loc_nodes(j)+1, nodes_coords(1,i+1), nodes_coords(2,i+1), nodes_coords(3,i+1)
- end if
- end do
- end do
- end if
-
- end subroutine Write_glob2loc_nodes_database
-
-
-
- !--------------------------------------------------
- ! Write elements (their nodes) pertaining to iproc partition in the corresponding Database
- !--------------------------------------------------
- subroutine write_partition_database(IIN_database, iproc, nspec, nelmnts, elmnts, glob2loc_elmnts, glob2loc_nodes_nparts, &
- glob2loc_nodes_parts, glob2loc_nodes, part, num_modele, ngnod, num_phase)
-
- include './constants_decompose_mesh.h'
-
- integer, intent(in) :: IIN_database
- integer, intent(in) :: num_phase, iproc
- integer(long), intent(in) :: nelmnts
- integer, intent(inout) :: nspec
- integer, dimension(0:nelmnts-1) :: part
- integer, dimension(0:esize*nelmnts-1) :: elmnts
- integer, dimension(:), pointer :: glob2loc_elmnts
- integer, dimension(:) :: num_modele
- integer, dimension(:), pointer :: glob2loc_nodes_nparts
- integer, dimension(:), pointer :: glob2loc_nodes_parts
- integer, dimension(:), pointer :: glob2loc_nodes
- integer, intent(in) :: ngnod
-
- integer :: i,j,k
- integer, dimension(0:ngnod-1) :: loc_nodes
-
- if ( num_phase == 1 ) then
- nspec = 0
-
- do i = 0, nelmnts-1
- if ( part(i) == iproc ) then
- nspec = nspec + 1
-
- end if
- end do
-
- else
- do i = 0, nelmnts-1
- if ( part(i) == iproc ) then
-
- do j = 0, ngnod-1
- do k = glob2loc_nodes_nparts(elmnts(i*ngnod+j)), glob2loc_nodes_nparts(elmnts(i*ngnod+j)+1)-1
-
- if ( glob2loc_nodes_parts(k) == iproc ) then
- loc_nodes(j) = glob2loc_nodes(k)
-
- end if
- end do
-
- end do
- write(IIN_database,*) glob2loc_elmnts(i)+1, num_modele(i+1), (loc_nodes(k)+1, k=0,ngnod-1)
- end if
- end do
- end if
-
-
- end subroutine write_partition_database
-
-
-
-
- !--------------------------------------------------
- ! Write interfaces (element and common nodes) pertaining to iproc partition in the corresponding Database
- !--------------------------------------------------
- subroutine write_interfaces_database(IIN_database, tab_interfaces, tab_size_interfaces, nparts, iproc, ninterfaces, &
- my_ninterface, my_interfaces, my_nb_interfaces, glob2loc_elmnts, glob2loc_nodes_nparts, glob2loc_nodes_parts, &
- glob2loc_nodes, num_phase)
-
- integer, intent(in) :: IIN_database
- integer, intent(in) :: iproc
- integer, intent(in) :: nparts
- integer, intent(in) :: ninterfaces
- integer, intent(inout) :: my_ninterface
- integer, dimension(:), pointer :: tab_size_interfaces
- integer, dimension(:), pointer :: tab_interfaces
- integer, dimension(0:ninterfaces-1), intent(inout) :: my_interfaces
- integer, dimension(0:ninterfaces-1), intent(inout) :: my_nb_interfaces
- integer, dimension(:), pointer :: glob2loc_elmnts
- integer, dimension(:), pointer :: glob2loc_nodes_nparts
- integer, dimension(:), pointer :: glob2loc_nodes_parts
- integer, dimension(:), pointer :: glob2loc_nodes
-
- integer, dimension(4) :: local_nodes
- integer :: local_elmnt
- integer :: num_phase
-
- integer :: i, j, k, l
- integer :: num_interface
-
- num_interface = 0
-
- if ( num_phase == 1 ) then
-
- my_interfaces(:) = 0
- my_nb_interfaces(:) = 0
-
- do i = 0, nparts-1
- do j = i+1, nparts-1
- if ( (tab_size_interfaces(num_interface) < tab_size_interfaces(num_interface+1)) .and. &
- (i == iproc .or. j == iproc) ) then
- my_interfaces(num_interface) = 1
- my_nb_interfaces(num_interface) = tab_size_interfaces(num_interface+1) - tab_size_interfaces(num_interface)
- end if
- num_interface = num_interface + 1
- end do
- end do
- my_ninterface = sum(my_interfaces(:))
-
- else
-
- do i = 0, nparts-1
- do j = i+1, nparts-1
- if ( my_interfaces(num_interface) == 1 ) then
- if ( i == iproc ) then
- write(IIN_database,*) j, my_nb_interfaces(num_interface)
- else
- write(IIN_database,*) i, my_nb_interfaces(num_interface)
- end if
-
- do k = tab_size_interfaces(num_interface), tab_size_interfaces(num_interface+1)-1
- if ( i == iproc ) then
- local_elmnt = glob2loc_elmnts(tab_interfaces(k*7+0))+1
- else
- local_elmnt = glob2loc_elmnts(tab_interfaces(k*7+1))+1
- end if
-
-!!$ if ( tab_interfaces(k*7+2) == 1 ) then
-!!$ do l = glob2loc_nodes_nparts(tab_interfaces(k*7+3)), &
-!!$ glob2loc_nodes_nparts(tab_interfaces(k*7+3)+1)-1
-!!$ if ( glob2loc_nodes_parts(l) == iproc ) then
-!!$ local_nodes(1) = glob2loc_nodes(l)+1
-!!$ end if
-!!$ end do
-!!$
-!!$ write(IIN_database,*) local_elmnt, tab_interfaces(k*7+2), local_nodes(1), -1
-!!$ else
-!!$ if ( tab_interfaces(k*7+2) == 2 ) then
-!!$ do l = glob2loc_nodes_nparts(tab_interfaces(k*7+3)), &
-!!$ glob2loc_nodes_nparts(tab_interfaces(k*7+3)+1)-1
-!!$ if ( glob2loc_nodes_parts(l) == iproc ) then
-!!$ local_nodes(1) = glob2loc_nodes(l)+1
-!!$ end if
-!!$ end do
-!!$ do l = glob2loc_nodes_nparts(tab_interfaces(k*7+4)), &
-!!$ glob2loc_nodes_nparts(tab_interfaces(k*7+4)+1)-1
-!!$ if ( glob2loc_nodes_parts(l) == iproc ) then
-!!$ local_nodes(2) = glob2loc_nodes(l)+1
-!!$ end if
-!!$ end do
-!!$ write(IIN_database,*) local_elmnt, tab_interfaces(k*7+2), local_nodes(1), local_nodes(2)
-!!$ else
-!!$ write(IIN_database,*) "erreur_write_interface_", tab_interfaces(k*7+2)
-!!$ end if
-!!$ end if
- select case (tab_interfaces(k*7+2))
- case (1)
- do l = glob2loc_nodes_nparts(tab_interfaces(k*7+3)), &
- glob2loc_nodes_nparts(tab_interfaces(k*7+3)+1)-1
- if ( glob2loc_nodes_parts(l) == iproc ) then
- local_nodes(1) = glob2loc_nodes(l)+1
- end if
- end do
- write(IIN_database,*) local_elmnt, tab_interfaces(k*7+2), local_nodes(1), -1, -1, -1
- case (2)
- do l = glob2loc_nodes_nparts(tab_interfaces(k*7+3)), &
- glob2loc_nodes_nparts(tab_interfaces(k*7+3)+1)-1
- if ( glob2loc_nodes_parts(l) == iproc ) then
- local_nodes(1) = glob2loc_nodes(l)+1
- end if
- end do
- do l = glob2loc_nodes_nparts(tab_interfaces(k*7+4)), &
- glob2loc_nodes_nparts(tab_interfaces(k*7+4)+1)-1
- if ( glob2loc_nodes_parts(l) == iproc ) then
- local_nodes(2) = glob2loc_nodes(l)+1
- end if
- end do
- write(IIN_database,*) local_elmnt, tab_interfaces(k*7+2), local_nodes(1), local_nodes(2), -1, -1
- case (4)
- do l = glob2loc_nodes_nparts(tab_interfaces(k*7+3)), &
- glob2loc_nodes_nparts(tab_interfaces(k*7+3)+1)-1
- if ( glob2loc_nodes_parts(l) == iproc ) then
- local_nodes(1) = glob2loc_nodes(l)+1
- end if
- end do
- do l = glob2loc_nodes_nparts(tab_interfaces(k*7+4)), &
- glob2loc_nodes_nparts(tab_interfaces(k*7+4)+1)-1
- if ( glob2loc_nodes_parts(l) == iproc ) then
- local_nodes(2) = glob2loc_nodes(l)+1
- end if
- end do
- do l = glob2loc_nodes_nparts(tab_interfaces(k*7+5)), &
- glob2loc_nodes_nparts(tab_interfaces(k*7+5)+1)-1
- if ( glob2loc_nodes_parts(l) == iproc ) then
- local_nodes(3) = glob2loc_nodes(l)+1
- end if
- end do
- do l = glob2loc_nodes_nparts(tab_interfaces(k*7+6)), &
- glob2loc_nodes_nparts(tab_interfaces(k*7+6)+1)-1
- if ( glob2loc_nodes_parts(l) == iproc ) then
- local_nodes(4) = glob2loc_nodes(l)+1
- end if
- end do
- write(IIN_database,*) local_elmnt, tab_interfaces(k*7+2), &
- local_nodes(1), local_nodes(2),local_nodes(3), local_nodes(4)
- case default
- print *, "error in write_interfaces_database!", tab_interfaces(k*7+2), iproc
- end select
- end do
-
- end if
-
- num_interface = num_interface + 1
- end do
- end do
-
- end if
-
- end subroutine write_interfaces_database
-
-end module part_decompose_mesh
-
Copied: seismo/3D/SPECFEM3D_SESAME/trunk/decompose_mesh_SCOTCH/part_decompose_mesh_SCOTCH.f90 (from rev 14305, seismo/3D/SPECFEM3D_SESAME/trunk/decompose_mesh/part_decompose_mesh_SCOTCH.f90)
===================================================================
--- seismo/3D/SPECFEM3D_SESAME/trunk/decompose_mesh_SCOTCH/part_decompose_mesh_SCOTCH.f90 (rev 0)
+++ seismo/3D/SPECFEM3D_SESAME/trunk/decompose_mesh_SCOTCH/part_decompose_mesh_SCOTCH.f90 2009-03-12 17:59:58 UTC (rev 14306)
@@ -0,0 +1,622 @@
+module part_decompose_mesh_SCOTCH
+
+ implicit none
+
+contains
+
+ !-----------------------------------------------
+ ! Creating dual graph (adjacency is defined by 'ncommonnodes' between two elements).
+ !-----------------------------------------------
+ subroutine mesh2dual_ncommonnodes(nelmnts, nnodes, nsize, sup_neighbour, elmnts, xadj, adjncy, &
+ nnodes_elmnts, nodes_elmnts, max_neighbour, ncommonnodes)
+
+ include './constants_decompose_mesh_SCOTCH.h'
+
+ integer(long), intent(in) :: nelmnts
+ integer, intent(in) :: nnodes
+ integer(long), intent(in) :: nsize
+ integer(long), intent(in) :: sup_neighbour
+ integer, dimension(0:esize*nelmnts-1), intent(in) :: elmnts
+ integer, dimension(0:nelmnts) :: xadj
+ integer, dimension(0:sup_neighbour*nelmnts-1) :: adjncy
+ integer, dimension(0:nnodes-1) :: nnodes_elmnts
+ integer, dimension(0:nsize*nnodes-1) :: nodes_elmnts
+ integer, intent(out) :: max_neighbour
+ integer, intent(in) :: ncommonnodes
+
+ integer :: i, j, k, l, m, nb_edges
+ logical :: is_neighbour
+ integer :: num_node, n
+ integer :: elem_base, elem_target
+ integer :: connectivity
+
+
+ !allocate(xadj(0:nelmnts))
+ xadj(:) = 0
+ !allocate(adjncy(0:max_neighbour*nelmnts-1))
+ adjncy(:) = 0
+ !allocate(nnodes_elmnts(0:nnodes-1))
+ nnodes_elmnts(:) = 0
+ !allocate(nodes_elmnts(0:nsize*nnodes-1))
+ nodes_elmnts(:) = 0
+
+ nb_edges = 0
+
+
+ ! list of elements per node
+ do i = 0, esize*nelmnts-1
+ nodes_elmnts(elmnts(i)*nsize+nnodes_elmnts(elmnts(i))) = i/esize
+ nnodes_elmnts(elmnts(i)) = nnodes_elmnts(elmnts(i)) + 1
+
+ end do
+
+ !print *, 'nnodes_elmnts'
+
+ ! checking which elements are neighbours ('ncommonnodes' criteria)
+ do j = 0, nnodes-1
+ do k = 0, nnodes_elmnts(j)-1
+ do l = k+1, nnodes_elmnts(j)-1
+
+ connectivity = 0
+ elem_base = nodes_elmnts(k+j*nsize)
+ elem_target = nodes_elmnts(l+j*nsize)
+ do n = 1, esize
+ num_node = elmnts(esize*elem_base+n-1)
+ do m = 0, nnodes_elmnts(num_node)-1
+ if ( nodes_elmnts(m+num_node*nsize) == elem_target ) then
+ connectivity = connectivity + 1
+ end if
+ end do
+ end do
+
+ if ( connectivity >= ncommonnodes) then
+
+ is_neighbour = .false.
+
+ do m = 0, xadj(nodes_elmnts(k+j*nsize))
+ if ( .not.is_neighbour ) then
+ if ( adjncy(nodes_elmnts(k+j*nsize)*sup_neighbour+m) == nodes_elmnts(l+j*nsize) ) then
+ is_neighbour = .true.
+
+ end if
+ end if
+ end do
+ if ( .not.is_neighbour ) then
+ adjncy(nodes_elmnts(k+j*nsize)*sup_neighbour+xadj(nodes_elmnts(k+j*nsize))) = nodes_elmnts(l+j*nsize)
+ xadj(nodes_elmnts(k+j*nsize)) = xadj(nodes_elmnts(k+j*nsize)) + 1
+ if (xadj(nodes_elmnts(k+j*nsize))>sup_neighbour) stop 'ERROR : too much neighbours per element, modify the mesh.'
+ adjncy(nodes_elmnts(l+j*nsize)*sup_neighbour+xadj(nodes_elmnts(l+j*nsize))) = nodes_elmnts(k+j*nsize)
+ xadj(nodes_elmnts(l+j*nsize)) = xadj(nodes_elmnts(l+j*nsize)) + 1
+ if (xadj(nodes_elmnts(l+j*nsize))>sup_neighbour) stop 'ERROR : too much neighbours per element, modify the mesh.'
+ end if
+ end if
+ end do
+ end do
+ end do
+
+ max_neighbour = maxval(xadj)
+
+ ! making adjacency arrays compact (to be used for partitioning)
+ do i = 0, nelmnts-1
+ k = xadj(i)
+ xadj(i) = nb_edges
+ do j = 0, k-1
+ adjncy(nb_edges) = adjncy(i*sup_neighbour+j)
+ nb_edges = nb_edges + 1
+ end do
+ end do
+
+ xadj(nelmnts) = nb_edges
+
+
+ end subroutine mesh2dual_ncommonnodes
+
+
+
+ !--------------------------------------------------
+ ! construct local numbering for the elements in each partition
+ !--------------------------------------------------
+ subroutine Construct_glob2loc_elmnts(nelmnts, part, nparts, glob2loc_elmnts)
+
+ include './constants_decompose_mesh_SCOTCH.h'
+
+ integer(long), intent(in) :: nelmnts
+ integer, intent(in) :: nparts
+ integer, dimension(0:nelmnts-1), intent(in) :: part
+ integer, dimension(:), pointer :: glob2loc_elmnts
+
+ integer :: num_glob, num_part
+ integer, dimension(0:nparts-1) :: num_loc
+
+
+ allocate(glob2loc_elmnts(0:nelmnts-1))
+
+ do num_part = 0, nparts-1
+ num_loc(num_part) = 0
+
+ end do
+
+ do num_glob = 0, nelmnts-1
+ num_part = part(num_glob)
+ glob2loc_elmnts(num_glob) = num_loc(num_part)
+ num_loc(num_part) = num_loc(num_part) + 1
+
+ end do
+
+
+ end subroutine Construct_glob2loc_elmnts
+
+
+
+ !--------------------------------------------------
+ ! construct local numbering for the nodes in each partition
+ !--------------------------------------------------
+ subroutine Construct_glob2loc_nodes(nelmnts, nnodes, nsize, nnodes_elmnts, nodes_elmnts, part, nparts, &
+ glob2loc_nodes_nparts, glob2loc_nodes_parts, glob2loc_nodes)
+
+ include './constants_decompose_mesh_SCOTCH.h'
+
+ integer(long), intent(in) :: nelmnts, nsize
+ integer, intent(in) :: nnodes, nparts
+ integer, dimension(0:nelmnts-1), intent(in) :: part
+ integer, dimension(0:nnodes-1), intent(in) :: nnodes_elmnts
+ integer, dimension(0:nsize*nnodes-1), intent(in) :: nodes_elmnts
+ integer, dimension(:), pointer :: glob2loc_nodes_nparts
+ integer, dimension(:), pointer :: glob2loc_nodes_parts
+ integer, dimension(:), pointer :: glob2loc_nodes
+
+ integer :: num_node
+ integer :: el
+ integer :: num_part
+ integer :: size_glob2loc_nodes
+ integer, dimension(0:nparts-1) :: parts_node
+ integer, dimension(0:nparts-1) :: num_parts
+
+ allocate(glob2loc_nodes_nparts(0:nnodes))
+
+ size_glob2loc_nodes = 0
+
+ parts_node(:) = 0
+
+
+ do num_node = 0, nnodes-1
+ glob2loc_nodes_nparts(num_node) = size_glob2loc_nodes
+ do el = 0, nnodes_elmnts(num_node)-1
+ parts_node(part(nodes_elmnts(el+nsize*num_node))) = 1
+
+ end do
+
+ do num_part = 0, nparts-1
+ if ( parts_node(num_part) == 1 ) then
+ size_glob2loc_nodes = size_glob2loc_nodes + 1
+ parts_node(num_part) = 0
+
+ end if
+ end do
+
+ end do
+
+ glob2loc_nodes_nparts(nnodes) = size_glob2loc_nodes
+
+ allocate(glob2loc_nodes_parts(0:glob2loc_nodes_nparts(nnodes)-1))
+ allocate(glob2loc_nodes(0:glob2loc_nodes_nparts(nnodes)-1))
+
+ glob2loc_nodes(0) = 0
+
+ parts_node(:) = 0
+ num_parts(:) = 0
+ size_glob2loc_nodes = 0
+
+
+ do num_node = 0, nnodes-1
+ do el = 0, nnodes_elmnts(num_node)-1
+ parts_node(part(nodes_elmnts(el+nsize*num_node))) = 1
+
+ end do
+ do num_part = 0, nparts-1
+
+ if ( parts_node(num_part) == 1 ) then
+ glob2loc_nodes_parts(size_glob2loc_nodes) = num_part
+ glob2loc_nodes(size_glob2loc_nodes) = num_parts(num_part)
+ size_glob2loc_nodes = size_glob2loc_nodes + 1
+ num_parts(num_part) = num_parts(num_part) + 1
+ parts_node(num_part) = 0
+ end if
+
+ end do
+ end do
+
+
+ end subroutine Construct_glob2loc_nodes
+
+
+
+ !--------------------------------------------------
+ ! Construct interfaces between each partitions.
+ ! Two adjacent elements in distinct partitions make an entry in array tab_interfaces :
+ ! 1/ first element, 2/ second element, 3/ number of common nodes, 4/ first node,
+ ! 5/ second node, if relevant.
+ ! No interface between acoustic and elastic elements.
+ !--------------------------------------------------
+ subroutine Construct_interfaces(nelmnts, nparts, sup_neighbour, part, elmnts, xadj, adjncy, &
+ tab_interfaces, tab_size_interfaces, ninterfaces, nb_materials, cs_material, num_material)
+
+ include './constants_decompose_mesh_SCOTCH.h'
+
+ integer, intent(in) :: nparts
+ integer(long), intent(in) :: nelmnts, sup_neighbour
+ integer, dimension(0:nelmnts-1), intent(in) :: part
+ integer, dimension(0:esize*nelmnts-1), intent(in) :: elmnts
+ integer, dimension(0:nelmnts), intent(in) :: xadj
+ integer, dimension(0:sup_neighbour*nelmnts-1), intent(in) :: adjncy
+ integer, dimension(:),pointer :: tab_size_interfaces, tab_interfaces
+ integer, intent(out) :: ninterfaces
+ integer, dimension(1:nelmnts), intent(in) :: num_material
+ double precision, dimension(1:nb_materials), intent(in) :: cs_material
+ integer, intent(in) :: nb_materials
+
+
+ integer :: num_part, num_part_bis, el, el_adj, num_interface, num_edge, ncommon_nodes, &
+ num_node, num_node_bis
+ integer :: i, j
+ logical :: is_acoustic_el, is_acoustic_el_adj
+
+ ninterfaces = 0
+ do i = 0, nparts-1
+ do j = i+1, nparts-1
+ ninterfaces = ninterfaces + 1
+ end do
+ end do
+
+ allocate(tab_size_interfaces(0:ninterfaces))
+ tab_size_interfaces(:) = 0
+
+ num_interface = 0
+ num_edge = 0
+
+ do num_part = 0, nparts-1
+ do num_part_bis = num_part+1, nparts-1
+ do el = 0, nelmnts-1
+ if ( part(el) == num_part ) then
+ if ( cs_material(num_material(el+1)) < TINYVAL) then
+ is_acoustic_el = .true.
+ else
+ is_acoustic_el = .false.
+ end if
+ do el_adj = xadj(el), xadj(el+1)-1
+ if ( cs_material(num_material(adjncy(el_adj)+1)) < TINYVAL) then
+ is_acoustic_el_adj = .true.
+ else
+ is_acoustic_el_adj = .false.
+ end if
+ if ( (part(adjncy(el_adj)) == num_part_bis) .and. (is_acoustic_el .eqv. is_acoustic_el_adj) ) then
+ num_edge = num_edge + 1
+
+ end if
+ end do
+ end if
+ end do
+ tab_size_interfaces(num_interface+1) = tab_size_interfaces(num_interface) + num_edge
+ num_edge = 0
+ num_interface = num_interface + 1
+
+ end do
+ end do
+
+ num_interface = 0
+ num_edge = 0
+
+ allocate(tab_interfaces(0:(tab_size_interfaces(ninterfaces)*7-1)))
+ tab_interfaces(:) = 0
+
+ do num_part = 0, nparts-1
+ do num_part_bis = num_part+1, nparts-1
+ do el = 0, nelmnts-1
+ if ( part(el) == num_part ) then
+ if ( cs_material(num_material(el+1)) < TINYVAL) then
+ is_acoustic_el = .true.
+ else
+ is_acoustic_el = .false.
+ end if
+ do el_adj = xadj(el), xadj(el+1)-1
+ if ( cs_material(num_material(adjncy(el_adj)+1)) < TINYVAL) then
+ is_acoustic_el_adj = .true.
+ else
+ is_acoustic_el_adj = .false.
+ end if
+ if ( (part(adjncy(el_adj)) == num_part_bis) .and. (is_acoustic_el .eqv. is_acoustic_el_adj) ) then
+ tab_interfaces(tab_size_interfaces(num_interface)*7+num_edge*7+0) = el
+ tab_interfaces(tab_size_interfaces(num_interface)*7+num_edge*7+1) = adjncy(el_adj)
+ ncommon_nodes = 0
+ do num_node = 0, esize-1
+ do num_node_bis = 0, esize-1
+ if ( elmnts(el*esize+num_node) == elmnts(adjncy(el_adj)*esize+num_node_bis) ) then
+ tab_interfaces(tab_size_interfaces(num_interface)*7+num_edge*7+3+ncommon_nodes) &
+ = elmnts(el*esize+num_node)
+ ncommon_nodes = ncommon_nodes + 1
+ end if
+ end do
+ end do
+ if ( ncommon_nodes > 0 ) then
+ tab_interfaces(tab_size_interfaces(num_interface)*7+num_edge*7+2) = ncommon_nodes
+ else
+ print *, "Error while building interfaces!", ncommon_nodes
+ end if
+ num_edge = num_edge + 1
+ end if
+ end do
+ end if
+
+ end do
+ num_edge = 0
+ num_interface = num_interface + 1
+ end do
+ end do
+
+
+ end subroutine Construct_interfaces
+
+
+
+ !--------------------------------------------------
+ ! Write nodes (their coordinates) pertaining to iproc partition in the corresponding Database
+ !--------------------------------------------------
+ subroutine write_glob2loc_nodes_database(IIN_database, iproc, npgeo, nodes_coords, glob2loc_nodes_nparts, glob2loc_nodes_parts, &
+ glob2loc_nodes, nnodes, num_phase)
+
+ integer, intent(in) :: IIN_database
+ integer, intent(in) :: nnodes, iproc, num_phase
+ integer, intent(inout) :: npgeo
+
+ double precision, dimension(3,nnodes) :: nodes_coords
+ integer, dimension(:), pointer :: glob2loc_nodes_nparts
+ integer, dimension(:), pointer :: glob2loc_nodes_parts
+ integer, dimension(:), pointer :: glob2loc_nodes
+
+ integer :: i, j
+
+ if ( num_phase == 1 ) then
+ npgeo = 0
+
+ do i = 0, nnodes-1
+ do j = glob2loc_nodes_nparts(i), glob2loc_nodes_nparts(i+1)-1
+ if ( glob2loc_nodes_parts(j) == iproc ) then
+ npgeo = npgeo + 1
+
+ end if
+
+ end do
+ end do
+ else
+ do i = 0, nnodes-1
+ do j = glob2loc_nodes_nparts(i), glob2loc_nodes_nparts(i+1)-1
+ if ( glob2loc_nodes_parts(j) == iproc ) then
+ write(IIN_database,*) glob2loc_nodes(j)+1, nodes_coords(1,i+1), nodes_coords(2,i+1), nodes_coords(3,i+1)
+ end if
+ end do
+ end do
+ end if
+
+ end subroutine Write_glob2loc_nodes_database
+
+
+
+ !--------------------------------------------------
+ ! Write elements (their nodes) pertaining to iproc partition in the corresponding Database
+ !--------------------------------------------------
+ subroutine write_partition_database(IIN_database, iproc, nspec, nelmnts, elmnts, glob2loc_elmnts, glob2loc_nodes_nparts, &
+ glob2loc_nodes_parts, glob2loc_nodes, part, num_modele, ngnod, num_phase)
+
+ include './constants_decompose_mesh_SCOTCH.h'
+
+ integer, intent(in) :: IIN_database
+ integer, intent(in) :: num_phase, iproc
+ integer(long), intent(in) :: nelmnts
+ integer, intent(inout) :: nspec
+ integer, dimension(0:nelmnts-1) :: part
+ integer, dimension(0:esize*nelmnts-1) :: elmnts
+ integer, dimension(:), pointer :: glob2loc_elmnts
+ integer, dimension(:) :: num_modele
+ integer, dimension(:), pointer :: glob2loc_nodes_nparts
+ integer, dimension(:), pointer :: glob2loc_nodes_parts
+ integer, dimension(:), pointer :: glob2loc_nodes
+ integer, intent(in) :: ngnod
+
+ integer :: i,j,k
+ integer, dimension(0:ngnod-1) :: loc_nodes
+
+ if ( num_phase == 1 ) then
+ nspec = 0
+
+ do i = 0, nelmnts-1
+ if ( part(i) == iproc ) then
+ nspec = nspec + 1
+
+ end if
+ end do
+
+ else
+ do i = 0, nelmnts-1
+ if ( part(i) == iproc ) then
+
+ do j = 0, ngnod-1
+ do k = glob2loc_nodes_nparts(elmnts(i*ngnod+j)), glob2loc_nodes_nparts(elmnts(i*ngnod+j)+1)-1
+
+ if ( glob2loc_nodes_parts(k) == iproc ) then
+ loc_nodes(j) = glob2loc_nodes(k)
+
+ end if
+ end do
+
+ end do
+ write(IIN_database,*) glob2loc_elmnts(i)+1, num_modele(i+1), (loc_nodes(k)+1, k=0,ngnod-1)
+ end if
+ end do
+ end if
+
+
+ end subroutine write_partition_database
+
+
+
+
+ !--------------------------------------------------
+ ! Write interfaces (element and common nodes) pertaining to iproc partition in the corresponding Database
+ !--------------------------------------------------
+ subroutine write_interfaces_database(IIN_database, tab_interfaces, tab_size_interfaces, nparts, iproc, ninterfaces, &
+ my_ninterface, my_interfaces, my_nb_interfaces, glob2loc_elmnts, glob2loc_nodes_nparts, glob2loc_nodes_parts, &
+ glob2loc_nodes, num_phase)
+
+ integer, intent(in) :: IIN_database
+ integer, intent(in) :: iproc
+ integer, intent(in) :: nparts
+ integer, intent(in) :: ninterfaces
+ integer, intent(inout) :: my_ninterface
+ integer, dimension(:), pointer :: tab_size_interfaces
+ integer, dimension(:), pointer :: tab_interfaces
+ integer, dimension(0:ninterfaces-1), intent(inout) :: my_interfaces
+ integer, dimension(0:ninterfaces-1), intent(inout) :: my_nb_interfaces
+ integer, dimension(:), pointer :: glob2loc_elmnts
+ integer, dimension(:), pointer :: glob2loc_nodes_nparts
+ integer, dimension(:), pointer :: glob2loc_nodes_parts
+ integer, dimension(:), pointer :: glob2loc_nodes
+
+ integer, dimension(4) :: local_nodes
+ integer :: local_elmnt
+ integer :: num_phase
+
+ integer :: i, j, k, l
+ integer :: num_interface
+
+ num_interface = 0
+
+ if ( num_phase == 1 ) then
+
+ my_interfaces(:) = 0
+ my_nb_interfaces(:) = 0
+
+ do i = 0, nparts-1
+ do j = i+1, nparts-1
+ if ( (tab_size_interfaces(num_interface) < tab_size_interfaces(num_interface+1)) .and. &
+ (i == iproc .or. j == iproc) ) then
+ my_interfaces(num_interface) = 1
+ my_nb_interfaces(num_interface) = tab_size_interfaces(num_interface+1) - tab_size_interfaces(num_interface)
+ end if
+ num_interface = num_interface + 1
+ end do
+ end do
+ my_ninterface = sum(my_interfaces(:))
+
+ else
+
+ do i = 0, nparts-1
+ do j = i+1, nparts-1
+ if ( my_interfaces(num_interface) == 1 ) then
+ if ( i == iproc ) then
+ write(IIN_database,*) j, my_nb_interfaces(num_interface)
+ else
+ write(IIN_database,*) i, my_nb_interfaces(num_interface)
+ end if
+
+ do k = tab_size_interfaces(num_interface), tab_size_interfaces(num_interface+1)-1
+ if ( i == iproc ) then
+ local_elmnt = glob2loc_elmnts(tab_interfaces(k*7+0))+1
+ else
+ local_elmnt = glob2loc_elmnts(tab_interfaces(k*7+1))+1
+ end if
+
+!!$ if ( tab_interfaces(k*7+2) == 1 ) then
+!!$ do l = glob2loc_nodes_nparts(tab_interfaces(k*7+3)), &
+!!$ glob2loc_nodes_nparts(tab_interfaces(k*7+3)+1)-1
+!!$ if ( glob2loc_nodes_parts(l) == iproc ) then
+!!$ local_nodes(1) = glob2loc_nodes(l)+1
+!!$ end if
+!!$ end do
+!!$
+!!$ write(IIN_database,*) local_elmnt, tab_interfaces(k*7+2), local_nodes(1), -1
+!!$ else
+!!$ if ( tab_interfaces(k*7+2) == 2 ) then
+!!$ do l = glob2loc_nodes_nparts(tab_interfaces(k*7+3)), &
+!!$ glob2loc_nodes_nparts(tab_interfaces(k*7+3)+1)-1
+!!$ if ( glob2loc_nodes_parts(l) == iproc ) then
+!!$ local_nodes(1) = glob2loc_nodes(l)+1
+!!$ end if
+!!$ end do
+!!$ do l = glob2loc_nodes_nparts(tab_interfaces(k*7+4)), &
+!!$ glob2loc_nodes_nparts(tab_interfaces(k*7+4)+1)-1
+!!$ if ( glob2loc_nodes_parts(l) == iproc ) then
+!!$ local_nodes(2) = glob2loc_nodes(l)+1
+!!$ end if
+!!$ end do
+!!$ write(IIN_database,*) local_elmnt, tab_interfaces(k*7+2), local_nodes(1), local_nodes(2)
+!!$ else
+!!$ write(IIN_database,*) "erreur_write_interface_", tab_interfaces(k*7+2)
+!!$ end if
+!!$ end if
+ select case (tab_interfaces(k*7+2))
+ case (1)
+ do l = glob2loc_nodes_nparts(tab_interfaces(k*7+3)), &
+ glob2loc_nodes_nparts(tab_interfaces(k*7+3)+1)-1
+ if ( glob2loc_nodes_parts(l) == iproc ) then
+ local_nodes(1) = glob2loc_nodes(l)+1
+ end if
+ end do
+ write(IIN_database,*) local_elmnt, tab_interfaces(k*7+2), local_nodes(1), -1, -1, -1
+ case (2)
+ do l = glob2loc_nodes_nparts(tab_interfaces(k*7+3)), &
+ glob2loc_nodes_nparts(tab_interfaces(k*7+3)+1)-1
+ if ( glob2loc_nodes_parts(l) == iproc ) then
+ local_nodes(1) = glob2loc_nodes(l)+1
+ end if
+ end do
+ do l = glob2loc_nodes_nparts(tab_interfaces(k*7+4)), &
+ glob2loc_nodes_nparts(tab_interfaces(k*7+4)+1)-1
+ if ( glob2loc_nodes_parts(l) == iproc ) then
+ local_nodes(2) = glob2loc_nodes(l)+1
+ end if
+ end do
+ write(IIN_database,*) local_elmnt, tab_interfaces(k*7+2), local_nodes(1), local_nodes(2), -1, -1
+ case (4)
+ do l = glob2loc_nodes_nparts(tab_interfaces(k*7+3)), &
+ glob2loc_nodes_nparts(tab_interfaces(k*7+3)+1)-1
+ if ( glob2loc_nodes_parts(l) == iproc ) then
+ local_nodes(1) = glob2loc_nodes(l)+1
+ end if
+ end do
+ do l = glob2loc_nodes_nparts(tab_interfaces(k*7+4)), &
+ glob2loc_nodes_nparts(tab_interfaces(k*7+4)+1)-1
+ if ( glob2loc_nodes_parts(l) == iproc ) then
+ local_nodes(2) = glob2loc_nodes(l)+1
+ end if
+ end do
+ do l = glob2loc_nodes_nparts(tab_interfaces(k*7+5)), &
+ glob2loc_nodes_nparts(tab_interfaces(k*7+5)+1)-1
+ if ( glob2loc_nodes_parts(l) == iproc ) then
+ local_nodes(3) = glob2loc_nodes(l)+1
+ end if
+ end do
+ do l = glob2loc_nodes_nparts(tab_interfaces(k*7+6)), &
+ glob2loc_nodes_nparts(tab_interfaces(k*7+6)+1)-1
+ if ( glob2loc_nodes_parts(l) == iproc ) then
+ local_nodes(4) = glob2loc_nodes(l)+1
+ end if
+ end do
+ write(IIN_database,*) local_elmnt, tab_interfaces(k*7+2), &
+ local_nodes(1), local_nodes(2),local_nodes(3), local_nodes(4)
+ case default
+ print *, "error in write_interfaces_database!", tab_interfaces(k*7+2), iproc
+ end select
+ end do
+
+ end if
+
+ num_interface = num_interface + 1
+ end do
+ end do
+
+ end if
+
+ end subroutine write_interfaces_database
+
+end module part_decompose_mesh_SCOTCH
+
More information about the CIG-COMMITS
mailing list