stdlib_string_type Module

Implementation of a string type to hold an arbitrary sequence of characters.

This module provides string type compatible with all Fortran instrinsic character procedures as well as overloaded operators for working with character variables.

A string type can be easily constructed by creating a new instance from a character variable or literal by invoking its constructor or by assigning it to a string type. Generally, the string type behaves similar to a deferred length character in most regards but adds memory access safety.

The specification of this module is available here.


Used by


Interfaces

public interface adjustl

Left-adjust the character sequence represented by the string. The length of the character sequence remains unchanged.

This method is elemental and returns a scalar character value.

  • private elemental function adjustl_string(string) result(adjusted_string)

    Left-adjust the character sequence represented by the string. The length of the character sequence remains unchanged.

    Arguments

    Type IntentOptional Attributes Name
    type(string_type), intent(in) :: string

    Return Value type(string_type)

public interface adjustr

Right-adjust the character sequence represented by the string. The length of the character sequence remains unchanged.

This method is elemental and returns a scalar character value.

  • private elemental function adjustr_string(string) result(adjusted_string)

    Right-adjust the character sequence represented by the string. The length of the character sequence remains unchanged.

    Arguments

    Type IntentOptional Attributes Name
    type(string_type), intent(in) :: string

    Return Value type(string_type)

public interface assignment(=)

Assign a character sequence to a string.

  • private elemental subroutine assign_string_char(lhs, rhs)

    Assign a character sequence to a string.

    Arguments

    Type IntentOptional Attributes Name
    type(string_type), intent(inout) :: lhs
    character(len=*), intent(in) :: rhs

public interface char

Return the character sequence represented by the string.

This method is elemental and returns a scalar character value.

  • private pure function char_string(string) result(character_string)

    Return the character sequence represented by the string.

    Arguments

    Type IntentOptional Attributes Name
    type(string_type), intent(in) :: string

    Return Value character(len=len)

  • private elemental function char_string_pos(string, pos) result(character_string)

    Return the character sequence represented by the string.

    Arguments

    Type IntentOptional Attributes Name
    type(string_type), intent(in) :: string
    integer, intent(in) :: pos

    Return Value character(len=1)

  • private pure function char_string_range(string, start, last) result(character_string)

    Return the character sequence represented by the string.

    Arguments

    Type IntentOptional Attributes Name
    type(string_type), intent(in) :: string
    integer, intent(in) :: start
    integer, intent(in) :: last

    Return Value character(len=last)

public interface iachar

Code in ASCII collating sequence.

This method is elemental and returns a default integer scalar value.

  • private elemental function iachar_string(string) result(ich)

    Code in ASCII collating sequence.

    Arguments

    Type IntentOptional Attributes Name
    type(string_type), intent(in) :: string

    Return Value integer

public interface ichar

Character-to-integer conversion function.

This method is elemental and returns a default integer scalar value.

  • private elemental function ichar_string(string) result(ich)

    Character-to-integer conversion function.

    Arguments

    Type IntentOptional Attributes Name
    type(string_type), intent(in) :: string

    Return Value integer

public interface index

Position of a substring within a string.

Returns the position of the start of the leftmost or rightmost occurrence of string substring in string, counting from one. If substring is not present in string, zero is returned.

This method is elemental and returns a default integer scalar value.

  • private elemental function index_string_string(string, substring, back) result(pos)

    Position of a sequence of character within a character sequence. In this version both character sequences are represented by a string.

    Arguments

    Type IntentOptional Attributes Name
    type(string_type), intent(in) :: string
    type(string_type), intent(in) :: substring
    logical, intent(in), optional :: back

    Return Value integer

  • private elemental function index_string_char(string, substring, back) result(pos)

    Position of a sequence of character within a character sequence. In this version the main character sequence is represented by a string.

    Arguments

    Type IntentOptional Attributes Name
    type(string_type), intent(in) :: string
    character(len=*), intent(in) :: substring
    logical, intent(in), optional :: back

    Return Value integer

  • private elemental function index_char_string(string, substring, back) result(pos)

    Position of a sequence of character within a character sequence. In this version the sub character sequence is represented by a string.

    Arguments

    Type IntentOptional Attributes Name
    character(len=*), intent(in) :: string
    type(string_type), intent(in) :: substring
    logical, intent(in), optional :: back

    Return Value integer

