400 type(
gs_t),
target,
intent(inout) :: gs
401 type(
mesh_t),
pointer :: msh
403 type(
stack_i4_t),
target :: local_dof, dof_local, shared_dof, dof_shared
404 type(
stack_i4_t),
target :: local_face_dof, face_dof_local
405 type(
stack_i4_t),
target :: shared_face_dof, face_dof_shared
406 integer :: i, j, k, l, lx, ly, lz, max_id, max_sid, id, lid, dm_size
412 sdm => gs%shared_dofs
417 dm_size =
dofmap%size()/lx
419 call dm%init(dm_size, i)
423 call sdm%init(
dofmap%size(), i)
426 call local_dof%init()
427 call dof_local%init()
429 call local_face_dof%init()
430 call face_dof_local%init()
432 call shared_dof%init()
433 call dof_shared%init()
435 call shared_face_dof%init()
436 call face_dof_shared%init()
448 if (
dofmap%shared_dof(1, 1, 1, i))
then
451 call shared_dof%push(id)
453 call dof_shared%push(lid)
459 call local_dof%push(id)
460 call dof_local%push(lid)
467 if (
dofmap%shared_dof(lx, 1, 1, i))
then
469 call shared_dof%push(id)
470 call dof_shared%push(lid)
473 call local_dof%push(id)
474 call dof_local%push(lid)
478 if (
dofmap%shared_dof(1, ly, 1, i))
then
480 call shared_dof%push(id)
481 call dof_shared%push(lid)
484 call local_dof%push(id)
485 call dof_local%push(lid)
489 if (
dofmap%shared_dof(lx, ly, 1, i))
then
491 call shared_dof%push(id)
492 call dof_shared%push(lid)
495 call local_dof%push(id)
496 call dof_local%push(lid)
500 if (
dofmap%shared_dof(1, 1, lz, i))
then
502 call shared_dof%push(id)
503 call dof_shared%push(lid)
506 call local_dof%push(id)
507 call dof_local%push(lid)
511 if (
dofmap%shared_dof(lx, 1, lz, i))
then
513 call shared_dof%push(id)
514 call dof_shared%push(lid)
517 call local_dof%push(id)
518 call dof_local%push(lid)
522 if (
dofmap%shared_dof(1, ly, lz, i))
then
524 call shared_dof%push(id)
525 call dof_shared%push(lid)
528 call local_dof%push(id)
529 call dof_local%push(lid)
533 if (
dofmap%shared_dof(lx, ly, lz, i))
then
535 call shared_dof%push(id)
536 call dof_shared%push(lid)
539 call local_dof%push(id)
540 call dof_local%push(lid)
557 if (
dofmap%shared_dof(2, 1, 1, i))
then
560 call shared_dof%push(id)
562 call dof_shared%push(id)
567 call local_dof%push(id)
569 call dof_local%push(id)
572 if (
dofmap%shared_dof(2, 1, lz, i))
then
575 call shared_dof%push(id)
577 call dof_shared%push(id)
582 call local_dof%push(id)
584 call dof_local%push(id)
588 if (
dofmap%shared_dof(2, ly, 1, i))
then
591 call shared_dof%push(id)
593 call dof_shared%push(id)
599 call local_dof%push(id)
601 call dof_local%push(id)
604 if (
dofmap%shared_dof(2, ly, lz, i))
then
607 call shared_dof%push(id)
609 call dof_shared%push(id)
614 call local_dof%push(id)
616 call dof_local%push(id)
623 if (
dofmap%shared_dof(1, 2, 1, i))
then
626 call shared_dof%push(id)
628 call dof_shared%push(id)
633 call local_dof%push(id)
635 call dof_local%push(id)
638 if (
dofmap%shared_dof(1, 2, lz, i))
then
641 call shared_dof%push(id)
643 call dof_shared%push(id)
648 call local_dof%push(id)
650 call dof_local%push(id)
654 if (
dofmap%shared_dof(lx, 2, 1, i))
then
657 call shared_dof%push(id)
659 call dof_shared%push(id)
664 call local_dof%push(id)
666 call dof_local%push(id)
669 if (
dofmap%shared_dof(lx, 2, lz, i))
then
672 call shared_dof%push(id)
674 call dof_shared%push(id)
679 call local_dof%push(id)
681 call dof_local%push(id)
687 if (
dofmap%shared_dof(1, 1, 2, i))
then
690 call shared_dof%push(id)
692 call dof_shared%push(id)
697 call local_dof%push(id)
699 call dof_local%push(id)
703 if (
dofmap%shared_dof(lx, 1, 2, i))
then
706 call shared_dof%push(id)
708 call dof_shared%push(id)
713 call local_dof%push(id)
715 call dof_local%push(id)
719 if (
dofmap%shared_dof(1, ly, 2, i))
then
722 call shared_dof%push(id)
724 call dof_shared%push(id)
729 call local_dof%push(id)
731 call dof_local%push(id)
735 if (
dofmap%shared_dof(lx, ly, 2, i))
then
738 call shared_dof%push(id)
740 call dof_shared%push(id)
745 call local_dof%push(id)
747 call dof_local%push(id)
766 if (msh%facet_neigh(3, i) .ne. 0)
then
767 if (
dofmap%shared_dof(2, 1, 1, i))
then
770 call shared_face_dof%push(id)
772 call face_dof_shared%push(id)
777 call local_face_dof%push(id)
779 call face_dof_local%push(id)
784 if (msh%facet_neigh(4, i) .ne. 0)
then
785 if (
dofmap%shared_dof(2, ly, 1, i))
then
788 call shared_face_dof%push(id)
790 call face_dof_shared%push(id)
796 call local_face_dof%push(id)
798 call face_dof_local%push(id)
806 if (msh%facet_neigh(1, i) .ne. 0)
then
807 if (
dofmap%shared_dof(1, 2, 1, i))
then
810 call shared_face_dof%push(id)
812 call face_dof_shared%push(id)
817 call local_face_dof%push(id)
819 call face_dof_local%push(id)
824 if (msh%facet_neigh(2, i) .ne. 0)
then
825 if (
dofmap%shared_dof(lx, 2, 1, i))
then
828 call shared_face_dof%push(id)
830 call face_dof_shared%push(id)
835 call local_face_dof%push(id)
837 call face_dof_local%push(id)
846 if (msh%facet_neigh(1, i) .ne. 0)
then
847 if (
dofmap%shared_dof(1, 2, 2, i))
then
851 call shared_face_dof%push(id)
853 call face_dof_shared%push(id)
860 call local_face_dof%push(id)
862 call face_dof_local%push(id)
868 if (msh%facet_neigh(2, i) .ne. 0)
then
869 if (
dofmap%shared_dof(lx, 2, 2, i))
then
873 call shared_face_dof%push(id)
875 call face_dof_shared%push(id)
882 call local_face_dof%push(id)
884 call face_dof_local%push(id)
891 if (msh%facet_neigh(3, i) .ne. 0)
then
892 if (
dofmap%shared_dof(2, 1, 2, i))
then
896 call shared_face_dof%push(id)
898 call face_dof_shared%push(id)
905 call local_face_dof%push(id)
907 call face_dof_local%push(id)
913 if (msh%facet_neigh(4, i) .ne. 0)
then
914 if (
dofmap%shared_dof(2, ly, 2, i))
then
918 call shared_face_dof%push(id)
920 call face_dof_shared%push(id)
927 call local_face_dof%push(id)
929 call face_dof_local%push(id)
936 if (msh%facet_neigh(5, i) .ne. 0)
then
937 if (
dofmap%shared_dof(2, 2, 1, i))
then
941 call shared_face_dof%push(id)
943 call face_dof_shared%push(id)
950 call local_face_dof%push(id)
952 call face_dof_local%push(id)
958 if (msh%facet_neigh(6, i) .ne. 0)
then
959 if (
dofmap%shared_dof(2, 2, lz, i))
then
963 call shared_face_dof%push(id)
965 call face_dof_shared%push(id)
972 call local_face_dof%push(id)
974 call face_dof_local%push(id)
985 gs%nlocal = local_dof%size() + local_face_dof%size()
986 gs%local_facet_offset = local_dof%size() + 1
989 allocate(gs%local_dof_gs(gs%nlocal))
996 select type(dof_array => local_dof%data)
1000 gs%local_dof_gs(i) = dof_array(i)
1003 call local_dof%free()
1010 select type(dof_array => local_face_dof%data)
1012 do i = 1, local_face_dof%size()
1013 gs%local_dof_gs(i + j) = dof_array(i)
1016 call local_face_dof%free()
1019 allocate(gs%local_gs_dof(gs%nlocal))
1026 select type(dof_array => dof_local%data)
1028 j = dof_local%size()
1030 gs%local_gs_dof(i) = dof_array(i)
1033 call dof_local%free()
1038 select type(dof_array => face_dof_local%data)
1040 do i = 1, face_dof_local%size()
1041 gs%local_gs_dof(i+j) = dof_array(i)
1044 call face_dof_local%free()
1047 gs%nlocal, 1, gs%nlocal)
1050 gs%nlocal_blks, gs%nlocal, gs%local_facet_offset)
1053 allocate(gs%local_gs(gs%nlocal))
1055 gs%nshared = shared_dof%size() + shared_face_dof%size()
1056 gs%shared_facet_offset = shared_dof%size() + 1
1059 allocate(gs%shared_dof_gs(gs%nshared))
1066 select type(dof_array => shared_dof%data)
1068 j = shared_dof%size()
1070 gs%shared_dof_gs(i) = dof_array(i)
1073 call shared_dof%free()
1080 select type(dof_array => shared_face_dof%data)
1082 do i = 1, shared_face_dof%size()
1083 gs%shared_dof_gs(i + j) = dof_array(i)
1086 call shared_face_dof%free()
1089 allocate(gs%shared_gs_dof(gs%nshared))
1096 select type(dof_array => dof_shared%data)
1098 j = dof_shared%size()
1100 gs%shared_gs_dof(i) = dof_array(i)
1103 call dof_shared%free()
1108 select type(dof_array => face_dof_shared%data)
1110 do i = 1, face_dof_shared%size()
1111 gs%shared_gs_dof(i + j) = dof_array(i)
1114 call face_dof_shared%free()
1117 allocate(gs%shared_gs(gs%nshared))
1119 if (gs%nshared .gt. 0)
then
1121 gs%nshared, 1, gs%nshared)
1123 call gs_find_blks(gs%shared_dof_gs, gs%shared_blk_len, &
1124 gs%nshared_blks, gs%nshared, gs%shared_facet_offset)
1139 integer(kind=i8),
intent(inout) :: dof
1140 integer,
intent(inout) :: max_id
1143 if (map_%get(dof, id) .gt. 0)
then
1145 call map_%set(dof, max_id)
1153 integer,
intent(inout) :: n
1154 integer,
dimension(n),
intent(inout) :: dg
1155 integer,
dimension(n),
intent(inout) :: gd
1157 integer :: tmp, i, j, pivot
1161 pivot = dg((lo + hi) / 2)
1165 if (dg(i) .ge. pivot)
exit
1170 if (dg(j) .le. pivot)
exit
1181 else if (i .eq. j)
then
1195 integer,
intent(in) :: n
1196 integer,
intent(in) :: m
1197 integer,
dimension(n),
intent(inout) :: dg
1198 integer,
allocatable,
intent(inout) :: blk_len(:)
1199 integer,
intent(inout) :: nblks
1201 integer :: id, count
1210 do while ( j+1 .le. n .and. dg(j+1) .eq. id)
1214 call blks%push(count)
1218 select type(blk_array => blks%data)
1221 allocate(blk_len(nblks))
1223 blk_len(i) = blk_array(i)