strjoin_characters_array Function

private pure function strjoin_characters_array(array, sep, is_trim, is_col) result(join)

Arguments

TypeIntentOptionalAttributesName
character(kind=CK,len=*), intent(in) :: array(1:,1:)
character(kind=CK,len=*), intent(in), optional :: sep
logical, intent(in), optional :: is_trim
logical, intent(in), optional :: is_col

Return Value type(string),allocatable,(:)


Calls

proc~~strjoin_characters_array~~CallsGraph proc~strjoin_characters_array strjoin_characters_array proc~strjoin_characters~2 strjoin_characters proc~strjoin_characters_array->proc~strjoin_characters~2

Called by

proc~~strjoin_characters_array~~CalledByGraph proc~strjoin_characters_array strjoin_characters_array interface~strjoin~2 strjoin interface~strjoin~2->proc~strjoin_characters_array

Contents


Source Code

  pure function strjoin_characters_array(array, sep, is_trim, is_col) result(join)
   !< Return a string that is a join of columns or rows of an array of characters.
   !<
   !< The join-separator is set equals to a null string '' if custom separator isn't specified.
   !< The trim function is applied to array items if optional logical is_trim variable isn't set to .false.
   !< The is_col is setup the direction of join: within default columns (.true.) or rows(.false.).
   !<
   !<```fortran
   !< character(len=10)         :: chars_arr(3, 2)
   !< logical                   :: test_passed(9)
   !< chars_arr(:, 1) = ['one       ', 'two       ', 'three     ']
   !< chars_arr(:, 2) = ['ONE       ', 'TWO       ', 'THREE     ']
   !<
   !< test_passed(1) = all( strjoin(array=chars_arr) == &
   !<                       reshape([string('onetwothree'), string('ONETWOTHREE')], &
   !<                       shape = [2]) )
   !<
   !< test_passed(2) = all( strjoin(array=chars_arr, is_trim=.false.) ==  &
   !<                       reshape([string('one       two       three     '),  &
   !<                                string('ONE       TWO       THREE     ')], &
   !<                       shape = [2]) )
   !<
   !< test_passed(3) = all( strjoin(array=chars_arr, sep='_') == &
   !<                       reshape([string('one_two_three'), string('ONE_TWO_THREE')], &
   !<                       shape = [2]) )
   !<
   !< test_passed(4) = all( strjoin(array=chars_arr, sep='_', is_trim=.false.) ==  &
   !<                       reshape([string('one       _two       _three     '),  &
   !<                                string('ONE       _TWO       _THREE     ')], &
   !<                       shape = [2]) )
   !<
   !< test_passed(5) = all( strjoin(array=chars_arr, is_col=.false.) == &
   !<                       reshape([string('oneONE'), string('twoTWO'), string('threeTHREE')], &
   !<                       shape = [3]) )
   !<
   !< test_passed(6) = all( strjoin(array=chars_arr, is_trim=.false., is_col=.false.) ==  &
   !<                       reshape([string('one       ONE       '),  &
   !<                                string('two       TWO       '),  &
   !<                                string('three     THREE     ')], &
   !<                       shape = [3]) )
   !<
   !< test_passed(7) = all( strjoin(array=chars_arr, sep='_', is_col=.false.) == &
   !<                       reshape([string('one_ONE'), string('two_TWO'), string('three_THREE')], &
   !<                       shape = [3]) )
   !<
   !< test_passed(8) = all( strjoin(array=chars_arr, sep='_', is_trim=.false., is_col=.false.) ==  &
   !<                       reshape([string('one       _ONE       '),  &
   !<                                string('two       _TWO       '),  &
   !<                                string('three     _THREE     ')], &
   !<                       shape = [3]) )
   !<
   !< chars_arr(2,1) = ''
   !< test_passed(9) = all( strjoin(array=chars_arr, sep='_', is_col=.false.) ==  &
   !<                       reshape([string('one_ONE'),  &
   !<                                string('TWO'),  &
   !<                                string('three_THREE')], &
   !<                       shape = [3]) )
   !<
   !< print '(L1)', all(test_passed)
   !<```
   !=> T <<<
   character(kind=CK, len=*), intent(in)           :: array(1:, 1:) !< Array to be joined.
   character(kind=CK, len=*), intent(in), optional :: sep       !< Separator.
   logical,                   intent(in), optional :: is_trim   !< Flag to setup trim character or not
   logical,                   intent(in), optional :: is_col    !< Direction: 'columns' if .true. or 'rows' if .false.
   type(string),              allocatable          :: join(:)   !< The join of array.
   character(kind=CK, len=:), allocatable          :: slice(:)  !< The column or row slice of array
   character(kind=CK, len=:), allocatable          :: sep_      !< Separator, default value.
   logical                                         :: is_trim_  !< Flag to setup trim character or not
   logical                                         :: is_col_   !< Direction, default value.
   integer                                         :: a, join_size, slice_size  !< Counter, sizes of join vector and of slice of array
   integer                                         :: item_len  !< Length of array item (all items of character array have equal lengths)

   item_len = len(array(1,1)) !< all items of character array have equal lengths
   sep_     = ''     ; if (present(sep)) sep_ = sep
   is_trim_ = .true. ; if (present(is_trim)) is_trim_ = is_trim
   is_col_  = .true. ; if (present(is_col)) is_col_ = is_col

   if (is_col_) then
       join_size  = size(array, dim=2)
       slice_size = size(array, dim=1)

       if (.not.allocated(join))  allocate(join(join_size))
       if (.not.allocated(slice)) allocate(character(len=item_len) :: slice(slice_size))
       do a = 1, join_size
           slice(:) = array(:, a)
           join(a)  = strjoin_characters(slice, sep_, is_trim_)
       end do
   else
       join_size  = size(array, dim=1)
       slice_size = size(array, dim=2)

       if (.not.allocated(join))  allocate(join(join_size))
       if (.not.allocated(slice)) allocate(character(len=item_len) :: slice(slice_size))
       do a = 1, join_size
           slice(:) = array(a, :)
           join(a)  = strjoin_characters(slice, sep_, is_trim_)
       end do
   endif
   endfunction strjoin_characters_array