320 type(
gs_t),
target,
intent(inout) :: gs
321 type(
mesh_t),
pointer :: msh
323 type(
stack_i4_t),
target :: local_dof, dof_local, shared_dof, dof_shared
324 type(
stack_i4_t),
target :: local_face_dof, face_dof_local
325 type(
stack_i4_t),
target :: shared_face_dof, face_dof_shared
326 integer :: i, j, k, l, lx, ly, lz, max_id, max_sid, id, lid, dm_size
332 sdm => gs%shared_dofs
337 dm_size =
dofmap%size()/lx
339 call dm%init(dm_size, i)
342 call sdm%init(
dofmap%size(), i)
345 call local_dof%init()
346 call dof_local%init()
348 call local_face_dof%init()
349 call face_dof_local%init()
351 call shared_dof%init()
352 call dof_shared%init()
354 call shared_face_dof%init()
355 call face_dof_shared%init()
365 if (
dofmap%shared_dof(1, 1, 1, i))
then
367 call shared_dof%push(id)
368 call dof_shared%push(lid)
371 call local_dof%push(id)
372 call dof_local%push(lid)
376 if (
dofmap%shared_dof(lx, 1, 1, i))
then
378 call shared_dof%push(id)
379 call dof_shared%push(lid)
382 call local_dof%push(id)
383 call dof_local%push(lid)
387 if (
dofmap%shared_dof(1, ly, 1, i))
then
389 call shared_dof%push(id)
390 call dof_shared%push(lid)
393 call local_dof%push(id)
394 call dof_local%push(lid)
398 if (
dofmap%shared_dof(lx, ly, 1, i))
then
400 call shared_dof%push(id)
401 call dof_shared%push(lid)
404 call local_dof%push(id)
405 call dof_local%push(lid)
409 if (
dofmap%shared_dof(1, 1, lz, i))
then
411 call shared_dof%push(id)
412 call dof_shared%push(lid)
415 call local_dof%push(id)
416 call dof_local%push(lid)
420 if (
dofmap%shared_dof(lx, 1, lz, i))
then
422 call shared_dof%push(id)
423 call dof_shared%push(lid)
426 call local_dof%push(id)
427 call dof_local%push(lid)
431 if (
dofmap%shared_dof(1, ly, lz, i))
then
433 call shared_dof%push(id)
434 call dof_shared%push(lid)
437 call local_dof%push(id)
438 call dof_local%push(lid)
442 if (
dofmap%shared_dof(lx, ly, lz, i))
then
444 call shared_dof%push(id)
445 call dof_shared%push(lid)
448 call local_dof%push(id)
449 call dof_local%push(lid)
466 if (
dofmap%shared_dof(2, 1, 1, i))
then
469 call shared_dof%push(id)
471 call dof_shared%push(id)
476 call local_dof%push(id)
478 call dof_local%push(id)
481 if (
dofmap%shared_dof(2, 1, lz, i))
then
484 call shared_dof%push(id)
486 call dof_shared%push(id)
491 call local_dof%push(id)
493 call dof_local%push(id)
497 if (
dofmap%shared_dof(2, ly, 1, i))
then
500 call shared_dof%push(id)
502 call dof_shared%push(id)
508 call local_dof%push(id)
510 call dof_local%push(id)
513 if (
dofmap%shared_dof(2, ly, lz, i))
then
516 call shared_dof%push(id)
518 call dof_shared%push(id)
523 call local_dof%push(id)
525 call dof_local%push(id)
532 if (
dofmap%shared_dof(1, 2, 1, i))
then
535 call shared_dof%push(id)
537 call dof_shared%push(id)
542 call local_dof%push(id)
544 call dof_local%push(id)
547 if (
dofmap%shared_dof(1, 2, lz, i))
then
550 call shared_dof%push(id)
552 call dof_shared%push(id)
557 call local_dof%push(id)
559 call dof_local%push(id)
563 if (
dofmap%shared_dof(lx, 2, 1, i))
then
566 call shared_dof%push(id)
568 call dof_shared%push(id)
573 call local_dof%push(id)
575 call dof_local%push(id)
578 if (
dofmap%shared_dof(lx, 2, lz, i))
then
581 call shared_dof%push(id)
583 call dof_shared%push(id)
588 call local_dof%push(id)
590 call dof_local%push(id)
596 if (
dofmap%shared_dof(1, 1, 2, i))
then
599 call shared_dof%push(id)
601 call dof_shared%push(id)
606 call local_dof%push(id)
608 call dof_local%push(id)
612 if (
dofmap%shared_dof(lx, 1, 2, i))
then
615 call shared_dof%push(id)
617 call dof_shared%push(id)
622 call local_dof%push(id)
624 call dof_local%push(id)
628 if (
dofmap%shared_dof(1, ly, 2, i))
then
631 call shared_dof%push(id)
633 call dof_shared%push(id)
638 call local_dof%push(id)
640 call dof_local%push(id)
644 if (
dofmap%shared_dof(lx, ly, 2, i))
then
647 call shared_dof%push(id)
649 call dof_shared%push(id)
654 call local_dof%push(id)
656 call dof_local%push(id)
674 if (msh%facet_neigh(3, i) .ne. 0)
then
675 if (
dofmap%shared_dof(2, 1, 1, i))
then
678 call shared_face_dof%push(id)
680 call face_dof_shared%push(id)
685 call local_face_dof%push(id)
687 call face_dof_local%push(id)
692 if (msh%facet_neigh(4, i) .ne. 0)
then
693 if (
dofmap%shared_dof(2, ly, 1, i))
then
696 call shared_face_dof%push(id)
698 call face_dof_shared%push(id)
704 call local_face_dof%push(id)
706 call face_dof_local%push(id)
714 if (msh%facet_neigh(1, i) .ne. 0)
then
715 if (
dofmap%shared_dof(1, 2, 1, i))
then
718 call shared_face_dof%push(id)
720 call face_dof_shared%push(id)
725 call local_face_dof%push(id)
727 call face_dof_local%push(id)
732 if (msh%facet_neigh(2, i) .ne. 0)
then
733 if (
dofmap%shared_dof(lx, 2, 1, i))
then
736 call shared_face_dof%push(id)
738 call face_dof_shared%push(id)
743 call local_face_dof%push(id)
745 call face_dof_local%push(id)
754 if (msh%facet_neigh(1, i) .ne. 0)
then
755 if (
dofmap%shared_dof(1, 2, 2, i))
then
759 call shared_face_dof%push(id)
761 call face_dof_shared%push(id)
768 call local_face_dof%push(id)
770 call face_dof_local%push(id)
776 if (msh%facet_neigh(2, i) .ne. 0)
then
777 if (
dofmap%shared_dof(lx, 2, 2, i))
then
781 call shared_face_dof%push(id)
783 call face_dof_shared%push(id)
790 call local_face_dof%push(id)
792 call face_dof_local%push(id)
799 if (msh%facet_neigh(3, i) .ne. 0)
then
800 if (
dofmap%shared_dof(2, 1, 2, i))
then
804 call shared_face_dof%push(id)
806 call face_dof_shared%push(id)
813 call local_face_dof%push(id)
815 call face_dof_local%push(id)
821 if (msh%facet_neigh(4, i) .ne. 0)
then
822 if (
dofmap%shared_dof(2, ly, 2, i))
then
826 call shared_face_dof%push(id)
828 call face_dof_shared%push(id)
835 call local_face_dof%push(id)
837 call face_dof_local%push(id)
844 if (msh%facet_neigh(5, i) .ne. 0)
then
845 if (
dofmap%shared_dof(2, 2, 1, i))
then
849 call shared_face_dof%push(id)
851 call face_dof_shared%push(id)
858 call local_face_dof%push(id)
860 call face_dof_local%push(id)
866 if (msh%facet_neigh(6, i) .ne. 0)
then
867 if (
dofmap%shared_dof(2, 2, lz, i))
then
871 call shared_face_dof%push(id)
873 call face_dof_shared%push(id)
880 call local_face_dof%push(id)
882 call face_dof_local%push(id)
893 gs%nlocal = local_dof%size() + local_face_dof%size()
894 gs%local_facet_offset = local_dof%size() + 1
897 allocate(gs%local_dof_gs(gs%nlocal))
904 select type(dof_array => local_dof%data)
908 gs%local_dof_gs(i) = dof_array(i)
911 call local_dof%free()
918 select type(dof_array => local_face_dof%data)
920 do i = 1, local_face_dof%size()
921 gs%local_dof_gs(i + j) = dof_array(i)
924 call local_face_dof%free()
927 allocate(gs%local_gs_dof(gs%nlocal))
934 select type(dof_array => dof_local%data)
938 gs%local_gs_dof(i) = dof_array(i)
941 call dof_local%free()
946 select type(dof_array => face_dof_local%data)
948 do i = 1, face_dof_local%size()
949 gs%local_gs_dof(i+j) = dof_array(i)
952 call face_dof_local%free()
955 gs%nlocal, 1, gs%nlocal)
958 gs%nlocal_blks, gs%nlocal, gs%local_facet_offset)
961 allocate(gs%local_gs(gs%nlocal))
963 gs%nshared = shared_dof%size() + shared_face_dof%size()
964 gs%shared_facet_offset = shared_dof%size() + 1
967 allocate(gs%shared_dof_gs(gs%nshared))
974 select type(dof_array => shared_dof%data)
976 j = shared_dof%size()
978 gs%shared_dof_gs(i) = dof_array(i)
981 call shared_dof%free()
988 select type(dof_array => shared_face_dof%data)
990 do i = 1, shared_face_dof%size()
991 gs%shared_dof_gs(i + j) = dof_array(i)
994 call shared_face_dof%free()
997 allocate(gs%shared_gs_dof(gs%nshared))
1004 select type(dof_array => dof_shared%data)
1006 j = dof_shared%size()
1008 gs%shared_gs_dof(i) = dof_array(i)
1011 call dof_shared%free()
1016 select type(dof_array => face_dof_shared%data)
1018 do i = 1, face_dof_shared%size()
1019 gs%shared_gs_dof(i + j) = dof_array(i)
1022 call face_dof_shared%free()
1025 allocate(gs%shared_gs(gs%nshared))
1027 if (gs%nshared .gt. 0)
then
1029 gs%nshared, 1, gs%nshared)
1031 call gs_find_blks(gs%shared_dof_gs, gs%shared_blk_len, &
1032 gs%nshared_blks, gs%nshared, gs%shared_facet_offset)
1040 integer(kind=i8),
intent(inout) :: dof
1041 integer,
intent(inout) :: max_id
1044 if (map_%get(dof, id) .gt. 0)
then
1046 call map_%set(dof, max_id)
1054 integer,
intent(inout) :: n
1055 integer,
dimension(n),
intent(inout) :: dg
1056 integer,
dimension(n),
intent(inout) :: gd
1058 integer :: tmp, i, j, pivot
1062 pivot = dg((lo + hi) / 2)
1066 if (dg(i) .ge. pivot)
exit
1071 if (dg(j) .le. pivot)
exit
1082 else if (i .eq. j)
then
1096 integer,
intent(in) :: n
1097 integer,
intent(in) :: m
1098 integer,
dimension(n),
intent(inout) :: dg
1099 integer,
allocatable,
intent(inout) :: blk_len(:)
1100 integer,
intent(inout) :: nblks
1102 integer :: id, count
1111 do while ( j+1 .le. n .and. dg(j+1) .eq. id)
1115 call blks%push(count)
1119 select type(blk_array => blks%data)
1122 allocate(blk_len(nblks))
1124 blk_len(i) = blk_array(i)