alloc_node Subroutine

public subroutine alloc_node(igrid)

Uses

  • proc~~alloc_node~4~~UsesGraph proc~alloc_node~4 alloc_node mod_physics mod_physics proc~alloc_node~4->mod_physics module~gpu_utils gpu_utils proc~alloc_node~4->module~gpu_utils module~mod_b0 mod_b0 proc~alloc_node~4->module~mod_b0 module~mod_forest mod_forest proc~alloc_node~4->module~mod_forest module~mod_geometry mod_geometry proc~alloc_node~4->module~mod_geometry module~mod_global_parameters mod_global_parameters proc~alloc_node~4->module~mod_global_parameters module~mod_comm_lib mod_comm_lib module~mod_geometry->module~mod_comm_lib module~mod_basic_types mod_basic_types module~mod_global_parameters->module~mod_basic_types module~mod_connectivity mod_connectivity module~mod_global_parameters->module~mod_connectivity module~mod_constants mod_constants module~mod_global_parameters->module~mod_constants module~mod_physicaldata mod_physicaldata module~mod_global_parameters->module~mod_physicaldata module~mod_variables mod_variables module~mod_global_parameters->module~mod_variables mpi mpi module~mod_global_parameters->mpi module~mod_variables->module~mod_basic_types

allocate arrays on igrid node

Arguments

Type IntentOptional Attributes Name
integer, intent(in) :: igrid

Calls

