lohner_grid Subroutine

private subroutine lohner_grid()

Uses

  • proc~~lohner_grid~~UsesGraph proc~lohner_grid lohner_grid module~mod_forest mod_forest proc~lohner_grid->module~mod_forest module~mod_global_parameters mod_global_parameters proc~lohner_grid->module~mod_global_parameters 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

Arguments

None

Called by

proc~~lohner_grid~~CalledByGraph proc~lohner_grid lohner_grid proc~errest errest proc~errest->proc~lohner_grid proc~resettree resettree proc~resettree->proc~errest proc~settree settree proc~settree->proc~errest proc~main main proc~main->proc~settree proc~timeintegration timeintegration proc~main->proc~timeintegration proc~timeintegration->proc~resettree program~agile agile program~agile->proc~main

Source Code

  subroutine lohner_grid()
    use mod_forest, only: coarsen, refine
    use mod_global_parameters

    integer                            :: igrid, iigrid
    integer                            :: iflag, idims1, idims2, level
    integer                            :: ix1, ix2, ix3
    double precision                   :: threshold, error, numerator, denominator
    logical                            :: refineflag, coarsenflag
    double precision, parameter        :: epsilon=1.0d-6

    
    do iigrid=1,igridstail; igrid=igrids(iigrid);

      level       = node(plevel_,igrid)
      threshold   = refine_threshold(level)

      refineflag  = .false.
      coarsenflag = .true.
      
      do ix3 = ixMlo3, ixMhi3
         do ix2 = ixMlo2, ixMhi2
            do ix1 = ixMlo1, ixMhi1

               error = zero
               
               do iflag = 1, nw
                  if(w_refine_weight(iflag)==0.d0) cycle

                  numerator   = zero
                  denominator = zero
                  
                  do idims1 = 1, ndim
                     do idims2 = 1, ndim

                        numerator = numerator + &
                             ( &
                             ( bg(1)%w(ix1+kr(1,idims2)+kr(1,idims1), &
                             ix2+kr(2,idims2)+kr(2,idims1), &
                             ix3+kr(3,idims2)+kr(3,idims1), iflag, igrid)    &
                             - bg(1)%w(ix1-kr(1,idims2)+kr(1,idims1), &
                             ix2-kr(2,idims2)+kr(2,idims1), &
                             ix3-kr(3,idims2)+kr(3,idims1), iflag, igrid) )  &
                             - &
                             ( bg(1)%w(ix1+kr(1,idims2)-kr(1,idims1), &
                             ix2+kr(2,idims2)-kr(2,idims1), &
                             ix3+kr(3,idims2)-kr(3,idims1), iflag, igrid)    &
                             - bg(1)%w(ix1-kr(1,idims2)-kr(1,idims1), &
                             ix2-kr(2,idims2)-kr(2,idims1), &
                             ix3-kr(3,idims2)-kr(3,idims1), iflag, igrid) )  &
                             )**2

                        denominator = denominator + &
                             ( &
                             abs( &
                             bg(1)%w(ix1+2*kr(1,idims1), ix2+2*kr(2,idims1), ix3+2*kr(3,idims1), iflag, igrid) &
                             - bg(1)%w(ix1, ix2, ix3, iflag, igrid) &
                             ) &
                             + abs( &
                             bg(1)%w(ix1, ix2, ix3, iflag, igrid) &
                             - bg(1)%w(ix1-2*kr(1,idims1), ix2-2*kr(2,idims1), ix3-2*kr(3,idims1), iflag, igrid) &
                             ) &
                             + amr_wavefilter(level) * ( &
                             ( abs( bg(1)%w(ix1+kr(1,idims1)+kr(1,idims2), &
                             ix2+kr(2,idims1)+kr(2,idims2), &
                             ix3+kr(3,idims1)+kr(3,idims2), iflag, igrid) )   &
                             + abs( bg(1)%w(ix1-kr(1,idims1)+kr(1,idims2), &
                             ix2-kr(2,idims1)+kr(2,idims2), ix3-kr(3,idims1)+kr(3,idims2), iflag, igrid) ) ) &
                             + &
                             ( abs( bg(1)%w(ix1+kr(1,idims1)-kr(1,idims2), &
                             ix2+kr(2,idims1)-kr(2,idims2), &
                             ix3+kr(3,idims1)-kr(3,idims2), iflag, igrid) )   &
                             + abs( bg(1)%w(ix1-kr(1,idims1)-kr(1,idims2), &
                             ix2-kr(2,idims1)-kr(2,idims2), &
                             ix3-kr(3,idims1)-kr(3,idims2), iflag, igrid) ) ) &
                             ) &
                             )**2
                     end do
                  end do

                  error = error + w_refine_weight(iflag) * sqrt( numerator / max( denominator, epsilon ) )

               end do

               if (error > threshold) then
                  refineflag = .true.
               end if
               if (error > derefine_ratio(level) * threshold) then
                  coarsenflag = .false.
               end if

            end do
         end do
      end do

      if (refineflag .and. level < refine_max_level) refine(igrid,mype)=.true.
      if (coarsenflag .and. level > 1) coarsen(igrid,mype)=.true.

    end do

  end subroutine lohner_grid