test_interp_pond Subroutine

subroutine test_interp_pond(ordre)

Test interpolation/weighting function for a particular order

Arguments

Type IntentOptional Attributes Name
integer(kind=I4), intent(in) :: ordre

order

Calls

proc~~test_interp_pond~~CallsGraph proc~test_interp_pond test_interp_pond proc~def_tab1d def_tab1D proc~test_interp_pond->proc~def_tab1d proc~def_tab2d def_tab2D proc~test_interp_pond->proc~def_tab2d proc~interp1d interp1D proc~test_interp_pond->proc~interp1d proc~interp2d interp2D proc~test_interp_pond->proc~interp2d proc~restrict1d restrict1D proc~test_interp_pond->proc~restrict1d proc~restrict2d restrict2D proc~test_interp_pond->proc~restrict2d proc~interp interp proc~interp1d->proc~interp proc~interp2d->proc~interp1d proc~restrict restrict proc~restrict1d->proc~restrict proc~restrict2d->proc~restrict1d

Called by

proc~~test_interp_pond~~CalledByGraph proc~test_interp_pond test_interp_pond program~test_intpl test_intpl program~test_intpl->proc~test_interp_pond

Source Code

   subroutine test_interp_pond( ordre )
   !! Test interpolation/weighting function for a particular order
   implicit none
   integer(kind=I4), intent(in) :: ordre !! order

      integer(kind=I4) :: i, ii, j, jj, istat1, istat2

      real(kind=R8), allocatable, dimension(:)   :: tableau1D, tab_f1D, tab_g1D, erreur1D
      real(kind=R8), allocatable, dimension(:,:) :: tableau2D, tab_f2D, tab_g2D, erreur2D

      type(tborne) :: bfin, bgro

      allocate( tableau1D(0:n2),  tab_f1D(0:n2),   &  !
                  tab_g1D(0:n1), erreur1D(0:n2),   &  !
                  stat = istat1 )                     !

      allocate( tableau2D(0:n2, 0:n2),  tab_f2D(0:n2, 0:n2),   &  !
                  tab_g2D(0:n1, 0:n1), erreur2D(0:n2, 0:n2),   &  !
                  stat = istat2 )                                 !

      if ( istat1 + istat2 /=0 ) stop '"test_interp_pond" problem of allocation'

      !.............................................................
      do ii = 0, n1
         i = 2*ii
         tableau1D(ii) = def_tab1D(i) ! initialisation à une fonction ressemblant à UN noyau élastique
      enddo

      call interp1D( tabgros = tableau1D(0:n1),    &  !
                     lb_gros = 0,                  &  !
                     tabfin  = tab_f1D(0:n2),      &  !
                     lb_fin  = 0,                  &  !
                     ub_gros = n1,                 &  !
                     ordre   = ordre )                ! interpolation de ce tableau

      do i = 0, n2
         erreur1D(i) = 200*abs( ( def_tab1D(i) - tab_f1D(i) ) / &  !
                                ( def_tab1D(i) + tab_f1D(i) ) )    ! comparaison théorique/interpolé
      enddo
      write(*,*) 'interp 1D - max err, mean err: :         ', maxval( erreur1D(0:n2) ), sum( erreur1D(0:n2) ) / (n2 + 1)

      !-!<.............................................................

      do i = 0, n2
         tableau1D(i) = def_tab1D(i) ! initialisation à une fonction ressemblant à UN noyau élastique
      enddo

      call restrict1D( tabfin  = tableau1D(0:n2),     &  !
                       lb_fin  = 0,                   &  !
                       tabgros = tab_g1D(0:n1),       &  !
                       lb_gros = 0,                   &  !
                       ub_gros = n1,                  &  !
                       ordre   = ordre )                 ! restriction de ce tableau

      do ii = 0, n1
         erreur1D(ii) = 200*abs( ( def_tab1D(2*ii) - tab_g1D(ii) ) / &  !
                                 ( def_tab1D(2*ii) + tab_g1D(ii) ) )    ! comparaison théorique/interpolé
      enddo
      write(*,*) 'weight 1D - max err, mean err:           ',  maxval( erreur1D(0:n1) ), sum( erreur1D(0:n1) ) / (n1 + 1)

      !-!<.............................................................

      do i = 0, n2
         tableau1D(i) = def_tab1D(i) ! initialisation à une fonction ressemblant à UN noyau élastique
      enddo

      call restrict1D( tabfin  = tableau1D(0:n2),  &  !
                       lb_fin  = 0,                &  !
                       tabgros = tab_g1D(0:n1),    &  !
                       lb_gros = 0,                &  !
                       ub_gros = n1,               &  !
                       ordre   = ordre )              ! restriction de ce tableau

      call interp1D( tabgros = tab_g1D(0:n1),      &  !
                     lb_gros = 0,                  &  !
                     tabfin  = tab_f1D(0:n2),      &  !
                     lb_fin  = 0,                  &  !
                     ub_gros = n1,                 &  !
                     ordre   = ordre )                ! interpolation de ce tableau

      do i = 0, n2
         erreur1D(i) = 200*abs( ( tableau1D(i) - tab_f1D(i) ) / &  !
                                ( tableau1D(i) + tab_f1D(i) ) )    ! comparaison avant/après
      enddo
      write(*,*) 'weight + interp 1D - max err, mean err:  ', maxval( erreur1D(0:n2) ), sum( erreur1D(0:n2) ) / (n2 + 1)

      !.............................................................
      ! Idem 2D
      !.............................................................

      do jj = 0, n1
      do ii = 0, n1
         i = 2*ii
         j = 2*jj
         tableau2D(ii, jj) = def_tab2D(i, j)
      enddo
      enddo

      bfin = tborne( lb1 = 0, ub1 = n2, lb2 = 0, ub2 = n2 )
      bgro = tborne( lb1 = 0, ub1 = n1, lb2 = 0, ub2 = n1 )

      call interp2D( tabgro = tableau2D(0:n1, 0:n1),  &  !
                     bgro   = bgro,                   &  !
                     tabfin = tab_f2D(0:n2, 0:n2),    &  !
                     bfin   = bfin,                   &  !
                     ordre  = ordre )                    !

      do j = 0, n2
      do i = 0, n2
         erreur2D(i, j) = 200*abs( ( def_tab2D(i,j) - tab_f2D(i,j) ) / &  !
                                   ( def_tab2D(i,j) + tab_f2D(i,j) ) )    !
      enddo
      enddo
      write(*,*) 'interp 2D - max err, mean err:           ',  maxval( erreur2D(0:n2, 0:n2) ), sum( erreur2D(0:n2, 0:n2) ) / (n2 + 1)**2

      !.............................................................

      do j = 0, n2
      do i = 0, n2
         tableau2D(i, j) = def_tab2D(i, j)
      enddo
      enddo

      bfin = tborne( lb1 = 0, ub1 = n2, lb2 = 0, ub2 = n2 )
      bgro = tborne( lb1 = 0, ub1 = n1, lb2 = 0, ub2 = n1 )

      call restrict2D( tabfin  = tableau2D(0:n2, 0:n2),  &  !
                       bfin    = bfin,                   &  !
                       tabgros = tab_g2D(0:n1, 0:n1),    &  !
                       bgros   = bgro,                   &  !
                       ordre   = ordre )                    !

      do jj = 0, n1
      do ii = 0, n1
         erreur2D(ii, jj) = 200*abs( ( def_tab2D(2*ii, 2*jj) - tab_g2D(ii, jj) ) / &  !
                                     ( def_tab2D(2*ii, 2*jj) + tab_g2D(ii, jj) ) )    !
      enddo
      enddo

      write(*,*) 'weight 2D - max err, mean err:           ', maxval( erreur2D(0:n1, 0:n1) ), sum( erreur2D(0:n1, 0:n1) ) / (n1 + 1)**2

      !.............................................................

      do j = 0, n2
      do i = 0, n2
         tableau2D(i, j) = def_tab2D(i, j)
      enddo
      enddo

      bfin = tborne( lb1 = 0, ub1 = n2, lb2 = 0, ub2 = n2 )
      bgro = tborne( lb1 = 0, ub1 = n1, lb2 = 0, ub2 = n1 )

      call restrict2D( tabfin  = tableau2D(0:n2, 0:n2),     &  !
                       bfin    = bfin,                      &  !
                       tabgros = tab_g2D(0:n1, 0:n1),       &  !
                       bgros   = bgro,                      &  !
                       ordre   = ordre )                       !

      call interp2D( tabgro = tab_g2D(0:n1, 0:n1),       &  !
                     bgro   = bgro,                      &  !
                     tabfin = tab_f2D(0:n2, 0:n2),       &  !
                     bfin   = bfin,                      &  !
                     ordre  = ordre )                       !

      do j = 0, n2
      do i = 0, n2
         erreur2D(i,j) = 200*abs( ( tableau2D(i, j) - tab_f2D(i, j) ) / &  !
                                  ( tableau2D(i, j) + tab_f2D(i, j ) ) )   !
      enddo
      enddo
      write(*,*) 'weight + interp 2D - max err, mean err:  ',  maxval( erreur2D(0:n2, 0:n2) ), sum( erreur2D(0:n2, 0:n2) ) / (n2 + 1)**2

      deallocate( tableau1D, tab_f1D, tab_g1D, erreur1D )
      deallocate( tableau2D, tab_f2D, tab_g2D, erreur2D )

   return
   endsubroutine test_interp_pond