public interface len

Returns the length of the character sequence represented by the string.

This method is elemental and returns a default integer scalar value.

  • private elemental function len_string(string) result(length)

    Returns the length of the character sequence represented by the string.

    Arguments

    Type IntentOptional Attributes Name
    type(string_type), intent(in) :: string

    Return Value integer

public interface len_trim

Returns the length of the character sequence without trailing spaces represented by the string.

This method is elemental and returns a default integer scalar value.

  • private elemental function len_trim_string(string) result(length)

    Returns the length of the character sequence without trailing spaces represented by the string.

    Arguments

    Type IntentOptional Attributes Name
    type(string_type), intent(in) :: string

    Return Value integer

public interface lge

Lexically compare the order of two character sequences being greater equal, The left-hand side, the right-hand side or both character sequences can be represented by a string.

This method is elemental and returns a default logical scalar value.

  • private elemental function lge_string_string(lhs, rhs) result(is_lge)

    Lexically compare two character sequences for being greater or equal. In this version both character sequences are by a string.

    Arguments

    Type IntentOptional Attributes Name
    type(string_type), intent(in) :: lhs
    type(string_type), intent(in) :: rhs

    Return Value logical

  • private elemental function lge_string_char(lhs, rhs) result(is_lge)

    Lexically compare two character sequences for being greater or equal. In this version the left-hand side character sequences is by a string.

    Arguments

    Type IntentOptional Attributes Name
    type(string_type), intent(in) :: lhs
    character(len=*), intent(in) :: rhs

    Return Value logical

  • private elemental function lge_char_string(lhs, rhs) result(is_lge)

    Lexically compare two character sequences for being greater or equal In this version the right-hand side character sequences is by a string.

    Arguments

    Type IntentOptional Attributes Name
    character(len=*), intent(in) :: lhs
    type(string_type), intent(in) :: rhs

    Return Value logical

public interface lgt

Lexically compare the order of two character sequences being greater, The left-hand side, the right-hand side or both character sequences can be represented by a string.

This method is elemental and returns a default logical scalar value.

  • private elemental function lgt_string_string(lhs, rhs) result(is_lgt)

    Lexically compare two character sequences for being greater. In this version both character sequences are by a string.

    Arguments

    Type IntentOptional Attributes Name
    type(string_type), intent(in) :: lhs
    type(string_type), intent(in) :: rhs

    Return Value logical

  • private elemental function lgt_string_char(lhs, rhs) result(is_lgt)

    Lexically compare two character sequences for being greater. In this version the left-hand side character sequences is by a string.

    Arguments

    Type IntentOptional Attributes Name
    type(string_type), intent(in) :: lhs
    character(len=*), intent(in) :: rhs

    Return Value logical

  • private elemental function lgt_char_string(lhs, rhs) result(is_lgt)

    Lexically compare two character sequences for being greater. In this version the right-hand side character sequences is by a string.

    Arguments

    Type IntentOptional Attributes Name
    character(len=*), intent(in) :: lhs
    type(string_type), intent(in) :: rhs

    Return Value logical

public interface lle

Lexically compare the order of two character sequences being less equal, The left-hand side, the right-hand side or both character sequences can be represented by a string.

