code arrangement

Re-arranged the code. Will add amendments to manifest created by
--full option shortly.

Any other discussions still open?

4 files changed, 240 insertions, 229 deletions

diff --git a/fpm/src/fpm/cmd/new.f90 b/fpm/src/fpm/cmd/new.f90
index 9b0b362..52a5d42 100644
--- a/fpm/src/fpm/cmd/new.f90
+++ b/fpm/src/fpm/cmd/new.f90
@@ -7,7 +7,7 @@ module fpm_cmd_new
 !> from this type to decide what actions to take.
 !>
 !> It is virtually self-contained and so independant of the rest of the
-!> application that it could function as a seperate program.
+!> application that it could function as a separate program.
 !>
 !> The "new" subcommand options currently consist of a SINGLE top
 !> directory name to create that must have a name that is an
@@ -16,7 +16,7 @@ module fpm_cmd_new
 !> So basically this routine has already had the options vetted and
 !> just needs to conditionally create a few files.
 !>
-!> As described in the documentation documentation it will selectively
+!> As described in the documentation it will selectively
 !> create the subdirectories app/, test/, src/, and example/
 !> and populate them with sample files.
 !>
@@ -56,6 +56,8 @@ module fpm_cmd_new
 use fpm_command_line, only : fpm_new_settings
 use fpm_environment, only : run, OS_LINUX, OS_MACOS, OS_WINDOWS
 use fpm_filesystem, only : join_path, exists, basename, mkdir, is_dir
+use fpm_filesystem, only : fileopen, fileclose, filewrite, warnwrite
+use fpm_strings, only : join
 use,intrinsic :: iso_fortran_env, only : stderr=>error_unit
 implicit none
 private
@@ -148,6 +150,9 @@ character(len=:,kind=tfc),allocatable :: littlefile(:)
        &'                                                                                ',&
        &'## BUILD CONFIGURATION SECTION                                                  ',&
        &'[build]                                                                         ',&
+       &'#                                                                               ',&
+       &'# Files will be searched for automatically (by default) in src/, app/, test/    ',&
+       &'# and example/. This can be turned off for app/, test, exampl                   ',&
        &'auto-executables = true  # Toggle automatic discovery of executables            ',&
        &'auto-examples = true     # Toggle automatic discovery of example programs       ',&
        &'auto-tests = true        # Toggle automatic discovery of test executables       ',&
