profil_theo_trie_1D Subroutine

private subroutine profil_theo_trie_1D(tab, lg, x, mx)

Note

Function that generates the heights when the function limits have been determined.

Arguments

Type IntentOptional Attributes Name
real(kind=R8), intent(out), dimension(1:lg) :: tab

height vector
integer(kind=I4), intent(in) :: lg

height vector size
real(kind=R8), intent(in), dimension( : ) :: x

unknowns: height function limits
type(moment_stat), intent(out) :: mx

resulting statistical moments

Calls

proc~~profil_theo_trie_1d~~CallsGraph proc~profil_theo_trie_1d profil_theo_trie_1D std_array std_array proc~profil_theo_trie_1d->std_array

Called by

proc~~profil_theo_trie_1d~~CalledByGraph proc~profil_theo_trie_1d profil_theo_trie_1D proc~build_heights build_heights proc~build_heights->proc~profil_theo_trie_1d proc~add_nois add_nois proc~add_nois->proc~build_heights proc~calc_z_f calc_z_f proc~calc_z_f->proc~build_heights proc~calc_z_i calc_z_i proc~calc_z_i->proc~build_heights proc~sub_surf sub_surf proc~sub_surf->proc~build_heights proc~read_job read_job proc~read_job->proc~add_nois proc~read_job->proc~calc_z_f proc~read_job->proc~calc_z_i proc~read_job->proc~sub_surf proc~prg_surf prg_surf proc~prg_surf->proc~read_job program~main main program~main->proc~prg_surf

Source Code

   subroutine profil_theo_trie_1D(tab, lg, x, mx)
   !================================================================================================
   !<@note Function that generates the heights when the function limits have been determined.
   !<
   !<@endnote
   !------------------------------------------------------------------------------------------------
   implicit none
   integer (kind=I4), intent(in )                  :: lg    !! *height vector size*
   real    (kind=R8), intent(out), dimension(1:lg) :: tab   !! *height vector*
   real    (kind=R8), intent(in ), dimension( :  ) :: x     !! *unknowns: height function limits*
   type(MOMENT_STAT), intent(out)                  :: mx    !! *resulting statistical moments*

      real   (kind=R8) :: b1, b2, alp, bet, tmp
      integer(kind=I4) :: i

      select case(PARAM%func_gen)

         case(FCT_TANG)

            b1 = -PI_R8/2 *(UN-x(1))
            b2 = +PI_R8/2 *(UN-x(2))
            alp = -(b2-lg*b1)/(b2-b1)
            bet =     (lg- 1)/(b2-b1)

            do i = 1, lg
               tab(i) = tan( (i*UN+alp)/bet )
            enddo

         case(FCT_EXPO)

            b1 = -(UN-x(1))/x(1)
            b2 = +(UN-x(2))/x(2)
            alp = -(b2-lg*b1)/(b2-b1)
            bet =     (lg- 1)/(b2-b1)
            do i = 1, lg
               tmp = (i*UN+alp)/bet
               tmp = max(-0.9*HIG_E8, tmp)
               tmp = min(+0.9*HIG_E8, tmp)

               tab(i) = sign(UN, tmp) * (UN - exp(-abs(tmp))) + (x(3) / (b2-b1)**3) * tmp**3
            enddo

      endselect

      call std_array(tab = tab(1:lg), mx = mx)

      mx%mu = 0._R8
      mx%si = 1._R8

   return
   endsubroutine profil_theo_trie_1D