This method is elemental and returns a default logical scalar value.

  • private elemental function lle_string_string(lhs, rhs) result(is_lle)

    Lexically compare two character sequences for being less or equal. In this version both character sequences are by a string.

    Arguments

    Type IntentOptional Attributes Name
    type(string_type), intent(in) :: lhs
    type(string_type), intent(in) :: rhs

    Return Value logical

  • private elemental function lle_string_char(lhs, rhs) result(is_lle)

    Lexically compare two character sequences for being less or equal. In this version the left-hand side character sequences is by a string.

    Arguments

    Type IntentOptional Attributes Name
    type(string_type), intent(in) :: lhs
    character(len=*), intent(in) :: rhs

    Return Value logical

  • private elemental function lle_char_string(lhs, rhs) result(is_lle)

    Lexically compare two character sequences for being less or equal In this version the right-hand side character sequences is by a string.

    Arguments

    Type IntentOptional Attributes Name
    character(len=*), intent(in) :: lhs
    type(string_type), intent(in) :: rhs

    Return Value logical

public interface llt

Lexically compare the order of two character sequences being less, The left-hand side, the right-hand side or both character sequences can be represented by a string.

This method is elemental and returns a default logical scalar value.

  • private elemental function llt_string_string(lhs, rhs) result(is_llt)

    Lexically compare two character sequences for being less. In this version both character sequences are by a string.

    Arguments

    Type IntentOptional Attributes Name
    type(string_type), intent(in) :: lhs
    type(string_type), intent(in) :: rhs

    Return Value logical

  • private elemental function llt_string_char(lhs, rhs) result(is_llt)

    Lexically compare two character sequences for being less. In this version the left-hand side character sequences is by a string.

    Arguments

    Type IntentOptional Attributes Name
    type(string_type), intent(in) :: lhs
    character(len=*), intent(in) :: rhs

    Return Value logical

  • private elemental function llt_char_string(lhs, rhs) result(is_llt)

    Lexically compare two character sequences for being less. In this version the right-hand side character sequences is by a string.

    Arguments

    Type IntentOptional Attributes Name
    character(len=*), intent(in) :: lhs
    type(string_type), intent(in) :: rhs

    Return Value logical

public interface move

Moves the allocated character scalar from 'from' to 'to' Specifications

  • private elemental subroutine move_string_string(from, to)

    Moves the allocated character scalar from 'from' to 'to' No output

    Arguments

    Type IntentOptional Attributes Name
    type(string_type), intent(inout), target :: from
    type(string_type), intent(inout), target :: to
  • private pure subroutine move_string_char(from, to)

    Moves the allocated character scalar from 'from' to 'to' No output

    Arguments

    Type IntentOptional Attributes Name
    type(string_type), intent(inout) :: from
    character(len=:), intent(out), allocatable :: to
  • private pure subroutine move_char_string(from, to)

    Moves the allocated character scalar from 'from' to 'to' No output

    Arguments

    Type IntentOptional Attributes Name
    character(len=:), intent(inout), allocatable :: from
    type(string_type), intent(out) :: to
  • private pure subroutine move_char_char(from, to)

    Moves the allocated character scalar from 'from' to 'to' No output

    Arguments

    Type IntentOptional Attributes Name
    character(len=:), intent(inout), allocatable :: from
    character(len=:), intent(out), allocatable :: to

