restrict Function

private function restrict(tab, lb, ind, ordre)

Restrict evenly spaced points

Arguments

Type IntentOptional Attributes Name
real(kind=R8), intent(in), dimension(lb:) :: tab

tableau 1D à réduire
integer(kind=4), intent(in) :: lb

borne inférieure
integer(kind=4), intent(in) :: ind

position de l’élément “milieu”
integer(kind=4), intent(in) :: ordre

ordre de la restriction 1, 3, 5 ou 7

Return Value real(kind=R8)

valeur particulière pondérée


Called by

proc~~restrict~~CalledByGraph proc~restrict restrict proc~restrict1d restrict1D proc~restrict1d->proc~restrict proc~restrict2d restrict2D proc~restrict2d->proc~restrict1d proc~test_interp_pond test_interp_pond proc~test_interp_pond->proc~restrict1d proc~test_interp_pond->proc~restrict2d program~test_intpl test_intpl program~test_intpl->proc~test_interp_pond

Source Code

function restrict(tab, lb, ind, ordre)
!! Restrict evenly spaced points
implicit none
real(kind=R8)                               :: restrict  !! *valeur particulière pondérée*
integer(kind=4), intent(in)                 :: lb        !! *borne inférieure*
integer(kind=4), intent(in)                 :: ind       !! *position de l'élément "milieu"*
integer(kind=4), intent(in)                 :: ordre     !! *ordre de la restriction 1, 3, 5 ou 7*
real(kind=R8),   intent(in), dimension(lb:) :: tab       !! *tableau 1D à réduire*

   select case (ordre)

      case(0)
         restrict =  cp0_00*tab(ind)

      case(1)
         restrict =  cp1_00*tab(ind-1) +  &  !
                     cp1_01*tab(ind  ) +  &  !
                     cp1_02*tab(ind+1)       !

      case(3)
         restrict =  cp3_00*tab(ind-3) +  &  !
                     cp3_01*tab(ind-2) +  &  !
                     cp3_02*tab(ind-1) +  &  !
                     cp3_03*tab(ind  ) +  &  !
                     cp3_04*tab(ind+1) +  &  !
                     cp3_05*tab(ind+2) +  &  !
                     cp3_06*tab(ind+3)       !

      case(5)
         restrict =  cp5_00*tab(ind-5) +  &  !
                     cp5_01*tab(ind-4) +  &  !
                     cp5_02*tab(ind-3) +  &  !
                     cp5_03*tab(ind-2) +  &  !
                     cp5_04*tab(ind-1) +  &  !
                     cp5_05*tab(ind  ) +  &  !
                     cp5_06*tab(ind+1) +  &  !
                     cp5_07*tab(ind+2) +  &  !
                     cp5_08*tab(ind+3) +  &  !
                     cp5_09*tab(ind+4) +  &  !
                     cp5_10*tab(ind+5)       !

      case(7)
         restrict =  cp7_00*tab(ind-7) +  &  !
                     cp7_01*tab(ind-6) +  &  !
                     cp7_02*tab(ind-5) +  &  !
                     cp7_03*tab(ind-4) +  &  !
                     cp7_04*tab(ind-3) +  &  !
                     cp7_05*tab(ind-2) +  &  !
                     cp7_06*tab(ind-1) +  &  !
                     cp7_07*tab(ind  ) +  &  !
                     cp7_08*tab(ind+1) +  &  !
                     cp7_09*tab(ind+2) +  &  !
                     cp7_10*tab(ind+3) +  &  !
                     cp7_11*tab(ind+4) +  &  !
                     cp7_12*tab(ind+5) +  &  !
                     cp7_13*tab(ind+6) +  &  !
                     cp7_14*tab(ind+7)       !

      case default
         stop 'Bad choice in function "restrict"'

   endselect

return
endfunction restrict