@@ -270,9 +275,6 @@ character(len=:,kind=tfc),allocatable :: littlefile(:)
     if(settings%with_full)then
        tomlfile=[character(len=80) ::  tomlfile,   &
        &'[dependencies]                                                                  ', &
-       &'#                                                                               ', &
-       &'#Files will be searched for automatically (by default) in                       ', &
-       &'# src/, app/, test/, and example/.                                              ', &
        &'#For a complete list of keys and their attributes see                           ', &
        &'#                                                                               ', &
        &'#  https://github.com/fortran-lang/fpm/blob/master/manifest-reference.md        ', &
@@ -311,11 +313,11 @@ character(len=*),intent(in) :: filename
     ser = toml_serializer()
     call fileopen(filename,lun) ! fileopen stops on error
 
-    call set_value(table, "name",       BNAME)        
-    call set_value(table, "version",    "0.1.0")          
-    call set_value(table, "license",    "license")        
-    call set_value(table, "author",     "Jane Doe")             
-    call set_value(table, "maintainer", "jane.doe@example.com")                    
+    call set_value(table, "name",       BNAME)
+    call set_value(table, "version",    "0.1.0")
+    call set_value(table, "license",    "license")
+    call set_value(table, "author",     "Jane Doe")
+    call set_value(table, "maintainer", "jane.doe@example.com")
     call set_value(table, "copyright",  'Copyright '//date(1:4)//', Jane Doe')
     ! continue building of manifest
     ! ...
@@ -330,95 +332,6 @@ character(len=*),intent(in) :: filename
 
 end subroutine create_verified_basic_manifest
 
-subroutine warnwrite(fname,data)
-character(len=*),intent(in) :: fname
-character(len=*),intent(in) :: data(:)
-
-    if(.not.exists(fname))then
-        call filewrite(fname,data)
-    else
-        write(stderr,'(*(g0,1x))')'<INFO>  ',fname,&
-        & 'already exists. Not overwriting'
-    endif
-
-end subroutine warnwrite
-
-subroutine fileopen(filename,lun)
-! procedure to open filedata to file filename
-use,intrinsic :: iso_fortran_env, only : &
- & stdin=>input_unit, stdout=>output_unit, stderr=>error_unit
-
-character(len=*),intent(in)   :: filename
-integer,intent(out)           :: lun
-integer                       :: i, ios
-character(len=256)            :: message
-
-    message=' '
-    ios=0
-    if(filename.ne.' ')then
-        open(file=filename, &
-        & newunit=lun, &
-        & form='formatted', &    ! FORM    = FORMATTED | UNFORMATTED
-        & access='sequential', & ! ACCESS  = SEQUENTIAL| DIRECT | STREAM
-        & action='write', &      ! ACTION  = READ|WRITE| READWRITE
-        & position='rewind', &   ! POSITION= ASIS      | REWIND | APPEND
-        & status='new', &        ! STATUS  = NEW| REPLACE| OLD| SCRATCH| UNKNOWN
-        & iostat=ios, &
-        & iomsg=message)
-    else
-        lun=stdout
-        ios=0
-    endif
-    if(ios.ne.0)then
-        write(stderr,'(*(a:,1x))')&
-        & '<ERROR> *filewrite*:',filename,trim(message)
-        lun=-1
-        stop 1
-    endif
-
-end subroutine fileopen
-
-subroutine fileclose(lun)
-use,intrinsic :: iso_fortran_env, only : &
- & stdin=>input_unit, stdout=>output_unit, stderr=>error_unit
-integer,intent(in)    :: lun
-character(len=256)    :: message
-integer               :: ios
-    if(lun.ne.-1)then
-        close(unit=lun,iostat=ios,iomsg=message)
-        if(ios.ne.0)then
-            write(stderr,'(*(a:,1x))')'<ERROR> *filewrite*:',trim(message)
-            stop 2
-        endif
-    endif
-end subroutine fileclose
-
-subroutine filewrite(filename,filedata)
-! procedure to write filedata to file filename
-use,intrinsic :: iso_fortran_env, only : &
- & stdin=>input_unit, stdout=>output_unit, stderr=>error_unit
-
-character(len=*),intent(in)           :: filename
-character(len=*),intent(in)           :: filedata(:)
-integer                               :: lun, i, ios
-character(len=256)                    :: message
-    call fileopen(filename,lun)
-    if(lun.ne.-1)then ! program currently stops on error on open, but might 
-                      ! want it to continue so -1 (unallowed LUN) indicates error
-       ! write file
-       do i=1,size(filedata)
-           write(lun,'(a)',iostat=ios,iomsg=message)trim(filedata(i))
-           if(ios.ne.0)then
-               write(stderr,'(*(a:,1x))')&
-               & '<ERROR> *filewrite*:',filename,trim(message)
-               stop 4
-           endif
-       enddo
-    endif
-    ! close file
-    call fileclose(lun)
-
-end subroutine filewrite
 
 subroutine validate_toml_data(input)
 !> verify a string array is a valid fpm.toml file
@@ -450,109 +363,6 @@ endif
 
 end subroutine validate_toml_data
 
-pure function join(str,sep,trm,left,right) result (string)
-
-!> M_strings::join(3f): append an array of character variables with specified separator into a single CHARACTER variable
-!>
-!>##NAME
-!>    join(3f) - [M_strings:EDITING] append CHARACTER variable array into
-!>    a single CHARACTER variable with specified separator
-!>    (LICENSE:PD)
-!>
-!>##SYNOPSIS
-!>
-!>    pure function join(str,sep,trm,left,right) result (string)
-!>
-!>     character(len=*),intent(in)          :: str(:)
-!>     character(len=*),intent(in),optional :: sep
-!>     logical,intent(in),optional          :: trm
-!>     character(len=*),intent(in),optional :: right
-!>     character(len=*),intent(in),optional :: left
-!>     character(len=:),allocatable         :: string
-!>
-!>##DESCRIPTION
-!>      JOIN(3f) appends the elements of a CHARACTER array into a single
-!>      CHARACTER variable, with elements 1 to N joined from left to right.
-!>      By default each element is trimmed of trailing spaces and the
-!>      default separator is a null string.
-!>
-!>##OPTIONS
-!>      STR(:)  array of CHARACTER variables to be joined
-!>      SEP     separator string to place between each variable. defaults
-!>              to a null string.
-!>      LEFT    string to place at left of each element
-!>      RIGHT   string to place at right of each element
-!>      TRM     option to trim each element of STR of trailing
-!>              spaces. Defaults to .TRUE.
-!>
-!>##RESULT
-!>      STRING  CHARACTER variable composed of all of the elements of STR()
-!>              appended together with the optional separator SEP placed
-!>              between the elements.
-!>
-!>##EXAMPLE
-!>
-!>  Sample program:
-!>
-!>   program demo_join
-!>   use M_strings, only: join
-!>   implicit none
-!>   character(len=:),allocatable  :: s(:)
-!>   character(len=:),allocatable  :: out
-!>   integer                       :: i
-!>     s=[character(len=10) :: 'United',' we',' stand,', &
-!>     & ' divided',' we fall.']
-!>     out=join(s)
-!>     write(*,'(a)') out
-!>     write(*,'(a)') join(s,trm=.false.)
-!>     write(*,'(a)') (join(s,trm=.false.,sep='|'),i=1,3)
-!>     write(*,'(a)') join(s,sep='<>')
-!>     write(*,'(a)') join(s,sep=';',left='[',right=']')
-!>     write(*,'(a)') join(s,left='[',right=']')
-!>     write(*,'(a)') join(s,left='>>')
-!>   end program demo_join
-!>
-!>  Expected output:
-!>
-!>   United we stand, divided we fall.
-!>   United     we        stand,    divided   we fall.
-!>   United    | we       | stand,   | divided  | we fall. |
-!>   United    | we       | stand,   | divided  | we fall. |
-!>   United    | we       | stand,   | divided  | we fall. |
-!>   United<> we<> stand,<> divided<> we fall.<>
-!>   [United];[ we];[ stand,];[ divided];[ we fall.];
-!>   [United][ we][ stand,][ divided][ we fall.]
-!>   >>United>> we>> stand,>> divided>> we fall.
-!>
-!>##AUTHOR
-!>    John S. Urban
-!>
-!>##LICENSE
-!>    Public Domain
-
-character(len=*,kind=tfc),intent(in)  :: str(:)
-character(len=*),intent(in),optional  :: sep, right, left
-logical,intent(in),optional           :: trm
-character(len=:,kind=tfc),allocatable :: string
-integer                               :: i
-logical                               :: trm_local
-character(len=:),allocatable          :: sep_local, left_local, right_local
-
-   if(present(sep))then    ;  sep_local=sep      ;  else  ;  sep_local=''      ;  endif
-   if(present(trm))then    ;  trm_local=trm      ;  else  ;  trm_local=.true.  ;  endif
-   if(present(left))then   ;  left_local=left    ;  else  ;  left_local=''     ;  endif
-   if(present(right))then  ;  right_local=right  ;  else  ;  right_local=''    ;  endif
-
-   string=''
-   do i = 1,size(str)
-      if(trm_local)then
-         string=string//left_local//trim(str(i))//right_local//sep_local
-      else
-         string=string//left_local//str(i)//right_local//sep_local
-      endif
-   enddo
-end function join
-
 end subroutine cmd_new
 
 end module fpm_cmd_new
diff --git a/fpm/src/fpm_command_line.f90 b/fpm/src/fpm_command_line.f90
index 18e4429..2256530 100644
--- a/fpm/src/fpm_command_line.f90
+++ b/fpm/src/fpm_command_line.f90
@@ -93,7 +93,7 @@ end type
 
 character(len=:),allocatable :: name
 character(len=:),allocatable :: os_type
-character(len=ibug),allocatable :: names(:) 
+character(len=ibug),allocatable :: names(:)
 character(len=:),allocatable :: tnames(:)
 
 character(len=:), allocatable :: version_text(:)
@@ -434,7 +434,7 @@ contains
         if(val_compiler.eq.'') then
             val_compiler='gfortran'
         endif
-   
+
         val_build=trim(merge('release','debug  ',lget('release')))
 
     end subroutine check_build_vals
diff --git a/fpm/src/fpm_filesystem.f90 b/fpm/src/fpm_filesystem.f90
index f221917..7f1cbf5 100644
--- a/fpm/src/fpm_filesystem.f90
+++ b/fpm/src/fpm_filesystem.f90
@@ -1,4 +1,5 @@
 module fpm_filesystem
+use,intrinsic :: iso_fortran_env, only : stdin=>input_unit, stdout=>output_unit, stderr=>error_unit
     use fpm_environment, only: get_os_type, &
                                OS_UNKNOWN, OS_LINUX, OS_MACOS, OS_WINDOWS, &
                                OS_CYGWIN, OS_SOLARIS, OS_FREEBSD
@@ -7,6 +8,7 @@ module fpm_filesystem
     private
     public :: basename, canon_path, dirname, is_dir, join_path, number_of_rows, read_lines, list_files, env_variable, &
             mkdir, exists, get_temp_filename, windows_path, unix_path, getline, delete_file
+    public :: fileopen, fileclose, filewrite, warnwrite
 
     integer, parameter :: LINE_BUFFER_LEN = 1000
 
@@ -73,7 +75,7 @@ function canon_path(path) result(canon)
     ! Canonicalize path for comparison
     !  Handles path string redundancies
     !  Does not test existence of path
-    ! 
+    !
     ! To be replaced by realpath/_fullname in stdlib_os
     !
     character(*), intent(in) :: path
@@ -127,7 +129,7 @@ function canon_path(path) result(canon)
             end if
 
         end if
-        
+
 
         temp(j:j) = nixpath(i:i)
         j = j + 1
@@ -152,23 +154,23 @@ function dirname(path) result (dir)
 end function dirname
 
 
-logical function is_dir(dir) 
-    character(*), intent(in) :: dir 
-    integer :: stat 
+logical function is_dir(dir)
+    character(*), intent(in) :: dir
+    integer :: stat
 
-    select case (get_os_type()) 
+    select case (get_os_type())
 
     case (OS_UNKNOWN, OS_LINUX, OS_MACOS, OS_CYGWIN, OS_SOLARIS, OS_FREEBSD)
-        call execute_command_line("test -d " // dir , exitstat=stat) 
+        call execute_command_line("test -d " // dir , exitstat=stat)
 
-    case (OS_WINDOWS) 
-        call execute_command_line('cmd /c "if not exist ' // windows_path(dir) // '\ exit /B 1"', exitstat=stat) 
+    case (OS_WINDOWS)
+        call execute_command_line('cmd /c "if not exist ' // windows_path(dir) // '\ exit /B 1"', exitstat=stat)
 
-    end select 
+    end select
 
-    is_dir = (stat == 0) 
+    is_dir = (stat == 0)
 
-end function is_dir 
+end function is_dir
 
 
 function join_path(a1,a2,a3,a4,a5) result(path)
@@ -315,7 +317,7 @@ recursive subroutine list_files(dir, files, recurse)
             do i=1,size(files)
                 if (is_dir(files(i)%s)) then
 
-                    call list_files(files(i)%s, dir_files, recurse=.true.) 
+                    call list_files(files(i)%s, dir_files, recurse=.true.)
                     sub_dir_files = [sub_dir_files, dir_files]
 
                 end if
@@ -347,7 +349,7 @@ function get_temp_filename() result(tempfile)
 
     type(c_ptr) :: c_tempfile_ptr
     character(len=1), pointer :: c_tempfile(:)
-    
+
     interface
 
         function c_tempnam(dir,pfx) result(tmp) bind(c,name="tempnam")
@@ -389,7 +391,7 @@ function windows_path(path) result(winpath)
         winpath(idx:idx) = '\'
         idx = index(winpath,'/')
     end do
-    
+
 end function windows_path
 
 
@@ -408,7 +410,7 @@ function unix_path(path) result(nixpath)
         nixpath(idx:idx) = '/'
         idx = index(nixpath,'\')
     end do
-    
+
 end function unix_path
 
 
@@ -464,5 +466,100 @@ subroutine delete_file(file)
     end if
 end subroutine delete_file
 
+subroutine warnwrite(fname,data)
+!> write trimmed character data to a file if it does not exist
+character(len=*),intent(in) :: fname
+character(len=*),intent(in) :: data(:)
+
+    if(.not.exists(fname))then
+        call filewrite(fname,data)
+    else
+        write(stderr,'(*(g0,1x))')'<INFO>  ',fname,&
+        & 'already exists. Not overwriting'
+    endif
+
+end subroutine warnwrite
+
+subroutine fileopen(filename,lun,ier)
+! procedure to open filename as a sequential "text" file
+
+character(len=*),intent(in)   :: filename
+integer,intent(out)           :: lun
+integer,intent(out),optional  :: ier
+integer                       :: i, ios
+character(len=256)            :: message
+
+    message=' '
+    ios=0
+    if(filename.ne.' ')then
+        open(file=filename, &
+        & newunit=lun, &
+        & form='formatted', &    ! FORM    = FORMATTED | UNFORMATTED
+        & access='sequential', & ! ACCESS  = SEQUENTIAL| DIRECT | STREAM
+        & action='write', &      ! ACTION  = READ|WRITE| READWRITE
+        & position='rewind', &   ! POSITION= ASIS      | REWIND | APPEND
+        & status='new', &        ! STATUS  = NEW| REPLACE| OLD| SCRATCH| UNKNOWN
+        & iostat=ios, &
+        & iomsg=message)
+    else
+        lun=stdout
+        ios=0
+    endif
+    if(ios.ne.0)then
+        write(stderr,'(*(a:,1x))')&
+        & '<ERROR> *filewrite*:',filename,trim(message)
+        lun=-1
+        if(present(ier))then
+           ier=ios
+        else
+           stop 1
+        endif
+    endif
+
+end subroutine fileopen
+
+subroutine fileclose(lun,ier)
+! simple close of a LUN.  On error show message and stop (by default)
+integer,intent(in)    :: lun
+integer,intent(out),optional :: ier
+character(len=256)    :: message
+integer               :: ios
+    if(lun.ne.-1)then
+        close(unit=lun,iostat=ios,iomsg=message)
+        if(ios.ne.0)then
+            write(stderr,'(*(a:,1x))')'<ERROR> *filewrite*:',trim(message)
+            if(present(ier))then
+               ier=ios
+            else
+               stop 2
+            endif
+        endif
+    endif
+end subroutine fileclose
+
+subroutine filewrite(filename,filedata)
+! procedure to write filedata to file filename
+
+character(len=*),intent(in)           :: filename
+character(len=*),intent(in)           :: filedata(:)
+integer                               :: lun, i, ios
+character(len=256)                    :: message
+    call fileopen(filename,lun)
+    if(lun.ne.-1)then ! program currently stops on error on open, but might
+                      ! want it to continue so -1 (unallowed LUN) indicates error
+       ! write file
+       do i=1,size(filedata)
+           write(lun,'(a)',iostat=ios,iomsg=message)trim(filedata(i))
+           if(ios.ne.0)then
+               write(stderr,'(*(a:,1x))')&
+               & '<ERROR> *filewrite*:',filename,trim(message)
+               stop 4
+           endif
+       enddo
+    endif
+    ! close file
+    call fileclose(lun)
+
+end subroutine filewrite
 
 end module fpm_filesystem
diff --git a/fpm/src/fpm_strings.f90 b/fpm/src/fpm_strings.f90
index 8e57d5b..649be36 100644
--- a/fpm/src/fpm_strings.f90
+++ b/fpm/src/fpm_strings.f90
@@ -6,6 +6,7 @@ private
 public :: f_string, lower, split, str_ends_with, string_t
 public :: string_array_contains, string_cat, operator(.in.), fnv_1a
 public :: resize
+public :: join
 
 type string_t
     character(len=:), allocatable :: s
@@ -48,7 +49,7 @@ pure logical function str_ends_with_any(s, e) result(r)
     character(*), intent(in) :: e(:)
 
     integer :: i
-    
+
     r = .true.
     do i=1,size(e)
 
@@ -76,11 +77,11 @@ function f_string(c_string)
     do i=1,n
       f_string(i:i) = c_string(i)
     end do
-  
+
 end function f_string
 
 
-!> Hash a character(*) string of default kind 
+!> Hash a character(*) string of default kind
 pure function fnv_1a_char(input, seed) result(hash)
     character(*), intent(in) :: input
     integer(int64), intent(in), optional :: seed
@@ -103,7 +104,7 @@ pure function fnv_1a_char(input, seed) result(hash)
 end function fnv_1a_char
 
 
-!> Hash a string_t array of default kind 
+!> Hash a string_t array of default kind
 pure function fnv_1a_string_t(input, seed) result(hash)
     type(string_t), intent(in) :: input(:)
     integer(int64), intent(in), optional :: seed
@@ -166,7 +167,7 @@ logical function string_array_contains(search_string,array)
 
 end function string_array_contains
 
-!> Concatenate an array of type(string_t) into 
+!> Concatenate an array of type(string_t) into
 !>  a single character
 function string_cat(strings,delim) result(cat)
     type(string_t), intent(in) :: strings(:)
@@ -191,7 +192,7 @@ function string_cat(strings,delim) result(cat)
     do i=2,size(strings)
 
         cat = cat//delim_str//strings(i)%s
-        
+
     end do
 
 end function string_cat
@@ -201,7 +202,7 @@ subroutine split(input_line,array,delimiters,order,nulls)
     ! Author: John S. Urban
     ! License: Public Domain
 
-    
+
     !  given a line of structure " par1 par2 par3 ... parn " store each par(n) into a separate variable in array.
     !    o by default adjacent delimiters in the input string do not create an empty string in the output array
     !    o no quoting of delimiters is supported
@@ -210,7 +211,7 @@ subroutine split(input_line,array,delimiters,order,nulls)
     character(len=*),optional,intent(in)     :: order       ! order of output array sequential|[reverse|right]
     character(len=*),optional,intent(in)     :: nulls       ! return strings composed of delimiters or not ignore|return|ignoreend
     character(len=:),allocatable,intent(out) :: array(:)    ! output array of tokens
-    
+
     integer                       :: n                      ! max number of strings INPUT_LINE could split into if all delimiter
     integer,allocatable           :: ibegin(:)              ! positions in input string where tokens start
     integer,allocatable           :: iterm(:)               ! positions in input string where tokens end
@@ -227,7 +228,7 @@ subroutine split(input_line,array,delimiters,order,nulls)
     integer                       :: inotnull               ! count strings not composed of delimiters
     integer                       :: ireturn                ! number of tokens returned
     integer                       :: imax                   ! length of longest token
-    
+
     ! decide on value for optional DELIMITERS parameter
     if (present(delimiters)) then                                     ! optional delimiter list was present
         if(delimiters.ne.'')then                                       ! if DELIMITERS was specified and not null use it
@@ -349,4 +350,107 @@ subroutine resize_string(list, n)
 
 end subroutine resize_string
 
+pure function join(str,sep,trm,left,right) result (string)
+
+!> M_strings::join(3f): append an array of character variables with specified separator into a single CHARACTER variable
+!>
+!>##NAME
+!>    join(3f) - [M_strings:EDITING] append CHARACTER variable array into
+!>    a single CHARACTER variable with specified separator
+!>    (LICENSE:PD)
+!>
+!>##SYNOPSIS
+!>
+!>    pure function join(str,sep,trm,left,right) result (string)
+!>
+!>     character(len=*),intent(in)          :: str(:)
+!>     character(len=*),intent(in),optional :: sep
+!>     logical,intent(in),optional          :: trm
+!>     character(len=*),intent(in),optional :: right
+!>     character(len=*),intent(in),optional :: left
+!>     character(len=:),allocatable         :: string
+!>
+!>##DESCRIPTION
+!>      JOIN(3f) appends the elements of a CHARACTER array into a single
+!>      CHARACTER variable, with elements 1 to N joined from left to right.
+!>      By default each element is trimmed of trailing spaces and the
+!>      default separator is a null string.
+!>
+!>##OPTIONS
+!>      STR(:)  array of CHARACTER variables to be joined
+!>      SEP     separator string to place between each variable. defaults
+!>              to a null string.
+!>      LEFT    string to place at left of each element
+!>      RIGHT   string to place at right of each element
+!>      TRM     option to trim each element of STR of trailing
+!>              spaces. Defaults to .TRUE.
+!>
+!>##RESULT
+!>      STRING  CHARACTER variable composed of all of the elements of STR()
+!>              appended together with the optional separator SEP placed
+!>              between the elements and optional left and right elements.
+!>
+!>##EXAMPLE
+!>
+!>  Sample program:
+!>
+!>   program demo_join
+!>   use M_strings, only: join
+!>   implicit none
+!>   character(len=:),allocatable  :: s(:)
+!>   character(len=:),allocatable  :: out
+!>   integer                       :: i
+!>     s=[character(len=10) :: 'United',' we',' stand,', &
+!>     & ' divided',' we fall.']
+!>     out=join(s)
+!>     write(*,'(a)') out
+!>     write(*,'(a)') join(s,trm=.false.)
+!>     write(*,'(a)') (join(s,trm=.false.,sep='|'),i=1,3)
+!>     write(*,'(a)') join(s,sep='<>')
+!>     write(*,'(a)') join(s,sep=';',left='[',right=']')
+!>     write(*,'(a)') join(s,left='[',right=']')
+!>     write(*,'(a)') join(s,left='>>')
+!>   end program demo_join
+!>
+!>  Expected output:
+!>
+!>   United we stand, divided we fall.
+!>   United     we        stand,    divided   we fall.
+!>   United    | we       | stand,   | divided  | we fall. |
+!>   United    | we       | stand,   | divided  | we fall. |
+!>   United    | we       | stand,   | divided  | we fall. |
+!>   United<> we<> stand,<> divided<> we fall.<>
+!>   [United];[ we];[ stand,];[ divided];[ we fall.];
+!>   [United][ we][ stand,][ divided][ we fall.]
+!>   >>United>> we>> stand,>> divided>> we fall.
+!>
+!>##AUTHOR
+!>    John S. Urban
+!>
+!>##LICENSE
+!>    Public Domain
+
+character(len=*),intent(in)           :: str(:)
+character(len=*),intent(in),optional  :: sep, right, left
+logical,intent(in),optional           :: trm
+character(len=:),allocatable          :: string
+integer                               :: i
+logical                               :: trm_local
+character(len=:),allocatable          :: sep_local, left_local, right_local
+
+   if(present(sep))then    ;  sep_local=sep      ;  else  ;  sep_local=''      ;  endif
+   if(present(trm))then    ;  trm_local=trm      ;  else  ;  trm_local=.true.  ;  endif
+   if(present(left))then   ;  left_local=left    ;  else  ;  left_local=''     ;  endif
+   if(present(right))then  ;  right_local=right  ;  else  ;  right_local=''    ;  endif
+
+   string=''
+   do i = 1,size(str)
+      if(trm_local)then
+         string=string//left_local//trim(str(i))//right_local//sep_local
+      else
+         string=string//left_local//str(i)//right_local//sep_local
+      endif
+   enddo
+end function join
+
 end module fpm_strings