@@ -431,12 +431,13 @@ end subroutine resize_string
431
431
432
432
! >AUTHOR: John S. Urban
433
433
! !LICENSE: Public Domain
434
- ! !## NAME
435
- ! ! join(3f) - [fpm_strings:EDITING] append CHARACTER variable array into
434
+ ! >
435
+ ! !##NAME
436
+ ! ! join(3f) - [M_strings:EDITING] append CHARACTER variable array into
436
437
! ! a single CHARACTER variable with specified separator
437
438
! ! (LICENSE:PD)
438
439
! !
439
- ! !## SYNOPSIS
440
+ ! !##SYNOPSIS
440
441
! !
441
442
! ! pure function join(str,sep,trm,left,right,start,end) result (string)
442
443
! !
@@ -449,13 +450,13 @@ end subroutine resize_string
449
450
! ! character(len=*),intent(in),optional :: end
450
451
! ! character(len=:),allocatable :: string
451
452
! !
452
- ! !## DESCRIPTION
453
+ ! !##DESCRIPTION
453
454
! ! JOIN(3f) appends the elements of a CHARACTER array into a single
454
455
! ! CHARACTER variable, with elements 1 to N joined from left to right.
455
456
! ! By default each element is trimmed of trailing spaces and the
456
457
! ! default separator is a null string.
457
458
! !
458
- ! !## OPTIONS
459
+ ! !##OPTIONS
459
460
! ! STR(:) array of CHARACTER variables to be joined
460
461
! ! SEP separator string to place between each variable. defaults
461
462
! ! to a null string.
@@ -466,81 +467,75 @@ end subroutine resize_string
466
467
! ! TRM option to trim each element of STR of trailing
467
468
! ! spaces. Defaults to .TRUE.
468
469
! !
469
- ! !## RESULT
470
+ ! !##RESULT
470
471
! ! STRING CHARACTER variable composed of all of the elements of STR()
471
472
! ! appended together with the optional separator SEP placed
472
473
! ! between the elements.
473
474
! !
474
- ! !## EXAMPLE
475
+ ! !##EXAMPLE
475
476
! !
476
477
! ! Sample program:
477
- ! !```fortran
478
- ! ! program demo_join
479
- ! ! use fpm_strings, only: join
480
- ! ! implicit none
481
- ! ! character(len=:),allocatable :: s(:)
482
- ! ! character(len=:),allocatable :: out
483
- ! ! integer :: i
484
- ! ! s=[character(len=10) :: 'United',' we',' stand,', &
485
- ! ! & ' divided',' we fall.']
486
- ! ! out=join(s)
487
- ! ! write(*,'(a)') out
488
- ! ! write(*,'(a)') join(s,trm=.false.)
489
- ! ! write(*,'(a)') (join(s,trm=.false.,sep='|'),i=1,3)
490
- ! ! write(*,'(a)') join(s,sep='<>')
491
- ! ! write(*,'(a)') join(s,sep=';',left='[',right=']')
492
- ! ! write(*,'(a)') join(s,left='[',right=']')
493
- ! ! write(*,'(a)') join(s,left='>>')
494
- ! ! end program demo_join
495
- ! !```fortran
496
478
! !
497
- ! ! Expected output:
479
+ ! ! program demo_join
480
+ ! ! use M_strings, only: join
481
+ ! ! implicit none
482
+ ! ! character(len=:),allocatable :: s(:)
483
+ ! ! character(len=:),allocatable :: out
484
+ ! ! integer :: i
485
+ ! ! s=[character(len=10) :: 'United',' we',' stand,', &
486
+ ! ! & ' divided',' we fall.']
487
+ ! ! out=join(s)
488
+ ! ! write(*,'(a)') out
489
+ ! ! write(*,'(a)') join(s,trm=.false.)
490
+ ! ! write(*,'(a)') (join(s,trm=.false.,sep='|'),i=1,3)
491
+ ! ! write(*,'(a)') join(s,sep='<>')
492
+ ! ! write(*,'(a)') join(s,sep=';',left='[',right=']')
493
+ ! ! write(*,'(a)') join(s,left='[',right=']')
494
+ ! ! write(*,'(a)') join(s,left='>>')
495
+ ! ! end program demo_join
498
496
! !
499
- ! ! United we stand, divided we fall.
500
- ! ! United we stand, divided we fall.
501
- ! ! United | we | stand, | divided | we fall.
502
- ! ! United | we | stand, | divided | we fall.
503
- ! ! United | we | stand, | divided | we fall.
504
- ! ! United<> we<> stand,<> divided<> we fall.
505
- ! ! [United];[ we];[ stand,];[ divided];[ we fall.]
506
- ! ! [United][ we][ stand,][ divided][ we fall.]
507
- ! ! >>United>> we>> stand,>> divided>> we fall.
497
+ ! ! Expected output:
508
498
! !
499
+ ! ! United we stand, divided we fall.
500
+ ! ! United we stand, divided we fall.
501
+ ! ! United | we | stand, | divided | we fall.
502
+ ! ! United | we | stand, | divided | we fall.
503
+ ! ! United | we | stand, | divided | we fall.
504
+ ! ! United<> we<> stand,<> divided<> we fall.
505
+ ! ! [United];[ we];[ stand,];[ divided];[ we fall.]
506
+ ! ! [United][ we][ stand,][ divided][ we fall.]
507
+ ! ! >>United>> we>> stand,>> divided>> we fall.
509
508
pure function join (str ,sep ,trm ,left ,right ,start ,end ) result (string)
510
509
511
- ! @(#)join(3f): append an array of character variables with specified separator into a single CHARACTER variable
510
+ ! @(#)M_strings:: join(3f): merge string array into a single CHARACTER value adding specified separators, caps, prefix and suffix
512
511
513
512
character (len=* ),intent (in ) :: str(:)
514
- character (len=* ),intent (in ),optional :: sep
515
- character (len=* ),intent (in ),optional :: right
516
- character (len=* ),intent (in ),optional :: left
517
- character (len=* ),intent (in ),optional :: start
518
- character (len=* ),intent (in ),optional :: end
513
+ character (len=* ),intent (in ),optional :: sep, right, left, start, end
519
514
logical ,intent (in ),optional :: trm
515
+ character (len= :),allocatable :: sep_local, left_local, right_local
520
516
character (len= :),allocatable :: string
521
- integer :: i
522
517
logical :: trm_local
523
- character (len= :),allocatable :: sep_local
524
- character (len= :),allocatable :: left_local
525
- character (len= :),allocatable :: right_local
526
-
527
- if (present (sep))then ; sep_local= sep ; else ; sep_local= ' ' ; endif
528
- if (present (trm))then ; trm_local= trm ; else ; trm_local= .true. ; endif
529
- if (present (left))then ; left_local= left ; else ; left_local= ' ' ; endif
530
- if (present (right))then ; right_local= right ; else ; right_local= ' ' ; endif
531
-
518
+ integer :: i
519
+ if (present (sep))then ; sep_local= sep ; else ; sep_local= ' ' ; endif
520
+ if (present (trm))then ; trm_local= trm ; else ; trm_local= .true. ; endif
521
+ if (present (left))then ; left_local= left ; else ; left_local= ' ' ; endif
522
+ if (present (right))then ; right_local= right ; else ; right_local= ' ' ; endif
532
523
string= ' '
533
- do i = 1 ,size (str)- 1
524
+ if (size (str).eq. 0 )then
525
+ string= string// left_local// right_local
526
+ else
527
+ do i = 1 ,size (str)- 1
528
+ if (trm_local)then
529
+ string= string// left_local// trim (str(i))// right_local// sep_local
530
+ else
531
+ string= string// left_local// str(i)// right_local// sep_local
532
+ endif
533
+ enddo
534
534
if (trm_local)then
535
- string= string// left_local// trim (str(i))// right_local// sep_local
535
+ string= string// left_local// trim (str(i))// right_local
536
536
else
537
- string= string// left_local// str(i)// right_local// sep_local
537
+ string= string// left_local// str(i)// right_local
538
538
endif
539
- enddo
540
- if (trm_local)then
541
- string= string// left_local// trim (str(i))// right_local
542
- else
543
- string= string// left_local// str(i)// right_local
544
539
endif
545
540
if (present (start))string= start// string
546
541
if (present (end))string= string// end
0 commit comments