bundle Function

public function bundle(x1, x2, x3, x4, x5, x6, x7, x8, x9, x10, x11, x12, x13, x14, x15, x16, x17, x18, x19, x20, len) result(vec)

NAME

bundle(3f) - [M_strings:ARRAY] return up to twenty strings of arbitrary length
             as an array
(LICENSE:PD)

SYNOPSIS

function bundle(str1,str2,...str20,len) result (vec)

 character(len=*),intent(in),optional   :: str1, str2 ... str20
 integer,intent(in),optional            :: len

DESCRIPTION

Given a list of up to twenty strings create a string array. The
length of the variables with be the same as the maximum length
of the input strings unless explicitly specified via LEN.

This is an alternative to the syntax

  [ CHARACTER(LEN=NN) :: str1, str2, ... ]

that by default additionally calculates the minimum length required
to prevent truncation.

OPTIONS

str1,str2, ... str20  input strings to combine into a vector
len   length of returned array variables

EXAMPLES

Sample Program:

program demo_bundle
use M_strings, only: bundle
implicit none
   print "(*('""',a,'""':,',',1x))", bundle("one")
   print "(*('""',a,'""':,',',1x))", bundle("one","two")
   print "(*('""',a,'""':,',',1x))", bundle("one","two","three")
   print "(*('""',a,'""':,',',1x))", bundle("one","two","three",&
           & "four","five","six","seven")
end program demo_bundle

Expected output

"one"
"one", "two"
"one  ", "two  ", "three"
"one  ", "two  ", "three", "four ", "five ", "six  ", "seven"

AUTHOR

John S. Urban

LICENSE

Public Domain

Arguments

Type IntentOptional Attributes Name
character(len=*), intent(in), optional :: x1
character(len=*), intent(in), optional :: x2
character(len=*), intent(in), optional :: x3
character(len=*), intent(in), optional :: x4
character(len=*), intent(in), optional :: x5
character(len=*), intent(in), optional :: x6
character(len=*), intent(in), optional :: x7
character(len=*), intent(in), optional :: x8
character(len=*), intent(in), optional :: x9
character(len=*), intent(in), optional :: x10
character(len=*), intent(in), optional :: x11
character(len=*), intent(in), optional :: x12
character(len=*), intent(in), optional :: x13
character(len=*), intent(in), optional :: x14
character(len=*), intent(in), optional :: x15
character(len=*), intent(in), optional :: x16
character(len=*), intent(in), optional :: x17
character(len=*), intent(in), optional :: x18
character(len=*), intent(in), optional :: x19
character(len=*), intent(in), optional :: x20
integer, intent(in), optional :: len

Return Value character(len=:), allocatable, (:)


Contents

Source Code


Source Code

function bundle(x1,x2,x3,x4,x5,x6,x7,x8,x9,x10,x11,x12,x13,x14,x15,x16,x17,x18,x19,x20,len) result(vec)
! return character array containing present arguments
character(len=*),intent(in),optional  :: x1,x2,x3,x4,x5,x6,x7,x8,x9,x10
character(len=*),intent(in),optional  :: x11,x12,x13,x14,x15,x16,x17,x18,x19,x20
integer,intent(in),optional           :: len
character(len=:),allocatable          :: vec(:)
integer                               :: ilen, icount, iset
   ilen=0
   icount=0
   iset=0
   call increment(x1)
   call increment(x2)
   call increment(x3)
   call increment(x4)
   call increment(x5)
   call increment(x6)
   call increment(x7)
   call increment(x8)
   call increment(x9)
   call increment(x10)
   call increment(x11)
   call increment(x12)
   call increment(x13)
   call increment(x14)
   call increment(x15)
   call increment(x16)
   call increment(x17)
   call increment(x18)
   call increment(x19)
   call increment(x20)

   if(present(len)) ilen=len
   allocate (character(len=ilen) ::vec(icount))

   call set(x1)
   call set(x2)
   call set(x3)
   call set(x4)
   call set(x5)
   call set(x6)
   call set(x7)
   call set(x8)
   call set(x9)
   call set(x10)
   call set(x11)
   call set(x12)
   call set(x13)
   call set(x14)
   call set(x15)
   call set(x16)
   call set(x17)
   call set(x18)
   call set(x19)
   call set(x20)

contains

subroutine increment(str)
character(len=*),intent(in),optional :: str
   if(present(str))then
      ilen=max(ilen,len_trim(str))
      icount=icount+1
   endif
end subroutine increment

subroutine set(str)
character(len=*),intent(in),optional :: str
   if(present(str))then
      iset=iset+1
      vec(iset)=str
   endif
end subroutine set

end function bundle