proc~~alloc_node~4~~CallsGraph proc~alloc_node~4 alloc_node interface~copy_or_update copy_or_update proc~alloc_node~4->interface~copy_or_update interface~copy_or_update_pointer copy_or_update_pointer proc~alloc_node~4->interface~copy_or_update_pointer phys_set_equi_vars phys_set_equi_vars proc~alloc_node~4->phys_set_equi_vars proc~alloc_state_coarse~4 alloc_state_coarse proc~alloc_node~4->proc~alloc_state_coarse~4 proc~alloc_state~4 alloc_state proc~alloc_node~4->proc~alloc_state~4 proc~fill_geometry_device~4 fill_geometry_device proc~alloc_node~4->proc~fill_geometry_device~4 proc~fill_nwextra_device fill_nwextra_device proc~alloc_node~4->proc~fill_nwextra_device proc~set_b0_grid set_B0_grid proc~alloc_node~4->proc~set_b0_grid proc~sync_positions_host sync_positions_host proc~alloc_node~4->proc~sync_positions_host proc~copy_or_update_double_nonpointer copy_or_update_double_nonpointer interface~copy_or_update->proc~copy_or_update_double_nonpointer proc~copy_or_update_double_nonpointer_r1 copy_or_update_double_nonpointer_r1 interface~copy_or_update->proc~copy_or_update_double_nonpointer_r1 proc~copy_or_update_double_nonpointer_r2 copy_or_update_double_nonpointer_r2 interface~copy_or_update->proc~copy_or_update_double_nonpointer_r2 proc~copy_or_update_double_nonpointer_r3 copy_or_update_double_nonpointer_r3 interface~copy_or_update->proc~copy_or_update_double_nonpointer_r3 proc~copy_or_update_double_nonpointer_r4 copy_or_update_double_nonpointer_r4 interface~copy_or_update->proc~copy_or_update_double_nonpointer_r4 proc~copy_or_update_double_nonpointer_r5 copy_or_update_double_nonpointer_r5 interface~copy_or_update->proc~copy_or_update_double_nonpointer_r5 proc~copy_or_update_double_nonpointer_r6 copy_or_update_double_nonpointer_r6 interface~copy_or_update->proc~copy_or_update_double_nonpointer_r6 proc~copy_or_update_integer_nonpointer copy_or_update_integer_nonpointer interface~copy_or_update->proc~copy_or_update_integer_nonpointer proc~copy_or_update_integer_nonpointer_r1 copy_or_update_integer_nonpointer_r1 interface~copy_or_update->proc~copy_or_update_integer_nonpointer_r1 proc~copy_or_update_integer_nonpointer_r2 copy_or_update_integer_nonpointer_r2 interface~copy_or_update->proc~copy_or_update_integer_nonpointer_r2 proc~copy_or_update_integer_nonpointer_r3 copy_or_update_integer_nonpointer_r3 interface~copy_or_update->proc~copy_or_update_integer_nonpointer_r3 proc~copy_or_update_integer_nonpointer_r4 copy_or_update_integer_nonpointer_r4 interface~copy_or_update->proc~copy_or_update_integer_nonpointer_r4 proc~copy_or_update_integer_nonpointer_r5 copy_or_update_integer_nonpointer_r5 interface~copy_or_update->proc~copy_or_update_integer_nonpointer_r5 proc~copy_or_update_integer_nonpointer_r6 copy_or_update_integer_nonpointer_r6 interface~copy_or_update->proc~copy_or_update_integer_nonpointer_r6 proc~copy_or_update_logical_nonpointer copy_or_update_logical_nonpointer interface~copy_or_update->proc~copy_or_update_logical_nonpointer proc~copy_or_update_logical_nonpointer_r1 copy_or_update_logical_nonpointer_r1 interface~copy_or_update->proc~copy_or_update_logical_nonpointer_r1 proc~copy_or_update_logical_nonpointer_r2 copy_or_update_logical_nonpointer_r2 interface~copy_or_update->proc~copy_or_update_logical_nonpointer_r2 proc~copy_or_update_logical_nonpointer_r3 copy_or_update_logical_nonpointer_r3 interface~copy_or_update->proc~copy_or_update_logical_nonpointer_r3 proc~copy_or_update_logical_nonpointer_r4 copy_or_update_logical_nonpointer_r4 interface~copy_or_update->proc~copy_or_update_logical_nonpointer_r4 proc~copy_or_update_logical_nonpointer_r5 copy_or_update_logical_nonpointer_r5 interface~copy_or_update->proc~copy_or_update_logical_nonpointer_r5 proc~copy_or_update_logical_nonpointer_r6 copy_or_update_logical_nonpointer_r6 interface~copy_or_update->proc~copy_or_update_logical_nonpointer_r6 proc~copy_or_update_double_pointer copy_or_update_double_pointer interface~copy_or_update_pointer->proc~copy_or_update_double_pointer proc~copy_or_update_double_pointer_r1 copy_or_update_double_pointer_r1 interface~copy_or_update_pointer->proc~copy_or_update_double_pointer_r1 proc~copy_or_update_double_pointer_r2 copy_or_update_double_pointer_r2 interface~copy_or_update_pointer->proc~copy_or_update_double_pointer_r2 proc~copy_or_update_double_pointer_r3 copy_or_update_double_pointer_r3 interface~copy_or_update_pointer->proc~copy_or_update_double_pointer_r3 proc~copy_or_update_double_pointer_r4 copy_or_update_double_pointer_r4 interface~copy_or_update_pointer->proc~copy_or_update_double_pointer_r4 proc~copy_or_update_double_pointer_r5 copy_or_update_double_pointer_r5 interface~copy_or_update_pointer->proc~copy_or_update_double_pointer_r5 proc~copy_or_update_double_pointer_r6 copy_or_update_double_pointer_r6 interface~copy_or_update_pointer->proc~copy_or_update_double_pointer_r6 proc~copy_or_update_integer_pointer copy_or_update_integer_pointer interface~copy_or_update_pointer->proc~copy_or_update_integer_pointer proc~copy_or_update_integer_pointer_r1 copy_or_update_integer_pointer_r1 interface~copy_or_update_pointer->proc~copy_or_update_integer_pointer_r1 proc~copy_or_update_integer_pointer_r2 copy_or_update_integer_pointer_r2 interface~copy_or_update_pointer->proc~copy_or_update_integer_pointer_r2 proc~copy_or_update_integer_pointer_r3 copy_or_update_integer_pointer_r3 interface~copy_or_update_pointer->proc~copy_or_update_integer_pointer_r3 proc~copy_or_update_integer_pointer_r4 copy_or_update_integer_pointer_r4 interface~copy_or_update_pointer->proc~copy_or_update_integer_pointer_r4 proc~copy_or_update_integer_pointer_r5 copy_or_update_integer_pointer_r5 interface~copy_or_update_pointer->proc~copy_or_update_integer_pointer_r5 proc~copy_or_update_integer_pointer_r6 copy_or_update_integer_pointer_r6 interface~copy_or_update_pointer->proc~copy_or_update_integer_pointer_r6 proc~copy_or_update_logical_pointer copy_or_update_logical_pointer interface~copy_or_update_pointer->proc~copy_or_update_logical_pointer proc~copy_or_update_logical_pointer_r1 copy_or_update_logical_pointer_r1 interface~copy_or_update_pointer->proc~copy_or_update_logical_pointer_r1 proc~copy_or_update_logical_pointer_r2 copy_or_update_logical_pointer_r2 interface~copy_or_update_pointer->proc~copy_or_update_logical_pointer_r2 proc~copy_or_update_logical_pointer_r3 copy_or_update_logical_pointer_r3 interface~copy_or_update_pointer->proc~copy_or_update_logical_pointer_r3 proc~copy_or_update_logical_pointer_r4 copy_or_update_logical_pointer_r4 interface~copy_or_update_pointer->proc~copy_or_update_logical_pointer_r4 proc~copy_or_update_logical_pointer_r5 copy_or_update_logical_pointer_r5 interface~copy_or_update_pointer->proc~copy_or_update_logical_pointer_r5 proc~copy_or_update_logical_pointer_r6 copy_or_update_logical_pointer_r6 interface~copy_or_update_pointer->proc~copy_or_update_logical_pointer_r6 proc~point_at_geometry~4 point_at_geometry proc~alloc_state_coarse~4->proc~point_at_geometry~4 proc~alloc_state~4->proc~point_at_geometry~4 usr_set_nwextra usr_set_nwextra proc~fill_nwextra_device->usr_set_nwextra proc~set_b0_cell set_B0_cell proc~set_b0_grid->proc~set_b0_cell proc~set_b0_face set_B0_face proc~set_b0_grid->proc~set_b0_face proc~set_j0_cell set_J0_cell proc~set_b0_grid->proc~set_j0_cell dcos dcos proc~set_b0_cell->dcos dsin dsin proc~set_b0_cell->dsin proc~set_b0_face->proc~set_b0_cell proc~curlvector curlvector proc~set_j0_cell->proc~curlvector proc~curlvector->dcos proc~curlvector->dsin proc~mpistop mpistop proc~curlvector->proc~mpistop mpi_abort mpi_abort proc~mpistop->mpi_abort

