spct_sur Subroutine

private subroutine spct_sur(file_spct, apod)

Note

Returns the default surface spectrum

Arguments

Type IntentOptional Attributes Name
character(len=*), intent(in), optional :: file_spct

txt file containing the surface FFT module
logical(kind=I4), intent(in), optional :: apod

window applied to surface?

Calls

proc~~spct_sur~~CallsGraph proc~spct_sur spct_sur calc_fftw3 calc_fftw3 proc~spct_sur->calc_fftw3 get_unit get_unit proc~spct_sur->get_unit proc~apod_sur apod_sur proc~spct_sur->proc~apod_sur trans_corner2center trans_corner2center proc~spct_sur->trans_corner2center apod apod proc~apod_sur->apod std_array std_array proc~apod_sur->std_array

Called by

proc~~spct_sur~~CalledByGraph proc~spct_sur spct_sur proc~read_job read_job proc~read_job->proc~spct_sur proc~prg_surf prg_surf proc~prg_surf->proc~read_job program~main main program~main->proc~prg_surf

Source Code

   subroutine spct_sur(file_spct, apod)
   !================================================================================================
   !<@note Returns the default surface spectrum
   !<
   !<@endnote
   !------------------------------------------------------------------------------------------------
   implicit none
   character(len=*), intent(in), optional :: file_spct   !! *txt file containing the surface FFT module*
   logical(kind=I4), intent(in), optional :: apod        !! *window applied to surface?*

      integer(kind=I4) :: w, h, ww, hh, i, j, np, txt_file
      logical(kind=I4) :: apod_surf

      character(len=512) :: str

      real(kind=R8),    dimension(:,:), allocatable :: tab_tmp, tab_freq1, tab_freq2, tab_spc
      complex(kind=R8), dimension(:,:), allocatable :: tab_cmpl, cmpl1

      w = PARAM%width
      h = PARAM%height

      if ( present(file_spct) ) then

         ! use in the program -> arguments passed to subroutine
         str = file_spct
         apod_surf = apod

      else

         ! use in script -> arguments passed to batch file
         read(JOB,*) str       ; LINE_READ = LINE_READ + 1 ; write(SPY,*) "line: ", LINE_READ, 'file_spct: ', trim(str)
         read(JOB,*) apod_surf ; LINE_READ = LINE_READ + 1 ; write(SPY,*) "line: ", LINE_READ, 'apod surf: ', apod_surf

      endif

      allocate( tab_tmp(1:w, 1:h) )
      allocate( tab_freq1(1:w, 1:h), tab_freq2(1:w, 1:h) )
      allocate( tab_cmpl(1:w, 1:h), cmpl1(1:w, 1:h) )

      if ( apod_surf ) then

         tab_tmp(1:w, 1:h) = PARAM%surf(1:w, 1:h)

         call apod_sur()

      endif

      cmpl1(1:w, 1:h) = cmplx( PARAM%surf(1:w, 1:h), 0, kind = R8 )

      call calc_fftw3(   sens = FORWARD,                    &  ! IN
                       tab_in = cmpl1(1:w, 1:h),            &  ! IN
                       tab_ou = tab_cmpl(1:w, 1:h),         &  ! OUT
                         long = w,                          &  ! IN
                         larg = h)                             ! IN


      tab_freq1(1:w, 1:h) = log10( abs( tab_cmpl(1:w, 1:h) ) + UN )

      call trans_corner2center(  tab_in  = tab_freq1(1:w, 1:h),  &  ! IN
                                 tab_out = tab_freq2(1:w, 1:h),  &  ! OUT
                                 long    = w,                    &  ! IN
                                 larg    = h  )                     ! IN

      np = 50     ! reduce image size
      ww = w / np
      hh = h / np

      allocate( tab_spc(1:ww, 1:hh) )

      do i = 1, ww
      do j = 1, hh

         tab_spc(i, j) = sum( tab_freq2( (i - 1) * np + 1 : i * np,  &  !
                                         (j - 1) * np + 1 : j * np  ) ) !

      enddo
      enddo

      call get_unit( txt_file )

      ! Ouvrir un fichier binaire
      open( newunit = txt_file, file = trim(str), action = "write" )

         ! Écrire les dimensions (pour Python)
         write(txt_file, *) ww, hh

         ! Écrire les données en mémoire contiguë
         write(txt_file, *) tab_spc(1:ww, 1:hh)

      close(txt_file)

      if ( apod_surf ) PARAM%surf(1:w, 1:h) = tab_tmp(1:w, 1:h)

      deallocate( tab_tmp, tab_freq1, tab_freq2, tab_spc )
      deallocate( tab_cmpl, cmpl1 )

   return
   endsubroutine spct_sur