genere_surf_poly Subroutine

subroutine genere_surf_poly(long1, long2, deg1, deg2, tab_out, tab_coef)

génère une surface

Arguments

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

taille x

integer(kind=I4), intent(in) :: long2

taille y

integer(kind=I4), intent(in) :: deg1

degré selon x

integer(kind=I4), intent(in) :: deg2

degré selon y

real(kind=R8), intent(out), dimension(1:long1, 1:long2) :: tab_out

tableau résultant : surface

real(kind=R8), intent(out), dimension(1:(deg1+1) * (deg2+1)) :: tab_coef

tableau des coefficients


Calls

proc~~genere_surf_poly~~CallsGraph proc~genere_surf_poly genere_surf_poly proc~coeff_tcheby_vers_monome coeff_tcheby_vers_monome proc~genere_surf_poly->proc~coeff_tcheby_vers_monome proc~tcheby tcheby proc~genere_surf_poly->proc~tcheby

Called by

proc~~genere_surf_poly~~CalledByGraph proc~genere_surf_poly genere_surf_poly program~test_tchebychev test_tchebychev program~test_tchebychev->proc~genere_surf_poly

Source Code

   subroutine genere_surf_poly(long1, long2, deg1, deg2, tab_out, tab_coef)
   !! génère une surface
   implicit none
   integer(kind=I4), intent(in )                                     :: long1    !! *taille x*
   integer(kind=I4), intent(in )                                     :: long2    !! *taille y*
   integer(kind=I4), intent(in )                                     :: deg1     !! *degré selon x*
   integer(kind=I4), intent(in )                                     :: deg2     !! *degré selon y*
   real   (kind=R8), intent(out), dimension(1:long1, 1:long2)        :: tab_out  !! *tableau résultant : surface*
   real   (kind=R8), intent(out), dimension(1:(deg1+1) * (deg2+1))   :: tab_coef !! *tableau des coefficients*

      real(kind=R8)    :: xi, xj
      integer(kind=I4) :: i, j, ij, k1, k2, k1k2

      real(kind=R8), dimension(0:deg1) :: ai
      real(kind=R8), dimension(0:deg2) :: aj

      real(kind=R8), dimension(0:deg1) :: ai_m

      real(kind=R8), dimension(1:long1) :: val_xi_t
      real(kind=R8), dimension(1:long1) :: val_xi_m

      call random_number( ai(0:deg1) )
      call random_number( aj(0:deg2) )

      ai = +9 * ai - 4._R8
      aj = -5 * aj + 8._R8
      ! =========================== SIMPLE CHECK =====================================================

      ! A combination of Tchebychev polynomials must
      ! yield the same results as a classical polynomial
      !--------------------------------------------
      val_xi_t = 0._R8
      do i = 1, long1
         xi = -1. + (i - 1) * 2. / (long1 - 1)

         do k1 = 0, deg1
            val_xi_t(i) = val_xi_t(i) + ai(k1) * tcheby(n = k1, x = xi)
         enddo
      enddo
      !--------------------------------------------
      ! Towards equivalent classical polynomial
      call coeff_tcheby_vers_monome(coeff_t = ai(0:deg1), coeff_m = ai_m(0:deg1), deg = deg1)

      val_xi_m = 0._R8
      do i = 1, long1
         xi = -1. + (i - 1) * 2. / (long1 - 1)

         do k1 = 0, deg1
            val_xi_m(i) = val_xi_m(i) + ai_m(k1) * (xi**k1)
         enddo
      enddo
      !--------------------------------------------
      write(*,*) 'Equivalence of Tchebychev and classical polynomials'
      write(*,*) 'Difference must be negligible'
      write(*,*) ' Diff = ', maxval( abs( val_xi_m - val_xi_t ) )
      !--------------------------------------------
      ! =========================== END SIMPLE CHECK ==================================================

      tab_coef = 0._R8
      ij = 0
      do j = 0, deg2
         do i = 0, deg1
            ij = ij + 1
            tab_coef(ij) = ai(i) * aj(j)
         enddo
      enddo

      tab_out = 0._R8
      do j = 1, long2
         xj = -1. + (j - 1)* 2. / (long2 - 1)

         do i = 1, long1
            xi = -1. + (i - 1) * 2. / (long1 - 1)

            k1k2 = 0
            do k2 = 0, deg2
            do k1 = 0, deg1

               k1k2 = k1k2 + 1
               tab_out(i, j) = tab_out(i, j) + tab_coef(k1k2) * (xi ** k1) * (xj ** k2)

            enddo
            enddo
         enddo

      enddo

   return
   endsubroutine genere_surf_poly