4 REAL(KIND=8) :: epsilon = 1.d-10
6 INTEGER :: METIS_NOPTIONS=40, METIS_OPTION_NUMBERING=18
9 #include "petsc/finclude/petsc.h"
12 SUBROUTINE part_mesh_m_t_h_phi(nb_proc,list_u, list_T_in, list_h_in, list_phi ,mesh,list_of_interfaces,part,my_periodic)
19 INTEGER,
DIMENSION(mesh%me) :: part
20 INTEGER,
DIMENSION(:) :: list_of_interfaces
21 INTEGER,
DIMENSION(:) :: list_u, list_t_in, list_h_in, list_phi
24 LOGICAL,
DIMENSION(mesh%mes) :: virgins
25 INTEGER,
DIMENSION(3,mesh%me) :: neigh_new
26 INTEGER,
DIMENSION(5) :: opts
27 INTEGER,
DIMENSION(SIZE(mesh%jjs,1)) :: i_loc
28 INTEGER,
DIMENSION(:),
ALLOCATABLE :: xadj_u, xadj_t, xadj_h, xadj_phi, list_h, list_t
29 INTEGER,
DIMENSION(:),
ALLOCATABLE :: xind_u, xind_t, xind_h, xind_phi
30 INTEGER,
DIMENSION(:),
ALLOCATABLE :: vwgt, adjwgt
31 INTEGER,
DIMENSION(:),
ALLOCATABLE :: u2glob, t2glob, h2glob, phi2glob
32 INTEGER,
DIMENSION(:),
ALLOCATABLE :: part_u, part_t, part_h, part_phi
33 INTEGER,
DIMENSION(1) :: jm_loc
34 INTEGER,
DIMENSION(mesh%np,3) :: per_pts
35 INTEGER,
DIMENSION(mesh%me) :: glob2loc
36 INTEGER,
DIMENSION(mesh%np) :: indicator
37 INTEGER,
DIMENSION(3) :: j_loc
38 INTEGER :: nb_neigh, edge, m, ms, n, nb, numflag, p, wgtflag, j, &
39 ns, nws, msop, nsop, proc, iop, mop, s2, k, me_u, me_t, me_h, me_phi, idm
42 REAL(KIND=8),
DIMENSION(:),
ALLOCATABLE :: tpwgts
43 INTEGER,
DIMENSION(METIS_NOPTIONS) :: metis_opt
44 REAL(KIND=8),
DIMENSION(1) :: ubvec
45 petscmpiint :: nb_proc
47 petscerrorcode :: ierr
59 DO j = 1,
SIZE(list_t_in)
60 IF (minval(abs(list_t_in(j)-list_u))==0) cycle
65 DO j = 1,
SIZE(list_t_in)
66 IF (minval(abs(list_t_in(j)-list_u))==0) cycle
68 list_t(nb) = list_t_in(j)
74 DO j = 1,
SIZE(list_h_in)
75 IF (minval(abs(list_h_in(j)-list_t_in))==0) cycle
80 DO j = 1,
SIZE(list_h_in)
81 IF (minval(abs(list_h_in(j)-list_t_in))==0) cycle
83 list_h(nb) = list_h_in(j)
88 nws =
SIZE( mesh%jjs,1)
89 neigh_new = mesh%neigh
90 IF (
SIZE(list_of_interfaces)/=0)
THEN
93 IF (.NOT.virgins(ms)) cycle
94 IF (minval(abs(mesh%sides(ms)-list_of_interfaces))/=0) cycle
95 i_loc = mesh%jjs(:,ms)
97 IF (msop==ms .OR. .NOT.virgins(msop)) cycle
98 IF (minval(abs(mesh%sides(msop)-list_of_interfaces))/=0) cycle
102 iop = mesh%jjs(nsop,msop)
103 IF (maxval(abs(mesh%rr(:,i_loc(ns))-mesh%rr(:,iop))).LT.epsilon)
THEN
115 CALL
error_petsc(.NOT.
'BUG in part_mesh_M_T_H_phi, test ')
118 IF (neigh_new(n,mesh%neighs(msop))==0)
THEN
119 neigh_new(n,mesh%neighs(msop)) = mesh%neighs(ms)
121 IF (neigh_new(n,mesh%neighs(ms))==0)
THEN
122 neigh_new(n,mesh%neighs(ms)) = mesh%neighs(msop)
125 virgins(ms) = .false.
126 virgins(msop) = .false.
132 IF (present(my_periodic))
THEN
133 IF (my_periodic%nb_periodic_pairs/=0)
THEN
136 IF (minval(abs(mesh%sides(ms)-my_periodic%list_periodic(1,:))) == 0)
THEN
137 jm_loc = minloc(abs(mesh%sides(ms)-my_periodic%list_periodic(1,:)))
138 s2 = my_periodic%list_periodic(2,jm_loc(1))
140 DO msop = 1, mesh%mes
141 IF (mesh%sides(msop) /= s2) cycle
144 DO ns = 1,
SIZE(my_periodic%vect_e,1)
145 err = err + abs(sum(mesh%rr(ns,mesh%jjs(:,ms))-mesh%rr(ns,mesh%jjs(:,msop)) &
146 +my_periodic%vect_e(ns,jm_loc(1))))
149 IF (err .LE. epsilon)
THEN
155 CALL
error_petsc(
'BUG in part_mesh_M_T_H_phi, mop not found')
157 mop = mesh%neighs(msop)
159 IF (neigh_new(n,m) == 0)
THEN
162 IF (neigh_new(n,mop) == 0)
THEN
179 IF (minval(abs(idm-list_u))==0)
THEN
181 ELSE IF (minval(abs(idm-list_t))==0)
THEN
183 ELSE IF (minval(abs(idm-list_h))==0)
THEN
185 ELSE IF (minval(abs(idm-list_phi))==0)
THEN
188 CALL
error_petsc(
'BUG in part_mesh_M_T_H_phi : element not in the mesh')
191 ALLOCATE(u2glob(me_u), t2glob(me_t), h2glob(me_h), phi2glob(me_phi))
198 IF (minval(abs(idm-list_u))==0)
THEN
202 ELSE IF (minval(abs(idm-list_t))==0)
THEN
206 ELSE IF (minval(abs(idm-list_h))==0)
THEN
210 ELSE IF (minval(abs(idm-list_phi))==0)
THEN
215 CALL
error_petsc(
'BUG in part_mesh_M_T_H_phi: element not in the mesh')
221 nb_neigh =
SIZE(mesh%neigh,1)
222 ALLOCATE(xind_u(me_u+1), xind_t(me_t+1), xind_h(me_h+1), xind_phi(me_phi+1))
230 IF (minval(abs(mesh%i_d(mop)-list_u))/=0) cycle
233 xind_u(k+1) = xind_u(k) + nb
242 IF (minval(abs(mesh%i_d(mop)-list_t))/=0) cycle
245 xind_t(k+1) = xind_t(k) + nb
254 IF (minval(abs(mesh%i_d(mop)-list_h))/=0) cycle
257 xind_h(k+1) = xind_h(k) + nb
266 IF (minval(abs(mesh%i_d(mop)-list_phi))/=0) cycle
269 xind_phi(k+1) = xind_phi(k) + nb
272 ALLOCATE(xadj_u(xind_u(me_u+1)-1))
273 ALLOCATE(xadj_t(xind_t(me_t+1)-1))
274 ALLOCATE(xadj_h(xind_h(me_h+1)-1))
275 ALLOCATE(xadj_phi(xind_phi(me_phi+1)-1))
282 IF (minval(abs(mesh%i_d(mop)-list_u))/=0) cycle
284 xadj_u(p) = glob2loc(mop)
287 IF (p/=xind_u(me_u+1)-1)
THEN
288 CALL
error_petsc(
'BUG in part_mesh_M_T_H_phi, p/=xind_u(me_u+1)-1')
296 IF (minval(abs(mesh%i_d(mop)-list_t))/=0) cycle
298 xadj_t(p) = glob2loc(mop)
301 IF (p/=xind_t(me_t+1)-1)
THEN
302 CALL
error_petsc(
'BUG in part_mesh_M_T_H_phi, p/=xind_T(me_T+1)-1')
310 IF (minval(abs(mesh%i_d(mop)-list_h))/=0) cycle
312 xadj_h(p) = glob2loc(mop)
315 IF (p/=xind_h(me_h+1)-1)
THEN
316 CALL
error_petsc(
'BUG in part_mesh_M_T_H_phi, p/=xind_h(me_h+1)-1')
324 IF (minval(abs(mesh%i_d(mop)-list_phi))/=0) cycle
326 xadj_phi(p) = glob2loc(mop)
329 IF (p/=xind_phi(me_phi+1)-1)
THEN
330 CALL
error_petsc(
'BUG in part_mesh_M_T_H_phi, p/=xind_phi(me_phi+1)-1')
338 ALLOCATE(tpwgts(nb_proc))
340 CALL metis_setdefaultoptions(metis_opt)
341 metis_opt(metis_option_numbering)=1
344 ALLOCATE(vwgt(me_u), adjwgt(
SIZE(xadj_u)), part_u(me_u))
347 CALL metis_partgraphrecursive(me_u, 1, xind_u, xadj_u, vwgt, vwgt, adjwgt, nb_proc, tpwgts, ubvec, metis_opt, edge, part_u)
350 IF (
ALLOCATED(vwgt))
THEN
351 DEALLOCATE(vwgt, adjwgt)
353 ALLOCATE(vwgt(me_t), adjwgt(
SIZE(xadj_t)), part_t(me_t))
356 CALL metis_partgraphrecursive(me_t, 1, xind_t, xadj_t, vwgt, vwgt, adjwgt, nb_proc, tpwgts, ubvec, metis_opt, edge, part_t)
359 IF (
ALLOCATED(vwgt))
THEN
360 DEALLOCATE(vwgt, adjwgt)
362 ALLOCATE(vwgt(me_h), adjwgt(
SIZE(xadj_h)), part_h(me_h))
365 CALL metis_partgraphrecursive(me_h, 1, xind_h, xadj_h, vwgt, vwgt, adjwgt, nb_proc,tpwgts, ubvec, metis_opt, edge, part_h)
367 IF (me_phi /= 0)
THEN
368 IF (
ALLOCATED(vwgt))
THEN
369 DEALLOCATE(vwgt, adjwgt)
371 ALLOCATE(vwgt(me_phi), adjwgt(
SIZE(xadj_phi)), part_phi(me_phi))
374 CALL metis_partgraphrecursive(me_phi, 1, xind_phi,xadj_phi,vwgt, vwgt, adjwgt, nb_proc,tpwgts, &
375 ubvec, metis_opt, edge, part_phi)
380 part(u2glob(:)) = part_u
383 part(t2glob(:)) = part_t
386 part(h2glob(:)) = part_h
389 part(phi2glob(:)) = part_phi
391 IF (minval(part)==-1)
THEN
392 CALL
error_petsc(
'BUG in part_mesh_mhd_bis, MINVAL(part) == -1')
398 IF (
SIZE(mesh%jj,1)/=3)
THEN
399 write(*,*)
'SIZE(mesh%jj,1)',
SIZE(mesh%jj,1)
400 CALL
error_petsc(
'BUG in part_mesh_M_T_H_phi, SIZE(mesh%jj,1)/=3')
403 nws =
SIZE( mesh%jjs,1)
404 IF (
SIZE(list_of_interfaces)/=0)
THEN
407 IF (.NOT.virgins(ms)) cycle
408 IF (minval(abs(mesh%sides(ms)-list_of_interfaces))/=0) cycle
409 i_loc = mesh%jjs(:,ms)
410 DO msop = 1, mesh%mes
411 IF (msop==ms .OR. .NOT.virgins(msop)) cycle
412 IF (minval(abs(mesh%sides(msop)-list_of_interfaces))/=0) cycle
416 iop = mesh%jjs(nsop,msop)
417 IF (maxval(abs(mesh%rr(:,i_loc(ns))-mesh%rr(:,iop))).LT.epsilon)
THEN
429 CALL
error_petsc(.NOT.
'BUG in part_mesh_M_T_H_phi, test ')
431 IF (part(mesh%neighs(ms)) == part(mesh%neighs(msop))) cycle
432 proc = min(part(mesh%neighs(ms)),part(mesh%neighs(msop)))
433 part(mesh%neighs(ms)) = proc
434 part(mesh%neighs(msop)) = proc
435 virgins(ms) = .false.
436 virgins(msop) = .false.
437 indicator(mesh%jjs(:,ms)) = proc
438 indicator(mesh%jjs(:,msop)) = proc
446 n = maxval(indicator(j_loc))
448 IF (indicator(j_loc(1))*indicator(j_loc(2))*indicator(j_loc(3))<0) cycle
454 IF (present(my_periodic))
THEN
455 IF (my_periodic%nb_periodic_pairs/=0)
THEN
462 IF ((minval(abs(mesh%sides(ms)-my_periodic%list_periodic(1,:))) /=0) .AND. &
463 (minval(abs(mesh%sides(ms)-my_periodic%list_periodic(2,:))) /=0) ) cycle
464 DO ns = 1,
SIZE(mesh%jjs,1)
467 DO msop = 1, mesh%mes
468 IF (minval(abs(mesh%sides(msop)-my_periodic%list_periodic(:,:))) /=0 ) cycle
469 IF (msop == ms) cycle
470 DO nsop = 1,
SIZE(mesh%jjs,1)
471 IF (mesh%jjs(nsop,msop)==j)
THEN
472 per_pts(j,3) = mesh%neighs(msop)
481 IF (minval(abs(mesh%sides(ms)-my_periodic%list_periodic(1,:))) /= 0) cycle
482 jm_loc = minloc(abs(mesh%sides(ms)-my_periodic%list_periodic(1,:)))
483 s2 = my_periodic%list_periodic(2,jm_loc(1))
485 DO msop = 1, mesh%mes
486 IF (mesh%sides(msop) /= s2) cycle
488 DO ns = 1,
SIZE(my_periodic%vect_e,1)
489 err = err + abs(sum(mesh%rr(ns,mesh%jjs(:,ms))-mesh%rr(ns,mesh%jjs(:,msop)) &
490 +my_periodic%vect_e(ns,jm_loc(1))))
492 IF (err .LE. epsilon)
THEN
498 CALL
error_petsc(
'BUG in part_mesh_M_T_H_phi, mop not found')
500 IF (part(mesh%neighs(ms)) /= part(mesh%neighs(msop)))
THEN
501 proc = min(part(mesh%neighs(ms)),part(mesh%neighs(msop)))
502 part(mesh%neighs(ms)) = proc
503 part(mesh%neighs(msop)) = proc
512 CALL mpi_comm_rank(mpi_comm_world,rank,ierr)
519 DEALLOCATE(vwgt,adjwgt)
520 IF (
ALLOCATED(xadj_u))
DEALLOCATE(xadj_u)
521 IF (
ALLOCATED(xadj_t))
DEALLOCATE(xadj_t)
522 IF (
ALLOCATED(xadj_h))
DEALLOCATE(xadj_h)
523 IF (
ALLOCATED(xadj_phi))
DEALLOCATE(xadj_phi)
524 IF (
ALLOCATED(list_t))
DEALLOCATE(list_t)
525 IF (
ALLOCATED(list_h))
DEALLOCATE(list_h)
526 IF (
ALLOCATED(xind_u))
DEALLOCATE(xind_u)
527 IF (
ALLOCATED(xind_t))
DEALLOCATE(xind_t)
528 IF (
ALLOCATED(xind_h))
DEALLOCATE(xind_h)
529 IF (
ALLOCATED(xind_phi))
DEALLOCATE(xind_phi)
530 IF (
ALLOCATED(u2glob))
DEALLOCATE(u2glob)
531 IF (
ALLOCATED(t2glob))
DEALLOCATE(t2glob)
532 IF (
ALLOCATED(h2glob))
DEALLOCATE(h2glob)
533 IF (
ALLOCATED(phi2glob))
DEALLOCATE(phi2glob)
534 IF (
ALLOCATED(part_u))
DEALLOCATE(part_u)
535 IF (
ALLOCATED(part_t))
DEALLOCATE(part_t)
536 IF (
ALLOCATED(part_h))
DEALLOCATE(part_h)
537 IF (
ALLOCATED(part_phi))
DEALLOCATE(part_phi)
543 SUBROUTINE part_mesh_mhd(nb_proc,vwgt,mesh,list_of_interfaces,part,my_periodic)
550 INTEGER,
DIMENSION(mesh%me+1) :: xind
551 INTEGER,
DIMENSION(mesh%me) :: vwgt, part
552 INTEGER,
DIMENSION(:) :: list_of_interfaces
555 LOGICAL,
DIMENSION(mesh%mes) :: virgins
556 INTEGER,
DIMENSION(3,mesh%me) :: neigh_new
557 INTEGER,
DIMENSION(5) :: opts
558 INTEGER,
DIMENSION(SIZE(mesh%jjs,1)) :: i_loc
559 INTEGER,
DIMENSION(:),
ALLOCATABLE :: xadj, adjwgt
560 INTEGER,
DIMENSION(1) :: jm_loc
561 INTEGER,
DIMENSION(mesh%np,3) :: per_pts
562 INTEGER :: nb_neigh, edge, m, ms, n, nb, numflag, p, wgtflag, j, &
563 ns, nws, msop, nsop, proc, iop, mop, s2
565 REAL(KIND=8),
DIMENSION(:),
ALLOCATABLE :: tpwgts
566 INTEGER,
DIMENSION(METIS_NOPTIONS) :: metis_opt
567 REAL(KIND=8),
DIMENSION(1) :: ubvec
569 petscmpiint :: nb_proc
571 petscerrorcode :: ierr
579 nws =
SIZE( mesh%jjs,1)
580 neigh_new = mesh%neigh
581 IF (
SIZE(list_of_interfaces)/=0)
THEN
584 IF (.NOT.virgins(ms)) cycle
585 IF (minval(abs(mesh%sides(ms)-list_of_interfaces))/=0) cycle
586 i_loc = mesh%jjs(:,ms)
587 DO msop = 1, mesh%mes
588 IF (msop==ms .OR. .NOT.virgins(msop)) cycle
589 IF (minval(abs(mesh%sides(msop)-list_of_interfaces))/=0) cycle
593 iop = mesh%jjs(nsop,msop)
594 IF (maxval(abs(mesh%rr(:,i_loc(ns))-mesh%rr(:,iop))).LT.epsilon)
THEN
606 CALL
error_petsc(.NOT.
'BUG in part_mesh_mhd, test ')
609 IF (neigh_new(n,mesh%neighs(msop))==0)
THEN
610 neigh_new(n,mesh%neighs(msop)) = mesh%neighs(ms)
612 IF (neigh_new(n,mesh%neighs(ms))==0)
THEN
613 neigh_new(n,mesh%neighs(ms)) = mesh%neighs(msop)
616 virgins(ms) = .false.
617 virgins(msop) = .false.
622 IF (present(my_periodic))
THEN
623 IF (my_periodic%nb_periodic_pairs/=0)
THEN
626 IF (minval(abs(mesh%sides(ms)-my_periodic%list_periodic(1,:))) == 0)
THEN
627 jm_loc = minloc(abs(mesh%sides(ms)-my_periodic%list_periodic(1,:)))
628 s2 = my_periodic%list_periodic(2,jm_loc(1))
630 DO msop = 1, mesh%mes
631 IF (mesh%sides(msop) /= s2) cycle
634 DO ns = 1,
SIZE(my_periodic%vect_e,1)
635 err = err + abs(sum(mesh%rr(ns,mesh%jjs(:,ms))-mesh%rr(ns,mesh%jjs(:,msop)) &
636 +my_periodic%vect_e(ns,jm_loc(1))))
639 IF (err .LE. epsilon)
THEN
647 mop = mesh%neighs(msop)
649 IF (neigh_new(n,m) == 0)
THEN
652 IF (neigh_new(n,mop) == 0)
THEN
664 nb_neigh =
SIZE(mesh%neigh,1)
669 IF (neigh_new(n,m)==0) cycle
672 xind(m+1) = xind(m) + nb
674 ALLOCATE(xadj(xind(mesh%me+1)-1))
678 IF (neigh_new(n,m)==0) cycle
680 xadj(p) = neigh_new(n,m)
683 IF (p/=xind(mesh%me+1)-1)
THEN
688 ALLOCATE(adjwgt(
SIZE(xadj)))
694 ALLOCATE(tpwgts(nb_proc))
696 CALL metis_setdefaultoptions(metis_opt)
697 metis_opt(metis_option_numbering)=1
699 CALL metis_partgraphrecursive(mesh%me, 1, xind,xadj,vwgt, vwgt, adjwgt, nb_proc,tpwgts , ubvec, metis_opt, edge, part)
704 nws =
SIZE( mesh%jjs,1)
705 IF (
SIZE(list_of_interfaces)/=0)
THEN
708 IF (.NOT.virgins(ms)) cycle
709 IF (minval(abs(mesh%sides(ms)-list_of_interfaces))/=0) cycle
710 i_loc = mesh%jjs(:,ms)
711 DO msop = 1, mesh%mes
712 IF (msop==ms .OR. .NOT.virgins(msop)) cycle
713 IF (minval(abs(mesh%sides(msop)-list_of_interfaces))/=0) cycle
717 iop = mesh%jjs(nsop,msop)
718 IF (maxval(abs(mesh%rr(:,i_loc(ns))-mesh%rr(:,iop))).LT.epsilon)
THEN
730 CALL
error_petsc(.NOT.
'BUG in create_local_mesh, test ')
732 IF (part(mesh%neighs(ms)) == part(mesh%neighs(msop))) cycle
733 proc = min(part(mesh%neighs(ms)),part(mesh%neighs(msop)))
734 part(mesh%neighs(ms)) = proc
735 part(mesh%neighs(msop)) = proc
736 virgins(ms) = .false.
737 virgins(msop) = .false.
743 IF (present(my_periodic))
THEN
744 IF (my_periodic%nb_periodic_pairs/=0)
THEN
753 IF ((minval(abs(mesh%sides(ms)-my_periodic%list_periodic(1,:))) /=0) .AND. &
754 (minval(abs(mesh%sides(ms)-my_periodic%list_periodic(2,:))) /=0) ) cycle
755 DO ns = 1,
SIZE(mesh%jjs,1)
758 DO msop = 1, mesh%mes
759 IF (minval(abs(mesh%sides(msop)-my_periodic%list_periodic(:,:))) /=0 ) cycle
760 IF (msop == ms) cycle
761 DO nsop = 1,
SIZE(mesh%jjs,1)
762 IF (mesh%jjs(nsop,msop)==j)
THEN
763 per_pts(j,3) = mesh%neighs(msop)
774 IF (minval(abs(mesh%sides(ms)-my_periodic%list_periodic(1,:))) /= 0) cycle
775 jm_loc = minloc(abs(mesh%sides(ms)-my_periodic%list_periodic(1,:)))
776 s2 = my_periodic%list_periodic(2,jm_loc(1))
778 DO msop = 1, mesh%mes
779 IF (mesh%sides(msop) /= s2) cycle
782 DO ns = 1,
SIZE(my_periodic%vect_e,1)
783 err = err + abs(sum(mesh%rr(ns,mesh%jjs(:,ms))-mesh%rr(ns,mesh%jjs(:,msop)) &
784 +my_periodic%vect_e(ns,jm_loc(1))))
787 IF (err .LE. epsilon)
THEN
795 IF (part(mesh%neighs(ms)) /= part(mesh%neighs(msop)))
THEN
796 proc = min(part(mesh%neighs(ms)),part(mesh%neighs(msop)))
797 part(mesh%neighs(ms)) = proc
798 part(mesh%neighs(msop)) = proc
807 CALL mpi_comm_rank(mpi_comm_world,rank,ierr)
814 DEALLOCATE(xadj,adjwgt)
820 SUBROUTINE part_mesh_mhd_bis(nb_proc,list_u, list_h_in, list_phi ,mesh,list_of_interfaces,part,my_periodic)
827 INTEGER,
DIMENSION(mesh%me) :: part
828 INTEGER,
DIMENSION(:) :: list_of_interfaces
829 INTEGER,
DIMENSION(:) :: list_u, list_h_in, list_phi
832 LOGICAL,
DIMENSION(mesh%mes) :: virgins
833 INTEGER,
DIMENSION(3,mesh%me) :: neigh_new
834 INTEGER,
DIMENSION(5) :: opts
835 INTEGER,
DIMENSION(SIZE(mesh%jjs,1)) :: i_loc
836 INTEGER,
DIMENSION(:),
ALLOCATABLE :: xadj_u, xadj_h, xadj_phi, list_h
837 INTEGER,
DIMENSION(:),
ALLOCATABLE :: xind_u, xind_h, xind_phi
838 INTEGER,
DIMENSION(:),
ALLOCATABLE :: vwgt, adjwgt
839 INTEGER,
DIMENSION(:),
ALLOCATABLE :: u2glob, h2glob, phi2glob
840 INTEGER,
DIMENSION(:),
ALLOCATABLE :: part_u, part_h, part_phi
841 INTEGER,
DIMENSION(1) :: jm_loc
843 INTEGER,
DIMENSION(mesh%np,3) :: per_pts
844 INTEGER,
DIMENSION(mesh%me) :: glob2loc
845 INTEGER,
DIMENSION(mesh%np) :: indicator
846 INTEGER,
DIMENSION(3) :: j_loc
847 INTEGER :: nb_neigh, edge, m, ms, n, nb, numflag, p, wgtflag, j, &
848 ns, nws, msop, nsop, proc, iop, mop, s2, k, me_u, me_h, me_phi, idm
851 REAL(KIND=8),
DIMENSION(:),
ALLOCATABLE :: tpwgts
852 INTEGER,
DIMENSION(METIS_NOPTIONS) :: metis_opt
853 REAL(KIND=8),
DIMENSION(1) :: ubvec
854 petscmpiint :: nb_proc
856 petscerrorcode :: ierr
867 DO j = 1,
SIZE(list_h_in)
868 IF (minval(abs(list_h_in(j)-list_u))==0) cycle
873 DO j = 1,
SIZE(list_h_in)
874 IF (minval(abs(list_h_in(j)-list_u))==0) cycle
876 list_h(nb) = list_h_in(j)
881 nws =
SIZE( mesh%jjs,1)
882 neigh_new = mesh%neigh
883 IF (
SIZE(list_of_interfaces)/=0)
THEN
886 IF (.NOT.virgins(ms)) cycle
887 IF (minval(abs(mesh%sides(ms)-list_of_interfaces))/=0) cycle
888 i_loc = mesh%jjs(:,ms)
889 DO msop = 1, mesh%mes
890 IF (msop==ms .OR. .NOT.virgins(msop)) cycle
891 IF (minval(abs(mesh%sides(msop)-list_of_interfaces))/=0) cycle
895 iop = mesh%jjs(nsop,msop)
896 IF (maxval(abs(mesh%rr(:,i_loc(ns))-mesh%rr(:,iop))).LT.epsilon)
THEN
908 CALL
error_petsc(.NOT.
'BUG in part_mesh_mhd, test ')
911 IF (neigh_new(n,mesh%neighs(msop))==0)
THEN
912 neigh_new(n,mesh%neighs(msop)) = mesh%neighs(ms)
914 IF (neigh_new(n,mesh%neighs(ms))==0)
THEN
915 neigh_new(n,mesh%neighs(ms)) = mesh%neighs(msop)
918 virgins(ms) = .false.
919 virgins(msop) = .false.
925 IF (present(my_periodic))
THEN
926 IF (my_periodic%nb_periodic_pairs/=0)
THEN
929 IF (minval(abs(mesh%sides(ms)-my_periodic%list_periodic(1,:))) == 0)
THEN
930 jm_loc = minloc(abs(mesh%sides(ms)-my_periodic%list_periodic(1,:)))
931 s2 = my_periodic%list_periodic(2,jm_loc(1))
933 DO msop = 1, mesh%mes
934 IF (mesh%sides(msop) /= s2) cycle
937 DO ns = 1,
SIZE(my_periodic%vect_e,1)
938 err = err + abs(sum(mesh%rr(ns,mesh%jjs(:,ms))-mesh%rr(ns,mesh%jjs(:,msop)) &
939 +my_periodic%vect_e(ns,jm_loc(1))))
942 IF (err .LE. epsilon)
THEN
950 mop = mesh%neighs(msop)
952 IF (neigh_new(n,m) == 0)
THEN
955 IF (neigh_new(n,mop) == 0)
THEN
970 IF (minval(abs(idm-list_u))==0)
THEN
972 ELSE IF (minval(abs(idm-list_h))==0)
THEN
974 ELSE IF (minval(abs(idm-list_phi))==0)
THEN
977 CALL
error_petsc(
'BUG in part_mesh_mhd_bis : element not in the mesh')
980 ALLOCATE(u2glob(me_u), h2glob(me_h),phi2glob(me_phi))
986 IF (minval(abs(idm-list_u))==0)
THEN
990 ELSE IF (minval(abs(idm-list_h))==0)
THEN
994 ELSE IF (minval(abs(idm-list_phi))==0)
THEN
999 CALL
error_petsc(
'BUG in part_mesh_mhd_bis : element not in the mesh')
1003 nb_neigh =
SIZE(mesh%neigh,1)
1004 ALLOCATE(xind_u(me_u+1), xind_h(me_h+1), xind_phi(me_phi+1))
1010 mop = neigh_new(n,m)
1012 IF (minval(abs(mesh%i_d(mop)-list_u))/=0) cycle
1015 xind_u(k+1) = xind_u(k) + nb
1022 mop = neigh_new(n,m)
1024 IF (minval(abs(mesh%i_d(mop)-list_h))/=0) cycle
1027 xind_h(k+1) = xind_h(k) + nb
1034 mop = neigh_new(n,m)
1036 IF (minval(abs(mesh%i_d(mop)-list_phi))/=0) cycle
1039 xind_phi(k+1) = xind_phi(k) + nb
1042 ALLOCATE(xadj_u(xind_u(me_u+1)-1))
1043 ALLOCATE(xadj_h(xind_h(me_h+1)-1))
1044 ALLOCATE(xadj_phi(xind_phi(me_phi+1)-1))
1049 mop = neigh_new(n,m)
1051 IF (minval(abs(mesh%i_d(mop)-list_u))/=0) cycle
1055 xadj_u(p) = glob2loc(mop)
1058 IF (p/=xind_u(me_u+1)-1)
THEN
1065 mop = neigh_new(n,m)
1067 IF (minval(abs(mesh%i_d(mop)-list_h))/=0) cycle
1071 xadj_h(p) = glob2loc(mop)
1074 IF (p/=xind_h(me_h+1)-1)
THEN
1081 mop = neigh_new(n,m)
1083 IF (minval(abs(mesh%i_d(mop)-list_phi))/=0) cycle
1087 xadj_phi(p) = glob2loc(mop)
1090 IF (p/=xind_phi(me_phi+1)-1)
THEN
1098 ALLOCATE(tpwgts(nb_proc))
1100 CALL metis_setdefaultoptions(metis_opt)
1101 metis_opt(metis_option_numbering)=1
1104 ALLOCATE(vwgt(me_u), adjwgt(
SIZE(xadj_u)), part_u(me_u))
1107 CALL metis_partgraphrecursive(me_u, 1, xind_u,xadj_u,vwgt, vwgt, adjwgt, nb_proc,tpwgts , ubvec, metis_opt, edge, part_u)
1111 IF (
ALLOCATED(vwgt))
THEN
1112 DEALLOCATE(vwgt, adjwgt)
1114 ALLOCATE(vwgt(me_h), adjwgt(
SIZE(xadj_h)), part_h(me_h))
1117 CALL metis_partgraphrecursive(me_h, 1, xind_h,xadj_h,vwgt, vwgt, adjwgt, nb_proc,tpwgts , ubvec, metis_opt, edge, part_h)
1120 IF (me_phi /= 0)
THEN
1121 IF (
ALLOCATED(vwgt))
THEN
1122 DEALLOCATE(vwgt, adjwgt)
1124 ALLOCATE(vwgt(me_phi), adjwgt(
SIZE(xadj_phi)), part_phi(me_phi))
1127 CALL metis_partgraphrecursive(me_phi, 1, xind_phi,xadj_phi,vwgt, vwgt, adjwgt, nb_proc,tpwgts, &
1128 ubvec, metis_opt, edge, part_phi)
1147 part(u2glob(:)) = part_u
1150 part(h2glob(:)) = part_h
1153 part(phi2glob(:)) = part_phi
1155 IF (minval(part)==-1)
THEN
1156 CALL
error_petsc(
'BUG in part_mesh_mhd_bis, MINVAL(part) == -1')
1162 IF (
SIZE(mesh%jj,1)/=3)
THEN
1163 write(*,*)
'SIZE(mesh%jj,1)',
SIZE(mesh%jj,1)
1164 CALL
error_petsc(
'BUG in part_mesh_mhd_bis, SIZE(mesh%jj,1)/=3')
1167 nws =
SIZE( mesh%jjs,1)
1168 IF (
SIZE(list_of_interfaces)/=0)
THEN
1171 IF (.NOT.virgins(ms)) cycle
1172 IF (minval(abs(mesh%sides(ms)-list_of_interfaces))/=0) cycle
1173 i_loc = mesh%jjs(:,ms)
1174 DO msop = 1, mesh%mes
1175 IF (msop==ms .OR. .NOT.virgins(msop)) cycle
1176 IF (minval(abs(mesh%sides(msop)-list_of_interfaces))/=0) cycle
1180 iop = mesh%jjs(nsop,msop)
1181 IF (maxval(abs(mesh%rr(:,i_loc(ns))-mesh%rr(:,iop))).LT.epsilon)
THEN
1193 CALL
error_petsc(.NOT.
'BUG in create_local_mesh, test ')
1195 IF (part(mesh%neighs(ms)) == part(mesh%neighs(msop))) cycle
1196 proc = min(part(mesh%neighs(ms)),part(mesh%neighs(msop)))
1197 part(mesh%neighs(ms)) = proc
1198 part(mesh%neighs(msop)) = proc
1199 virgins(ms) = .false.
1200 virgins(msop) = .false.
1201 indicator(mesh%jjs(:,ms)) = proc
1202 indicator(mesh%jjs(:,msop)) = proc
1209 j_loc = mesh%jj(:,m)
1210 n = maxval(indicator(j_loc))
1212 IF (indicator(j_loc(1))*indicator(j_loc(2))*indicator(j_loc(3))<0) cycle
1218 IF (present(my_periodic))
THEN
1219 IF (my_periodic%nb_periodic_pairs/=0)
THEN
1228 IF ((minval(abs(mesh%sides(ms)-my_periodic%list_periodic(1,:))) /=0) .AND. &
1229 (minval(abs(mesh%sides(ms)-my_periodic%list_periodic(2,:))) /=0) ) cycle
1230 DO ns = 1,
SIZE(mesh%jjs,1)
1233 DO msop = 1, mesh%mes
1234 IF (minval(abs(mesh%sides(msop)-my_periodic%list_periodic(:,:))) /=0 ) cycle
1235 IF (msop == ms) cycle
1236 DO nsop = 1,
SIZE(mesh%jjs,1)
1237 IF (mesh%jjs(nsop,msop)==j)
THEN
1238 per_pts(j,3) = mesh%neighs(msop)
1249 IF (minval(abs(mesh%sides(ms)-my_periodic%list_periodic(1,:))) /= 0) cycle
1250 jm_loc = minloc(abs(mesh%sides(ms)-my_periodic%list_periodic(1,:)))
1251 s2 = my_periodic%list_periodic(2,jm_loc(1))
1253 DO msop = 1, mesh%mes
1254 IF (mesh%sides(msop) /= s2) cycle
1257 DO ns = 1,
SIZE(my_periodic%vect_e,1)
1258 err = err + abs(sum(mesh%rr(ns,mesh%jjs(:,ms))-mesh%rr(ns,mesh%jjs(:,msop)) &
1259 +my_periodic%vect_e(ns,jm_loc(1))))
1262 IF (err .LE. epsilon)
THEN
1270 IF (part(mesh%neighs(ms)) /= part(mesh%neighs(msop)))
THEN
1271 proc = min(part(mesh%neighs(ms)),part(mesh%neighs(msop)))
1272 part(mesh%neighs(ms)) = proc
1273 part(mesh%neighs(msop)) = proc
1282 CALL mpi_comm_rank(mpi_comm_world,rank,ierr)
1289 DEALLOCATE(vwgt,adjwgt)
1290 IF (
ALLOCATED(xadj_u))
DEALLOCATE(xadj_u)
1291 IF (
ALLOCATED(xadj_h))
DEALLOCATE(xadj_h)
1292 IF (
ALLOCATED(xadj_phi))
DEALLOCATE(xadj_phi)
1293 IF (
ALLOCATED(list_h))
DEALLOCATE(list_h)
1294 IF (
ALLOCATED(xind_u))
DEALLOCATE(xind_u)
1295 IF (
ALLOCATED(xind_h))
DEALLOCATE(xind_h)
1296 IF (
ALLOCATED(xind_phi))
DEALLOCATE(xind_phi)
1297 IF (
ALLOCATED(u2glob))
DEALLOCATE(u2glob)
1298 IF (
ALLOCATED(h2glob))
DEALLOCATE(h2glob)
1299 IF (
ALLOCATED(phi2glob))
DEALLOCATE(phi2glob)
1300 IF (
ALLOCATED(part_u))
DEALLOCATE(part_u)
1301 IF (
ALLOCATED(part_h))
DEALLOCATE(part_h)
1302 IF (
ALLOCATED(part_phi))
DEALLOCATE(part_phi)
1308 SUBROUTINE extract_mesh(communicator,nb_proc,mesh_glob,part,list_dom,mesh,mesh_loc)
1312 TYPE(mesh_type) :: mesh_glob, mesh, mesh_loc
1313 INTEGER,
DIMENSION(:) :: part, list_dom
1314 INTEGER,
DIMENSION(mesh_glob%me) :: bat
1315 INTEGER,
DIMENSION(mesh_glob%np) :: i_old_to_new
1316 INTEGER,
DIMENSION(mesh_glob%mes) :: parts
1317 INTEGER,
DIMENSION(nb_proc) :: nblmt_per_proc, start, displ
1318 INTEGER,
DIMENSION(2) :: np_loc, me_loc, mes_loc
1319 INTEGER,
DIMENSION(:),
ALLOCATABLE :: list_m, tab, tabs
1320 INTEGER :: nb_proc, ms, i, index, m, mop, n
1321 petscerrorcode :: ierr
1323 mpi_comm :: communicator
1324 CALL mpi_comm_rank(communicator,rank,ierr)
1327 parts = part(mesh_glob%neighs)
1332 DO m = 1, mesh_glob%me
1333 IF (minval(abs(list_dom-mesh_glob%i_d(m)))/=0) cycle
1337 ALLOCATE (list_m(mesh%me))
1339 DO m = 1, mesh_glob%me
1340 IF (minval(abs(list_dom-mesh_glob%i_d(m)))/=0) cycle
1350 nblmt_per_proc(part(m)) = nblmt_per_proc(part(m)) + 1
1354 start(n) = start(n-1) + nblmt_per_proc(n-1)
1356 me_loc(1) = start(rank+1) + 1
1357 me_loc(2) = start(rank+1) + nblmt_per_proc(rank+1)
1362 ALLOCATE(tab(mesh%me))
1366 start(part(m)) = start(part(m)) + 1
1367 tab(start(part(m))) = m
1368 bat(m) = start(part(m))
1373 mesh%gauss%n_w =
SIZE(mesh_glob%jj,1)
1374 ALLOCATE(mesh%jj(
SIZE(mesh_glob%jj,1),mesh%me))
1378 DO n = 1,
SIZE(mesh_glob%jj,1)
1379 i = mesh_glob%jj(n,tab(m))
1380 IF (i_old_to_new(i)/=0)
THEN
1381 mesh%jj(n,m) = i_old_to_new(i)
1384 i_old_to_new(i) = index
1385 mesh%jj(n,m) = i_old_to_new(i)
1393 ALLOCATE(mesh%rr(2,mesh%np))
1394 DO i = 1, mesh_glob%np
1395 IF (i_old_to_new(i)==0) cycle
1396 mesh%rr(:,i_old_to_new(i)) = mesh_glob%rr(:,i)
1401 ALLOCATE(mesh%neigh(3,mesh%me))
1404 mop = mesh_glob%neigh(n,tab(m))
1408 mesh%neigh(n,m) = bat(mop)
1415 ALLOCATE(mesh%i_d(mesh%me))
1416 mesh%i_d = mesh_glob%i_d(tab)
1420 IF (displ(rank+1)/=0)
THEN
1421 np_loc(1) = maxval(mesh%jj(:,1:displ(rank+1))) + 1
1425 np_loc(2) = np_loc(1) - 1
1426 IF (me_loc(1).LE.me_loc(2))
THEN
1427 np_loc(2) = maxval(mesh%jj(:,me_loc(1):me_loc(2)))
1429 IF (np_loc(2) .LT. np_loc(1)-1)
THEN
1430 np_loc(2) = np_loc(1) - 1
1436 DO ms = 1, mesh_glob%mes
1437 IF (minval(abs(list_dom-mesh_glob%i_d(mesh_glob%neighs(ms))))/=0) cycle
1439 nblmt_per_proc(n) = nblmt_per_proc(n) + 1
1443 start(n) = start(n-1) + nblmt_per_proc(n-1)
1445 mes_loc(1) = start(rank+1) + 1
1446 mes_loc(2) = start(rank+1) + nblmt_per_proc(rank+1)
1447 mesh%mes = sum(nblmt_per_proc)
1451 ALLOCATE(tabs(mesh%mes))
1452 DO ms = 1, mesh_glob%mes
1453 IF (minval(abs(list_dom-mesh_glob%i_d(mesh_glob%neighs(ms))))/=0) cycle
1454 start(parts(ms)) = start(parts(ms)) + 1
1455 tabs(start(parts(ms))) = ms
1460 ALLOCATE(mesh%neighs(mesh%mes))
1461 mesh%neighs = bat(mesh_glob%neighs(tabs))
1465 ALLOCATE(mesh%sides(mesh%mes))
1466 mesh%sides = mesh_glob%sides(tabs)
1470 mesh%gauss%n_ws =
SIZE(mesh_glob%jjs,1)
1471 ALLOCATE(mesh%jjs(
SIZE(mesh_glob%jjs,1),mesh%mes))
1473 DO n = 1,
SIZE(mesh%jjs,1)
1474 mesh%jjs(n,:) = i_old_to_new(mesh_glob%jjs(n,tabs))
1479 mesh%edge_stab = .false.
1482 DEALLOCATE(list_m, tab, tabs)
1491 INTEGER,
DIMENSION(2),
INTENT(IN) :: me_loc, mes_loc, np_loc
1492 INTEGER,
DIMENSION(mesh%me) :: m_glob_to_loc
1493 INTEGER,
DIMENSION(:),
ALLOCATABLE :: m_loc_to_glob
1494 INTEGER,
DIMENSION(mesh%np) :: glob_to_loc,
loc_to_glob
1495 LOGICAL,
DIMENSION(mesh%np) :: virgin
1496 INTEGER :: dim, nws, nw, m, ms, mop, ns, msup, minf, dof, &
1497 dom_me, nwc, dom_mes, dom_np, n, i
1500 dim =
SIZE(mesh%rr,1)
1501 nws =
SIZE(mesh%jjs,1)
1502 nw =
SIZE(mesh%jj,1)
1503 nwc =
SIZE(mesh%neigh,1)
1505 IF (me_loc(2) - me_loc(1) + 1==mesh%me)
THEN
1506 mesh_loc%me = mesh%me
1507 mesh_loc%np = mesh%np
1508 mesh_loc%mes = mesh%mes
1509 mesh_loc%dom_me = mesh%me
1510 mesh_loc%dom_np = mesh%np
1511 mesh_loc%dom_mes = mesh%mes
1512 mesh_loc%gauss%n_w = nw
1513 ALLOCATE(mesh_loc%jj(nw,mesh%me))
1514 mesh_loc%jj = mesh%jj
1515 ALLOCATE(mesh_loc%loc_to_glob(mesh%np))
1517 mesh_loc%loc_to_glob(n) = n
1519 ALLOCATE(mesh_loc%rr(dim,mesh%np))
1521 ALLOCATE(mesh_loc%neigh(nwc,mesh%me))
1522 mesh_loc%neigh = mesh%neigh
1523 ALLOCATE(mesh_loc%i_d(mesh%me))
1524 mesh_loc%i_d = mesh%i_d
1525 ALLOCATE(mesh_loc%neighs(mesh_loc%mes))
1526 mesh_loc%neighs = mesh%neighs
1527 ALLOCATE(mesh_loc%sides(mesh_loc%mes))
1528 mesh_loc%sides = mesh%sides
1529 mesh_loc%gauss%n_ws = nws
1530 ALLOCATE(mesh_loc%jjs(nws,mesh_loc%mes))
1531 mesh_loc%jjs = mesh%jjs
1538 dom_me = me_loc(2) - me_loc(1) + 1
1539 dom_mes = mes_loc(2) - mes_loc(1) + 1
1540 dom_np = np_loc(2) - np_loc(1) + 1
1541 mesh_loc%me = dom_me
1542 mesh_loc%mes = dom_mes
1543 mesh_loc%dom_me = dom_me
1544 mesh_loc%dom_np = dom_np
1545 mesh_loc%dom_mes = dom_mes
1548 ALLOCATE(mesh_loc%jj(0,0))
1549 ALLOCATE(mesh_loc%loc_to_glob(0))
1550 ALLOCATE(mesh_loc%rr(0,0))
1551 ALLOCATE(mesh_loc%neigh(0,0))
1552 ALLOCATE(mesh_loc%i_d(0))
1553 ALLOCATE(mesh_loc%neighs(0))
1554 ALLOCATE(mesh_loc%sides(0))
1555 ALLOCATE(mesh_loc%jjs(0,0))
1556 mesh_loc%gauss%n_w = 0
1557 mesh_loc%gauss%n_ws = 0
1559 ELSE IF (dom_me<0)
THEN
1560 CALL
error_petsc(
'BUG in create_local_mesh, dom_me<0 ')
1562 mesh_loc%gauss%n_w = nw
1563 mesh_loc%gauss%n_ws = nws
1569 DO m = me_loc(1), me_loc(2)
1572 IF(.NOT.virgin(i) .OR. i.GE.np_loc(1)) cycle
1577 ALLOCATE(mesh_loc%jj(nw,mesh_loc%me))
1579 ALLOCATE(m_loc_to_glob(mesh_loc%me))
1583 DO m = me_loc(1), me_loc(2)
1588 IF (i .LT. np_loc(1))
THEN
1590 glob_to_loc(i) = dof
1593 glob_to_loc(i) = i-np_loc(1) + 1
1598 m_loc_to_glob(m-me_loc(1)+1) = m
1599 m_glob_to_loc(m) = m-me_loc(1)+1
1603 mesh_loc%jj(n,1:dom_me) = glob_to_loc(mesh%jj(n,me_loc(1):me_loc(2)))
1608 IF (maxval(mesh_loc%jj)/=dof)
THEN
1609 CALL
error_petsc(
'BUG in create_local_mesh, mesh_loc%jj)/=dof')
1612 ALLOCATE(mesh_loc%loc_to_glob(mesh_loc%np))
1617 ALLOCATE(mesh_loc%rr(dim,mesh_loc%np))
1618 DO n = 1, mesh_loc%np
1619 mesh_loc%rr(:,n) = mesh%rr(:,mesh_loc%loc_to_glob(n))
1624 ALLOCATE(mesh_loc%neigh(nwc,mesh_loc%me))
1625 msup = maxval(m_loc_to_glob)
1626 minf = minval(m_loc_to_glob)
1627 DO m = 1, mesh_loc%me
1629 mop = mesh%neigh(n,m_loc_to_glob(m))
1631 mesh_loc%neigh(n,m) = 0
1632 ELSE IF(mop<minf .OR. mop>msup)
THEN
1634 mesh_loc%neigh(n,m) = -mop
1636 mesh_loc%neigh(n,m) = m_glob_to_loc(mop)
1643 ALLOCATE(mesh_loc%i_d(mesh_loc%me))
1644 mesh_loc%i_d = mesh%i_d(m_loc_to_glob)
1648 ALLOCATE(mesh_loc%neighs(mesh_loc%mes))
1649 mesh_loc%neighs = m_glob_to_loc(mesh%neighs(mes_loc(1):mes_loc(2)))
1654 ALLOCATE(mesh_loc%sides(mesh_loc%mes))
1655 mesh_loc%sides = mesh%sides(mes_loc(1):mes_loc(2))
1659 ALLOCATE(mesh_loc%jjs(nws,mesh_loc%mes))
1661 mesh_loc%jjs(ns,:) = glob_to_loc(mesh%jjs(ns,mes_loc(1):mes_loc(2)))
1667 DO ms = 1, mesh_loc%mes
1668 m = mesh_loc%neighs(ms)
1672 IF (maxval(abs(mesh_loc%rr(:,mesh_loc%jj(n,m))-mesh_loc%rr(:,mesh_loc%jjs(ns,ms)))) .LT. 1.d-10)
THEN
1677 WRITE(*,*)
'bug in create local mesh, non consistent numbering'
1685 DEALLOCATE(m_loc_to_glob)
1696 DEALLOCATE(mesh%jjs)
1698 DEALLOCATE(mesh%neigh)
1699 DEALLOCATE(mesh%sides)
1700 DEALLOCATE(mesh%neighs)
1701 DEALLOCATE(mesh%i_d)
1703 nullify(mesh%loc_to_glob)
1708 IF (mesh%edge_stab)
THEN
1709 DEALLOCATE(mesh%iis)
1711 DEALLOCATE(mesh%jjsi)
1712 DEALLOCATE(mesh%neighi)
1723 mesh%edge_stab = .false.
1734 DEALLOCATE(interf%mesh1)
1735 DEALLOCATE(interf%mesh2)
1736 DEALLOCATE(interf%jjs1)
1737 DEALLOCATE(interf%jjs2)
1746 INTEGER,
DIMENSION(mesh%me),
INTENT(INOUT) :: partition
1747 INTEGER,
DIMENSION(mesh%np,3),
INTENT(IN) :: list_pts
1749 INTEGER :: i, j_loc, proc_min, index, i_loc, m, mop, n, proc1, proc2
1750 INTEGER,
DIMENSION(50) :: list_elmts
1756 IF (list_pts(i,2)==0) cycle
1757 j_loc = list_pts(i,1)
1760 list_elmts(index) = list_pts(i,2)
1767 mop = mesh%neigh(n, m)
1769 IF (minval(abs(mesh%jj(:,mop)-j_loc)) /=0) cycle
1770 IF (minval(abs(mop-list_elmts))==0) cycle
1773 IF (i_loc-index==2)
THEN
1774 CALL
error_petsc(
'BUG in reassign_per_pts, how is that possible?')
1776 list_elmts(i_loc) = mop
1781 IF (list_pts(i,3) == 0)
THEN
1782 proc_min = minval(partition(list_elmts(1:index)))
1783 partition(list_elmts(1)) = proc_min
1785 IF (list_elmts(index) /= list_pts(i,3))
THEN
1786 CALL
error_petsc(
'BUG in reassign_per_pts, wrong element')
1788 proc1 = partition(list_elmts(1))
1789 proc2 = partition(list_elmts(2))
1790 partition(list_elmts(2:index-1)) = min(proc1,proc2)
subroutine, public free_interface(interf)
subroutine, public free_mesh(mesh)
subroutine, public part_mesh_m_t_h_phi(nb_proc, list_u, list_T_in, list_h_in, list_phi, mesh, list_of_interfaces, part, my_periodic)
subroutine, public extract_mesh(communicator, nb_proc, mesh_glob, part, list_dom, mesh, mesh_loc)
subroutine create_local_mesh(mesh, mesh_loc, me_loc, mes_loc, np_loc, news, inter_news)
subroutine, public part_mesh_mhd(nb_proc, vwgt, mesh, list_of_interfaces, part, my_periodic)
subroutine plot_const_p1_label(jj, rr, uu, file_name)
subroutine reassign_per_pts(mesh, partition, list_pts)
subroutine error_petsc(string)
subroutine, public part_mesh_mhd_bis(nb_proc, list_u, list_h_in, list_phi, mesh, list_of_interfaces, part, my_periodic)