!####################################################################### ! SUBROUTINE --- sub_create_tree_list --- ### !####################################################################### ! ### ! Subroutine for Creating Tree List ### ! ### ! Calculated Variables ### ! flag_node(node) ### ! center_node(3,node) ### ! leng_node(node) ### ! radius_node(node) ### ! head_branch_id(node) ### ! num_branch(node) ### ! node_tot ### ! ### ! 2009/07/24 ### ! 2009/08/27 ### ! 2011/06/25 ### ! 2011/08/20 ### !####################################################################### subroutine sub_create_tree_list use mod_parameter use mod_variable implicit none !==== Variables Used in This Subroutine ================================ integer node real*8 x_max,x_min real*8 y_max,y_min real*8 z_max,z_min integer i real*8 x_leng,y_leng,z_leng integer i_head,i_tail integer id integer id_temp(8) integer k integer tmp integer ii ! ---- Variable for Node ------------------------------------------- ! ---- Variables for 8 Branches ------------------------------------ integer j_branch integer np_branch(8) integer flag_branch(8) integer head_ptcl_id_list_branch(8) integer cum_np_branch(8) integer node_branch real*8 center_branch(3,8) real*8 leng_half_branch real*8 radius_branch !======================================================================= flag_node=0 !==== Get the Entire Node ============================================== ! ---- First Node -------------------------------------------------- node=1 ! ---- Temporal Number of Node ------------------------------------- node_tot=1 ! ---- Calculate Range of the System ------------------------------- x_max=-1.0d30 x_min= 1.0d30 y_max=-1.0d30 y_min= 1.0d30 z_max=-1.0d30 z_min= 1.0d30 do i=1,np if(x(1,i) .gt. x_max) x_max=x(1,i) if(x(1,i) .lt. x_min) x_min=x(1,i) if(x(2,i) .gt. y_max) y_max=x(2,i) if(x(2,i) .lt. y_min) y_min=x(2,i) if(x(3,i) .gt. z_max) z_max=x(3,i) if(x(3,i) .lt. z_min) z_min=x(3,i) enddo x_leng=x_max-x_min y_leng=y_max-y_min z_leng=z_max-z_min ! ---- Half Length of First Node ----------------------------------- leng_node(node)=dmax1(x_leng,y_leng,z_leng) ! ---- Radius of First Node ---------------------------------------- radius_node(node)=dsqrt(3.0d0)*leng_node(node)*0.5d0 ! ---- Center of First Node ---------------------------------------- center_node(1,node)=(x_max+x_min)/2.0d0 center_node(2,node)=(y_max+y_min)/2.0d0 center_node(3,node)=(z_max+z_min)/2.0d0 ! ---- The Number of Particles in First Node ----------------------- np_node(node)=np ! ---- Flag of First Node ------------------------------------------ flag_node(node)=-1 ! ---- Particle List and Head Particle of First Node --------------- head_ptcl_id_list(node)=1 do i=1,np ptcl_id_list(i)=i enddo !======================================================================= !==== Create Tree List ================================================= !======================================================================= 555 continue !==== Case for One Particle in Node ==================================== tmp=flag_node(node) if (tmp .gt. 0) then center_node(1,node)=x(1,tmp) center_node(2,node)=x(2,tmp) center_node(3,node)=x(3,tmp) radius_node(node)=0.0d0 node=node+1 go to 555 ! go to Next Node endif !==== Case for Very Small Length of Node =============================== if (flag_node(node) .eq. -1) then if (leng_node(node) .lt. LENG_NODE_LIM) then head_branch_id(node)=node_tot+1 num_branch(node)=np_node(node) i_head=head_ptcl_id_list(node) !xxx num_branch(node)=np_node(node) !!!!! if (np_node(node) .gt. 8) then !!!!! write(*,*) np_node(node) !!!!! stop !!!!! endif ! stop do j_branch=1,np_node(node) id=ptcl_id_list(i_head-1+j_branch) flag_node(node_tot+j_branch)=id !cccc center_node(1,node_tot+j_branch)=x(1,id) center_node(2,node_tot+j_branch)=x(2,id) center_node(3,node_tot+j_branch)=x(3,id) leng_node(node_tot+j_branch)=0.0d0 radius_node(node_tot+j_branch)=0.0d0 !cccc enddo node_tot=node_tot+np_node(node) node=node+1 go to 555 ! go to Next Node endif endif !==== Case for Particles in Node ======================================= if (flag_node(node) .eq. -1) then ! ---- Define the Head Node Number of Branches ------------------- head_branch_id(node)=node_tot+1 ! ---- Initialization of the Number of Particles for Branches ---- do j_branch=1,8 np_branch(j_branch)=0 enddo ! ---- Calculate the Number of Particles of Branches ------------- i_head=head_ptcl_id_list(node) i_tail=i_head+np_node(node)-1 do i=i_head,i_tail j_branch=1 id=ptcl_id_list(i) if(x(1,id) .lt. center_node(1,node)) j_branch=j_branch+1 if(x(2,id) .lt. center_node(2,node)) j_branch=j_branch+2 if(x(3,id) .lt. center_node(3,node)) j_branch=j_branch+4 np_branch(j_branch)=np_branch(j_branch)+1 ! ---- Case for One Particle in Branch --------------- id_temp(j_branch)=id ! ---------------------------------------------------- enddo ! ---- Flag of Each Branches ------------------------------------- do j_branch=1,8 if(np_branch(j_branch) .eq. 0) flag_branch(j_branch)=0 if(np_branch(j_branch) .ge. 2) flag_branch(j_branch)=-1 if(np_branch(j_branch) .eq. 1) flag_branch(j_branch) & =id_temp(j_branch) enddo ! ---- Head Number of Particle List in Each Branches ------------- head_ptcl_id_list_branch(1)=i_head do j_branch=2,8 head_ptcl_id_list_branch(j_branch) & =head_ptcl_id_list_branch(j_branch-1)+np_branch(j_branch-1) enddo do j_branch=1,8 cum_np_branch(j_branch)=0 enddo do i=i_head,i_tail j_branch=1 id=ptcl_id_list(i) if(x(1,id) .lt. center_node(1,node)) j_branch=j_branch+1 if(x(2,id) .lt. center_node(2,node)) j_branch=j_branch+2 if(x(3,id) .lt. center_node(3,node)) j_branch=j_branch+4 ii=head_ptcl_id_list_branch(j_branch)+cum_np_branch(j_branch) ptcl_id_list_branch(ii)=id cum_np_branch(j_branch)=cum_np_branch(j_branch)+1 enddo do i=i_head,i_tail ptcl_id_list(i)=ptcl_id_list_branch(i) enddo leng_half_branch=leng_node(node)*0.25d0 radius_branch=dsqrt(3.0d0)*leng_half_branch center_branch(1,1)=center_node(1,node)+leng_half_branch center_branch(2,1)=center_node(2,node)+leng_half_branch center_branch(3,1)=center_node(3,node)+leng_half_branch center_branch(1,2)=center_node(1,node)-leng_half_branch center_branch(2,2)=center_node(2,node)+leng_half_branch center_branch(3,2)=center_node(3,node)+leng_half_branch center_branch(1,3)=center_node(1,node)+leng_half_branch center_branch(2,3)=center_node(2,node)-leng_half_branch center_branch(3,3)=center_node(3,node)+leng_half_branch center_branch(1,4)=center_node(1,node)-leng_half_branch center_branch(2,4)=center_node(2,node)-leng_half_branch center_branch(3,4)=center_node(3,node)+leng_half_branch center_branch(1,5)=center_node(1,node)+leng_half_branch center_branch(2,5)=center_node(2,node)+leng_half_branch center_branch(3,5)=center_node(3,node)-leng_half_branch center_branch(1,6)=center_node(1,node)-leng_half_branch center_branch(2,6)=center_node(2,node)+leng_half_branch center_branch(3,6)=center_node(3,node)-leng_half_branch center_branch(1,7)=center_node(1,node)+leng_half_branch center_branch(2,7)=center_node(2,node)-leng_half_branch center_branch(3,7)=center_node(3,node)-leng_half_branch center_branch(1,8)=center_node(1,node)-leng_half_branch center_branch(2,8)=center_node(2,node)-leng_half_branch center_branch(3,8)=center_node(3,node)-leng_half_branch num_branch(node)=0 do j_branch=1,8 if(np_branch(j_branch) .ne. 0) then num_branch(node)=num_branch(node)+1 node_branch=node_tot+num_branch(node) flag_node(node_branch)=flag_branch(j_branch) do k=1,3 center_node(k,node_branch)=center_branch(k,j_branch) enddo leng_node(node_branch)=2.0d0*leng_half_branch radius_node(node_branch)=radius_branch head_ptcl_id_list(node_branch) & =head_ptcl_id_list_branch(j_branch) np_node(node_branch)=np_branch(j_branch) endif enddo node_tot=node_tot+num_branch(node) node=node+1 go to 555 endif return end !####################################################################### ! SUBROUTINE --- sub_reconst_tree_list --- ### !####################################################################### ! ### ! Subroutine for Reconstructing Tree List ### ! ### ! Calculated Variables ### ! center_mass_node(3,node) ### ! mass_node(node) ### ! h_max_node(node) ### ! ### ! 2011/08/20 ### !####################################################################### subroutine sub_reconst_tree_list use mod_variable implicit none !==== Variables Used in This Subroutine ================================ integer(4) :: node integer(4) :: ii real(8) :: mx_node(3) integer(4) :: branch_head integer(4) :: branch_tail integer(4) :: branch !======================================================================= do node=node_tot,1,-1 !=== One Particle in the Node ================================ if(flag_node(node) /= -1) then ii=flag_node(node) mass_node(node)=m(ii) center_mass_node(:,node)=x(:,ii) h_max_node(node)=h(ii) !=== Particles in the Node =================================== else mass_node(node)=0.0d0 mx_node(:)=0.0d0 branch_head=head_branch_id(node) branch_tail=branch_head+num_branch(node)-1 do branch=branch_head,branch_tail mass_node(node)=mass_node(node)+mass_node(branch) mx_node(:)=mx_node(:) & & +mass_node(branch)*center_mass_node(:,branch) enddo center_mass_node(:,node)=mx_node(:)/mass_node(node) h_max_node(node)=maxval(h_max_node(branch_head:branch_tail)) endif !============================================================= enddo return end subroutine sub_reconst_tree_list