Source Code

  subroutine alloc_node(igrid)
#if defined(_OPENACC) || defined(_OPENMP)
    use gpu_utils
#endif
    use mod_forest
    use mod_global_parameters
    use mod_geometry
    use mod_physics, only: phys_set_equi_vars
    use mod_b0, only: set_B0_grid 
    
    integer, intent(in) :: igrid
  
    integer :: level, ig1,ig2,ig3, ign1,ign2,ign3, ixCoGmin1,ixCoGmin2,&
       ixCoGmin3,ixCoGmax1,ixCoGmax2,ixCoGmax3, i1,i2,i3
    logical :: first_alloc

    ixCoGmin1=1;ixCoGmin2=1;ixCoGmin3=1;
    ixCoGmax1=(ixGhi1-2*nghostcells)/2+2*nghostcells
    ixCoGmax2=(ixGhi2-2*nghostcells)/2+2*nghostcells
    ixCoGmax3=(ixGhi3-2*nghostcells)/2+2*nghostcells;
  
    ! set level information
    level=igrid_to_node(igrid,mype)%node%level
  
    first_alloc = .not. associated(ps(igrid)%w)
    if(first_alloc) then
       
       ! allocate arrays for solution and space
       call alloc_state(igrid, ps(igrid), ixGlo1,ixGlo2,ixGlo3,ixGhi1,ixGhi2,&
          ixGhi3, .true.)
       ! allocate arrays for one level coarser solution
       call alloc_state_coarse(igrid, psc(igrid), ixCoGmin1,ixCoGmin2,&
          ixCoGmin3,ixCoGmax1,ixCoGmax2,ixCoGmax3)
       if(.not.convert) then
        ! allocate arrays for temp solution 1
        call alloc_state(igrid, ps1(igrid), ixGlo1,ixGlo2,ixGlo3,ixGhi1,ixGhi2,&
           ixGhi3, .false.)

        ! allocate temporary solution space
        select case (t_integrator)
        case(ssprk3,ssprk4,IMEX_Midpoint,IMEX_Trapezoidal,IMEX_222)
          call alloc_state(igrid, ps2(igrid), ixGlo1,ixGlo2,ixGlo3,ixGhi1,&
             ixGhi2,ixGhi3, .false.)
        case(RK3_BT,rk4,ssprk5,IMEX_CB3a)
          call alloc_state(igrid, ps2(igrid), ixGlo1,ixGlo2,ixGlo3,ixGhi1,&
             ixGhi2,ixGhi3, .false.)
          call alloc_state(igrid, ps3(igrid), ixGlo1,ixGlo2,ixGlo3,ixGhi1,&
             ixGhi2,ixGhi3, .false.)
        case(IMEX_ARS3,IMEX_232)
          call alloc_state(igrid, ps2(igrid), ixGlo1,ixGlo2,ixGlo3,ixGhi1,&
             ixGhi2,ixGhi3, .false.)
          call alloc_state(igrid, ps3(igrid), ixGlo1,ixGlo2,ixGlo3,ixGhi1,&
             ixGhi2,ixGhi3, .false.)
          call alloc_state(igrid, ps4(igrid), ixGlo1,ixGlo2,ixGlo3,ixGhi1,&
             ixGhi2,ixGhi3, .false.)
        end select
      end if
  
    end if

    ! avoid dividing by zero rho in skipped corner ghostcells when phys_req_diagonal=F
    ps(igrid)%w(:,:,:,1)=1.d0
    ps(igrid)%level=level
    psc(igrid)%level=level-1
    ! avoid dividing by zero rho in skipped corner ghostcells when phys_req_diagonal=F
    psc(igrid)%w(:,:,:,1)=1.d0
    if(phys_trac) ps(igrid)%special_values=0.d0
    if(.not.convert) then
      ps1(igrid)%level=level
      select case (t_integrator)
      case(ssprk3,ssprk4,IMEX_Midpoint,IMEX_Trapezoidal,IMEX_222)
        ps2(igrid)%level=level
      case(RK3_BT,rk4,ssprk5,IMEX_CB3a)
        ps2(igrid)%level=level
        ps3(igrid)%level=level
      case(IMEX_ARS3,IMEX_232)
        ps2(igrid)%level=level
        ps3(igrid)%level=level
        ps4(igrid)%level=level
      end select
    end if

    ! block pointer to current block
    block=>ps(igrid)
    ig1=igrid_to_node(igrid,mype)%node%ig1
    ig2=igrid_to_node(igrid,mype)%node%ig2
    ig3=igrid_to_node(igrid,mype)%node%ig3;
    node(plevel_,igrid)=level
    node(pig1_,igrid)=ig1
    node(pig2_,igrid)=ig2
    node(pig3_,igrid)=ig3
 
    
    ! set dx information
    rnode(rpdx1_,igrid)=dx(1,level)
    rnode(rpdx2_,igrid)=dx(2,level)
    rnode(rpdx3_,igrid)=dx(3,level)
    dxlevel(:)=dx(:,level)
 

    ! uniform cartesian case as well as all unstretched coordinates
    ! determine the minimal and maximal corners
    rnode(rpxmin1_,igrid)=xprobmin1+dble(ig1-1)*dg1(level)
    rnode(rpxmin2_,igrid)=xprobmin2+dble(ig2-1)*dg2(level)
    rnode(rpxmin3_,igrid)=xprobmin3+dble(ig3-1)*dg3(level)
    rnode(rpxmax1_,igrid)=xprobmin1+dble(ig1)*dg1(level)
    rnode(rpxmax2_,igrid)=xprobmin2+dble(ig2)*dg2(level)
    rnode(rpxmax3_,igrid)=xprobmin3+dble(ig3)*dg3(level)
   if(rnode(rpxmax1_,igrid)>xprobmax1) rnode(rpxmax1_,igrid)=xprobmax1
   if(rnode(rpxmax2_,igrid)>xprobmax2) rnode(rpxmax2_,igrid)=xprobmax2
   if(rnode(rpxmax3_,igrid)>xprobmax3) rnode(rpxmax3_,igrid)=xprobmax3

 
   
    ! Fill this block's cell metrics. A uniform block is an analytic function
    ! of rnode alone, so this runs on the device and only the positions come
    ! back; see sync_geometry_host for the rest.
    call fill_geometry_device(igrid)

    ! Fill this block's analytic extra variables (past nwgc) the same way, from
    ! the positions fill_geometry_device just wrote. This is the only place
    ! they are set: getbc, prolongation and coarsening all stop at nwgc, so
    ! every block that reaches alloc_node - a fresh root, a refined child, a
    ! coarsened parent, a load-balanced arrival - gets them here and nothing
    ! overwrites them afterwards.
    call fill_nwextra_device(igrid)

    ! initialize background non-evolving solution; both of these read
    ! ps(igrid)%x on the host, so this block is the one place in alloc_node
    ! that still needs the positions back
    if (B0field .or. number_equi_vars>0) call sync_positions_host(igrid)
    if (B0field) call set_B0_grid(igrid)
    if (number_equi_vars>0) call phys_set_equi_vars(igrid)
  
    ! find the blocks on the boundaries
    ps(igrid)%is_physical_boundary=.false.
    
    do i1=-1,1
      if(i1==0) cycle
      ign1=ig1+i1
      ! blocks at periodic boundary have neighbors in the physical domain
      ! thus threated at internal blocks with no physical boundary
      if (periodB(1)) ign1=1+modulo(ign1-1,ng1(level))
      if (ign1 > ng1(level)) then
         if(phi_ > 0 .and. poleB(2,1)) then
           ! if at a pole, the boundary is not physical boundary
           ps(igrid)%is_physical_boundary(2*1)=.false.
         else
           ps(igrid)%is_physical_boundary(2*1)=.true.
         end if
      else if (ign1 < 1) then
         if(phi_ > 0 .and. poleB(1,1)) then
           ! if at a pole, the boundary is not physical boundary
           ps(igrid)%is_physical_boundary(2*1-1)=.false.
         else
           ps(igrid)%is_physical_boundary(2*1-1)=.true.
         end if
      end if
    end do
    
    do i2=-1,1
      if(i2==0) cycle
      ign2=ig2+i2
      ! blocks at periodic boundary have neighbors in the physical domain
      ! thus threated at internal blocks with no physical boundary
      if (periodB(2)) ign2=1+modulo(ign2-1,ng2(level))
      if (ign2 > ng2(level)) then
         if(phi_ > 0 .and. poleB(2,2)) then
           ! if at a pole, the boundary is not physical boundary
           ps(igrid)%is_physical_boundary(2*2)=.false.
         else
           ps(igrid)%is_physical_boundary(2*2)=.true.
         end if
      else if (ign2 < 1) then
         if(phi_ > 0 .and. poleB(1,2)) then
           ! if at a pole, the boundary is not physical boundary
           ps(igrid)%is_physical_boundary(2*2-1)=.false.
         else
           ps(igrid)%is_physical_boundary(2*2-1)=.true.
         end if
      end if
    end do
    
    
    do i3=-1,1
      if(i3==0) cycle
      ign3=ig3+i3
      ! blocks at periodic boundary have neighbors in the physical domain
      ! thus threated at internal blocks with no physical boundary
      if (periodB(3)) ign3=1+modulo(ign3-1,ng3(level))
      if (ign3 > ng3(level)) then
         if(phi_ > 0 .and. poleB(2,3)) then
           ! if at a pole, the boundary is not physical boundary
           ps(igrid)%is_physical_boundary(2*3)=.false.
         else
           ps(igrid)%is_physical_boundary(2*3)=.true.
         end if
      else if (ign3 < 1) then
         if(phi_ > 0 .and. poleB(1,3)) then
           ! if at a pole, the boundary is not physical boundary
           ps(igrid)%is_physical_boundary(2*3-1)=.false.
         else
           ps(igrid)%is_physical_boundary(2*3-1)=.true.
         end if
      end if
    end do
    
    if(any(ps(igrid)%is_physical_boundary)) then
      phyboundblock(igrid)=.true.
    else
      phyboundblock(igrid)=.false.
   end if

   
