Note
Function that set parameters for image reproduction
subroutine repr_img() !================================================================================================ !<@note Function that set parameters for image reproduction !< !<@endnote !------------------------------------------------------------------------------------------------ implicit none integer(kind=I4) :: w, h, l real(kind=R8), allocatable, dimension(:,:) :: tab_tmp, surf_tmp integer(kind=I4) :: reproduction_step real(kind=R8) :: cutoff, dx, dy type(SCALE_SURF) :: scale_img_tmp type(MOMENT_STAT) :: m_res read(JOB,*) reproduction_step ; LINE_READ = LINE_READ +1 ; write(SPY,*) "line: ", LINE_READ, "reproduction_step ", reproduction_step w = PARAM%width h = PARAM%height l = PARAM%npts dx = PARAM%surf_dx dy = PARAM%surf_dy allocate( tab_tmp(1:w, 1:h) ) allocate( surf_tmp(1:w, 1:h) ) select case (reproduction_step) case(0:1) PARAM%orig_surf%cut = 0.5_R8 PARAM%curr_surf%cut = 0.5_R8 call alloc_tabs() PARAM%surf_copy(1:w, 1:h) = PARAM%surf(1:w, 1:h) call calc_moments( tab = PARAM%surf(1:w, 1:h), & ! IN mx = PARAM%m_ini, & ! OUT nb_mom = 4 ) ! IN call apod( tab_in = PARAM%surf(1:w, 1:h), & ! tab_out = tab_tmp(1:w, 1:h), & ! long = w, & ! larg = h, & ! type_apo = 'tuckey' ) ! call std_array( tab_tmp(1:w, 1:h) ) call acf_wiener( tab_in = tab_tmp(1:w, 1:h), & ! IN tab_out = PARAM%acf_surf(1:w, 1:h), & ! OUT w = w, & ! IN h = h ) ! IN call surface_analysis( app = 0 ) !-------------- NORMALIZATION ------------------------ call std_array( PARAM%surf(1:w, 1:h), PARAM%m_ini ) case(2) !------------ SAVE LOW FREQ SURF --------------------- PARAM%surf_LF(1:w, 1:h) = PARAM%surf(1:w, 1:h) !------------ REPRODUCE HIGH FREQ --------------------- PARAM%surf(1:w, 1:h) = PARAM%surf_HF(1:w, 1:h) PARAM%m_end = PARAM%m__HF PARAM%vect_h(1:l) = reshape( PARAM%surf(1:w, 1:h), [l] ) call sort_array2(tab_inout = PARAM%vect_h(1:l), n = l) surf_tmp(1:w, 1:h) = PARAM%surf(1:w, 1:h) case(3) !------------ SAVE HIGH FREQ SURF --------------------- PARAM%surf_HF(1:w, 1:h) = PARAM%surf(1:w, 1:h) PARAM%surf(1:w, 1:h) = PARAM%surf_LF(1:w, 1:h) + PARAM%surf_HF(1:w, 1:h) * PARAM%m__HF%si / PARAM%m__LF%si call std_array( PARAM%surf(1:w, 1:h) ) PARAM%vect_h(1:l) = reshape( PARAM%surf_copy(1:w, 1:h), [l] ) ! heights are sorted call sort_array2(tab_inout = PARAM%vect_h(1:l), n = l) call calc_moments( tab = PARAM%vect_h(1:l), & ! IN mx = m_res, & ! OUT nb_mom = 2 ) ! IN PARAM%vect_h(1:l) = ( PARAM%vect_h(1:l) - m_res%mu ) / m_res%si surf_tmp(1:w, 1:h) = PARAM%surf_copy(1:w, 1:h) call std_array( surf_tmp(1:w, 1:h) ) case(4) call std_array( PARAM%surf(1:w, 1:h) ) PARAM%surf(1:w, 1:h) = PARAM%surf(1:w, 1:h) * PARAM%m_ini%si + PARAM%m_ini%mu call surface_analysis( app = 1 ) endselect select case (reproduction_step) case(0) PARAM%imp_acf(1:w, 1:h) = PARAM%acf_surf(1:w, 1:h) ! the calculated moments become the prescribed ones PARAM%m_end = PARAM%m_ini ! heights are stored because they are the prescribed ones PARAM%vect_h(1:l) = reshape( PARAM%surf(1:w, 1:h), [l] ) ! shuffle the set, then ... call scramble( tab = PARAM%vect_h(1:l), & ! INOUT lg = l ) ! IN ! ... define an initial random surface ... PARAM%surf(1:w, 1:h) = reshape( PARAM%vect_h(1:l), [w, h] ) ! and sort heights call sort_array2(tab_inout = PARAM%vect_h(1:l), n = l) case(1) !------------ SUBTRACT LOW FREQ ---------------------- read(JOB,*) cutoff ; LINE_READ = LINE_READ +1 ; write(SPY,*) "line: ", LINE_READ, "cutoff ", cutoff call fft_filter( tab = PARAM%surf(1:w, 1:h), & ! IN long = w, & ! IN larg = h, & ! IN cutoff = cutoff, & ! IN bf_tab = PARAM%surf_LF(1:w, 1:h), & ! OUT multi_fft = .false., & ! IN ext = 'constant' ) ! IN PARAM%surf_HF(1:w, 1:h) = PARAM%surf(1:w, 1:h) - PARAM%surf_LF(1:w, 1:h) !------------ MOMENTS LF & HF ---------------------- call std_array( tab = PARAM%surf_HF(1:w, 1:h), mx = PARAM%m__HF ) call std_array( tab = PARAM%surf_LF(1:w, 1:h), mx = PARAM%m__LF ) !------------ PRINT LF & HF SURFS ---------------------- call init_scal( scal = scale_img_tmp, & ! out; creates a surface type, containing ... nx = w, & ! in; ... the number of points along x ... ny = h, & ! in; ... the number of points along y ... lx = PARAM%surf_width, & ! in; ... the length (default unit : m) ... ly = PARAM%surf_height, & ! in; ... the width ... unit_z = 'm' ) ! in; ... and the unit along z. call write_surf( nom_fic = "out/BF.sur", & ! tab_s = PARAM%surf_LF(1:w, 1:h), & ! scal = scale_img_tmp ) ! call write_surf( nom_fic = "out/HF.sur", & ! tab_s = PARAM%surf_HF(1:w, 1:h), & ! scal = scale_img_tmp ) ! !------------ REPRODUCE LOW FREQ ---------------------- PARAM%surf(1:w, 1:h) = PARAM%surf_LF(1:w, 1:h) PARAM%m_end = PARAM%m__LF PARAM%vect_h(1:l) = reshape( PARAM%surf(1:w, 1:h), [l] ) call sort_array2(tab_inout = PARAM%vect_h(1:l), n = l) surf_tmp(1:w, 1:h) = PARAM%surf(1:w, 1:h) case default continue endselect if ( reproduction_step > 0 .and. reproduction_step < 4 ) then !------------ DESIRED ACF: PARAM%imp_acf ------------- call apod( tab_in = surf_tmp(1:w, 1:h), & ! tab_out = tab_tmp(1:w, 1:h), & ! long = w, & ! larg = h, & ! type_apo = 'tuckey' ) ! call std_array( tab_tmp(1:w, 1:h) ) call acf_wiener( tab_in = tab_tmp(1:w, 1:h), & ! IN tab_out = PARAM%imp_acf(1:w, 1:h), & ! OUT w = w, & ! IN h = h ) ! IN endif deallocate( tab_tmp ) deallocate( surf_tmp ) return endsubroutine repr_img