Repository of the treelm library. Now found at https://github.com/apes-suite/treelm
Revision | a70a2244ff7c18b561df78983f79d63b04400405 (tree) |
---|---|
Zeit | 2020-08-28 00:28:18 |
Autor | Harald Klimach <harald.klimach@uni-...> |
Commiter | Harald Klimach |
Removed unnecessary if condition in identify_elements and some formatting.
@@ -1,5 +1,5 @@ | ||
1 | 1 | ! Copyright (c) 2011-2012 Jens Zudrop <j.zudrop@grs-sim.de> |
2 | -! Copyright (c) 2011-2019 Harald Klimach <harald.klimach@uni-siegen.de> | |
2 | +! Copyright (c) 2011-2020 Harald Klimach <harald.klimach@uni-siegen.de> | |
3 | 3 | ! Copyright (c) 2011-2013 Manuel Hasert <m.hasert@grs-sim.de> |
4 | 4 | ! Copyright (c) 2011-2019 Kannan Masilamani <kannan.masilamani@uni-siegen.de> |
5 | 5 | ! Copyright (c) 2011 Khaled Ibrahim <k.ibrahim@grs-sim.de> |
@@ -36,7 +36,7 @@ | ||
36 | 36 | ! CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, |
37 | 37 | ! OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE |
38 | 38 | ! OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. |
39 | -! ****************************************************************************** ! | |
39 | +! **************************************************************************** ! | |
40 | 40 | !> author: Harald Klimach |
41 | 41 | !! author: Manuel Hasert |
42 | 42 | !! author: Jens Zudrop |
@@ -54,14 +54,14 @@ | ||
54 | 54 | |
55 | 55 | ! include treelm modules |
56 | 56 | use mpi |
57 | - use env_module, only: long_k, rk, globalMaxLevels, & | |
57 | + use env_module, only: long_k, rk, globalMaxLevels, & | |
58 | 58 | & io_buffer_size, pathLen |
59 | 59 | use tem_aux_module, only: tem_abort |
60 | 60 | use tem_param_module, only: childPosition |
61 | - use tem_dyn_array_module, only: dyn_longArray_type, dyn_intArray_type, & | |
62 | - & init, append, expand, destroy, & | |
61 | + use tem_dyn_array_module, only: dyn_longArray_type, dyn_intArray_type, & | |
62 | + & init, append, expand, destroy, & | |
63 | 63 | & PositionOfVal |
64 | - use tem_grow_array_module, only: grw_longArray_type, grw_intArray_type, & | |
64 | + use tem_grow_array_module, only: grw_longArray_type, grw_intArray_type, & | |
65 | 65 | & init, append, expand, destroy, empty |
66 | 66 | use treelmesh_module, only: treelmesh_type |
67 | 67 | use tem_geometry_module, only: tem_tIdInfo, tem_PosOfPath, tem_baryOfID |
@@ -71,32 +71,32 @@ | ||
71 | 71 | & tem_log |
72 | 72 | use tem_debug_module, only: tem_debug, main_debug, dbgUnit |
73 | 73 | use tem_comm_env_module, only: tem_comm_env_type |
74 | - use tem_comm_module, only: tem_communication_type, tem_comm_dumpType, & | |
75 | - & tem_commPattern_type, tem_comm_init, & | |
74 | + use tem_comm_module, only: tem_communication_type, tem_comm_dumpType, & | |
75 | + & tem_commPattern_type, tem_comm_init, & | |
76 | 76 | & tem_comm_count |
77 | - use tem_topology_module, only: tem_LevelOf, tem_FirstIdAtLevel, & | |
78 | - & tem_PathComparison, tem_ParentOf, & | |
79 | - & tem_directChildren, tem_childNumber, & | |
80 | - & tem_PathOf, tem_path_type, tem_coordOfId, & | |
77 | + use tem_topology_module, only: tem_LevelOf, tem_FirstIdAtLevel, & | |
78 | + & tem_PathComparison, tem_ParentOf, & | |
79 | + & tem_directChildren, tem_childNumber, & | |
80 | + & tem_PathOf, tem_path_type, tem_coordOfId, & | |
81 | 81 | & tem_IDofCoord |
82 | 82 | use tem_property_module, only: prp_hasBnd, prp_solid |
83 | 83 | use tem_bc_prop_module, only: tem_bc_prop_type |
84 | - use tem_stencil_module, only: tem_stencilHeader_type, & | |
85 | - & tem_stencilElement_type, & | |
86 | - & tem_stencil_map_toTreelmDef, & | |
84 | + use tem_stencil_module, only: tem_stencilHeader_type, & | |
85 | + & tem_stencilElement_type, & | |
86 | + & tem_stencil_map_toTreelmDef, & | |
87 | 87 | & tem_stencil_getHeaderPos |
88 | - use tem_element_module, only: tem_element_type, tem_element_dump, & | |
89 | - & tem_eTypeOfID, & | |
90 | - & print_nElems, & | |
91 | - & init, append, PositionOfVal, truncate, & | |
92 | - & changeType, & | |
93 | - & eT_labels, & | |
94 | - & eT_fluid, eT_nonExisting, & | |
95 | - & eT_halo, destroy, & | |
96 | - & eT_ghostFromCoarser, eT_minNumber, & | |
97 | - & eT_ghostFromFiner, eT_maxNumber, & | |
98 | - & eT_minRelevant, eT_maxRelevant, & | |
99 | - & eT_undefined, & | |
88 | + use tem_element_module, only: tem_element_type, tem_element_dump, & | |
89 | + & tem_eTypeOfID, & | |
90 | + & print_nElems, & | |
91 | + & init, append, PositionOfVal, truncate, & | |
92 | + & changeType, & | |
93 | + & eT_labels, & | |
94 | + & eT_fluid, eT_nonExisting, & | |
95 | + & eT_halo, destroy, & | |
96 | + & eT_ghostFromCoarser, eT_minNumber, & | |
97 | + & eT_ghostFromFiner, eT_maxNumber, & | |
98 | + & eT_minRelevant, eT_maxRelevant, & | |
99 | + & eT_undefined, & | |
100 | 100 | & eT_distributedGhostFromFiner |
101 | 101 | use tem_halo_module, only: tem_haloList_type, tem_halo_append, & |
102 | 102 | & tem_halo_init, tem_halo_destroy |
@@ -304,7 +304,7 @@ | ||
304 | 304 | |
305 | 305 | contains |
306 | 306 | |
307 | -! ******************************************************************************* | |
307 | + ! ------------------------------------------------------------------------ ! | |
308 | 308 | !> call this routine from your geometry initialization routine in the solver |
309 | 309 | !! create all the necessary level-wise objects, such as element lists, |
310 | 310 | !! dependencies |
@@ -317,7 +317,7 @@ | ||
317 | 317 | subroutine tem_find_allElements( tree, levelDesc, levelPointer, & |
318 | 318 | & computeStencil, commPattern, cleanup, & |
319 | 319 | & reqNesting, proc ) |
320 | - ! --------------------------------------------------------------------------- | |
320 | + ! -------------------------------------------------------------------- ! | |
321 | 321 | !> the global tree |
322 | 322 | type(treelmesh_type), intent(inout) :: tree |
323 | 323 | !> the level descriptor to be filled |
@@ -334,13 +334,13 @@ | ||
334 | 334 | logical, intent(in), optional :: cleanup |
335 | 335 | !> Process description to use. |
336 | 336 | type(tem_comm_env_type), intent(in) :: proc |
337 | - ! --------------------------------------------------------------------------- | |
337 | + ! -------------------------------------------------------------------- ! | |
338 | 338 | ! Geometry and Tree related variables |
339 | 339 | integer :: iLevel |
340 | 340 | type( tem_path_type ), allocatable :: pathFirst(:), pathLast(:) |
341 | 341 | logical :: doAdditional |
342 | 342 | logical :: clean_constructionArrays |
343 | - ! --------------------------------------------------------------------------- | |
343 | + ! -------------------------------------------------------------------- ! | |
344 | 344 | |
345 | 345 | call tem_horizontalSpacer( fUnit = dbgUnit(1), before = 1 ) |
346 | 346 | write(dbgUnit(1),*) 'Inside routine: tem_find_allElements' |
@@ -374,12 +374,12 @@ | ||
374 | 374 | |
375 | 375 | ! Step 2: build levelDesc element list including identification of neighbor |
376 | 376 | ! elements |
377 | - call build_levelElements( levelDesc = levelDesc, & | |
378 | - & tree = tree, & | |
379 | - & proc = proc, & | |
380 | - & stencil = computeStencil(1), & | |
381 | - & pathFirst = pathFirst, & | |
382 | - & pathLast = pathLast ) | |
377 | + call build_levelElements( levelDesc = levelDesc, & | |
378 | + & tree = tree, & | |
379 | + & proc = proc, & | |
380 | + & stencil = computeStencil(1), & | |
381 | + & pathFirst = pathFirst, & | |
382 | + & pathLast = pathLast ) | |
383 | 383 | |
384 | 384 | ! Step 3: assign totalPnt to elem%tID in sorted fashion and prepare |
385 | 385 | ! haloPrc list |
@@ -393,13 +393,13 @@ | ||
393 | 393 | ! Each process checks whether requested element exist and returns |
394 | 394 | ! list of available elements. |
395 | 395 | ! With this new information halo list is redefined. |
396 | - call communicate_elements( tree, proc, levelDesc, commPattern, & | |
396 | + call communicate_elements( tree, proc, levelDesc, commPattern, & | |
397 | 397 | & pathFirst, pathLast, computeStencil ) |
398 | 398 | |
399 | 399 | ! Step 5: do additional communication if there are elements in require list |
400 | 400 | ! which are neighbors of higher order boundaries. |
401 | - call check_additionalComm( levelDesc, proc, doAdditional, & | |
402 | - & tree%global%minlevel ) | |
401 | + call check_additionalComm( levelDesc, proc, doAdditional, & | |
402 | + & tree%global%minlevel ) | |
403 | 403 | |
404 | 404 | ! If doAdditional then identify neighbors of higher order boundary |
405 | 405 | ! neighbor elements. |
@@ -407,22 +407,23 @@ | ||
407 | 407 | ! we need to communicate all halo elements again. |
408 | 408 | if( doAdditional ) then |
409 | 409 | ! passing only first stencil as this is the required compute stencil |
410 | - call identify_additionalNeigh( tree, proc, levelDesc, & | |
410 | + call identify_additionalNeigh( tree, proc, levelDesc, & | |
411 | 411 | & pathFirst, pathLast, computeStencil(1) ) |
412 | - call communicate_elements( tree, proc, levelDesc, commPattern, & | |
412 | + call communicate_elements( tree, proc, levelDesc, commPattern, & | |
413 | 413 | & pathFirst, pathLast, computeStencil ) |
414 | 414 | end if |
415 | 415 | |
416 | 416 | ! Step 6: assemble levelDesc total(treeID) list, property list and |
417 | 417 | ! pntTID list in sorted fashion (fluids+ghosts+halos) |
418 | 418 | ! which are pre-assembled in element type |
419 | - call assemble_lists( levelDesc, tree%global%minLevel, tree%global%maxLevel,& | |
420 | - & tree ) | |
419 | + call assemble_lists( levelDesc, & | |
420 | + & tree%global%minLevel, tree%global%maxLevel, & | |
421 | + & tree ) | |
421 | 422 | |
422 | 423 | ! Step 7: |
423 | 424 | call tem_build_levelPointer( levelPointer, tree, levelDesc ) |
424 | - call update_elemPosToTotalPos( levelDesc, levelPointer, tree, & | |
425 | - & computeStencil ) | |
425 | + call update_elemPosToTotalPos( levelDesc, levelPointer, tree, & | |
426 | + & computeStencil ) | |
426 | 427 | ! Warning: Truncation introduces a memory peak because of copy |
427 | 428 | ! operations! Better not use... |
428 | 429 | !call truncate_lists( levelDesc, tree%global%minLevel ) |
@@ -441,10 +442,10 @@ | ||
441 | 442 | call tem_horizontalSpacer( fUnit = dbgUnit(1), after = 1 ) |
442 | 443 | |
443 | 444 | end subroutine tem_find_allElements |
444 | -! ****************************************************************************** ! | |
445 | - | |
446 | - | |
447 | -! ****************************************************************************** ! | |
445 | + ! ------------------------------------------------------------------------ ! | |
446 | + | |
447 | + | |
448 | + ! ------------------------------------------------------------------------ ! | |
448 | 449 | !> subroutine to find neighbours of cells |
449 | 450 | !! |
450 | 451 | !! Typically every element requires information from its neighbors to perform |
@@ -511,11 +512,12 @@ | ||
511 | 512 | !! This interpolation usually has to take into account solver specific |
512 | 513 | !! requirements, but is otherwise quite isolated from the numerical operation |
513 | 514 | !! on each refinement level. |
514 | - !! The <em>TreElM library</em> offers the solver a level-wise view, as suggested | |
515 | - !! by the properties described above. | |
515 | + !! The <em>TreElM library</em> offers the solver a level-wise view, as | |
516 | + !! suggested by the properties described above. | |
516 | 517 | !! To find all required neighbors in the distributed octree, the solver merely |
517 | 518 | !! has to provide its horizontal dependencies. |
518 | - !! These are described with the help of an element specific [[tem_stencil_module]]. | |
519 | + !! These are described with the help of an element specific | |
520 | + !! [[tem_stencil_module]]. | |
519 | 521 | !! A stencil is basically a set of element-offsets \((s_x, s_y, s_z)\), |
520 | 522 | !! describing the relative positions of all required elements for a given |
521 | 523 | !! element. |
@@ -526,7 +528,7 @@ | ||
526 | 528 | !! including their `property, pntTID, stencil, neighID, sourceProc` |
527 | 529 | !! |
528 | 530 | subroutine tem_init_elemLevels( me, boundary, tree, stencils ) |
529 | - ! --------------------------------------------------------------------------- | |
531 | + ! -------------------------------------------------------------------- ! | |
530 | 532 | !> neighbor list containing all the neighbours for the |
531 | 533 | !! cells given in treeidsubset. Result of this routine |
532 | 534 | type(tem_levelDesc_type), allocatable, intent(out) :: me(:) |
@@ -536,7 +538,7 @@ | ||
536 | 538 | type(treelmesh_type), intent(in) :: tree |
537 | 539 | !> the given stencil |
538 | 540 | type(tem_stencilHeader_type), intent(in) :: stencils(:) |
539 | - ! --------------------------------------------------------------------------- | |
541 | + ! -------------------------------------------------------------------- ! | |
540 | 542 | type(tem_stencilElement_type) :: tStencil |
541 | 543 | integer :: posInTree, nElemsBnd, iQQN, iLevel, nProcs, hashpos |
542 | 544 | integer :: x(4), nStencils, iStencil, elemPos, nStencilElems |
@@ -547,7 +549,7 @@ | ||
547 | 549 | integer :: addedPos |
548 | 550 | logical :: wasAdded |
549 | 551 | integer :: posInBCID |
550 | - ! --------------------------------------------------------------------------- | |
552 | + ! -------------------------------------------------------------------- ! | |
551 | 553 | |
552 | 554 | call tem_horizontalSpacer( fUnit = dbgUnit(1), before = 1 ) |
553 | 555 | write(dbgUnit(1),*) 'Inside routine: tem_init_elemLevels ' |
@@ -646,14 +648,14 @@ | ||
646 | 648 | ! there already from previous stencil iterations |
647 | 649 | hashpos = int(mod( treeID, nHashes)) |
648 | 650 | if (hash(hashpos) /= treeID) then ! cache miss |
649 | - call append( me = me( x(4) )%elem, & | |
650 | - & tID = treeID, & | |
651 | - & pntTID = posInTree, & | |
652 | - & eType = eT_fluid, & | |
653 | - & nNeighIDs = QQN, & | |
654 | - & sourceProc = tree%global%myPart+1, & | |
655 | - & property = tree%ElemPropertyBits( posInTree ), & | |
656 | - & pos = elemPos ) | |
651 | + call append( me = me( x(4) )%elem, & | |
652 | + & tID = treeID, & | |
653 | + & pntTID = posInTree, & | |
654 | + & eType = eT_fluid, & | |
655 | + & nNeighIDs = QQN, & | |
656 | + & sourceProc = tree%global%myPart+1, & | |
657 | + & property = tree%ElemPropertyBits(posInTree), & | |
658 | + & pos = elemPos ) | |
657 | 659 | hash(hashpos) = treeID |
658 | 660 | hash_elemPos( hashpos ) = elemPos |
659 | 661 | else ! cache hit |
@@ -714,7 +716,7 @@ | ||
714 | 716 | call tem_elemList_dump( me = me( iLevel )%elem, & |
715 | 717 | & compact = .true., & |
716 | 718 | & nUnit = dbgUnit(5), & |
717 | - & stencil = .true., & | |
719 | + & stencil = .true., & | |
718 | 720 | & string = 'after initializing level elements' & |
719 | 721 | & //' i.e. only fluids') |
720 | 722 | if( me( iLevel )%require%nVals > 0 ) then |
@@ -730,16 +732,16 @@ | ||
730 | 732 | call tem_horizontalSpacer( fUnit = dbgUnit(1), after = 1 ) |
731 | 733 | |
732 | 734 | end subroutine tem_init_elemLevels |
733 | -! ****************************************************************************** ! | |
734 | - | |
735 | - | |
736 | -! ****************************************************************************** ! | |
735 | + ! ------------------------------------------------------------------------ ! | |
736 | + | |
737 | + | |
738 | + ! ------------------------------------------------------------------------ ! | |
737 | 739 | !> Assemble the fluid list and identify neighbor relations |
738 | 740 | !! start with building up the ghost and halo element collection as well |
739 | 741 | !! |
740 | 742 | subroutine build_levelElements( levelDesc, tree, proc, stencil, & |
741 | 743 | & pathFirst, pathLast ) |
742 | - ! --------------------------------------------------------------------------- | |
744 | + ! -------------------------------------------------------------------- ! | |
743 | 745 | !> the global tree |
744 | 746 | type(treelmesh_type), intent(in) :: tree |
745 | 747 | !> the level descriptor to be filled |
@@ -750,13 +752,13 @@ | ||
750 | 752 | type(tem_stencilHeader_type) :: stencil |
751 | 753 | !> first and last treeID path in every process |
752 | 754 | type(tem_path_type), intent(in) :: pathFirst(:), pathLast(:) |
753 | - ! --------------------------------------------------------------------------- | |
755 | + ! -------------------------------------------------------------------- ! | |
754 | 756 | integer(kind=long_k) :: neighID ! neighboring neighID |
755 | 757 | integer :: elemPos, minLevel, maxLevel |
756 | 758 | integer :: iElem, iNeighElem, iLevel, iStencil |
757 | 759 | ! position of where to read the stencil neighbor neighID in the element |
758 | 760 | integer :: neighPos |
759 | - ! --------------------------------------------------------------------------- | |
761 | + ! -------------------------------------------------------------------- ! | |
760 | 762 | |
761 | 763 | minLevel = tree%global%minLevel |
762 | 764 | maxLevel = tree%global%maxLevel |
@@ -843,19 +845,19 @@ | ||
843 | 845 | call tem_horizontalSpacer( fUnit = dbgUnit(1), after = 1 ) |
844 | 846 | |
845 | 847 | end subroutine build_levelElements |
846 | -! ****************************************************************************** ! | |
847 | - | |
848 | - | |
849 | -! ****************************************************************************** ! | |
848 | + ! ------------------------------------------------------------------------ ! | |
849 | + | |
850 | + | |
851 | + ! ------------------------------------------------------------------------ ! | |
850 | 852 | !> Check, on which partition a given element is located add required elements |
851 | 853 | !! to corresponding lists: |
852 | 854 | !! if remote, add to halo |
853 | 855 | !! if ghost, add to resp. ghost list |
854 | 856 | !! |
855 | 857 | recursive subroutine identify_elements( treeID, tree, pathFirst, pathLast, & |
856 | - & levelDesc, elemPos, proc, & | |
857 | - & Stencil, nesting ) | |
858 | - ! --------------------------------------------------------------------------- | |
858 | + & levelDesc, elemPos, proc, & | |
859 | + & Stencil, nesting ) | |
860 | + ! -------------------------------------------------------------------- ! | |
859 | 861 | !> treeID to identify |
860 | 862 | integer(kind=long_k), intent(in) :: treeID |
861 | 863 | !> tree information |
@@ -874,7 +876,7 @@ | ||
874 | 876 | type(tem_stencilHeader_type), intent(in) :: Stencil |
875 | 877 | !> nesting level |
876 | 878 | integer, intent(in) :: nesting |
877 | - ! --------------------------------------------------------------------------- | |
879 | + ! -------------------------------------------------------------------- ! | |
878 | 880 | integer(kind=long_k) :: children(8) ! child elements |
879 | 881 | integer :: nDepProcs ! processes that this neigh depend on |
880 | 882 | integer :: depProc |
@@ -887,38 +889,41 @@ | ||
887 | 889 | integer :: hashpos, elemNesting |
888 | 890 | logical :: cacheHit |
889 | 891 | logical :: updated ! was the element updated during identify_local_element |
890 | - ! --------------------------------------------------------------------------= | |
892 | + ! -------------------------------------------------------------------- ! | |
891 | 893 | ! Increase the nesting |
892 | 894 | nNesting = nesting + 1 |
893 | 895 | cacheHit = .false. |
894 | 896 | |
895 | -! write(dbgUnit(6),"(2(A,I8))") 'Identifying ', treeID, ' with nesting ', nesting | |
896 | - | |
897 | - if( treeID > 0 ) then ! it is a element, otherwise it is a bcID | |
898 | - neighLevel = tem_LevelOf( TreeID ) | |
899 | - elemPath = tem_PathOf( TreeID ) | |
897 | + if (treeID > 0) then ! it is a element, otherwise it is a bcID | |
898 | + neighLevel = tem_LevelOf(TreeID) | |
899 | + elemPath = tem_PathOf(TreeID) | |
900 | + | |
900 | 901 | hashpos = int(mod(TreeID, nHashes)) |
901 | - if( hash(hashpos) > -1_long_k ) then | |
902 | - ! something is in the hash | |
903 | - if( hash(hashpos) == TreeID ) then | |
904 | - if( nesting == levelDesc( neighlevel )%elem%haloNesting%val( & | |
905 | - & hash_elemPos( hashPos )) ) then | |
906 | - cacheHit = .true. | |
907 | - end if | |
908 | - if( levelDesc( neighlevel )%elem%needsUpdate%val( & | |
909 | - & hash_elemPos( hashPos )) ) then | |
910 | - cacheHit = .false. | |
911 | - ! Set the needs update to false as it was now updated | |
912 | - levelDesc( neighLevel )%elem%needsUpdate%val( & | |
913 | - & hash_elemPos( hashPos )) = .false. | |
914 | - end if | |
915 | - end if ! hash(hashpos) == treeID | |
916 | - end if ! hash(hashpos) > -1 | |
917 | - | |
918 | - !@todo: Reactivate the cache! The problem is that the nesting of an | |
919 | - !element is updated to 0 without actually looping over its neighbors! | |
920 | - !cacheHit = .false. | |
921 | - cachemiss: if( .not. cacheHit ) then | |
902 | + | |
903 | + hashmatch: if (hash(hashpos) == TreeID) then | |
904 | + | |
905 | + if ( nesting == levelDesc(neighlevel) & | |
906 | + & %elem & | |
907 | + & %haloNesting & | |
908 | + & %val(hash_elemPos(hashPos)) ) then | |
909 | + cacheHit = .true. | |
910 | + end if | |
911 | + if ( levelDesc(neighlevel) & | |
912 | + & %elem & | |
913 | + & %needsUpdate & | |
914 | + & %val(hash_elemPos(hashPos)) ) then | |
915 | + cacheHit = .false. | |
916 | + ! Set the needs update to false as it was now updated | |
917 | + levelDesc(neighLevel) & | |
918 | + & %elem & | |
919 | + & %needsUpdate & | |
920 | + & %val(hash_elemPos(hashPos)) = .false. | |
921 | + end if | |
922 | + | |
923 | + end if hashmatch | |
924 | + | |
925 | + cachemiss: if (.not. cacheHit) then | |
926 | + ! Cache miss | |
922 | 927 | ! Probably did not hit this element yet, put it in the hash now, |
923 | 928 | ! and identify it. |
924 | 929 | ! (If this treeID is already in the hash, we definitely have |
@@ -927,7 +932,6 @@ | ||
927 | 932 | ! the case of hash collisions, which should be pretty few, for |
928 | 933 | ! a sufficiently large hash. |
929 | 934 | ! ----------------------------------------------- |
930 | - ! Cache miss | |
931 | 935 | call tem_find_depProc( depProc = depProc, & |
932 | 936 | & nDepProcs = nDepProcs, & |
933 | 937 | & tree = tree, & |
@@ -936,13 +940,13 @@ | ||
936 | 940 | & PathLast = PathLast ) |
937 | 941 | |
938 | 942 | ! How many processes possess a part of the requested treeID |
939 | - if ( nDepProcs == 1 ) then | |
943 | + if (nDepProcs == 1) then | |
940 | 944 | updated = .false. |
941 | - ! might be a local or halo of same level or a ghostFromCoarser | |
945 | + ! Might be a local or halo of same level or a ghostFromCoarser | |
942 | 946 | ! or a ghostFromFiner. If halo and ghost it is distributed |
943 | 947 | ! in single process. |
944 | 948 | ! elemPos here is position of TreeID in levelDesc elem list |
945 | - call single_process_element( targetID = TreeID, & | |
949 | + call single_process_element( targetID = TreeID, & | |
946 | 950 | & levelDesc = levelDesc, & |
947 | 951 | & tree = tree, & |
948 | 952 | & proc = proc, & |
@@ -950,37 +954,42 @@ | ||
950 | 954 | & minLevel = tree%global%minlevel, & |
951 | 955 | & elemPos = elemPos, & |
952 | 956 | & updated = updated, & |
953 | - & stencil = Stencil, & | |
954 | - & nesting = nesting ) | |
955 | - elemNesting = min( nesting, & | |
956 | - levelDesc( neighLevel )%elem%haloNesting%val( elemPos ) ) | |
957 | - if ( nesting < levelDesc( neighLevel )%elem%haloNesting & | |
958 | - & %val( elemPos )) then | |
957 | + & stencil = Stencil, & | |
958 | + & nesting = nesting ) | |
959 | + | |
960 | + elemNesting = min( nesting, & | |
961 | + & levelDesc(neighLevel) & | |
962 | + & %elem & | |
963 | + & %haloNesting & | |
964 | + & %val(elemPos) ) | |
965 | + | |
966 | + if ( nesting < levelDesc(neighLevel)%elem%haloNesting & | |
967 | + & %val(elemPos) ) then | |
959 | 968 | ! element needs updating as the current nesting is smaller than the |
960 | 969 | ! one in the element property |
961 | - levelDesc( neighLevel )%elem%needsUpdate%val( elemPos ) = .true. | |
962 | - levelDesc( neighLevel )%elem%haloNesting%val( elemPos ) & | |
970 | + levelDesc(neighLevel)%elem%needsUpdate%val(elemPos) = .true. | |
971 | + levelDesc(neighLevel)%elem%haloNesting%val(elemPos) & | |
963 | 972 | & = elemNesting |
964 | 973 | updated = .true. |
965 | 974 | end if |
966 | 975 | |
967 | 976 | ! it is ghost from coarser element in current process proc%rank |
968 | - if( updated ) then | |
969 | - if ( levelDesc( neighLevel )%elem%eType%val( elemPos ) & | |
977 | + if (updated) then | |
978 | + if ( levelDesc( neighLevel )%elem%eType%val( elemPos ) & | |
970 | 979 | & == eT_ghostFromCoarser ) then |
971 | - if( nesting < nestingLimit ) then | |
980 | + if (nesting < nestingLimit) then | |
972 | 981 | ! Create the direct neighbors of the ghostFromCoarser |
973 | 982 | |
974 | 983 | ! identify all the compute neighbors of the current element |
975 | - call identify_stencilNeigh( iElem = elemPos, & | |
976 | - & iLevel = neighLevel, & | |
977 | - & tree = tree, & | |
978 | - & iStencil = 1, & | |
979 | - & pathFirst = pathFirst, & | |
980 | - & pathLast = pathLast, & | |
981 | - & levelDesc = levelDesc, & | |
982 | - & proc = proc, & | |
983 | - & stencil = Stencil, & | |
984 | + call identify_stencilNeigh( iElem = elemPos, & | |
985 | + & iLevel = neighLevel, & | |
986 | + & tree = tree, & | |
987 | + & iStencil = 1, & | |
988 | + & pathFirst = pathFirst, & | |
989 | + & pathLast = pathLast, & | |
990 | + & levelDesc = levelDesc, & | |
991 | + & proc = proc, & | |
992 | + & stencil = Stencil, & | |
984 | 993 | & nesting = elemNesting + 1 ) |
985 | 994 | |
986 | 995 | end if ! nesting < 1? |
@@ -1011,12 +1020,12 @@ | ||
1011 | 1020 | & headerPos = 1 ) |
1012 | 1021 | ! Add to the level-wise ghost list |
1013 | 1022 | ! append and store position of element for return |
1014 | - call append( me = levelDesc( neighLevel )%elem, & | |
1015 | - & tID = TreeID, & | |
1016 | - & property = 0_long_k, & | |
1017 | - & eType = eT_distributedGhostFromFiner, & | |
1018 | - & stencilElements = emptyStencil, & | |
1019 | - & pos = elemPos ) | |
1023 | + call append( me = levelDesc( neighLevel )%elem, & | |
1024 | + & tID = TreeID, & | |
1025 | + & property = 0_long_k, & | |
1026 | + & eType = eT_distributedGhostFromFiner, & | |
1027 | + & stencilElements = emptyStencil, & | |
1028 | + & pos = elemPos ) | |
1020 | 1029 | |
1021 | 1030 | !... and store the position in the ghost list ! |
1022 | 1031 | ! Now find all children of this ghost |
@@ -1043,7 +1052,7 @@ | ||
1043 | 1052 | & // 'points to a bug or a buggy mesh.' |
1044 | 1053 | end if |
1045 | 1054 | |
1046 | - if( elemPos > 0 ) then | |
1055 | + if (elemPos > 0) then | |
1047 | 1056 | ! Set the encountered element position to the hash |
1048 | 1057 | hash(hashpos) = TreeID |
1049 | 1058 | hash_elemPos( hashpos ) = elemPos |
@@ -1054,21 +1063,20 @@ | ||
1054 | 1063 | ! ----------------------------------------------- |
1055 | 1064 | ! Cache hit, i.e. element already in levelDesc%elem, just update nesting |
1056 | 1065 | elemPos = hash_elemPos( hashpos ) |
1057 | - levelDesc( neighLevel )%elem%haloNesting%val( elemPos ) & | |
1058 | - & = min( levelDesc( neighLevel )%elem%haloNesting%val(elemPos), & | |
1059 | - & nesting ) | |
1066 | + levelDesc( neighLevel )%elem%haloNesting%val( elemPos ) & | |
1067 | + & = min( levelDesc( neighLevel )%elem%haloNesting%val(elemPos), & | |
1068 | + & nesting ) | |
1060 | 1069 | ! ----------------------------------------------- |
1061 | 1070 | end if cachemiss |
1062 | 1071 | else ! treeID <= 0, i.e. it is a bcID |
1063 | 1072 | elemPos = int( TreeID ) |
1064 | 1073 | end if ! TreeID > 0 |
1065 | 1074 | |
1066 | - | |
1067 | 1075 | end subroutine identify_elements |
1068 | -! ****************************************************************************** ! | |
1069 | - | |
1070 | - | |
1071 | -! ****************************************************************************** ! | |
1076 | + ! ------------------------------------------------------------------------ ! | |
1077 | + | |
1078 | + | |
1079 | + ! ------------------------------------------------------------------------ ! | |
1072 | 1080 | !> Find the partitions holding data on a given path |
1073 | 1081 | !! |
1074 | 1082 | !! Using a binary search over the processes first and last elements. |
@@ -1085,7 +1093,7 @@ | ||
1085 | 1093 | !! inside of one or several known partitions. |
1086 | 1094 | subroutine tem_find_depProc( depProc, nDepProcs, tree, elemPath, PathFirst, & |
1087 | 1095 | & PathLast ) |
1088 | - ! --------------------------------------------------------------------------- | |
1096 | + ! -------------------------------------------------------------------- ! | |
1089 | 1097 | !> List of partitions |
1090 | 1098 | integer, intent(out) :: depProc |
1091 | 1099 | !> Number of partitions |
@@ -1098,11 +1106,11 @@ | ||
1098 | 1106 | type(tem_path_type), intent(in) :: PathFirst(:) |
1099 | 1107 | !> Right partition bounds |
1100 | 1108 | type(tem_path_type), intent(in) :: PathLast(:) |
1101 | - ! --------------------------------------------------------------------------- | |
1109 | + ! -------------------------------------------------------------------- ! | |
1102 | 1110 | integer :: p_lb, p_ub ! process lower and upper bound |
1103 | 1111 | integer :: relFirst, relLast |
1104 | 1112 | integer :: myRank |
1105 | - ! --------------------------------------------------------------------------- | |
1113 | + ! -------------------------------------------------------------------- ! | |
1106 | 1114 | myRank = tree%global%myPart |
1107 | 1115 | |
1108 | 1116 | nDepProcs = 0 |
@@ -1157,10 +1165,10 @@ | ||
1157 | 1165 | end if ! local or non-local |
1158 | 1166 | |
1159 | 1167 | end subroutine tem_find_depProc |
1160 | -! ****************************************************************************** ! | |
1161 | - | |
1162 | - | |
1163 | -! ****************************************************************************** ! | |
1168 | + ! ------------------------------------------------------------------------ ! | |
1169 | + | |
1170 | + | |
1171 | + ! ------------------------------------------------------------------------ ! | |
1164 | 1172 | !> Find the remote partitions holding data on a given path |
1165 | 1173 | !! |
1166 | 1174 | !! Using a binary search over the processes first and last elements. |
@@ -1177,7 +1185,7 @@ | ||
1177 | 1185 | !! inside of one or several known partitions. |
1178 | 1186 | subroutine tem_find_depProc_globSearch( depProc, nDepProcs, elemPath, p_lb, & |
1179 | 1187 | & p_ub, PathFirst, PathLast) |
1180 | - ! --------------------------------------------------------------------------- | |
1188 | + ! -------------------------------------------------------------------- ! | |
1181 | 1189 | !> List of partitions |
1182 | 1190 | integer, intent(out) :: depProc |
1183 | 1191 | !> Number of partitions |
@@ -1192,12 +1200,12 @@ | ||
1192 | 1200 | integer, intent(in) :: p_lb |
1193 | 1201 | !> Right interval bound to search in |
1194 | 1202 | integer, intent(in) :: p_ub |
1195 | - ! --------------------------------------------------------------------------- | |
1203 | + ! -------------------------------------------------------------------- ! | |
1196 | 1204 | integer :: lb, ub |
1197 | 1205 | integer :: foundProc, lastProc |
1198 | 1206 | integer :: curProc |
1199 | 1207 | integer :: pComp |
1200 | - ! --------------------------------------------------------------------------- | |
1208 | + ! -------------------------------------------------------------------- ! | |
1201 | 1209 | |
1202 | 1210 | lb = p_lb |
1203 | 1211 | ub = p_ub |
@@ -1292,10 +1300,10 @@ | ||
1292 | 1300 | end if |
1293 | 1301 | |
1294 | 1302 | end subroutine tem_find_depProc_globSearch |
1295 | -! ****************************************************************************** ! | |
1296 | - | |
1297 | - | |
1298 | -! ****************************************************************************** ! | |
1303 | + ! ------------------------------------------------------------------------ ! | |
1304 | + | |
1305 | + | |
1306 | + ! ------------------------------------------------------------------------ ! | |
1299 | 1307 | !> create all the neighbors of an element's parent |
1300 | 1308 | !! |
1301 | 1309 | !! Create all elements required up to the actual existing fluid |
@@ -1306,10 +1314,10 @@ | ||
1306 | 1314 | !! |
1307 | 1315 | !! Here the fromCoarser interpolation should be handed in. |
1308 | 1316 | !! |
1309 | - recursive subroutine create_allParentNeighbors( & | |
1310 | - & targetID, level, stencil, tree, levelDesc, & | |
1311 | - & pathFirst, pathLast, proc ) | |
1312 | - ! --------------------------------------------------------------------------- | |
1317 | + recursive subroutine create_allParentNeighbors( & | |
1318 | + & targetID, level, stencil, tree, levelDesc, & | |
1319 | + & pathFirst, pathLast, proc ) | |
1320 | + ! -------------------------------------------------------------------- ! | |
1313 | 1321 | !> requested element position (child element) in LevelDesc elem list |
1314 | 1322 | integer(kind=long_k), intent(in) :: targetID |
1315 | 1323 | !> requested element level |
@@ -1326,28 +1334,28 @@ | ||
1326 | 1334 | type(tem_comm_env_type), intent(in) :: proc |
1327 | 1335 | !> current stencil definition |
1328 | 1336 | type(tem_stencilHeader_type), intent(in) :: stencil |
1329 | - ! --------------------------------------------------------------------------= | |
1337 | + ! -------------------------------------------------------------------- ! | |
1330 | 1338 | integer(kind=long_k) :: parentID ! current tree ID |
1331 | 1339 | integer :: coarserLevel, cPos, parentNesting |
1332 | - ! --------------------------------------------------------------------------- | |
1340 | + ! -------------------------------------------------------------------- ! | |
1333 | 1341 | |
1334 | 1342 | ! exit if we have reached the minimal level |
1335 | - if( level == tree%global%minlevel ) return | |
1343 | + if ( level == tree%global%minlevel ) return | |
1336 | 1344 | |
1337 | 1345 | ! Get the parent of the current treeID |
1338 | 1346 | parentID = tem_parentOf( targetID ) |
1339 | 1347 | |
1340 | 1348 | ! ... and identify the parent |
1341 | 1349 | parentNesting = -1 |
1342 | - call identify_elements( TreeID = parentID, & | |
1343 | - & tree = tree, & | |
1344 | - & pathFirst = pathFirst, & | |
1345 | - & pathLast = pathLast, & | |
1346 | - & levelDesc = levelDesc, & | |
1347 | - & elemPos = cPos, & | |
1348 | - & proc = proc, & | |
1349 | - & stencil = stencil, & | |
1350 | - & nesting = -1 ) | |
1350 | + call identify_elements( TreeID = parentID, & | |
1351 | + & tree = tree, & | |
1352 | + & pathFirst = pathFirst, & | |
1353 | + & pathLast = pathLast, & | |
1354 | + & levelDesc = levelDesc, & | |
1355 | + & elemPos = cPos, & | |
1356 | + & proc = proc, & | |
1357 | + & stencil = stencil, & | |
1358 | + & nesting = -1 ) | |
1351 | 1359 | |
1352 | 1360 | if ( cPos <= 0 ) then |
1353 | 1361 | write(dbgUnit(3),*) ' Element not found: ', parentID |
@@ -1358,29 +1366,29 @@ | ||
1358 | 1366 | ! Here we should identify the fromCoarser interpolation stencil neighbors |
1359 | 1367 | ! instead of the compute stencil neighbors |
1360 | 1368 | coarserLevel = level - 1 |
1361 | - call identify_stencilNeigh( iElem = cPos, & | |
1362 | - & iLevel = coarserLevel, & | |
1363 | - & tree = tree, & | |
1364 | - & iStencil = 1, & | |
1365 | - & pathFirst = pathFirst, & | |
1366 | - & pathLast = pathLast, & | |
1367 | - & levelDesc = levelDesc, & | |
1368 | - & proc = proc, & | |
1369 | - & stencil = stencil, & | |
1370 | - & nesting = parentNesting ) | |
1369 | + call identify_stencilNeigh( iElem = cPos, & | |
1370 | + & iLevel = coarserLevel, & | |
1371 | + & tree = tree, & | |
1372 | + & iStencil = 1, & | |
1373 | + & pathFirst = pathFirst, & | |
1374 | + & pathLast = pathLast, & | |
1375 | + & levelDesc = levelDesc, & | |
1376 | + & proc = proc, & | |
1377 | + & stencil = stencil, & | |
1378 | + & nesting = parentNesting ) | |
1371 | 1379 | |
1372 | 1380 | end subroutine create_allParentNeighbors |
1373 | -! ****************************************************************************** ! | |
1374 | - | |
1375 | - | |
1376 | -! ****************************************************************************** ! | |
1381 | + ! ------------------------------------------------------------------------ ! | |
1382 | + | |
1383 | + | |
1384 | + ! ------------------------------------------------------------------------ ! | |
1377 | 1385 | !> Invoke the identify_elements for each neighbor of the stencil |
1378 | 1386 | !! and store the positions of the encountered elements |
1379 | 1387 | !! |
1380 | - recursive subroutine identify_stencilNeigh( iElem, iLevel, iStencil, tree, & | |
1381 | - & pathFirst, pathLast, levelDesc, & | |
1382 | - & proc, stencil, nesting ) | |
1383 | - ! --------------------------------------------------------------------------- | |
1388 | + recursive subroutine identify_stencilNeigh( iElem, iLevel, iStencil, tree, & | |
1389 | + & pathFirst, pathLast, levelDesc, & | |
1390 | + & proc, stencil, nesting ) | |
1391 | + ! -------------------------------------------------------------------- ! | |
1384 | 1392 | !> element position in levelDesc to identify |
1385 | 1393 | integer, intent(in) :: iElem |
1386 | 1394 | !> element level |
@@ -1401,29 +1409,29 @@ | ||
1401 | 1409 | type(tem_stencilHeader_type), intent(in) :: stencil |
1402 | 1410 | !> nesting level |
1403 | 1411 | integer, intent(in) :: nesting |
1404 | - ! --------------------------------------------------------------------------- | |
1412 | + ! -------------------------------------------------------------------- ! | |
1405 | 1413 | integer :: iStencilElem, elemPos |
1406 | 1414 | integer :: neighIDpos |
1407 | 1415 | integer(kind=long_k) :: neighID |
1408 | - ! --------------------------------------------------------------------------- | |
1416 | + ! -------------------------------------------------------------------- ! | |
1409 | 1417 | ! identify all the compute neighbors of the current element |
1410 | 1418 | do iStencilElem = 1, stencil%QQN |
1411 | - neighIDpos = levelDesc( iLevel )%elem%stencil%val( iElem ) & | |
1412 | - & %val( iStencil )%tIDpos( iStencilElem ) | |
1419 | + neighIDpos = levelDesc(iLevel)%elem%stencil%val(iElem) & | |
1420 | + & %val(iStencil)%tIDpos(iStencilElem) | |
1413 | 1421 | if( neighIDpos > 0 ) then |
1414 | 1422 | neighID = & |
1415 | - & levelDesc( iLevel )%elem%neighID%val( iElem )%val( neighIDpos ) | |
1423 | + & levelDesc( iLevel )%elem%neighID%val(iElem)%val(neighIDpos) | |
1416 | 1424 | ! This call might add new halo elements |
1417 | 1425 | if ( neighID > 0_long_k ) then |
1418 | - call identify_elements( TreeID = neighID, & | |
1419 | - & tree = tree, & | |
1420 | - & pathFirst = pathFirst, & | |
1421 | - & pathLast = pathLast, & | |
1422 | - & levelDesc = levelDesc, & | |
1423 | - & elemPos = elemPos, & | |
1424 | - & proc = proc, & | |
1425 | - & stencil = stencil, & | |
1426 | - & nesting = nesting ) | |
1426 | + call identify_elements( TreeID = neighID, & | |
1427 | + & tree = tree, & | |
1428 | + & pathFirst = pathFirst, & | |
1429 | + & pathLast = pathLast, & | |
1430 | + & levelDesc = levelDesc, & | |
1431 | + & elemPos = elemPos, & | |
1432 | + & proc = proc, & | |
1433 | + & stencil = stencil, & | |
1434 | + & nesting = nesting ) | |
1427 | 1435 | else ! neighID < 0 |
1428 | 1436 | elemPos = 0 |
1429 | 1437 | end if |
@@ -1433,24 +1441,25 @@ | ||
1433 | 1441 | |
1434 | 1442 | ! And add the encountered neighbor elements to the current element's |
1435 | 1443 | ! stencil neighbors |
1436 | - levelDesc( iLevel )%elem%stencil%val( iElem ) & | |
1437 | - & %val( iStencil )%totalPos( iStencilElem ) = elemPos | |
1444 | + levelDesc(iLevel)%elem%stencil%val(iElem) & | |
1445 | + & %val(iStencil)%totalPos(iStencilElem) = elemPos | |
1438 | 1446 | end do |
1439 | 1447 | |
1440 | 1448 | end subroutine identify_stencilNeigh |
1441 | -! ****************************************************************************** ! | |
1442 | - | |
1443 | - | |
1444 | -! ****************************************************************************** ! | |
1449 | + ! ------------------------------------------------------------------------ ! | |
1450 | + | |
1451 | + | |
1452 | + ! ------------------------------------------------------------------------ ! | |
1445 | 1453 | !> Determine the location (which process) of a requested element, |
1446 | 1454 | !! which was identified to be located on one single process |
1447 | 1455 | !! (can be local or remote) |
1448 | 1456 | !! If it is located on a remote process: add to halo list |
1449 | 1457 | !! local process: identify if ghost or fluid |
1450 | 1458 | !! |
1451 | - subroutine single_process_element( targetID, levelDesc, tree, proc, iProc, & | |
1452 | - & minLevel, elemPos, stencil, nesting, updated ) | |
1453 | - ! --------------------------------------------------------------------------- | |
1459 | + subroutine single_process_element( targetID, levelDesc, tree, proc, iProc, & | |
1460 | + & minLevel, elemPos, stencil, nesting, & | |
1461 | + & updated ) | |
1462 | + ! -------------------------------------------------------------------- ! | |
1454 | 1463 | !> neighboring treeID |
1455 | 1464 | integer(kind=long_k), intent(in) :: targetID |
1456 | 1465 | !> minimum level fluid element in the tree |
@@ -1471,56 +1480,66 @@ | ||
1471 | 1480 | integer, intent(in) :: nesting |
1472 | 1481 | !> was the element updated in this call? |
1473 | 1482 | logical, intent(out) :: updated |
1474 | - ! --------------------------------------------------------------------------- | |
1483 | + ! -------------------------------------------------------------------- ! | |
1475 | 1484 | type(tem_stencilElement_type) :: emptyStencil(1) |
1476 | 1485 | integer :: targetLevel |
1477 | 1486 | logical :: wasAdded |
1478 | - ! --------------------------------------------------------------------------- | |
1479 | - | |
1480 | - targetLevel = tem_LevelOf( targetID ) ! Has to be same as tLevel!? | |
1481 | - if(( targetLevel < minLevel ) & | |
1482 | - & .or. (targetLevel > uBound(levelDesc,1)) ) then | |
1487 | + ! -------------------------------------------------------------------- ! | |
1488 | + | |
1489 | + targetLevel = tem_LevelOf(targetID) ! Has to be same as tLevel!? | |
1490 | + if ( (targetLevel < minLevel) & | |
1491 | + & .or. (targetLevel > uBound(levelDesc,1)) ) then | |
1483 | 1492 | write(logUnit(1),*) ' ERROR: level which is not included in the fluid'// & |
1484 | 1493 | & ' tree was demanded in singleProcNeigh' |
1485 | - write(logUnit(1),"(2(A,I0))") 'treeID: ', targetID, ', level: ', targetLevel | |
1494 | + write(logUnit(1),"(2(A,I0))") 'treeID: ', targetID, ', level: ', & | |
1495 | + & targetLevel | |
1486 | 1496 | call tem_abort() |
1487 | 1497 | end if |
1498 | + | |
1488 | 1499 | ! Set the element updated flag as a default to false |
1489 | 1500 | updated = .false. |
1490 | 1501 | |
1491 | 1502 | ! If it is a remote cell on only one process -> regular halo |
1492 | - if( iProc /= proc%rank + 1 ) then | |
1503 | + if (iProc /= proc%rank + 1) then | |
1493 | 1504 | ! REMOTE |
1494 | 1505 | call init( me = emptyStencil(1), QQN=stencil%QQN ) |
1506 | + | |
1495 | 1507 | ! append this targetID as halo element to levelDesc elem list |
1496 | - call append( me = levelDesc( targetLevel )%elem, & | |
1497 | - & tID = targetID, & | |
1498 | - & eType = eT_halo, & | |
1499 | - & property = 0_long_k, & | |
1500 | - & sourceProc = iProc, & | |
1501 | - & haloNesting = nesting, & | |
1502 | - & stencilElements = emptyStencil, & | |
1503 | - & pos = elemPos, & | |
1504 | - & wasAdded = wasAdded ) | |
1505 | - | |
1506 | - if( .not. wasAdded ) then | |
1507 | - ! update the nesting to the current one | |
1508 | - if( nesting < levelDesc( targetLevel )%elem%haloNesting% & | |
1509 | - & val( elemPos )) then | |
1510 | - levelDesc( targetLevel )%elem%needsUpdate%val( elemPos ) = .true. | |
1511 | - levelDesc( targetLevel )%elem%haloNesting%val( elemPos ) & | |
1512 | - & = min( levelDesc( targetLevel )%elem%haloNesting%val( elemPos ), & | |
1513 | - & nesting ) | |
1514 | - updated = .true. | |
1515 | - end if | |
1508 | + call append( me = levelDesc(targetLevel)%elem, & | |
1509 | + & tID = targetID, & | |
1510 | + & eType = eT_halo, & | |
1511 | + & property = 0_long_k, & | |
1512 | + & sourceProc = iProc, & | |
1513 | + & haloNesting = nesting, & | |
1514 | + & stencilElements = emptyStencil, & | |
1515 | + & pos = elemPos, & | |
1516 | + & wasAdded = wasAdded ) | |
1517 | + | |
1518 | + if (.not. wasAdded) then | |
1519 | + ! If this element was already there, make sure we use the minimal | |
1520 | + ! nesting level requested for this element. | |
1521 | + updated = ( nesting < levelDesc(targetLevel) & | |
1522 | + & %elem & | |
1523 | + & %haloNesting & | |
1524 | + & %val(elemPos) ) | |
1525 | + ! If the nesting has been updated (decreased, we need to revisit this | |
1526 | + ! element in search for its neighbors). | |
1527 | + levelDesc(targetLevel)%elem%needsUpdate%val(elemPos) = updated | |
1528 | + | |
1529 | + levelDesc(targetLevel)%elem%haloNesting%val(elemPos) & | |
1530 | + & = min( levelDesc(targetLevel)%elem%haloNesting%val(elemPos), & | |
1531 | + & nesting ) | |
1516 | 1532 | else |
1533 | + ! New halo element added | |
1517 | 1534 | updated = .true. |
1518 | 1535 | write(dbgUnit(7),"(A,I0)") 'Added as a Halo: ', targetID, & |
1519 | 1536 | & 'to level: ', targetLevel |
1520 | 1537 | end if ! wasAdded |
1538 | + | |
1521 | 1539 | else ! iProc == proc%rank + 1 |
1522 | 1540 | ! LOCAL |
1523 | - ! Either a ghost or fluid cell | |
1541 | + | |
1542 | + ! Either a local ghost or fluid cell | |
1524 | 1543 | call identify_local_element( targetID = targetID, & |
1525 | 1544 | & levelDesc = levelDesc, & |
1526 | 1545 | & tree = tree, & |
@@ -1532,10 +1551,10 @@ | ||
1532 | 1551 | end if ! iProc /= proc%rank + 1 |
1533 | 1552 | |
1534 | 1553 | end subroutine single_process_element |
1535 | -! ****************************************************************************** ! | |
1536 | - | |
1537 | - | |
1538 | -! ****************************************************************************** ! | |
1554 | + ! ------------------------------------------------------------------------ ! | |
1555 | + | |
1556 | + | |
1557 | + ! ------------------------------------------------------------------------ ! | |
1539 | 1558 | !> Determine if the target element (local) targetID is fluid or ghost in the |
1540 | 1559 | !! local process |
1541 | 1560 | !! If fluid: do nothing, as it will be added later on anyway (or already is) |
@@ -1546,8 +1565,8 @@ | ||
1546 | 1565 | !! not existing( localPos=0): add to halo |
1547 | 1566 | !! |
1548 | 1567 | subroutine identify_local_element( targetID, levelDesc, tree, minLevel, & |
1549 | - & elemPos, nesting, updated, stencil ) | |
1550 | - ! --------------------------------------------------------------------------- | |
1568 | + & elemPos, nesting, updated, stencil ) | |
1569 | + ! -------------------------------------------------------------------- ! | |
1551 | 1570 | !> neighboring treeID |
1552 | 1571 | integer(kind=long_k), intent(in) :: targetID |
1553 | 1572 | !> minimum level fluid element in the tree |
@@ -1564,11 +1583,11 @@ | ||
1564 | 1583 | integer, intent(out) :: elemPos |
1565 | 1584 | !> was the element updated in this call? |
1566 | 1585 | logical, intent(out) :: updated |
1567 | - ! --------------------------------------------------------------------------- | |
1586 | + ! -------------------------------------------------------------------- ! | |
1568 | 1587 | integer :: localPos, targetLevel, dPos, fluidLevel |
1569 | 1588 | integer(kind=long_k) :: fluidID |
1570 | 1589 | type(tem_path_type) :: targetPath |
1571 | - ! --------------------------------------------------------------------------- | |
1590 | + ! -------------------------------------------------------------------- ! | |
1572 | 1591 | ! Set the element updated flag as a default to false |
1573 | 1592 | updated = .false. |
1574 | 1593 |
@@ -1583,17 +1602,18 @@ | ||
1583 | 1602 | ! - fluid |
1584 | 1603 | ! - ghostFromCoarser |
1585 | 1604 | ! - ghostFromFiner |
1586 | - if( localPos > 0) then | |
1605 | + if (localPos > 0) then | |
1587 | 1606 | ! Path exist. It may be GhostFromCoarser or FLUID |
1588 | 1607 | fluidID = tree%treeID( localPos ) |
1589 | 1608 | fluidLevel = tem_LevelOf( fluidID ) |
1590 | 1609 | |
1591 | - if( fluidLevel == targetLevel ) then | |
1610 | + if (fluidLevel == targetLevel) then | |
1592 | 1611 | ! It is a FLUID. Already exists in element list |
1593 | 1612 | updated = .false. |
1594 | - elemPos = PositionOfVal( me = levelDesc( targetLevel )%elem%tID, & | |
1595 | - & val = targetID ) | |
1596 | - elseif( fluidLevel < targetLevel ) then | |
1613 | + elemPos = PositionOfVal( me = levelDesc( targetLevel )%elem%tID, & | |
1614 | + & val = targetID ) | |
1615 | + | |
1616 | + else if (fluidLevel < targetLevel) then | |
1597 | 1617 | ! Target element is a GhostFromCoarser. |
1598 | 1618 | ! Target element is a descendant of Fluid element. |
1599 | 1619 | ! --------------- |
@@ -1605,25 +1625,26 @@ | ||
1605 | 1625 | ! | T | | |
1606 | 1626 | ! | | | |
1607 | 1627 | ! --------------- |
1608 | - ! Add all the descendants of Fluid down to target( including intermediate levels) | |
1609 | - ! LBM specific. | |
1610 | - call add_all_virtual_children( & | |
1611 | - & sourceID = fluidID, & | |
1612 | - & foundPos = localPos, & | |
1613 | - & elemPath = targetPath, & | |
1614 | - & sourceProperty = tree%ElemPropertyBits( localPos ), & | |
1615 | - & targetLevel = targetLevel, & | |
1616 | - & levelDesc = levelDesc, & | |
1617 | - & minlevel = minLevel, & | |
1618 | - & nesting = nesting, & | |
1619 | - & updated = updated, & | |
1620 | - & tree = tree, & | |
1621 | - & Stencil = stencil ) | |
1628 | + ! Add all the descendants of Fluid down to target( including | |
1629 | + ! intermediate levels). | |
1630 | + call add_all_virtual_children( & | |
1631 | + & sourceID = fluidID, & | |
1632 | + & foundPos = localPos, & | |
1633 | + & elemPath = targetPath, & | |
1634 | + & sourceProperty = tree%ElemPropertyBits(localPos), & | |
1635 | + & targetLevel = targetLevel, & | |
1636 | + & levelDesc = levelDesc, & | |
1637 | + & minlevel = minLevel, & | |
1638 | + & nesting = nesting, & | |
1639 | + & updated = updated, & | |
1640 | + & tree = tree, & | |
1641 | + & Stencil = stencil ) | |
1622 | 1642 | end if ! on same level? |
1623 | - else if( localPos < 0) then | |
1643 | + | |
1644 | + else if (localPos < 0) then | |
1624 | 1645 | ! ghostFromFiner |
1625 | 1646 | ! Find all existing fluid cells within requested targetID position |
1626 | - ! Add all the parent between requested targetID and available child ID in | |
1647 | + ! Add all the parents between requested targetID and available child ID in | |
1627 | 1648 | ! treeID list |
1628 | 1649 | call add_ghostFromFiner( elemID = targetID, & |
1629 | 1650 | & levelDesc = levelDesc, & |
@@ -1632,7 +1653,9 @@ | ||
1632 | 1653 | & foundPos = dPos, & |
1633 | 1654 | & updated = updated, & |
1634 | 1655 | & stencil = stencil ) |
1656 | + | |
1635 | 1657 | else ! localPos == 0 |
1658 | + | |
1636 | 1659 | write(dbgUnit(6),*) 'Warning: element not existing ', targetID, & |
1637 | 1660 | & 'adding to nonexisting ...' |
1638 | 1661 | call tem_tIDinfo( me = targetID, tree = tree, nUnit = dbgUnit(6) ) |
@@ -1648,22 +1671,22 @@ | ||
1648 | 1671 | endif ! localPos > 0? coarser ghost or fluid? |
1649 | 1672 | |
1650 | 1673 | ! position of added targetID in the levelDesc elem list |
1651 | - elemPos = PositionOfVal( me = levelDesc( targetLevel )%elem%tID, & | |
1652 | - & val = targetID ) | |
1674 | + elemPos = PositionOfVal( me = levelDesc( targetLevel )%elem%tID, & | |
1675 | + & val = targetID ) | |
1653 | 1676 | |
1654 | 1677 | end subroutine identify_local_element |
1655 | -! ****************************************************************************** ! | |
1656 | - | |
1657 | - | |
1658 | -! ****************************************************************************** ! | |
1678 | + ! ------------------------------------------------------------------------ ! | |
1679 | + | |
1680 | + | |
1681 | + ! ------------------------------------------------------------------------ ! | |
1659 | 1682 | !> Find all the virtual children of the sourceID down to the targetLevel |
1660 | 1683 | !! and add to the level-wise ghostFromCoarser list in the level descriptor |
1661 | 1684 | !! |
1662 | - recursive subroutine add_all_virtual_children( & | |
1663 | - & sourceID, sourceProperty, foundPos, elemPath, & | |
1664 | - & targetLevel, levelDesc, minLevel, tree, Stencil,& | |
1665 | - & nesting, updated ) | |
1666 | - ! --------------------------------------------------------------------------- | |
1685 | + recursive subroutine add_all_virtual_children( & | |
1686 | + & sourceID, sourceProperty, foundPos, elemPath, & | |
1687 | + & targetLevel, levelDesc, minLevel, tree, & | |
1688 | + & stencil, nesting, updated ) | |
1689 | + ! -------------------------------------------------------------------- ! | |
1667 | 1690 | !> source treeID (existing founded ID in tree%treeID list or children ID |
1668 | 1691 | !! from recursion) |
1669 | 1692 | integer(kind=long_k), intent(in) :: sourceID |
@@ -1687,7 +1710,7 @@ | ||
1687 | 1710 | type(tem_stencilHeader_type), intent(in) :: stencil |
1688 | 1711 | !> was the element updated in this call? |
1689 | 1712 | logical, intent(out) :: updated |
1690 | - ! --------------------------------------------------------------------------- | |
1713 | + ! -------------------------------------------------------------------- ! | |
1691 | 1714 | integer :: targetPos, iChild, iDir, nVals, sourceLevel |
1692 | 1715 | ! position of the existing (source) tID in the elem list |
1693 | 1716 | integer :: sourcePos |
@@ -1700,59 +1723,62 @@ | ||
1700 | 1723 | type(tem_stencilElement_type) :: tStencil(1) |
1701 | 1724 | integer :: iChildCoord(4), curLevel, offset(4), xc(4), childCoord(4) |
1702 | 1725 | integer :: addedPos |
1703 | - ! --------------------------------------------------------------------------- | |
1726 | + ! -------------------------------------------------------------------- ! | |
1704 | 1727 | |
1705 | 1728 | !Position of the coarser source element |
1706 | - sourceLevel = tem_LevelOf( sourceID ) | |
1707 | - sourcePos = PositionOfVal( me = levelDesc( sourceLevel )%elem%tID, & | |
1708 | - & val = sourceID ) | |
1709 | - allocate( tNeighID( stencil%QQN )) | |
1729 | + sourceLevel = tem_LevelOf(sourceID) | |
1730 | + sourcePos = PositionOfVal( me = levelDesc( sourceLevel )%elem%tID, & | |
1731 | + & val = sourceID ) | |
1732 | + allocate( tNeighID(stencil%QQN) ) | |
1710 | 1733 | offset(4) = 0 |
1734 | + | |
1711 | 1735 | ! By default, set that no element was updated |
1712 | 1736 | updated = .false. |
1713 | 1737 | childUpdated = .false. |
1714 | 1738 | |
1715 | 1739 | ! create virual children until target level is reached |
1716 | - if( sourceLevel < targetLevel ) then | |
1740 | + if ( sourceLevel < targetLevel ) then | |
1717 | 1741 | curLevel = sourceLevel + 1 |
1718 | 1742 | call init( me = tStencil(1), QQN = stencil%QQN, headerPos = 1 ) |
1719 | 1743 | ! Add to the level-wise ghost list |
1720 | 1744 | cTreeID = elemPath%node( targetLevel - sourceLevel ) |
1721 | - call append( me = levelDesc( curLevel )%elem, & | |
1722 | - & tID = cTreeID, & | |
1723 | - & property = sourceProperty, & | |
1724 | - & eType = eT_ghostFromCoarser, & | |
1725 | - & sourceProc = tree%global%myPart+1, & | |
1726 | - & stencilElements = tStencil, & | |
1727 | - & pos = targetPos, & | |
1728 | - & haloNesting = nesting, & | |
1729 | - & wasAdded = wasAdded ) | |
1730 | - | |
1731 | - if( wasAdded ) then | |
1732 | - | |
1733 | - write(dbgUnit(7),"(2(A,I0))") 'Added as a GhostFromCoarser: ', cTreeID, & | |
1734 | - & ', to level: ', curLevel | |
1745 | + call append( me = levelDesc( curLevel )%elem, & | |
1746 | + & tID = cTreeID, & | |
1747 | + & property = sourceProperty, & | |
1748 | + & eType = eT_ghostFromCoarser, & | |
1749 | + & sourceProc = tree%global%myPart+1, & | |
1750 | + & stencilElements = tStencil, & | |
1751 | + & pos = targetPos, & | |
1752 | + & haloNesting = nesting, & | |
1753 | + & wasAdded = wasAdded ) | |
1754 | + | |
1755 | + if (wasAdded) then | |
1756 | + | |
1757 | + write(dbgUnit(7),"(2(A,I0))") 'Added as a GhostFromCoarser: ', & | |
1758 | + & cTreeID, ', to level: ', curLevel | |
1735 | 1759 | |
1736 | 1760 | updated = .true. |
1737 | - iChild = tem_childNumber( cTreeID ) | |
1761 | + iChild = tem_childNumber(cTreeID) | |
1738 | 1762 | iChildCoord(:) = tem_coordOfId( int(iChild, long_k) ) |
1739 | 1763 | ! inherit the boundary infos from the parent |
1740 | 1764 | tNeighID = 0_long_k |
1741 | 1765 | ! Get neighIds of (source) coarse element |
1742 | 1766 | do iDir = 1, 3 |
1743 | - call tem_find_BCs_fromCoarser( dir = iDir, & | |
1744 | - & childCoord = iChildCoord, & | |
1745 | - & sourceLevel = sourceLevel, & | |
1746 | - & sourcePos = sourcePos, & | |
1747 | - & neighID = tNeighID, & | |
1748 | - & minLevel = minLevel, & | |
1749 | - & levelDesc = levelDesc, & | |
1750 | - & computeStencil = Stencil ) | |
1751 | - enddo | |
1752 | - | |
1753 | - ! loop over all directions to determine neighIDs for ghost child (targetPos) | |
1767 | + call tem_find_BCs_fromCoarser( dir = iDir, & | |
1768 | + & childCoord = iChildCoord, & | |
1769 | + & sourceLevel = sourceLevel, & | |
1770 | + & sourcePos = sourcePos, & | |
1771 | + & neighID = tNeighID, & | |
1772 | + & minLevel = minLevel, & | |
1773 | + & levelDesc = levelDesc, & | |
1774 | + & computeStencil = Stencil ) | |
1775 | + end do | |
1776 | + | |
1777 | + ! loop over all directions to determine neighIDs for ghost child | |
1778 | + ! (targetPos) | |
1754 | 1779 | do iDir = 1, stencil%QQN |
1755 | - ! compute virtual neighbor child from coarser neighbor in iDir direction | |
1780 | + ! compute virtual neighbor child from coarser neighbor in iDir | |
1781 | + ! direction | |
1756 | 1782 | if( tNeighID(iDir) > 0_long_k ) then |
1757 | 1783 | ! find the corresponding children of the neighbor defined for my |
1758 | 1784 | ! parent. Find the child in the corresponding direction |
@@ -1769,7 +1795,7 @@ | ||
1769 | 1795 | ! calculate the child treeID from the coarser neighbor and the |
1770 | 1796 | ! childID |
1771 | 1797 | curNeighborID = tNeighID(iDir)*8_long_k + ichildID |
1772 | - elseif( tNeighID(iDir) == 0_long_k ) then | |
1798 | + else if (tNeighID(iDir) == 0_long_k) then | |
1773 | 1799 | ! virtual neighbor child exist in current parent. |
1774 | 1800 | ! If the neighbor is still 0, it must be a direct sibling, |
1775 | 1801 | ! so we can directly compute its tID. |
@@ -1780,42 +1806,44 @@ | ||
1780 | 1806 | else ! tNeighID(iDir) < 0_long_k |
1781 | 1807 | ! inherit the boundary ID |
1782 | 1808 | curNeighborID = tNeighID(iDir) |
1783 | - endif | |
1809 | + end if | |
1810 | + | |
1784 | 1811 | ! append the neighbor ID ... |
1785 | - call append( me = levelDesc( curLevel )%elem%neighID & | |
1786 | - & %val( targetPos ), & | |
1787 | - & val = curNeighborID, & | |
1788 | - & pos = addedPos ) | |
1812 | + call append( me = levelDesc( curLevel )%elem%neighID & | |
1813 | + & %val( targetPos ), & | |
1814 | + & val = curNeighborID, & | |
1815 | + & pos = addedPos ) | |
1789 | 1816 | ! ... and store this position in the stencil |
1790 | - levelDesc( curLevel )%elem%stencil%val( targetPos ) & | |
1791 | - & %val(1)%tIDpos( iDir ) & | |
1817 | + levelDesc( curLevel )%elem%stencil%val( targetPos ) & | |
1818 | + & %val(1)%tIDpos( iDir ) & | |
1792 | 1819 | & = addedPos |
1793 | - enddo !iDir QQN | |
1820 | + | |
1821 | + end do !iDir QQN | |
1794 | 1822 | |
1795 | 1823 | ! Set prp_hasBnd if any of neighbors is boundary |
1796 | 1824 | nVals = levelDesc( curLevel )%elem%neighID%val( targetPos )%nVals |
1797 | - if( minval( levelDesc( curLevel )%elem%neighID%val( targetPos ) & | |
1798 | - & %val( 1: nVals )) < 0 ) then | |
1825 | + if ( minval( levelDesc(curLevel)%elem%neighID%val(targetPos) & | |
1826 | + & %val(1:nVals) ) < 0 ) then | |
1799 | 1827 | ! Found boundary |
1800 | - levelDesc( curLevel )%elem%property%val( targetPos ) & | |
1801 | - & = ibset(levelDesc( curLevel )%elem%property%val(targetPos), & | |
1802 | - & prp_hasBnd) | |
1828 | + levelDesc( curLevel )%elem%property%val( targetPos ) & | |
1829 | + & = ibset( levelDesc( curLevel )%elem%property%val(targetPos), & | |
1830 | + & prp_hasBnd ) | |
1803 | 1831 | else |
1804 | 1832 | ! Unset the property bit |
1805 | - levelDesc( curLevel )%elem%property%val( targetPos ) & | |
1806 | - & = ibclr(levelDesc( curLevel )%elem%property%val(targetPos), & | |
1807 | - & prp_hasBnd) | |
1833 | + levelDesc( curLevel )%elem%property%val( targetPos ) & | |
1834 | + & = ibclr( levelDesc( curLevel )%elem%property%val(targetPos), & | |
1835 | + & prp_hasBnd ) | |
1808 | 1836 | end if |
1809 | 1837 | |
1810 | 1838 | else |
1811 | 1839 | ! Existing element encountered. |
1812 | 1840 | updated = .false. |
1813 | - endif | |
1841 | + end if | |
1814 | 1842 | ! Overwrite the eventually existing nesting with the smallest value. |
1815 | 1843 | ! The smallest nesting determines if further neighbors have to be |
1816 | 1844 | ! retrieved in communicate_elements |
1817 | - if( nesting < levelDesc( curLevel )%elem%haloNesting% & | |
1818 | - & val( targetPos )) then | |
1845 | + if ( nesting < levelDesc(curLevel)%elem%haloNesting & | |
1846 | + & %val(targetPos) ) then | |
1819 | 1847 | ! needs update |
1820 | 1848 | updated = .true. |
1821 | 1849 | levelDesc( curLevel )%elem%needsUpdate%val( targetPos ) = .true. |
@@ -1825,31 +1853,31 @@ | ||
1825 | 1853 | end if |
1826 | 1854 | ! In any case we have to recurse down to the target level |
1827 | 1855 | ! lower levels might not yet exist. |
1828 | - call add_all_virtual_children( sourceID = cTreeID, & | |
1829 | - & foundPos = foundPos, & | |
1830 | - & elemPath = elemPath, & | |
1831 | - & nesting = nesting, & | |
1832 | - & targetLevel = targetLevel, & | |
1833 | - & levelDesc = levelDesc, & | |
1834 | - & minLevel = minLevel, & | |
1835 | - & updated = childUpdated, & | |
1836 | - & tree = tree, & | |
1837 | - & sourceProperty = sourceProperty, & | |
1838 | - & Stencil = Stencil ) | |
1856 | + call add_all_virtual_children( sourceID = cTreeID, & | |
1857 | + & foundPos = foundPos, & | |
1858 | + & elemPath = elemPath, & | |
1859 | + & nesting = nesting, & | |
1860 | + & targetLevel = targetLevel, & | |
1861 | + & levelDesc = levelDesc, & | |
1862 | + & minLevel = minLevel, & | |
1863 | + & updated = childUpdated, & | |
1864 | + & tree = tree, & | |
1865 | + & sourceProperty = sourceProperty, & | |
1866 | + & Stencil = Stencil ) | |
1839 | 1867 | end if ! sourceLevel < targetLevel |
1840 | 1868 | updated = ( updated .or. childUpdated ) |
1841 | 1869 | |
1842 | 1870 | end subroutine add_all_virtual_children |
1843 | -! ****************************************************************************** ! | |
1844 | - | |
1845 | - | |
1846 | -! ****************************************************************************** ! | |
1871 | + ! ------------------------------------------------------------------------ ! | |
1872 | + | |
1873 | + | |
1874 | + ! ------------------------------------------------------------------------ ! | |
1847 | 1875 | !> Inherit the neighborhood from the sourceELem to the targetElem |
1848 | 1876 | !! |
1849 | 1877 | subroutine tem_find_BCs_fromCoarser( dir, childCoord, sourceLevel, & |
1850 | 1878 | & sourcePos, neighID, computeStencil, & |
1851 | 1879 | & levelDesc, minLevel ) |
1852 | - ! --------------------------------------------------------------------------- | |
1880 | + ! -------------------------------------------------------------------- ! | |
1853 | 1881 | !> coarse element level |
1854 | 1882 | integer, intent(in) :: sourceLevel |
1855 | 1883 | !> position of coarser element in original treeID list |
@@ -1866,7 +1894,7 @@ | ||
1866 | 1894 | type(tem_stencilHeader_type), intent(in) :: computeStencil |
1867 | 1895 | !> the level descriptor to be filled |
1868 | 1896 | type(tem_levelDesc_type), intent(in) :: levelDesc(minLevel:) |
1869 | - ! --------------------------------------------------------------------------- | |
1897 | + ! -------------------------------------------------------------------- ! | |
1870 | 1898 | ! Tangential direction iterators |
1871 | 1899 | integer :: iDirX, iDirY |
1872 | 1900 | integer :: dirX ! first tangential direction |
@@ -1878,11 +1906,12 @@ | ||
1878 | 1906 | integer :: iStencilElem ! stencil element iterator |
1879 | 1907 | integer :: iStencil |
1880 | 1908 | integer :: posInNeighID |
1881 | - ! --------------------------------------------------------------------------- | |
1909 | + ! -------------------------------------------------------------------- ! | |
1882 | 1910 | |
1883 | 1911 | ! curDir is -1 if childCoord(dir) is 0 |
1884 | 1912 | ! curDir is 1 if childCoord(dir) is 1 |
1885 | - ! it is needed to find in which direction of child's neighIDs are to be found | |
1913 | + ! it is needed to find in which direction of child's neighIDs are to be | |
1914 | + ! found | |
1886 | 1915 | curDir = childToStencil( childCoord( dir )) |
1887 | 1916 | myLink( dir ) = curDir |
1888 | 1917 | myLink(4) = 0 |
@@ -1914,30 +1943,37 @@ | ||
1914 | 1943 | ! matching direction of child to compute stencil |
1915 | 1944 | iChildStencil = 0 |
1916 | 1945 | do iStencilElem = 1, computeStencil%QQN |
1917 | - if ( computeStencil%cxDir( 1, iStencilElem ) == myLink( 1 ) & | |
1918 | - & .and. computeStencil%cxDir( 2, iStencilElem ) == myLink( 2 ) & | |
1919 | - & .and. computeStencil%cxDir( 3, iStencilElem ) == myLink( 3 ) & | |
1920 | - & ) then | |
1946 | + if ( computeStencil%cxDir(1, iStencilElem) == myLink(1) & | |
1947 | + & .and. computeStencil%cxDir(2, iStencilElem) == myLink(2) & | |
1948 | + & .and. computeStencil%cxDir(3, iStencilElem) == myLink(3) & | |
1949 | + & ) then | |
1921 | 1950 | ! Found matching stencil entry for current child direction |
1922 | 1951 | iChildStencil = iStencilElem |
1923 | - endif | |
1924 | - enddo | |
1925 | - if( iChildStencil > 0 ) then | |
1952 | + end if | |
1953 | + end do | |
1954 | + | |
1955 | + if ( iChildStencil > 0 ) then | |
1926 | 1956 | ! matching direction of parent to compute stencil |
1927 | 1957 | do iStencilElem = 1, computeStencil%QQN |
1928 | 1958 | if ( computeStencil%cxDir(1, iStencilElem) == parentLink(1) & |
1929 | 1959 | & .and. computeStencil%cxDir(2, iStencilElem) == parentLink(2) & |
1930 | 1960 | & .and. computeStencil%cxDir(3, iStencilElem) == parentLink(3) & |
1931 | - & ) then | |
1961 | + & ) then | |
1932 | 1962 | ! Found matching stencil entry for current child direction |
1933 | 1963 | ! Set the parent's neighbor here. Later we replace the |
1934 | 1964 | ! parent's neighbor by the current level's neighbor |
1935 | - !targetElem%neighID%val( targetElem%stencil%val(iStencil)%tIDpos( iChildStencil )) = & | |
1936 | - posInNeighID = levelDesc( sourceLevel )%elem%stencil%val(sourcePos) & | |
1937 | - & %val(iStencil)%tIDpos(iStencilElem) | |
1938 | - neighID( iChildStencil ) & | |
1939 | - & = levelDesc( sourceLevel )%elem%neighID%val(sourcePos)%val( posInNeighID ) | |
1940 | -! sourceElem%neighID%val( sourceElem%stencil%val(iStencil)%tIDpos( iStencilElem )) | |
1965 | + posInNeighID = levelDesc(sourceLevel) & | |
1966 | + & %elem & | |
1967 | + & %stencil & | |
1968 | + & %val(sourcePos) & | |
1969 | + & %val(iStencil) & | |
1970 | + & %tIDpos(iStencilElem) | |
1971 | + neighID( iChildStencil ) & | |
1972 | + & = levelDesc( sourceLevel ) & | |
1973 | + & %elem & | |
1974 | + & %neighID & | |
1975 | + & %val(sourcePos) & | |
1976 | + & %val(posInNeighID) | |
1941 | 1977 | end if |
1942 | 1978 | end do ! iStencilElem |
1943 | 1979 | end if ! iChildStencil > 0 |
@@ -1945,18 +1981,18 @@ | ||
1945 | 1981 | end do ! iDirY |
1946 | 1982 | |
1947 | 1983 | end subroutine tem_find_BCs_fromCoarser |
1948 | -! ****************************************************************************** ! | |
1949 | - | |
1950 | - | |
1951 | -! ****************************************************************************** ! | |
1984 | + ! ------------------------------------------------------------------------ ! | |
1985 | + | |
1986 | + | |
1987 | + ! ------------------------------------------------------------------------ ! | |
1952 | 1988 | !> Add parentID as GhostFromFiner. |
1953 | 1989 | !! Then set its BC from its children. |
1954 | 1990 | !! If any children do NOT exist, recursively call this routine to add them as |
1955 | 1991 | !! GhostFromFiner. |
1956 | 1992 | !! |
1957 | - recursive subroutine add_ghostFromFiner( elemID, levelDesc, minLevel, & | |
1993 | + recursive subroutine add_ghostFromFiner( elemID, levelDesc, minLevel, & | |
1958 | 1994 | & tree, updated, foundPos, stencil ) |
1959 | - ! --------------------------------------------------------------------------- | |
1995 | + ! -------------------------------------------------------------------- ! | |
1960 | 1996 | !> requested treeID |
1961 | 1997 | integer(kind=long_k), intent(in) :: elemID |
1962 | 1998 | !> minimum level fluid element in the tree |
@@ -1971,13 +2007,13 @@ | ||
1971 | 2007 | logical, intent(out) :: updated |
1972 | 2008 | !> current stencil definition |
1973 | 2009 | type( tem_stencilHeader_type ), intent(in) :: stencil |
1974 | - ! --------------------------------------------------------------------------- | |
2010 | + ! -------------------------------------------------------------------- ! | |
1975 | 2011 | integer :: iChild, level |
1976 | 2012 | integer(kind=long_k) :: children(8), property |
1977 | 2013 | logical :: wasAdded, childUpdated |
1978 | 2014 | integer :: childPos(8) |
1979 | 2015 | type(tem_path_type) :: childPath |
1980 | - ! --------------------------------------------------------------------------- | |
2016 | + ! -------------------------------------------------------------------- ! | |
1981 | 2017 | ! Set as not updated by default |
1982 | 2018 | updated = .false. |
1983 | 2019 |
@@ -1998,8 +2034,9 @@ | ||
1998 | 2034 | childPos = 0 ! reset child positions. non-existing children are 0 |
1999 | 2035 | ! reset property |
2000 | 2036 | property = 0_long_k |
2001 | - ! if added elemID is more than level coarser than available child treeID in | |
2002 | - ! original treeID list then add all children between level and neighLevel | |
2037 | + ! if added elemID is more than level coarser than available child treeID | |
2038 | + ! in original treeID list then add all children between level and | |
2039 | + ! neighLevel | |
2003 | 2040 | do iChild = 1, 8 |
2004 | 2041 | |
2005 | 2042 | ! Return position in the treeIDlist |
@@ -2008,16 +2045,19 @@ | ||
2008 | 2045 | |
2009 | 2046 | if( childPos( iChild ) < 0 ) then |
2010 | 2047 | ! This child does NOT exists, recusively add it as a ghostFromFiner. |
2011 | - call add_ghostFromFiner( elemID = children( iChild ), & | |
2048 | + call add_ghostFromFiner( elemID = children( iChild ), & | |
2012 | 2049 | & levelDesc = levelDesc, & |
2013 | 2050 | & minLevel = minlevel, & |
2014 | 2051 | & tree = tree, & |
2015 | 2052 | & foundPos = childPos( iChild ), & |
2016 | 2053 | & updated = childUpdated, & |
2017 | - & stencil = stencil ) | |
2054 | + & stencil = stencil ) | |
2018 | 2055 | ! Unify all properties of the children |
2019 | - property = ieor( property, & | |
2020 | - & levelDesc( level+1 )%elem%property%val( childPos( iChild ))) | |
2056 | + property = ieor( property, & | |
2057 | + & levelDesc(level+1) & | |
2058 | + & %elem & | |
2059 | + & %property & | |
2060 | + & %val( childPos(iChild) ) ) | |
2021 | 2061 | updated = ( updated .or. childUpdated ) |
2022 | 2062 | else |
2023 | 2063 | ! This child is a Fluid, i.e. already exists in element list |
@@ -2043,17 +2083,17 @@ | ||
2043 | 2083 | end if |
2044 | 2084 | |
2045 | 2085 | end subroutine add_ghostFromFiner |
2046 | -! ****************************************************************************** ! | |
2047 | - | |
2048 | - | |
2049 | -! ****************************************************************************** ! | |
2086 | + ! ------------------------------------------------------------------------ ! | |
2087 | + | |
2088 | + | |
2089 | + ! ------------------------------------------------------------------------ ! | |
2050 | 2090 | !> Inherit the neighborhood from the sourceELem to the targetElem |
2051 | 2091 | !! Note that targetElem is inout, as it might have already values assigned. |
2052 | 2092 | !! |
2053 | - subroutine tem_find_BCs_fromFiner( childPos, sourceLevel, targetLevel, & | |
2054 | - & targetPos, levelDesc, minLevel, & | |
2055 | - & stencil ) | |
2056 | - ! --------------------------------------------------------------------------- | |
2093 | + subroutine tem_find_BCs_fromFiner( childPos, sourceLevel, targetLevel, & | |
2094 | + & targetPos, levelDesc, minLevel, & | |
2095 | + & stencil ) | |
2096 | + ! -------------------------------------------------------------------- ! | |
2057 | 2097 | !> position of all childs in the levelDesc elem tID list |
2058 | 2098 | integer, intent(in) :: childPos(8) |
2059 | 2099 | !> level of child |
@@ -2068,7 +2108,7 @@ | ||
2068 | 2108 | type(tem_levelDesc_type ) :: levelDesc(minLevel:) |
2069 | 2109 | !> current stencil definition |
2070 | 2110 | type(tem_stencilHeader_type), intent(in) :: stencil |
2071 | - ! --------------------------------------------------------------------------- | |
2111 | + ! -------------------------------------------------------------------- ! | |
2072 | 2112 | integer :: dir |
2073 | 2113 | ! Tangential direction iterators |
2074 | 2114 | integer :: iDirX, iDirY, iDir |
@@ -2082,7 +2122,7 @@ | ||
2082 | 2122 | integer :: iStencil, addedPos |
2083 | 2123 | type(tem_stencilElement_type) :: tStencil |
2084 | 2124 | integer(kind=long_k) :: tNeighID |
2085 | - ! --------------------------------------------------------------------------- | |
2125 | + ! -------------------------------------------------------------------- ! | |
2086 | 2126 | |
2087 | 2127 | if ( .not. allocated( levelDesc( targetLevel )%elem%stencil% & |
2088 | 2128 | & val(targetPos)%val )) then |
@@ -2128,12 +2168,12 @@ | ||
2128 | 2168 | childCoord( dirY ) = iDirY |
2129 | 2169 | do iDirX = 0, 1 |
2130 | 2170 | childCoord( dirX ) = iDirX |
2131 | - call update_childNeighborID( neighID = tNeighID, & | |
2132 | - & childCoord = childCoord, & | |
2133 | - & childPos = childPos, & | |
2134 | - & iStencil = iStencil, & | |
2135 | - & iStencilElem = iStencilElem, & | |
2136 | - & elem = levelDesc(sourceLevel)%elem ) | |
2171 | + call update_childNeighborID( neighID = tNeighID, & | |
2172 | + & childCoord = childCoord, & | |
2173 | + & childPos = childPos, & | |
2174 | + & iStencil = iStencil, & | |
2175 | + & iStencilElem = iStencilElem, & | |
2176 | + & elem = levelDesc(sourceLevel)%elem ) | |
2137 | 2177 | end do |
2138 | 2178 | end do |
2139 | 2179 |
@@ -2149,47 +2189,50 @@ | ||
2149 | 2189 | childCoord( dirY ) = stencilToChild(stencil%cxDir(dirY,iStencilElem)) |
2150 | 2190 | do iDir = 0, 1 |
2151 | 2191 | childCoord( dir ) = iDir |
2152 | - call update_childNeighborID( neighID = tNeighID, & | |
2153 | - & childCoord = childCoord, & | |
2154 | - & childPos = childPos, & | |
2155 | - & iStencil = iStencil, & | |
2156 | - & iStencilElem = iStencilElem, & | |
2157 | - & elem = levelDesc(sourceLevel)%elem ) | |
2192 | + call update_childNeighborID( neighID = tNeighID, & | |
2193 | + & childCoord = childCoord, & | |
2194 | + & childPos = childPos, & | |
2195 | + & iStencil = iStencil, & | |
2196 | + & iStencilElem = iStencilElem, & | |
2197 | + & elem = levelDesc(sourceLevel)%elem ) | |
2158 | 2198 | enddo |
2159 | 2199 | |
2160 | 2200 | case(3) |
2161 | 2201 | ! No zero at all, all three directions have a offset |
2162 | 2202 | ! CORNER, just a single child is connected to this link |
2163 | 2203 | childCoord( 1:3 ) = stencilToChild( stencil%cxDir(:,iStencilElem) ) |
2164 | - call update_childNeighborID( neighID = tNeighID, & | |
2165 | - & childCoord = childCoord, & | |
2166 | - & childPos = childPos, & | |
2167 | - & iStencil = iStencil, & | |
2168 | - & iStencilElem = iStencilElem, & | |
2169 | - & elem = levelDesc(sourceLevel)%elem ) | |
2204 | + call update_childNeighborID( neighID = tNeighID, & | |
2205 | + & childCoord = childCoord, & | |
2206 | + & childPos = childPos, & | |
2207 | + & iStencil = iStencil, & | |
2208 | + & iStencilElem = iStencilElem, & | |
2209 | + & elem = levelDesc(sourceLevel)%elem ) | |
2170 | 2210 | end select |
2171 | 2211 | |
2172 | 2212 | ! Append the neighID of virtual parent |
2173 | - call append( me = levelDesc( targetLevel )%elem%neighID%val(targetPos), & | |
2174 | - & val = tNeighID, & | |
2175 | - & pos = addedPos ) | |
2176 | - levelDesc( targetLevel )%elem%stencil%val(targetPos) & | |
2177 | - & %val(iStencil)%tIDpos(iStencilElem) & | |
2178 | - & = addedPos | |
2213 | + call append( me = levelDesc(targetLevel)%elem%neighID%val(targetPos), & | |
2214 | + & val = tNeighID, & | |
2215 | + & pos = addedPos ) | |
2216 | + levelDesc(targetLevel) & | |
2217 | + & %elem & | |
2218 | + & %stencil & | |
2219 | + & %val(targetPos) & | |
2220 | + & %val(iStencil) & | |
2221 | + & %tIDpos(iStencilElem) = addedPos | |
2179 | 2222 | |
2180 | 2223 | end do |
2181 | 2224 | |
2182 | 2225 | end subroutine tem_find_BCs_fromFiner |
2183 | -! ****************************************************************************** ! | |
2184 | - | |
2185 | - | |
2186 | -! ****************************************************************************** ! | |
2226 | + ! ------------------------------------------------------------------------ ! | |
2227 | + | |
2228 | + | |
2229 | + ! ------------------------------------------------------------------------ ! | |
2187 | 2230 | !> Returns the absolute position in the total list of a given treeID |
2188 | 2231 | !! opposed to PosOfId, where the relative position in one of the separate |
2189 | 2232 | !! lists is returned. Herefore, total list has to be created beforehand. |
2190 | 2233 | !! |
2191 | 2234 | function tem_treeIDinTotal( tID, levelDesc, eType ) result( elemPos ) |
2192 | - ! --------------------------------------------------------------------------- | |
2235 | + ! -------------------------------------------------------------------- ! | |
2193 | 2236 | !> the element you are looking for |
2194 | 2237 | integer(kind=long_k), intent(in) :: tID |
2195 | 2238 | !> the descriptor you use for searching |
@@ -2198,9 +2241,9 @@ | ||
2198 | 2241 | integer, intent(in), optional :: eType |
2199 | 2242 | !> return position of tID in levelDesc%total list |
2200 | 2243 | integer :: elemPos |
2201 | - ! --------------------------------------------------------------------------- | |
2244 | + ! -------------------------------------------------------------------- ! | |
2202 | 2245 | integer :: eType_loc |
2203 | - ! --------------------------------------------------------------------------- | |
2246 | + ! -------------------------------------------------------------------- ! | |
2204 | 2247 | |
2205 | 2248 | if( present( eType )) then |
2206 | 2249 | eType_loc = eType |
@@ -2218,10 +2261,10 @@ | ||
2218 | 2261 | elemPos = max( elemPos, 0 ) |
2219 | 2262 | |
2220 | 2263 | end function tem_treeIDinTotal |
2221 | -! ****************************************************************************** ! | |
2222 | - | |
2223 | - | |
2224 | -! ****************************************************************************** ! | |
2264 | + ! ------------------------------------------------------------------------ ! | |
2265 | + | |
2266 | + | |
2267 | + ! ------------------------------------------------------------------------ ! | |
2225 | 2268 | !> create the intermediate, static list totalPnt, which holds pointers to the |
2226 | 2269 | !! elem%TID list, but in an ordered fashion. The order is the same as it will |
2227 | 2270 | !! be in the total list later on, i.e.: fluid, ghostFC, ghostFF, halo. |
@@ -2230,13 +2273,13 @@ | ||
2230 | 2273 | !! into haloList by grouping the treeIDs according to their belonging process |
2231 | 2274 | !! |
2232 | 2275 | subroutine identify_lists( me ) |
2233 | - ! --------------------------------------------------------------------------- | |
2276 | + ! -------------------------------------------------------------------- ! | |
2234 | 2277 | !> the level descriptor to be filled |
2235 | 2278 | type(tem_levelDesc_type), intent(inout) :: me |
2236 | - ! --------------------------------------------------------------------------- | |
2279 | + ! -------------------------------------------------------------------- ! | |
2237 | 2280 | integer :: iElem, indElem |
2238 | 2281 | integer :: iPnt( eT_minNumber:eT_maxNumber ), eType, iVal |
2239 | - ! --------------------------------------------------------------------------- | |
2282 | + ! -------------------------------------------------------------------- ! | |
2240 | 2283 | ! Destroy lists |
2241 | 2284 | call tem_halo_destroy(me%haloList) |
2242 | 2285 | ! init lists |
@@ -3556,33 +3599,39 @@ | ||
3556 | 3599 | if( elemPos > 0 ) then |
3557 | 3600 | ! if requested halo is ghostFromCoarser then find stencil neighbors of |
3558 | 3601 | ! this halo element |
3559 | - if( nesting < nestingLimit .and. & | |
3560 | - & levelDesc( iLevel )%elem%eType%val( elemPos ) & | |
3561 | - & == eT_ghostFromCoarser) then | |
3602 | + if ( (nesting < nestingLimit) & | |
3603 | + & .and. (levelDesc( iLevel )%elem%eType%val(elemPos) & | |
3604 | + & == eT_ghostFromCoarser) ) then | |
3562 | 3605 | ! identify all the compute neighbors of the current element |
3563 | - call identify_stencilNeigh( iElem = elemPos, & | |
3564 | - & iLevel = iLevel, & | |
3565 | - & tree = tree, & | |
3566 | - & iStencil = 1, & | |
3567 | - & pathFirst = pathFirst, & | |
3568 | - & pathLast = pathLast, & | |
3569 | - & levelDesc = levelDesc, & | |
3570 | - & proc = proc, & | |
3571 | - & stencil = stencil, & | |
3606 | + call identify_stencilNeigh( iElem = elemPos, & | |
3607 | + & iLevel = iLevel, & | |
3608 | + & tree = tree, & | |
3609 | + & iStencil = 1, & | |
3610 | + & pathFirst = pathFirst, & | |
3611 | + & pathLast = pathLast, & | |
3612 | + & levelDesc = levelDesc, & | |
3613 | + & proc = proc, & | |
3614 | + & stencil = stencil, & | |
3572 | 3615 | & nesting = nesting + 1 ) |
3573 | 3616 | end if |
3574 | 3617 | |
3575 | 3618 | ! if requested halo element haloNesting < found halo element (elemPos) |
3576 | 3619 | ! haloNesting |
3577 | - if( nestings_fromTarget( iProc )%val( iElem ) < & | |
3578 | - & levelDesc( haloLevel )%elem%haloNesting%val( elemPos )) then | |
3579 | - levelDesc( haloLevel )%elem%needsUpdate%val( elemPos ) = .true. | |
3580 | - levelDesc( haloLevel )%elem%haloNesting%val( elemPos ) = & | |
3581 | - min( nestings_fromTarget( iProc )%val( iElem ), & | |
3582 | - levelDesc( haloLevel )%elem%haloNesting%val( elemPos ) ) | |
3620 | + if ( nestings_fromTarget(iProc)%val(iElem) & | |
3621 | + & < levelDesc( haloLevel )%elem%haloNesting%val(elemPos) ) then | |
3622 | + levelDesc(haloLevel)%elem%needsUpdate%val(elemPos) = .true. | |
3623 | + levelDesc(haloLevel) & | |
3624 | + & %elem & | |
3625 | + & %haloNesting & | |
3626 | + & %val(elemPos) = min( nestings_fromTarget(iProc)%val(iElem), & | |
3627 | + & levelDesc(haloLevel) & | |
3628 | + & %elem & | |
3629 | + & %haloNesting & | |
3630 | + & %val(elemPos) ) | |
3583 | 3631 | end if |
3632 | + | |
3584 | 3633 | ! only add, if the element was added locally |
3585 | - select case( levelDesc( iLevel )%elem%eType%val( elemPos ) ) | |
3634 | + select case( levelDesc(iLevel)%elem%eType%val(elemPos) ) | |
3586 | 3635 | ! Depending on the type of the element, add to the |
3587 | 3636 | ! regular buffer, bufferFromCoarser, bufferFromFiner |
3588 | 3637 | case( eT_fluid ) |