#if defined(_OPENACC) || defined(_OPENMP)
   ! This differentiation is necessary for OpenMP, because it does not have the
   ! equivalent of acc_attach as used in copy_or_update_pointer
   if (first_alloc) then
      
   else
      
   end if

   call copy_or_update(ps(igrid)%igrid)
   call copy_or_update(ps1(igrid)%igrid) 
   call copy_or_update(ps2(igrid)%igrid)

   call copy_or_update_pointer(ps(igrid)%w, no_update=.true.)
   call copy_or_update_pointer(ps1(igrid)%w, no_update=.true.)
   call copy_or_update_pointer(ps2(igrid)%w, no_update=.true.)

   call copy_or_update_pointer(ps(igrid)%is_physical_boundary)
   call copy_or_update_pointer(ps1(igrid)%is_physical_boundary, no_update=.true.)
   call copy_or_update_pointer(ps2(igrid)%is_physical_boundary, no_update=.true.)
   call copy_or_update_pointer(psc(igrid)%w, no_update=.true.)
   ! The metrics are already resident on the device for every block (bgeo and
   ! bgeoc are allocated once in initialize_vars) and were filled above, on
   ! whichever side fill_geometry_* chose; ps1/ps2/psc share them, so there is
   ! nothing to do per state here.
#endif

 end subroutine alloc_node