public interface operator(//)

Concatenate two character sequences, the left-hand side, the right-hand side or both character sequences can be represented by a string.

This operator is elemental and returns a scalar character value.

  • private elemental function concat_string_string(lhs, rhs) result(string)

    Concatenate two character sequences. In this version both character sequences are by a string.

    Arguments

    Type IntentOptional Attributes Name
    type(string_type), intent(in) :: lhs
    type(string_type), intent(in) :: rhs

    Return Value type(string_type)

  • private elemental function concat_string_char(lhs, rhs) result(string)

    Concatenate two character sequences. In this version the left-hand side character sequences is by a string.

    Arguments

    Type IntentOptional Attributes Name
    type(string_type), intent(in) :: lhs
    character(len=*), intent(in) :: rhs

    Return Value type(string_type)

  • private elemental function concat_char_string(lhs, rhs) result(string)

    Concatenate two character sequences. In this version the right-hand side character sequences is by a string.

    Arguments

    Type IntentOptional Attributes Name
    character(len=*), intent(in) :: lhs
    type(string_type), intent(in) :: rhs

    Return Value type(string_type)

public interface operator(/=)

Compare two character sequences for inequality, the left-hand side, the right-hand side or both character sequences can be represented by a string.

This operator is elemental and returns a default logical scalar value.

  • private elemental function ne_string_string(lhs, rhs) result(is_ne)

    Compare two character sequences for inequality. In this version both character sequences are by a string.

    Arguments

    Type IntentOptional Attributes Name
    type(string_type), intent(in) :: lhs
    type(string_type), intent(in) :: rhs

    Return Value logical

  • private elemental function ne_string_char(lhs, rhs) result(is_ne)

    Compare two character sequences for inequality. In this version the left-hand side character sequences is by a string.

    Arguments

    Type IntentOptional Attributes Name
    type(string_type), intent(in) :: lhs
    character(len=*), intent(in) :: rhs

    Return Value logical

  • private elemental function ne_char_string(lhs, rhs) result(is_ne)

    Compare two character sequences for inequality. In this version the right-hand side character sequences is by a string.

    Arguments

    Type IntentOptional Attributes Name
    character(len=*), intent(in) :: lhs
    type(string_type), intent(in) :: rhs

    Return Value logical

public interface operator(<)

Compare two character sequences for being less, the left-hand side, the right-hand side or both character sequences can be represented by a string.

This operator is elemental and returns a default logical scalar value.

  • private elemental function lt_string_string(lhs, rhs) result(is_lt)

    Compare two character sequences for being less. In this version both character sequences are by a string.

    Arguments

    Type IntentOptional Attributes Name
    type(string_type), intent(in) :: lhs
    type(string_type), intent(in) :: rhs

    Return Value logical

  • private elemental function lt_string_char(lhs, rhs) result(is_lt)

    Compare two character sequences for being less. In this version the left-hand side character sequences is by a string.

    Arguments

    Type IntentOptional Attributes Name
    type(string_type), intent(in) :: lhs
    character(len=*), intent(in) :: rhs

    Return Value logical

  • private elemental function lt_char_string(lhs, rhs) result(is_lt)

    Compare two character sequences for being less. In this version the right-hand side character sequences is by a string.

    Arguments

    Type IntentOptional Attributes Name
    character(len=*), intent(in) :: lhs
    type(string_type), intent(in) :: rhs

    Return Value logical

public interface operator(<=)

Compare two character sequences for being less than, the left-hand side, the right-hand side or both character sequences can be represented by a string.

This operator is elemental and returns a default logical scalar value.

  • private elemental function le_string_string(lhs, rhs) result(is_le)

    Compare two character sequences for being less or equal. In this version both character sequences are by a string.

    Arguments

    Type IntentOptional Attributes Name
    type(string_type), intent(in) :: lhs
    type(string_type), intent(in) :: rhs

    Return Value logical

  • private elemental function le_string_char(lhs, rhs) result(is_le)

    Compare two character sequences for being less or equal. In this version the left-hand side character sequences is by a string.

    Arguments

    Type IntentOptional Attributes Name
    type(string_type), intent(in) :: lhs
    character(len=*), intent(in) :: rhs

    Return Value logical

  • private elemental function le_char_string(lhs, rhs) result(is_le)

    Compare two character sequences for being less or equal In this version the right-hand side character sequences is by a string.

    Arguments

    Type IntentOptional Attributes Name
    character(len=*), intent(in) :: lhs
    type(string_type), intent(in) :: rhs

    Return Value logical

public interface operator(==)

Compare two character sequences for equality, the left-hand side, the right-hand side or both character sequences can be represented by a string.

This operator is elemental and returns a default logical scalar value.

  • private elemental function eq_string_string(lhs, rhs) result(is_eq)

    Compare two character sequences for equality. In this version both character sequences are by a string.

    Arguments

    Type IntentOptional Attributes Name
    type(string_type), intent(in) :: lhs
    type(string_type), intent(in) :: rhs

    Return Value logical

  • private elemental function eq_string_char(lhs, rhs) result(is_eq)

    Compare two character sequences for equality. In this version the left-hand side character sequences is by a string.

    Arguments

    Type IntentOptional Attributes Name
    type(string_type), intent(in) :: lhs
    character(len=*), intent(in) :: rhs

    Return Value logical

  • private elemental function eq_char_string(lhs, rhs) result(is_eq)

    Compare two character sequences for equality. In this version the right-hand side character sequences is by a string.

    Arguments

    Type IntentOptional Attributes Name
    character(len=*), intent(in) :: lhs
    type(string_type), intent(in) :: rhs

    Return Value logical

public interface operator(>)

Compare two character sequences for being greater, the left-hand side, the right-hand side or both character sequences can be represented by a string.

This operator is elemental and returns a default logical scalar value.

  • private elemental function gt_string_string(lhs, rhs) result(is_gt)

    Compare two character sequences for being greater. In this version both character sequences are by a string.

    Arguments

    Type IntentOptional Attributes Name
    type(string_type), intent(in) :: lhs
    type(string_type), intent(in) :: rhs

    Return Value logical

  • private elemental function gt_string_char(lhs, rhs) result(is_gt)

    Compare two character sequences for being greater. In this version the left-hand side character sequences is by a string.

    Arguments

    Type IntentOptional Attributes Name
    type(string_type), intent(in) :: lhs
    character(len=*), intent(in) :: rhs

    Return Value logical

  • private elemental function gt_char_string(lhs, rhs) result(is_gt)

    Compare two character sequences for being greater. In this version the right-hand side character sequences is by a string.

    Arguments

    Type IntentOptional Attributes Name
    character(len=*), intent(in) :: lhs
    type(string_type), intent(in) :: rhs

    Return Value logical

public interface operator(>=)

Compare two character sequences for being greater than, the left-hand side, the right-hand side or both character sequences can be represented by a string.

This operator is elemental and returns a default logical scalar value.

  • private elemental function ge_string_string(lhs, rhs) result(is_ge)

    Compare two character sequences for being greater or equal. In this version both character sequences are by a string.

    Arguments

    Type IntentOptional Attributes Name
    type(string_type), intent(in) :: lhs
    type(string_type), intent(in) :: rhs

    Return Value logical

  • private elemental function ge_string_char(lhs, rhs) result(is_ge)

    Compare two character sequences for being greater or equal. In this version the left-hand side character sequences is by a string.

    Arguments

    Type IntentOptional Attributes Name
    type(string_type), intent(in) :: lhs
    character(len=*), intent(in) :: rhs

    Return Value logical

  • private elemental function ge_char_string(lhs, rhs) result(is_ge)

    Compare two character sequences for being greater or equal In this version the right-hand side character sequences is by a string.

    Arguments

    Type IntentOptional Attributes Name
    character(len=*), intent(in) :: lhs
    type(string_type), intent(in) :: rhs

    Return Value logical

public interface read(formatted)

Read a character sequence from a connected unformatted unit into the string.

  • private subroutine read_formatted(string, unit, iotype, v_list, iostat, iomsg)

    Read a character sequence from a connected formatted unit into the string.

    Arguments

    Type IntentOptional Attributes Name
    type(string_type), intent(inout) :: string
    integer, intent(in) :: unit
    character(len=*), intent(in) :: iotype
    integer, intent(in) :: v_list(:)
    integer, intent(out) :: iostat
    character(len=*), intent(inout) :: iomsg

public interface read(unformatted)

Read a character sequence from a connected unformatted unit into the string.

  • private subroutine read_unformatted(string, unit, iostat, iomsg)

    Read a character sequence from a connected unformatted unit into the string.

    Arguments

    Type IntentOptional Attributes Name
    type(string_type), intent(inout) :: string
    integer, intent(in) :: unit
    integer, intent(out) :: iostat
    character(len=*), intent(inout) :: iomsg

public interface repeat

Repeats the character sequence hold by the string by the number of specified copies.

This method is elemental and returns a scalar character value.

  • private elemental function repeat_string(string, ncopies) result(repeated_string)

    Repeats the character sequence hold by the string by the number of specified copies.

    Arguments

    Type IntentOptional Attributes Name
    type(string_type), intent(in) :: string
    integer, intent(in) :: ncopies

    Return Value type(string_type)

public interface reverse

Reverses the character sequence hold by the input string

This method is elemental and returns a new string_type instance which holds this reverse character sequence

  • private elemental function reverse_string(string) result(reversed_string)

    Reverse the character sequence hold by the input string

    Arguments

    Type IntentOptional Attributes Name
    type(string_type), intent(in) :: string

    Return Value type(string_type)

public interface scan

Scan a string for the presence of a set of characters. Scans a string for any of the characters in a set of characters.

If back is either absent or false, this function returns the position of the leftmost character of string that is in set. If back is true, the rightmost position is returned. If no character of set is found in string, the result is zero.

This method is elemental and returns a default integer scalar value.

  • private elemental function scan_string_string(string, set, back) result(pos)

    Scan a character sequence for any of the characters in a set of characters. In this version both the character sequence and the character set are represented by a string.

    Arguments

    Type IntentOptional Attributes Name
    type(string_type), intent(in) :: string
    type(string_type), intent(in) :: set
    logical, intent(in), optional :: back

    Return Value integer

  • private elemental function scan_string_char(string, set, back) result(pos)

    Scan a character sequence for any of the characters in a set of characters. In this version the character sequences is represented by a string.

    Arguments

    Type IntentOptional Attributes Name
    type(string_type), intent(in) :: string
    character(len=*), intent(in) :: set
    logical, intent(in), optional :: back

    Return Value integer

  • private elemental function scan_char_string(string, set, back) result(pos)

    Scan a character sequence for any of the characters in a set of characters. In this version the set of characters is represented by a string.

    Arguments

    Type IntentOptional Attributes Name
    character(len=*), intent(in) :: string
    type(string_type), intent(in) :: set
    logical, intent(in), optional :: back

    Return Value integer

public interface string_type

Constructor for new string instances

  • private elemental module function new_string(string) result(new)

    Arguments

    Type IntentOptional Attributes Name
    character(len=*), intent(in), optional :: string

    Return Value type(string_type)

  • private elemental module function new_string_from_integer_int16(val) result(new)

    Arguments

    Type IntentOptional Attributes Name
    integer(kind=int16), intent(in) :: val

    Return Value type(string_type)

  • private elemental module function new_string_from_integer_int32(val) result(new)

    Arguments

    Type IntentOptional Attributes Name
    integer(kind=int32), intent(in) :: val

    Return Value type(string_type)

  • private elemental module function new_string_from_integer_int64(val) result(new)

    Arguments

    Type IntentOptional Attributes Name
    integer(kind=int64), intent(in) :: val

    Return Value type(string_type)

  • private elemental module function new_string_from_integer_int8(val) result(new)

    Arguments

    Type IntentOptional Attributes Name
    integer(kind=int8), intent(in) :: val

    Return Value type(string_type)

  • private elemental module function new_string_from_logical_lk(val) result(new)

    Arguments

    Type IntentOptional Attributes Name
    logical(kind=lk), intent(in) :: val

    Return Value type(string_type)

public interface to_lower

Returns the lowercase version of the character sequence hold by the input string

This method is Elemental and returns a new string_type instance which holds this lowercase character sequence

  • private elemental function to_lower_string(string) result(lowercase_string)

    Convert the character sequence hold by the input string to lower case

    Arguments

    Type IntentOptional Attributes Name
    type(string_type), intent(in) :: string

    Return Value type(string_type)

public interface to_sentence

Returns the sentencecase version of the character sequence hold by the input string

This method is elemental and returns a new string_type instance which holds this sentencecase character sequence

  • private elemental function to_sentence_string(string) result(sentence_string)

    Convert the character sequence hold by the input string to sentence case

    Arguments

    Type IntentOptional Attributes Name
    type(string_type), intent(in) :: string

    Return Value type(string_type)

public interface to_title

Returns the titlecase version of the character sequence hold by the input string

This method is Elemental and returns a new string_type instance which holds this titlecase character sequence

  • private elemental function to_title_string(string) result(titlecase_string)

    Convert the character sequence hold by the input string to title case

    Arguments

    Type IntentOptional Attributes Name
    type(string_type), intent(in) :: string

    Return Value type(string_type)

public interface to_upper

Returns the uppercase version of the character sequence hold by the input string

This method is Elemental and returns a new string_type instance which holds this uppercase character sequence

  • private elemental function to_upper_string(string) result(uppercase_string)

    Convert the character sequence hold by the input string to upper case

    Arguments

    Type IntentOptional Attributes Name
    type(string_type), intent(in) :: string

    Return Value type(string_type)

public interface trim

Returns the character sequence hold by the string without trailing spaces.

This method is elemental and returns a scalar character value.

  • private elemental function trim_string(string) result(trimmed_string)

    Returns the character sequence hold by the string without trailing spaces.

    Arguments

    Type IntentOptional Attributes Name
    type(string_type), intent(in) :: string

    Return Value type(string_type)

public interface verify

Scan a string for the absence of a set of characters. Verifies that all the characters in string belong to the set of characters in set.

If back is either absent or false, this function returns the position of the leftmost character of string that is not in set. If back is true, the rightmost position is returned. If all characters of string are found in set, the result is zero.

This method is elemental and returns a default integer scalar value.

  • private elemental function verify_string_string(string, set, back) result(pos)

    Verify a character sequence for the absence any of the characters in a set of characters. In this version both the character sequence and the character set are represented by a string.

    Arguments

    Type IntentOptional Attributes Name
    type(string_type), intent(in) :: string
    type(string_type), intent(in) :: set
    logical, intent(in), optional :: back

    Return Value integer

  • private elemental function verify_string_char(string, set, back) result(pos)

    Verify a character sequence for the absence any of the characters in a set of characters. In this version the character sequences is represented by a string.

    Arguments

    Type IntentOptional Attributes Name
    type(string_type), intent(in) :: string
    character(len=*), intent(in) :: set
    logical, intent(in), optional :: back

    Return Value integer

  • private elemental function verify_char_string(string, set, back) result(pos)

    Verify a character sequence for the absence any of the characters in a set of characters. In this version the set of characters is represented by a string.

    Arguments

    Type IntentOptional Attributes Name
    character(len=*), intent(in) :: string
    type(string_type), intent(in) :: set
    logical, intent(in), optional :: back

    Return Value integer

public interface write(formatted)

Write the character sequence hold by the string to a connected formatted unit.

  • private subroutine write_formatted(string, unit, iotype, v_list, iostat, iomsg)

    Write the character sequence hold by the string to a connected formatted unit.

    Arguments

    Type IntentOptional Attributes Name
    type(string_type), intent(in) :: string
    integer, intent(in) :: unit
    character(len=*), intent(in) :: iotype
    integer, intent(in) :: v_list(:)
    integer, intent(out) :: iostat
    character(len=*), intent(inout) :: iomsg

public interface write(unformatted)

Write the character sequence hold by the string to a connected unformatted unit.

  • private subroutine write_unformatted(string, unit, iostat, iomsg)

    Write the character sequence hold by the string to a connected unformatted unit.

    Arguments

    Type IntentOptional Attributes Name
    type(string_type), intent(in) :: string
    integer, intent(in) :: unit
    integer, intent(out) :: iostat
    character(len=*), intent(inout) :: iomsg

Derived Types

type, public, sequence  ::  string_type

String type holding an arbitrary sequence of characters.

Constructor

Constructor for new string instances

private elemental, module function new_string (string)
private elemental, module function new_string_from_integer_int16 (val)
private elemental, module function new_string_from_integer_int32 (val)
private elemental, module function new_string_from_integer_int64 (val)
private elemental, module function new_string_from_integer_int8 (val)
private elemental, module function new_string_from_logical_lk (val)