strings.f90

Go to the documentation of this file.

MODULE strings

  USE base_routines
  USE constants
  USE kinds
  USE iso_varying_string

#include "macros.h"  

  IMPLICIT NONE

  PRIVATE

  !Module parameters

  !Module types

  !Interfaces

  INTERFACE character_to_lowercase
    MODULE PROCEDURE character_to_lowercase_c
    MODULE PROCEDURE character_to_lowercase_vs
  END INTERFACE character_to_lowercase

  INTERFACE charactertolowercase
    MODULE PROCEDURE character_to_lowercase_c
    MODULE PROCEDURE character_to_lowercase_vs
  END INTERFACE charactertolowercase

  INTERFACE character_to_uppercase
    MODULE PROCEDURE character_to_uppercase_c
    MODULE PROCEDURE character_to_uppercase_vs
  END INTERFACE character_to_uppercase

  INTERFACE charactertouppercase
    MODULE PROCEDURE character_to_uppercase_c
    MODULE PROCEDURE character_to_uppercase_vs
  END INTERFACE charactertouppercase

  INTERFACE is_abbreviation
    MODULE PROCEDURE is_abbreviation_c_c
    MODULE PROCEDURE is_abbreviation_c_vs
    MODULE PROCEDURE is_abbreviation_vs_c
    MODULE PROCEDURE is_abbreviation_vs_vs
  END INTERFACE is_abbreviation

  INTERFACE isabbreviation
    MODULE PROCEDURE is_abbreviation_c_c
    MODULE PROCEDURE is_abbreviation_c_vs
    MODULE PROCEDURE is_abbreviation_vs_c
    MODULE PROCEDURE is_abbreviation_vs_vs
  END INTERFACE isabbreviation
  
  INTERFACE isdigit
    MODULE PROCEDURE is_digit
  END INTERFACE isdigit

  INTERFACE isletter
    MODULE PROCEDURE is_letter
  END INTERFACE isletter

  INTERFACE iswhitespace
    MODULE PROCEDURE is_whitespace
  END INTERFACE iswhitespace

  INTERFACE list_to_character
    MODULE PROCEDURE list_to_character_c
    MODULE PROCEDURE list_to_character_intg
    MODULE PROCEDURE list_to_character_lintg
    MODULE PROCEDURE list_to_character_l
    MODULE PROCEDURE list_to_character_sp
    MODULE PROCEDURE list_to_character_dp
  END INTERFACE list_to_character

  INTERFACE listtocharacter
    MODULE PROCEDURE list_to_character_c
    MODULE PROCEDURE list_to_character_intg
    MODULE PROCEDURE list_to_character_lintg
    MODULE PROCEDURE list_to_character_l
    MODULE PROCEDURE list_to_character_sp
    MODULE PROCEDURE list_to_character_dp
  END INTERFACE listtocharacter

  INTERFACE logicaltocharacter
    MODULE PROCEDURE logical_to_character
  END INTERFACE logicaltocharacter

  INTERFACE logicaltovstring
    MODULE PROCEDURE logical_to_vstring
  END INTERFACE logicaltovstring

  INTERFACE number_to_character
    MODULE PROCEDURE number_to_character_intg
    MODULE PROCEDURE number_to_character_lintg
    MODULE PROCEDURE number_to_character_sp
    MODULE PROCEDURE number_to_character_dp
  END INTERFACE number_to_character

  INTERFACE numbertocharacter
    MODULE PROCEDURE number_to_character_intg
    MODULE PROCEDURE number_to_character_lintg
    MODULE PROCEDURE number_to_character_sp
    MODULE PROCEDURE number_to_character_dp
  END INTERFACE numbertocharacter

  INTERFACE number_to_vstring
    MODULE PROCEDURE number_to_vstring_intg
    MODULE PROCEDURE number_to_vstring_lintg
    MODULE PROCEDURE number_to_vstring_sp
    MODULE PROCEDURE number_to_vstring_dp
  END INTERFACE number_to_vstring

  !Provided to allow conversion to new code style
  INTERFACE numbertovstring
    MODULE PROCEDURE number_to_vstring_intg
    MODULE PROCEDURE number_to_vstring_lintg
    MODULE PROCEDURE number_to_vstring_sp
    MODULE PROCEDURE number_to_vstring_dp
  END INTERFACE numbertovstring

  INTERFACE string_to_double
    MODULE PROCEDURE string_to_double_c
    MODULE PROCEDURE string_to_double_vs
  END INTERFACE string_to_double

  INTERFACE stringtodouble
    MODULE PROCEDURE string_to_double_c
    MODULE PROCEDURE string_to_double_vs
  END INTERFACE stringtodouble

  INTERFACE string_to_integer
    MODULE PROCEDURE string_to_integer_c
    MODULE PROCEDURE string_to_integer_vs
  END INTERFACE string_to_integer

  INTERFACE stringtointeger
    MODULE PROCEDURE string_to_integer_c
    MODULE PROCEDURE string_to_integer_vs
  END INTERFACE stringtointeger

  INTERFACE string_to_long_integer
    MODULE PROCEDURE string_to_long_integer_c
    MODULE PROCEDURE string_to_long_integer_vs
  END INTERFACE string_to_long_integer

  INTERFACE stringtolonginteger
    MODULE PROCEDURE string_to_long_integer_c
    MODULE PROCEDURE string_to_long_integer_vs
  END INTERFACE stringtolonginteger

  INTERFACE string_to_logical
    MODULE PROCEDURE string_to_logical_c
    MODULE PROCEDURE string_to_logical_vs
  END INTERFACE string_to_logical

  INTERFACE stringtological
    MODULE PROCEDURE string_to_logical_c
    MODULE PROCEDURE string_to_logical_vs
  END INTERFACE stringtological

  INTERFACE string_to_single
    MODULE PROCEDURE string_to_single_c
    MODULE PROCEDURE string_to_single_vs
  END INTERFACE string_to_single

  INTERFACE stingtosingle
    MODULE PROCEDURE string_to_single_c
    MODULE PROCEDURE string_to_single_vs
  END INTERFACE stingtosingle

  INTERFACE vstring_to_lowercase
    MODULE PROCEDURE vstring_to_lowercase_c
    MODULE PROCEDURE vstring_to_lowercase_vs
  END INTERFACE vstring_to_lowercase

  INTERFACE vstringtolowercase
    MODULE PROCEDURE vstring_to_lowercase_c
    MODULE PROCEDURE vstring_to_lowercase_vs
  END INTERFACE vstringtolowercase

  INTERFACE vstring_to_uppercase
    MODULE PROCEDURE vstring_to_uppercase_c
    MODULE PROCEDURE vstring_to_uppercase_vs
  END INTERFACE vstring_to_uppercase

  INTERFACE vstringtouppercase
    MODULE PROCEDURE vstring_to_uppercase_c
    MODULE PROCEDURE vstring_to_uppercase_vs
  END INTERFACE vstringtouppercase

  PUBLIC character_to_lowercase,character_to_uppercase

  PUBLIC charactertolowercase,charactertouppercase

  PUBLIC is_abbreviation,is_digit,is_letter,is_whitespace

  PUBLIC isabbreviation,isdigit,isletter,iswhitespace

  PUBLIC list_to_character

  PUBLIC listtocharacter
  
  PUBLIC logical_to_character,logical_to_vstring

  PUBLIC logicaltocharacter,logicaltovstring

  PUBLIC number_to_character,number_to_vstring

  PUBLIC numbertocharacter,numbertovstring

  PUBLIC string_to_double,string_to_integer,string_to_long_integer,string_to_logical,string_to_single

  PUBLIC stringtodouble,stringtointeger,stringtolonginteger,stringtological,stingtosingle

  PUBLIC vstring_to_lowercase,vstring_to_uppercase

  PUBLIC vstringtolowercase,vstringtouppercase
  
CONTAINS
  
  !
  !================================================================================================================================
  !

  FUNCTION is_abbreviation_c_c(SHORT,LONG,MIN_NUM_CHARACTERS)

    !Argument variables
    CHARACTER(LEN=*), INTENT(IN) :: SHORT
    CHARACTER(LEN=*), INTENT(IN) :: LONG
    INTEGER(INTG), INTENT(IN) :: MIN_NUM_CHARACTERS
    !Function variable
    LOGICAL :: IS_ABBREVIATION_C_C
    !Local Variables
    INTEGER(INTG) :: noch,NUM_CHARACTERS
    CHARACTER(LEN=LEN(SHORT)) :: UPPER_SHORT
    CHARACTER(LEN=LEN(LONG)) :: UPPER_LONG
    
    is_abbreviation_c_c=.false.
    upper_short=character_to_uppercase(short)
    upper_long=character_to_uppercase(long)
    num_characters=min(len(long),len(short))
    DO noch=min_num_characters,num_characters
      IF(upper_short==upper_long(:noch)) THEN
          is_abbreviation_c_c=.true.
          EXIT
      ENDIF
    ENDDO !noch

    RETURN
  END FUNCTION is_abbreviation_c_c

  !
  !================================================================================================================================
  !

  FUNCTION is_abbreviation_c_vs(SHORT,LONG,MIN_NUM_CHARACTERS)

    !Argument variables
    CHARACTER(LEN=*), INTENT(IN) :: SHORT
    TYPE(varying_string), INTENT(IN) :: LONG
    INTEGER(INTG), INTENT(IN) :: MIN_NUM_CHARACTERS
    !Function variable
    LOGICAL :: IS_ABBREVIATION_C_VS
    !Local Variables
    INTEGER(INTG) :: noch,NUM_CHARACTERS
    CHARACTER(LEN=LEN(SHORT)) :: UPPER_SHORT
    TYPE(varying_string) :: UPPER_LONG
    
    is_abbreviation_c_vs=.false.
    upper_short=character_to_uppercase(short)
    upper_long=vstring_to_uppercase(long)
    num_characters=min(len(long),len(short))
    DO noch=min_num_characters,num_characters
      IF(upper_short==extract(upper_long,1,noch)) THEN
          is_abbreviation_c_vs=.true.
          EXIT
      ENDIF
    ENDDO !noch

    RETURN
  END FUNCTION is_abbreviation_c_vs

  !
  !================================================================================================================================
  !

  FUNCTION is_abbreviation_vs_c(SHORT,LONG,MIN_NUM_CHARACTERS)

    !Argument variables
    TYPE(varying_string), INTENT(IN) :: SHORT
    CHARACTER(LEN=*), INTENT(IN) :: LONG
    INTEGER(INTG), INTENT(IN) :: MIN_NUM_CHARACTERS
    !Function variable
    LOGICAL :: IS_ABBREVIATION_VS_C
    !Local Variables
    INTEGER(INTG) :: noch,NUM_CHARACTERS
    TYPE(varying_string) :: UPPER_SHORT
    CHARACTER(LEN=LEN(LONG)) :: UPPER_LONG
    
    is_abbreviation_vs_c=.false.
    upper_short=vstring_to_uppercase(short)
    upper_long=character_to_uppercase(long)
    num_characters=min(len(long),len(short))
    DO noch=min_num_characters,num_characters
      IF(upper_short==upper_long(:noch)) THEN
          is_abbreviation_vs_c=.true.
          EXIT
      ENDIF
    ENDDO !noch

    RETURN
  END FUNCTION is_abbreviation_vs_c

  !
  !================================================================================================================================
  !

  FUNCTION is_abbreviation_vs_vs(SHORT,LONG,MIN_NUM_CHARACTERS)

    !Argument variables
    TYPE(varying_string), INTENT(IN) :: SHORT
    TYPE(varying_string), INTENT(IN) :: LONG
    INTEGER(INTG), INTENT(IN) :: MIN_NUM_CHARACTERS
    !Function variable
    LOGICAL :: IS_ABBREVIATION_VS_VS
    !Local Variables
    INTEGER(INTG) :: noch,NUM_CHARACTERS
    TYPE(varying_string) :: UPPER_SHORT,UPPER_LONG
    
    is_abbreviation_vs_vs=.false.
    upper_short=vstring_to_uppercase(short)
    upper_long=vstring_to_uppercase(long)
    num_characters=min(len(long),len(short))
    DO noch=min_num_characters,num_characters
      IF(upper_short==extract(upper_long,1,noch)) THEN
          is_abbreviation_vs_vs=.true.
          EXIT
      ENDIF
    ENDDO !noch

    RETURN
  END FUNCTION is_abbreviation_vs_vs

  !
  !================================================================================================================================
  !

  FUNCTION is_digit(CHARAC)

    !Argument variables
    CHARACTER(LEN=1), INTENT(IN) :: CHARAC
    !Function variable
    LOGICAL :: IS_DIGIT
    !Local Variables

    is_digit=(ichar(charac)>=ichar("0").AND.ichar(charac)<=ichar("9"))

    RETURN
  END FUNCTION is_digit

  !
  !================================================================================================================================
  !

  FUNCTION is_letter(CHARAC)

    !Argument variables
    CHARACTER(LEN=1), INTENT(IN) :: CHARAC
    !Function variable
    LOGICAL :: IS_LETTER
    !Local Variables

    is_letter=((ichar(charac)>=ichar("A").AND.ichar(charac)<=ichar("Z")).OR.&
      & (ichar(charac)>=ichar("a").AND.ichar(charac)<=ichar("z")))

    RETURN
  END FUNCTION is_letter

  !
  !================================================================================================================================
  !

  FUNCTION is_lowercase(CHARC)

    !Argument variables
    CHARACTER(LEN=1), INTENT(IN) :: CHARC
    !Function variable
    LOGICAL :: IS_LOWERCASE
    !Local Variables

    IF(lge(charc,"a").AND.lle(charc,"z")) THEN
      is_lowercase=.true.
    ELSE
      is_lowercase=.false.
    ENDIF

    RETURN
  END FUNCTION is_lowercase

  !
  !================================================================================================================================
  !

  FUNCTION is_uppercase(CHARC)

    !Argument variables
    CHARACTER(LEN=1), INTENT(IN) :: CHARC
    !Function variable
    LOGICAL :: IS_UPPERCASE
    !Local Variables

    IF(lge(charc,"A").AND.lle(charc,"Z")) THEN
      is_uppercase=.true.
    ELSE
      is_uppercase=.false.
    ENDIF

    RETURN
  END FUNCTION is_uppercase

  !
  !================================================================================================================================
  !

  FUNCTION is_whitespace(CHARAC)

    !Argument variables
    CHARACTER(LEN=1), INTENT(IN) :: CHARAC
    !Function variable
    LOGICAL :: IS_WHITESPACE
    !Local Variables
    
    !!WARNING: Assumes ASCII encoding
    is_whitespace=(charac==char(32).OR.charac==char(9))

    RETURN
  END FUNCTION is_whitespace

  !
  !================================================================================================================================
  !

  FUNCTION list_to_character_c(NUMBER_IN_LIST,LIST,FORMAT,ERR,ERROR,LIST_LENGTHS)
    
    !Argument variables
    INTEGER(INTG), INTENT(IN) :: NUMBER_IN_LIST
    CHARACTER(LEN=*), INTENT(IN) :: LIST(number_in_list)
    CHARACTER(LEN=*), INTENT(IN) :: FORMAT
    INTEGER(INTG), INTENT(OUT) :: ERR
    TYPE(varying_string), INTENT(OUT) :: ERROR
    INTEGER(INTG), OPTIONAL, INTENT(IN) :: LIST_LENGTHS(number_in_list)
    !Function variable
    CHARACTER(LEN=MAXSTRLEN) :: LIST_TO_CHARACTER_C
    !Local variables
    INTEGER(INTG) :: i,POSITION,LENGTH
    
    enters("LIST_TO_CHARACTER_C",err,error,*999)

    list_to_character_c=""
    IF(number_in_list>0) THEN
      IF(PRESENT(list_lengths)) THEN
        length=list_lengths(1)
        list_to_character_c=list(1)(1:length)
        DO i=2,number_in_list
          IF(length+list_lengths(i)+1<=maxstrlen) THEN
            list_to_character_c=list_to_character_c(1:length)//","//list(i)(1:list_lengths(i))
            length=length+list_lengths(i)+1
          ELSE IF(length+5<=maxstrlen) THEN
            list_to_character_c=list_to_character_c(1:length)//",...."
            EXIT
          ELSE
            position=index(list_to_character_c(1:maxstrlen-4),",",.true.)
            IF(position/=0) THEN
              list_to_character_c=list_to_character_c(1:position)//"...."
            ELSE
              list_to_character_c=list_to_character_c(1:maxstrlen-5)//",...."
            ENDIF
            EXIT
          ENDIF
        ENDDO !i
      ELSE
        list_to_character_c=list(1)(1:len_trim(list(1)))
        DO i=2,number_in_list
          IF(len_trim(list_to_character_c)+len_trim(list(i))+1<=maxstrlen) THEN
            list_to_character_c=list_to_character_c(1:len_trim(list_to_character_c))//","//list(i)(1:len_trim(list(i)))
          ELSE IF(len_trim(list_to_character_c)+5<=maxstrlen) THEN
            list_to_character_c=list_to_character_c(1:len_trim(list_to_character_c))//",...."
            EXIT
          ELSE
            position=index(list_to_character_c(1:maxstrlen-4),",",.true.)
            IF(position/=0) THEN
              list_to_character_c=list_to_character_c(1:position)//"...."
            ELSE
              list_to_character_c=list_to_character_c(1:maxstrlen-5)//",...."
            ENDIF
            EXIT
          ENDIF
        ENDDO !i
      ENDIF
    ENDIF

    exits("LIST_TO_CHARACTER_C")
    RETURN
999 errorsexits("LIST_TO_CHARACTER_C",err,error)
    RETURN    
  END FUNCTION list_to_character_c
  
  !
  !================================================================================================================================
  !
  
  FUNCTION list_to_character_intg(NUMBER_IN_LIST,LIST,FORMAT,ERR,ERROR)
  
    !Argument variables
    INTEGER(INTG), INTENT(IN) :: NUMBER_IN_LIST
    INTEGER(INTG), INTENT(IN) :: LIST(number_in_list)
    CHARACTER(LEN=*), INTENT(IN) :: FORMAT
    INTEGER(INTG), INTENT(OUT) :: ERR
    TYPE(varying_string), INTENT(OUT) :: ERROR
    !Function variable
    CHARACTER(LEN=MAXSTRLEN) :: LIST_TO_CHARACTER_INTG
    !Local variables
    INTEGER(INTG) :: i,POSITION
    CHARACTER(LEN=MAXSTRLEN) :: LIST_VALUE
    
    enters("LIST_TO_CHARACTER_INTG",err,error,*999)

    list_to_character_intg=""
    IF(number_in_list>0) THEN
      list_to_character_intg=number_to_character_intg(list(1),FORMAT,err,error)
      IF(err/=0) GOTO 999
      DO i=2,number_in_list
        list_value=number_to_character_intg(list(i),FORMAT,err,error)
        IF(err/=0) GOTO 999
        IF(len_trim(list_to_character_intg)+len_trim(list_value)+1<=maxstrlen) THEN
          list_to_character_intg=list_to_character_intg(1:len_trim(list_to_character_intg))//","// &
            & list_value(1:len_trim(list_value))
        ELSE IF(len_trim(list_to_character_intg)+5<=maxstrlen) THEN
          list_to_character_intg=list_to_character_intg(1:len_trim(list_to_character_intg))//",...."
          EXIT
        ELSE
          position=index(list_to_character_intg(1:maxstrlen-4),",",.true.)
          IF(position/=0) THEN
            list_to_character_intg=list_to_character_intg(1:position)//"...."
          ELSE
            list_to_character_intg=list_to_character_intg(1:maxstrlen-5)//",...."
          ENDIF
          EXIT
        ENDIF
      ENDDO
    ENDIF

    exits("LIST_TO_CHARACTER_INTG")
    RETURN
999 errorsexits("LIST_TO_CHARACTER_INTG",err,error)
    RETURN    
  END FUNCTION list_to_character_intg
  
  !
  !================================================================================================================================
  !

  FUNCTION list_to_character_lintg(NUMBER_IN_LIST,LIST,FORMAT,ERR,ERROR)
  
    !Argument variables
    INTEGER(INTG), INTENT(IN) :: NUMBER_IN_LIST
    INTEGER(LINTG), INTENT(IN) :: LIST(number_in_list)
    CHARACTER(LEN=*), INTENT(IN) :: FORMAT
    INTEGER(INTG), INTENT(OUT) :: ERR
    TYPE(varying_string), INTENT(OUT) :: ERROR
    !Function variable
    CHARACTER(LEN=MAXSTRLEN) :: LIST_TO_CHARACTER_LINTG
    !Local variables
    INTEGER(INTG) :: i,POSITION
    CHARACTER(LEN=MAXSTRLEN) :: LIST_VALUE
    
    enters("LIST_TO_CHARACTER_LINTG",err,error,*999)

    list_to_character_lintg=""
    IF(number_in_list>0) THEN
      list_to_character_lintg=number_to_character_lintg(list(1),FORMAT,err,error)
      IF(err/=0) GOTO 999
      DO i=2,number_in_list
        list_value=number_to_character_lintg(list(i),FORMAT,err,error)
        IF(err/=0) GOTO 999
        IF(len_trim(list_to_character_lintg)+len_trim(list_value)+1<=maxstrlen) THEN
          list_to_character_lintg=list_to_character_lintg(1:len_trim(list_to_character_lintg))//","// &
            & list_value(1:len_trim(list_value))
        ELSE IF(len_trim(list_to_character_lintg)+5<=maxstrlen) THEN
          list_to_character_lintg=list_to_character_lintg(1:len_trim(list_to_character_lintg))//",...."
          EXIT
        ELSE
          position=index(list_to_character_lintg(1:maxstrlen-4),",",.true.)
          IF(position/=0) THEN
            list_to_character_lintg=list_to_character_lintg(1:position)//"...."
          ELSE
            list_to_character_lintg=list_to_character_lintg(1:maxstrlen-5)//",...."
          ENDIF
          EXIT
        ENDIF
      ENDDO
    ENDIF

    exits("LIST_TO_CHARACTER_LINTG")
    RETURN
999 errorsexits("LIST_TO_CHARACTER_LINTG",err,error)
    RETURN    
  END FUNCTION list_to_character_lintg
  
  !
  !================================================================================================================================
  !

  FUNCTION list_to_character_l(NUMBER_IN_LIST,LIST,FORMAT,ERR,ERROR)
  
    !Argument variables
    INTEGER(INTG), INTENT(IN) :: NUMBER_IN_LIST
    LOGICAL, INTENT(IN) :: LIST(number_in_list)
    CHARACTER(LEN=*), INTENT(IN) :: FORMAT
    INTEGER(INTG), INTENT(OUT) :: ERR
    TYPE(varying_string), INTENT(OUT) :: ERROR
    !Function variable
    CHARACTER(LEN=MAXSTRLEN) :: LIST_TO_CHARACTER_L
    !Local variables
    INTEGER(INTG) :: i,POSITION
    CHARACTER(LEN=MAXSTRLEN) :: LIST_VALUE
    
    enters("LIST_TO_CHARACTER_L",err,error,*999)

    list_to_character_l=""
    IF(number_in_list>0) THEN
      list_to_character_l=logical_to_character(list(1),err,error)
      IF(err/=0) GOTO 999
      DO i=2,number_in_list
        list_value=logical_to_character(list(i),err,error)
        IF(err/=0) GOTO 999
        IF(len_trim(list_to_character_l)+len_trim(list_value)+1<=maxstrlen) THEN
          list_to_character_l=list_to_character_l(1:len_trim(list_to_character_l))//","//list_value(1:len_trim(list_value))
        ELSE IF(len_trim(list_to_character_l)+5<=maxstrlen) THEN
          list_to_character_l=list_to_character_l(1:len_trim(list_to_character_l))//",...."
          EXIT
        ELSE
          position=index(list_to_character_l(1:maxstrlen-4),",",.true.)
          IF(position/=0) THEN
            list_to_character_l=list_to_character_l(1:position)//"...."
          ELSE
            list_to_character_l=list_to_character_l(1:maxstrlen-5)//",...."
          ENDIF
          EXIT
        ENDIF
      ENDDO
    ENDIF

    exits("LIST_TO_CHARACTER_L")
    RETURN
999 errorsexits("LIST_TO_CHARACTER_L",err,error)
    RETURN    
  END FUNCTION list_to_character_l
  
  !
  !================================================================================================================================
  !

  FUNCTION list_to_character_sp(NUMBER_IN_LIST,LIST,FORMAT,ERR,ERROR)
  
    !Argument variables
    INTEGER(INTG), INTENT(IN) :: NUMBER_IN_LIST
    REAL(SP), INTENT(IN) :: LIST(number_in_list)
    CHARACTER(LEN=*), INTENT(IN) :: FORMAT
    INTEGER(INTG), INTENT(OUT) :: ERR
    TYPE(varying_string), INTENT(OUT) :: ERROR
    !Function variable
    CHARACTER(LEN=MAXSTRLEN) :: LIST_TO_CHARACTER_SP
    !Local variables
    INTEGER(INTG) :: i,POSITION
    CHARACTER(LEN=MAXSTRLEN) :: LIST_VALUE
    
    enters("LIST_TO_CHARACTER_SP",err,error,*999)

    list_to_character_sp=""
    IF(number_in_list>0) THEN
      list_to_character_sp=number_to_character_sp(list(1),FORMAT,err,error)
      IF(err/=0) GOTO 999
      DO i=2,number_in_list
        list_value=number_to_character_sp(list(i),FORMAT,err,error)
        IF(err/=0) GOTO 999
        IF(len_trim(list_to_character_sp)+len_trim(list_value)+1<=maxstrlen) THEN
          list_to_character_sp=list_to_character_sp(1:len_trim(list_to_character_sp))//","//list_value(1:len_trim(list_value))
        ELSE IF(len_trim(list_to_character_sp)+5<=maxstrlen) THEN
          list_to_character_sp=list_to_character_sp(1:len_trim(list_to_character_sp))//",...."
          EXIT
        ELSE
          position=index(list_to_character_sp(1:maxstrlen-4),",",.true.)
          IF(position/=0) THEN
            list_to_character_sp=list_to_character_sp(1:position)//"...."
          ELSE
            list_to_character_sp=list_to_character_sp(1:maxstrlen-5)//",...."
          ENDIF
          EXIT
        ENDIF
      ENDDO
    ENDIF

    exits("LIST_TO_CHARACTER_SP")
    RETURN
999 errorsexits("LIST_TO_CHARACTER_SP",err,error)
    RETURN    
  END FUNCTION list_to_character_sp
  
  !
  !================================================================================================================================
  !

  FUNCTION list_to_character_dp(NUMBER_IN_LIST,LIST,FORMAT,ERR,ERROR)
  
    !Argument variables
    INTEGER(INTG), INTENT(IN) :: NUMBER_IN_LIST
    REAL(DP), INTENT(IN) :: LIST(number_in_list)
    CHARACTER(LEN=*), INTENT(IN) :: FORMAT
    INTEGER(INTG), INTENT(OUT) :: ERR
    TYPE(varying_string), INTENT(OUT) :: ERROR
    !Function variable
    CHARACTER(LEN=MAXSTRLEN) :: LIST_TO_CHARACTER_DP
    !Local variables
    INTEGER(INTG) :: i,POSITION
    CHARACTER(LEN=MAXSTRLEN) :: LIST_VALUE
    
    enters("LIST_TO_CHARACTER_DP",err,error,*999)

    list_to_character_dp=""
    IF(number_in_list>0) THEN
      list_to_character_dp=number_to_character_dp(list(1),FORMAT,err,error)
      IF(err/=0) GOTO 999
      DO i=2,number_in_list
        list_value=number_to_character_dp(list(i),FORMAT,err,error)
        IF(err/=0) GOTO 999
        IF(len_trim(list_to_character_dp)+len_trim(list_value)+1<=maxstrlen) THEN
          list_to_character_dp=list_to_character_dp(1:len_trim(list_to_character_dp))//","//list_value(1:len_trim(list_value))
        ELSE IF(len_trim(list_to_character_dp)+5<=maxstrlen) THEN
          list_to_character_dp=list_to_character_dp(1:len_trim(list_to_character_dp))//",...."
          EXIT
        ELSE
          position=index(list_to_character_dp(1:maxstrlen-4),",",.true.)
          IF(position/=0) THEN
            list_to_character_dp=list_to_character_dp(1:position)//"...."
          ELSE
            list_to_character_dp=list_to_character_dp(1:maxstrlen-5)//",...."
          ENDIF
          EXIT
        ENDIF
      ENDDO
    ENDIF

    exits("LIST_TO_CHARACTER_DP")
    RETURN
999 errorsexits("LIST_TO_CHARACTER_DP",err,error)
    RETURN    
  END FUNCTION list_to_character_dp
  
  !
  !================================================================================================================================
  !

  FUNCTION logical_to_character(LOGICALVALUE,ERR,ERROR)
  
    !Argument variables
    LOGICAL, INTENT(IN) :: LOGICALVALUE
    INTEGER(INTG), INTENT(OUT) :: ERR
    TYPE(varying_string), INTENT(OUT) :: ERROR
    !Function variable
    CHARACTER(LEN=MAXSTRLEN) :: LOGICAL_TO_CHARACTER
    !Local variables
    
    enters("LOGICAL_TO_CHARACTER",err,error,*999)

    IF(logicalvalue) THEN
      logical_to_character="TRUE"
    ELSE
      logical_to_character="FALSE"
    ENDIF

    exits("LOGICAL_TO_CHARACTER")
    RETURN
999 errorsexits("LOGICAL_TO_CHARACTER",err,error)
    RETURN    
  END FUNCTION logical_to_character
  
  !
  !================================================================================================================================
  !

  FUNCTION logical_to_vstring(LOGICALVALUE,ERR,ERROR)
    
    !Argument variables
    LOGICAL, INTENT(IN) :: LOGICALVALUE
    INTEGER(INTG), INTENT(OUT) :: ERR
    TYPE(varying_string), INTENT(OUT) :: ERROR
    !Function variable
    TYPE(varying_string) :: LOGICAL_TO_VSTRING
    !Local variables
    
    enters("LOGICAL_TO_VSTRING",err,error,*999)

    IF(logicalvalue) THEN
      logical_to_vstring="TRUE"
    ELSE
      logical_to_vstring="FALSE"
    ENDIF

    exits("LOGICAL_TO_VSTRING")
    RETURN
999 errorsexits("LOGICAL_TO_VSTRING",err,error)
    RETURN    
  END FUNCTION logical_to_vstring
  
  !
  !================================================================================================================================
  !

  FUNCTION number_to_character_intg(NUMBER,FORMAT,ERR,ERROR)
  
    !Argument variables
    INTEGER(INTG), INTENT(IN) :: NUMBER
    CHARACTER(LEN=*), INTENT(IN) :: FORMAT
    INTEGER(INTG), INTENT(OUT) :: ERR
    TYPE(varying_string), INTENT(OUT) :: ERROR
    !Function variable
    CHARACTER(LEN=MAXSTRLEN) :: NUMBER_TO_CHARACTER_INTG
    !Local variables
    CHARACTER(LEN=MAXSTRLEN) :: LOCAL_FORMAT
    
    enters("NUMBER_TO_CHARACTER_INTG",err,error,*999)

    IF(FORMAT(1:1)=="*") THEN
      local_format="(I12)"
    ELSE
      local_format="("//FORMAT(1:len_trim(format))//")"
    ENDIF
    WRITE(number_to_character_intg,local_format,err=999) number

    !Trim leading blanks
    number_to_character_intg=adjustl(number_to_character_intg)

    exits("NUMBER_TO_CHARACTER_INTG")
    RETURN
999 CALL flagerror("Error converting an integer to a character string",err,error,*998)
998 errorsexits("NUMBER_TO_CHARACTER_INTG",err,error)
    RETURN    
  END FUNCTION number_to_character_intg
  
  !
  !================================================================================================================================
  !

  FUNCTION number_to_character_lintg(NUMBER,FORMAT,ERR,ERROR)
  
    !Argument variables
    INTEGER(LINTG), INTENT(IN) :: NUMBER
    CHARACTER(LEN=*), INTENT(IN) :: FORMAT
    INTEGER(INTG), INTENT(OUT) :: ERR
    TYPE(varying_string), INTENT(OUT) :: ERROR
    !Function variable
    CHARACTER(LEN=MAXSTRLEN) :: NUMBER_TO_CHARACTER_LINTG
    !Local variables
    CHARACTER(LEN=MAXSTRLEN) :: LOCAL_FORMAT
    
    enters("NUMBER_TO_CHARACTER_LINTG",err,error,*999)

    IF(FORMAT(1:1)=="*") THEN
      local_format="(I18)"
    ELSE
      local_format="("//FORMAT(1:len_trim(format))//")"
    ENDIF
    WRITE(number_to_character_lintg,local_format,err=999) number

    !Trim leading blanks
    number_to_character_lintg=adjustl(number_to_character_lintg)

    exits("NUMBER_TO_CHARACTER_LINTG")
    RETURN
999 CALL flagerror("Error converting a long integer to a character string",err,error,*998)
998 errorsexits("NUMBER_TO_CHARACTER_LINTG",err,error)
    RETURN    
  END FUNCTION number_to_character_lintg
  
  !
  !================================================================================================================================
  !

  FUNCTION number_to_character_sp(NUMBER, FORMAT, ERR, ERROR)
  
    !Argument variables
    REAL(SP), INTENT(IN) :: NUMBER
    CHARACTER(LEN=*), INTENT(IN) :: FORMAT
    INTEGER(INTG), INTENT(OUT) :: ERR
    TYPE(varying_string), INTENT(OUT) :: ERROR
    !Function variable
    CHARACTER(LEN=MAXSTRLEN) :: NUMBER_TO_CHARACTER_SP
    !Local variables
    INTEGER(INTG) :: ASTERISK_POS,i0,i1,LENGTH
    CHARACTER(LEN=MAXSTRLEN) :: CI0,CI1
    CHARACTER(LEN=MAXSTRLEN) :: LOCAL_FORMAT
    
    enters("NUMBER_TO_CHARACTER_SP",err,error,*999)

    asterisk_pos=index(FORMAT,"*")
    length=len_trim(format)
    IF(asterisk_pos==1.AND.length==1) THEN !Free format
      WRITE(number_to_character_sp,*,err=999) number      
    ELSE IF(asterisk_pos>0) THEN !Adjustable format
      ci0=FORMAT(asterisk_pos+1:len_trim(format))
      READ(ci0,'(BN,I2)') i0
      IF(i0<=maxstrlen) THEN
        IF(number>=0.0_sp) THEN
          IF((number<10.0_sp**(i0-1)).AND.(number>=0.1_sp**(min(i0-2,5)))) THEN
            IF(number>1.0_sp) THEN
              i1=i0-2-floor(log10(number))
              local_format="(I2)"
              WRITE(ci1,local_format) i1
              local_format="(F"//ci0(1:len_trim(ci0))//"."//ci1(1:len_trim(ci1))//")"
              WRITE(number_to_character_sp,local_format,err=999) number
            ELSE
              local_format="(I2)"
              WRITE(ci1,local_format) i0-2
              local_format="(F"//ci0(1:len_trim(ci0))//"."//ci1(1:len_trim(ci1))//")"
              WRITE(number_to_character_sp,local_format,err=999) number
            ENDIF
          ELSE
            local_format="(I2)"
            WRITE(ci1,local_format) i0-6
            local_format="(E"//ci0(1:len_trim(ci0))//"."//ci1(1:len_trim(ci1))//")"
            WRITE(number_to_character_sp,local_format,err=999) number
          ENDIF
        ELSE
          IF((-number<10.0_sp**(i0-2)).AND.(-number>=0.01_sp**(min(i0-2,5)))) THEN
            IF(-number>=1.0_sp) THEN
              i1=i0-3-floor(log10(number))
              local_format="(I2)"
              WRITE(ci1,'(I2)') i1
              local_format="(F"//ci0(1:len_trim(ci0))//"."//ci1(1:len_trim(ci1))//")"
              WRITE(number_to_character_sp,local_format,err=999) number
            ELSE
              local_format="(I2)"
              WRITE(ci1,local_format) i0-2
              local_format="(F"//ci0(1:len_trim(ci0))//"."//ci1(1:len_trim(ci1))//")"
              WRITE(number_to_character_sp,local_format,err=999) number
            ENDIF
          ELSE
            local_format="(I2)"
            WRITE(ci1,local_format) i0-6
            local_format="(E"//ci0(1:len_trim(ci0))//"."//ci1(1:len_trim(ci1))//")"
            WRITE(number_to_character_sp,local_format,err=999) number
          ENDIF
        ENDIF
      ELSE
        CALL flagerror("Invalid FORMAT",err,error,*999)
        GOTO 999
      ENDIF
    ELSE
      local_format='('//FORMAT(1:len_trim(format))//')'
      WRITE(number_to_character_sp,local_format,err=999) number
    ENDIF

    !Add an extra zero if required
    IF(number_to_character_sp(len_trim(number_to_character_sp):len_trim(number_to_character_sp))==".") &
      & number_to_character_sp=number_to_character_sp(1:len_trim(number_to_character_sp))//"0"
    !Trim leading blanks
    number_to_character_sp=adjustl(number_to_character_sp)

    exits("NUMBER_TO_CHARACTER_SP")
    RETURN
999 CALL flagerror("Error converting a single precision number to a character string",err,error,*998)
998 errorsexits("NUMBER_TO_CHARACTER_SP",err,error)
    RETURN    
  END FUNCTION number_to_character_sp
  
  !
  !================================================================================================================================
  !

  FUNCTION number_to_character_dp(NUMBER, FORMAT, ERR, ERROR)
  
    !Argument variables
    REAL(DP), INTENT(IN) :: NUMBER
    CHARACTER(LEN=*), INTENT(IN) :: FORMAT
    INTEGER(INTG), INTENT(OUT) :: ERR
    TYPE(varying_string), INTENT(OUT) :: ERROR
    !Function variable
    CHARACTER(LEN=MAXSTRLEN) :: NUMBER_TO_CHARACTER_DP
    !Local variables
    INTEGER(INTG) :: ASTERISK_POS,i0,i1,LENGTH
    CHARACTER(LEN=2) :: CI0,CI1
    CHARACTER(LEN=MAXSTRLEN) :: LOCAL_FORMAT
    
    enters("NUMBER_TO_CHARACTER_DP",err,error,*999)

    asterisk_pos=index(FORMAT,"*")
    length=len_trim(format)
    IF(asterisk_pos==1.AND.length==1) THEN !Free format
      WRITE(number_to_character_dp,*,err=999) number      
    ELSE IF(asterisk_pos>0) THEN !Adjustable format
      ci0=FORMAT(asterisk_pos+1:len_trim(format))
      READ(ci0,'(BN,I2)') i0
      IF(i0<=maxstrlen) THEN
        IF(number>=0.0_dp) THEN
          IF((number<10.0_dp**(i0-1)).AND.(number>=0.1_dp**(min(i0-2,5)))) THEN
            IF(number>1.0_dp) THEN
              i1=i0-2-floor(log10(number))
              local_format="(I2)"
              WRITE(ci1,local_format) i1
              local_format="(F"//ci0(1:len_trim(ci0))//"."//ci1(1:len_trim(ci1))//")"
              WRITE(number_to_character_dp,local_format,err=999) number
            ELSE
              local_format="(I2)"
              WRITE(ci1,local_format) i0-2
              local_format="(F"//ci0(1:len_trim(ci0))//"."//ci1(1:len_trim(ci1))//")"
              WRITE(number_to_character_dp,local_format,err=999) number
            ENDIF
          ELSE
            local_format="(I2)"
            WRITE(ci1,local_format) i0-6
            local_format="(E"//ci0(1:len_trim(ci0))//"."//ci1(1:len_trim(ci1))//")"
            WRITE(number_to_character_dp,local_format,err=999) number
          ENDIF
        ELSE
          IF((-number<10.0_dp**(i0-2)).AND.(-number>=0.01_dp**(min(i0-2,5)))) THEN
            IF(-number>=1.0_dp) THEN
              i1=i0-3-floor(log10(number))
              local_format="(I2)"
              WRITE(ci1,'(I2)') i1
              local_format="(F"//ci0(1:len_trim(ci0))//"."//ci1(1:len_trim(ci1))//")"
              WRITE(number_to_character_dp,local_format,err=999) number
            ELSE
              local_format="(I2)"
              WRITE(ci1,local_format) i0-2
              local_format="(F"//ci0(1:len_trim(ci0))//"."//ci1(1:len_trim(ci1))//")"
              WRITE(number_to_character_dp,local_format,err=999) number
            ENDIF
          ELSE
            local_format="(I2)"
            WRITE(ci1,local_format) i0-6
            local_format="(E"//ci0(1:len_trim(ci0))//"."//ci1(1:len_trim(ci1))//")"
            WRITE(number_to_character_dp,local_format,err=999) number
          ENDIF
        ENDIF
      ELSE
        CALL flagerror("Invalid format",err,error,*999)
      ENDIF
    ELSE
      local_format='('//FORMAT(1:len_trim(format))//')'
      WRITE(number_to_character_dp,local_format,err=999) number
    ENDIF

    !Add an extra zero if required
    IF(number_to_character_dp(len_trim(number_to_character_dp):len_trim(number_to_character_dp))==".") &
      & number_to_character_dp=number_to_character_dp(1:len_trim(number_to_character_dp))//"0"
    !Trim leading blanks
    number_to_character_dp=adjustl(number_to_character_dp)

    exits("NUMBER_TO_CHARACTER_DP")
    RETURN
999 CALL flagerror("Error converting double precision number to a character string",err,error,*998)
998 errorsexits("NUMBER_TO_CHARACTER_DP",err,error)
    RETURN    
  END FUNCTION number_to_character_dp
  
  !
  !================================================================================================================================
  !

  FUNCTION number_to_vstring_intg(NUMBER,FORMAT,ERR,ERROR)
  
    !Argument variables
    INTEGER(INTG), INTENT(IN) :: NUMBER
    CHARACTER(LEN=*), INTENT(IN) :: FORMAT
    INTEGER(INTG), INTENT(OUT) :: ERR
    TYPE(varying_string), INTENT(OUT) :: ERROR
    !Function variable
    TYPE(varying_string) :: NUMBER_TO_VSTRING_INTG
    !Local variables
    CHARACTER(LEN=MAXSTRLEN) :: LOCAL_FORMAT,LOCAL_STRING
    
!!TODO: put back enters,exits.

!    ENTERS("NUMBER_TO_VSTRING_INTG",ERR,ERROR,*999)

!!TODO: remove dependance on LOCAL_STRING
    
    number_to_vstring_intg=""
    
    IF(FORMAT(1:1)=="*") THEN
      local_format="(I12)"
    ELSE
      local_format="("//FORMAT(1:len_trim(format))//")"
    ENDIF
    WRITE(local_string,local_format,err=999) number

    !Trim leading blanks
    number_to_vstring_intg=adjustl(local_string(1:len_trim(local_string)))

!    EXITS("NUMBER_TO_VSTRING_INTG")
    RETURN
999 CALL flagerror("Error converting an integer to a varying string",err,error,*998)
998 errorsexits("NUMBER_TO_VSTRING_INTG",err,error)
    RETURN    
  END FUNCTION number_to_vstring_intg
  
  !
  !================================================================================================================================
  !

  FUNCTION number_to_vstring_lintg(NUMBER,FORMAT,ERR,ERROR)
  
    !Argument variables
    INTEGER(LINTG), INTENT(IN) :: NUMBER
    CHARACTER(LEN=*), INTENT(IN) :: FORMAT
    INTEGER(INTG), INTENT(OUT) :: ERR
    TYPE(varying_string), INTENT(OUT) :: ERROR
    !Function variable
    TYPE(varying_string) :: NUMBER_TO_VSTRING_LINTG
    !Local variables
    CHARACTER(LEN=MAXSTRLEN) :: LOCAL_FORMAT,LOCAL_STRING
    
!!TODO: put back enters,exits.

!    ENTERS("NUMBER_TO_VSTRING_LINTG",ERR,ERROR,*999)

!!TODO: remove dependance on LOCAL_STRING
    
    number_to_vstring_lintg=""
    
    IF(FORMAT(1:1)=="*") THEN
      local_format="(I18)"
    ELSE
      local_format="("//FORMAT(1:len_trim(format))//")"
    ENDIF
    WRITE(local_string,local_format,err=999) number

    !Trim leading blanks
    number_to_vstring_lintg=adjustl(local_string(1:len_trim(local_string)))

!    EXITS("NUMBER_TO_VSTRING_LINTG")
    RETURN
999 CALL flagerror("Error converting a long integer to a varying string",err,error,*998)
998 errorsexits("NUMBER_TO_VSTRING_LINTG",err,error)
!    EXITS("NUMBER_TO_VSTRING_LINTG")
    RETURN    
  END FUNCTION number_to_vstring_lintg
  
  !
  !================================================================================================================================
  !

  FUNCTION number_to_vstring_sp(NUMBER, FORMAT, ERR, ERROR)
  
    !Argument variables
    REAL(SP), INTENT(IN) :: NUMBER
    CHARACTER(LEN=*), INTENT(IN) :: FORMAT
    INTEGER(INTG), INTENT(OUT) :: ERR
    TYPE(varying_string), INTENT(OUT) :: ERROR
    !Function variable
    TYPE(varying_string) :: NUMBER_TO_VSTRING_SP
    !Local variables
    INTEGER(INTG) :: ASTERISK_POS,i0,i1,LENGTH
    CHARACTER(LEN=MAXSTRLEN) :: CI0,CI1
    CHARACTER(LEN=MAXSTRLEN) :: LOCAL_FORMAT,LOCAL_STRING
    
    enters("NUMBER_TO_VSTRING_SP",err,error,*999)

!!TODO: remove dependance on LOCAL_STRING
    
    number_to_vstring_sp=""    

    asterisk_pos=index(FORMAT,"*")
    length=len_trim(format)
    IF(asterisk_pos==1.AND.length==1) THEN !Free format
      WRITE(local_string,*,err=999) number      
    ELSE IF(asterisk_pos>0) THEN !Adjustable format
      ci0=FORMAT(asterisk_pos+1:len_trim(format))
      READ(ci0,'(BN,I2)') i0
      IF(i0<=maxstrlen) THEN
        IF(number>=0.0_sp) THEN
          IF((number<10.0_sp**(i0-1)).AND.(number>=0.1_sp**(min(i0-2,5)))) THEN
            IF(number>1.0_sp) THEN
              i1=i0-2-floor(log10(number))
              local_format="(I2)"
              WRITE(ci1,local_format) i1
              local_format="(F"//ci0(1:len_trim(ci0))//"."//ci1(1:len_trim(ci1))//")"
              WRITE(local_string,local_format,err=999) number
            ELSE
              local_format="(I2)"
              WRITE(ci1,local_format) i0-2
              local_format="(F"//ci0(1:len_trim(ci0))//"."//ci1(1:len_trim(ci1))//")"
              WRITE(local_string,local_format,err=999) number
            ENDIF
          ELSE
            local_format="(I2)"
            WRITE(ci1,local_format) i0-6
            local_format="(E"//ci0(1:len_trim(ci0))//"."//ci1(1:len_trim(ci1))//")"
            WRITE(local_string,local_format,err=999) number
          ENDIF
        ELSE
          IF((-number<10.0_sp**(i0-2)).AND.(-number>=0.01_sp**(min(i0-2,5)))) THEN
            IF(-number>=1.0_sp) THEN
              i1=i0-3-floor(log10(number))
              local_format="(I2)"
              WRITE(ci1,'(I2)') i1
              local_format="(F"//ci0(1:len_trim(ci0))//"."//ci1(1:len_trim(ci1))//")"
              WRITE(local_string,local_format,err=999) number
            ELSE
              local_format="(I2)"
              WRITE(ci1,local_format) i0-2
              local_format="(F"//ci0(1:len_trim(ci0))//"."//ci1(1:len_trim(ci1))//")"
              WRITE(local_string,local_format,err=999) number
            ENDIF
          ELSE
            local_format="(I2)"
            WRITE(ci1,local_format) i0-6
            local_format="(E"//ci0(1:len_trim(ci0))//"."//ci1(1:len_trim(ci1))//")"
            WRITE(local_string,local_format,err=999) number
          ENDIF
        ENDIF
      ELSE
        CALL flagerror("Invalid format",err,error,*999)
        GOTO 999
      ENDIF
    ELSE
      local_format='('//FORMAT(1:len_trim(format))//')'
      WRITE(local_string,local_format,err=999) number
    ENDIF

    !Add an extra zero if required
    IF(local_string(len_trim(local_string):len_trim(local_string))==".") local_string=local_string(1:len_trim(local_string))//"0"
    
    !Trim leading blanks
    number_to_vstring_sp=adjustl(local_string(1:len_trim(local_string)))

    exits("NUMBER_TO_VSTRING_SP")
    RETURN
999 CALL flagerror("Error converting a single precision number to a varying string",err,error,*998)
998 errorsexits("NUMBER_TO_VSTRING_SP",err,error)
    RETURN    
  END FUNCTION number_to_vstring_sp
  
  !
  !================================================================================================================================
  !

  FUNCTION number_to_vstring_dp(NUMBER, FORMAT, ERR, ERROR)
      
    !Argument variables
    REAL(DP), INTENT(IN) :: NUMBER
    CHARACTER(LEN=*), INTENT(IN) :: FORMAT
    INTEGER(INTG), INTENT(OUT) :: ERR
    TYPE(varying_string), INTENT(OUT) :: ERROR
    !Function variable
    TYPE(varying_string) :: NUMBER_TO_VSTRING_DP
    !Local variables
    INTEGER(INTG) :: ASTERISK_POS,i0,i1,LENGTH
    CHARACTER(LEN=2) :: CI0,CI1
    CHARACTER(LEN=MAXSTRLEN) :: LOCAL_FORMAT,LOCAL_STRING
    
!!TODO: put back enters,exits.

!    ENTERS("NUMBER_TO_VSTRING_DP",ERR,ERROR,*999)

!!TODO: remove dependance on LOCAL_STRING
    
    number_to_vstring_dp=""    

    asterisk_pos=index(FORMAT,"*")
    length=len_trim(format)
    IF(asterisk_pos==1.AND.length==1) THEN !Free format
      WRITE(local_string,*,err=999) number      
    ELSE IF(asterisk_pos>0) THEN !Adjustable format
      ci0=FORMAT(asterisk_pos+1:len_trim(format))
      READ(ci0,'(BN,I2)') i0
      IF(i0<=maxstrlen) THEN
        IF(number>=0.0_dp) THEN
          IF((number<10.0_dp**(i0-1)).AND.(number>=0.1_dp**(min(i0-2,5)))) THEN
            IF(number>1.0_dp) THEN
              i1=i0-2-floor(log10(number))
              local_format="(I2)"
              WRITE(ci1,local_format) i1
              local_format="(F"//ci0(1:len_trim(ci0))//"."//ci1(1:len_trim(ci1))//")"
              WRITE(local_string,local_format,err=999) number
            ELSE
              local_format="(I2)"
              WRITE(ci1,local_format) i0-2
              local_format="(F"//ci0(1:len_trim(ci0))//"."//ci1(1:len_trim(ci1))//")"
              WRITE(local_string,local_format,err=999) number
            ENDIF
          ELSE
            local_format="(I2)"
            WRITE(ci1,local_format) i0-6
            local_format="(E"//ci0(1:len_trim(ci0))//"."//ci1(1:len_trim(ci1))//")"
            WRITE(local_string,local_format,err=999) number
          ENDIF
        ELSE
          IF((-number<10.0_dp**(i0-2)).AND.(-number>=0.01_dp**(min(i0-2,5)))) THEN
            IF(-number>=1.0_dp) THEN
              i1=i0-3-floor(log10(number))
              local_format="(I2)"
              WRITE(ci1,'(I2)') i1
              local_format="(F"//ci0(1:len_trim(ci0))//"."//ci1(1:len_trim(ci1))//")"
              WRITE(local_string,local_format,err=999) number
            ELSE
              local_format="(I2)"
              WRITE(ci1,local_format) i0-2
              local_format="(F"//ci0(1:len_trim(ci0))//"."//ci1(1:len_trim(ci1))//")"
              WRITE(local_string,local_format,err=999) number
            ENDIF
          ELSE
            local_format="(I2)"
            WRITE(ci1,local_format) i0-6
            local_format="(E"//ci0(1:len_trim(ci0))//"."//ci1(1:len_trim(ci1))//")"
            WRITE(local_string,local_format,err=999) number
          ENDIF
        ENDIF
      ELSE
        CALL flagerror("Invalid format",err,error,*999)
      ENDIF
    ELSE
      local_format='('//FORMAT(1:len_trim(format))//')'
      WRITE(local_string,local_format,err=999) number
    ENDIF

    !Add an extra zero if required
    IF(local_string(len_trim(local_string):len_trim(local_string))==".") local_string=local_string(1:len_trim(local_string))//"0"

    !!Do you really want to do this???
    !Trim leading blanks
    !NUMBER_TO_VSTRING_DP=ADJUSTL(LOCAL_STRING(1:LEN_TRIM(LOCAL_STRING)))
    number_to_vstring_dp=local_string(1:len_trim(local_string))

!    EXITS("NUMBER_TO_VSTRING_DP")
    RETURN
999 CALL flagerror("Error converting double precision number to a varying string",err,error,*998)
998 errorsexits("NUMBER_TO_VSTRING_DP",err,error)
!    EXITS("NUMBER_TO_VSTRING_DP")
    RETURN    
  END FUNCTION number_to_vstring_dp
  
  !
  !================================================================================================================================
  !

  FUNCTION string_to_double_c(STRING, ERR, ERROR)
  
    !Argument variables
    CHARACTER(LEN=*), INTENT(IN) :: STRING
    INTEGER(INTG), INTENT(OUT) :: ERR
    TYPE(varying_string), INTENT(OUT) :: ERROR
    !Function variable
    REAL(DP) :: STRING_TO_DOUBLE_C
    !Local variables
    
    enters("STRING_TO_DOUBLE_C",err,error,*999)

    READ(string,*,iostat=err,err=999) string_to_double_c

    exits("STRING_TO_DOUBLE_C")
    RETURN
999 CALL flagerror("Cannot convert '"//string(1:len_trim(string))//"' to a double real",err,error,*998)
998 errorsexits("STRING_TO_DOUBLE_C",err,error)
    RETURN    
  END FUNCTION string_to_double_c
  
  !
  !================================================================================================================================
  !

  FUNCTION string_to_double_vs(STRING, ERR, ERROR)
  
    !Argument variables
    TYPE(varying_string), INTENT(IN) :: STRING
    INTEGER(INTG), INTENT(OUT) :: ERR
    TYPE(varying_string), INTENT(OUT) :: ERROR
    !Function variable
    REAL(DP) :: STRING_TO_DOUBLE_VS
    !Local variables
    CHARACTER(LEN=MAXSTRLEN) :: LOCAL_STRING
    
    enters("STRING_TO_DOUBLE_VS",err,error,*999)

!!TODO: remove dependance on LOCAL_STRING

    local_string=char(string)
    READ(local_string,*,iostat=err,err=999) string_to_double_vs

    exits("STRING_TO_DOUBLE_VS")
    RETURN
999 CALL flagerror("Cannot convert '"//char(string)//"' to a double real",err,error,*998)
998 errorsexits("STRING_TO_DOUBLE_VS",err,error)
    RETURN    
  END FUNCTION string_to_double_vs
  
  !
  !================================================================================================================================
  !

  FUNCTION string_to_integer_c(STRING, ERR, ERROR)
  
    !Argument variables
    CHARACTER(LEN=*), INTENT(IN) :: STRING
    INTEGER(INTG), INTENT(OUT) :: ERR
    TYPE(varying_string), INTENT(OUT) :: ERROR
    !Function variable
    INTEGER(INTG) :: STRING_TO_INTEGER_C
    !Local variables
    
    enters("STRING_TO_INTEGER_C",err,error,*999)

    READ(string,*,iostat=err,err=999) string_to_integer_c

    exits("STRING_TO_INTEGER_C")
    RETURN
999 CALL flagerror("Cannot convert '"//string(1:len_trim(string))//"' to an integer",err,error,*998)
998 errorsexits("STRING_TO_INTEGER_C",err,error)
    RETURN 
  END FUNCTION string_to_integer_c
  
  !
  !================================================================================================================================
  !

  FUNCTION string_to_integer_vs(STRING, ERR, ERROR)
  
    !Argument variables
    TYPE(varying_string), INTENT(IN) :: STRING
    INTEGER(INTG), INTENT(OUT) :: ERR
    TYPE(varying_string), INTENT(OUT) :: ERROR
    !Function variable
    INTEGER(INTG) :: STRING_TO_INTEGER_VS
    !Local variables
    CHARACTER(LEN=MAXSTRLEN) :: LOCAL_STRING
    
    enters("STRING_TO_INTEGER_VS",err,error,*999)

!!TODO: remove dependance on LOCAL_STRING

    local_string=char(string)
    READ(local_string,*,iostat=err,err=999) string_to_integer_vs

    exits("STRING_TO_INTEGER_VS")
    RETURN
999 CALL flagerror("Cannot convert '"//char(string)//"' to an integer",err,error,*998)
998 errorsexits("STRING_TO_INTEGER_VS",err,error)
    RETURN 
  END FUNCTION string_to_integer_vs
  
  !
  !================================================================================================================================
  !

  FUNCTION string_to_long_integer_c(STRING, ERR, ERROR)
  
    !Argument variables
    CHARACTER(LEN=*), INTENT(IN) :: STRING
    INTEGER(INTG), INTENT(OUT) :: ERR
    TYPE(varying_string), INTENT(OUT) :: ERROR
    !Function variable
    INTEGER(LINTG) :: STRING_TO_LONG_INTEGER_C
    !Local variables
    
    enters("STRING_TO_LONG_INTEGER_C",err,error,*999)

    READ(string,*,iostat=err,err=999) string_to_long_integer_c

    exits("STRING_TO_LONG_INTEGER_C")
    RETURN
999 CALL flagerror("Cannot convert '"//string(1:len_trim(string))//"' to a long integer",err,error,*998)
998 errorsexits("STRING_TO_LONG_INTEGER_C",err,error)
    RETURN 
  END FUNCTION string_to_long_integer_c
  
  !
  !================================================================================================================================
  !

  FUNCTION string_to_long_integer_vs(STRING, ERR, ERROR)
  
    !Argument variables
    TYPE(varying_string), INTENT(IN) :: STRING
    INTEGER(INTG), INTENT(OUT) :: ERR
    TYPE(varying_string), INTENT(OUT) :: ERROR
    !Function variable
    INTEGER(LINTG) :: STRING_TO_LONG_INTEGER_VS
    !Local variables
    CHARACTER(LEN=MAXSTRLEN) :: LOCAL_STRING
    
    enters("STRING_TO_LONG_INTEGER_VS",err,error,*999)

!!TODO: remove dependance on LOCAL_STRING

    local_string=char(string)
    READ(local_string,*,iostat=err,err=999) string_to_long_integer_vs

    exits("STRING_TO_LONG_INTEGER_VS")
    RETURN
999 CALL flagerror("Cannot convert '"//char(string)//"' to a long integer",err,error,*998)
998 errorsexits("STRING_TO_LONG_INTEGER_VS",err,error)
    RETURN 
  END FUNCTION string_to_long_integer_vs
  
  !
  !================================================================================================================================
  !

  FUNCTION string_to_logical_c(STRING,ERR,ERROR)
  
    !Argument variables
    CHARACTER(LEN=*), INTENT(IN) :: STRING
    INTEGER(INTG), INTENT(OUT) :: ERR
    TYPE(varying_string), INTENT(OUT) :: ERROR
    !Function variable
    LOGICAL :: STRING_TO_LOGICAL_C
    !Local variables
    
    enters("STRING_TO_LOGICAL_C",err,error,*999)

    READ(string,*,iostat=err,err=999) string_to_logical_c

    exits("STRING_TO_LOGICAL_C")
    RETURN
999 CALL flagerror("Cannot convert '"//string(1:len_trim(string))//"' to a logical",err,error,*998)
998 errorsexits("STRING_TO_LOGICAL_C",err,error)
    RETURN    
  END FUNCTION string_to_logical_c
  
  !
  !================================================================================================================================
  !

  FUNCTION string_to_logical_vs(STRING,ERR,ERROR)
  
    !Argument variables
    TYPE(varying_string), INTENT(IN) :: STRING
    INTEGER(INTG), INTENT(OUT) :: ERR
    TYPE(varying_string), INTENT(OUT) :: ERROR
    !Function variable
    LOGICAL :: STRING_TO_LOGICAL_VS
    !Local variables
    CHARACTER(LEN=MAXSTRLEN) :: LOCAL_STRING
    
    enters("STRING_TO_LOGICAL_VS",err,error,*999)

    local_string=char(string)
    READ(local_string,*,iostat=err,err=999) string_to_logical_vs

    exits("STRING_TO_LOGICAL_VS")
    RETURN
999 CALL flagerror("Cannot convert '"//char(string)//"' to a logical",err,error,*998)
998 errorsexits("STRING_TO_LOGICAL_VS",err,error)
    RETURN    
  END FUNCTION string_to_logical_vs
  
  !
  !================================================================================================================================
  !

  FUNCTION string_to_single_c(STRING, ERR, ERROR)
  
    !Argument variables
    CHARACTER(LEN=*), INTENT(IN) :: STRING
    INTEGER(INTG), INTENT(OUT) :: ERR
    TYPE(varying_string), INTENT(OUT) :: ERROR
    !Function variable
    REAL(SP) :: STRING_TO_SINGLE_C
    !Local variables
    
    enters("STRING_TO_SINGLE_C",err,error,*999)

    READ(string,*,iostat=err,err=999) string_to_single_c
    
    exits("STRING_TO_SINGLE_C")
    RETURN
999 CALL flagerror("Cannot convert '"//string(1:len_trim(string))//"' to a single real",err,error,*998)
998 errorsexits("STRING_TO_SINGLE_C",err,error)
    RETURN    
  END FUNCTION string_to_single_c
    
  !
  !================================================================================================================================
  !

  FUNCTION string_to_single_vs(STRING, ERR, ERROR)
  
    !Argument variables
    TYPE(varying_string), INTENT(IN) :: STRING
    INTEGER(INTG), INTENT(OUT) :: ERR
    TYPE(varying_string), INTENT(OUT) :: ERROR
    !Function variable
    REAL(SP) :: STRING_TO_SINGLE_VS
    !Local variables
    CHARACTER(LEN=MAXSTRLEN) :: LOCAL_STRING
    
    enters("STRING_TO_SINGLE_VS",err,error,*999)

!!TODO: remove dependance on LOCAL_STRING

    local_string=char(string)
    READ(local_string,*,iostat=err,err=999) string_to_single_vs
    
    exits("STRING_TO_SINGLE_VS")
    RETURN
999 CALL flagerror("Cannot convert '"//char(string)//"' to a single real",err,error,*998)
998 errorsexits("STRING_TO_SINGLE_VS",err,error)
    RETURN
    
  END FUNCTION string_to_single_vs
    
  !
  !================================================================================================================================
  !
    
  FUNCTION character_to_lowercase_c(STRING)

    !Argument variables
    CHARACTER(LEN=*), INTENT(IN) :: STRING
    !Function variable
    CHARACTER(LEN=LEN(STRING)) :: CHARACTER_TO_LOWERCASE_C
    !Local Variables
    INTEGER(INTG), PARAMETER :: OFFSET=(ichar("a")-ichar("A"))
    INTEGER(INTG) :: i

    character_to_lowercase_c=string
    DO i=1,len(string)
      IF(is_uppercase(string(i:i))) THEN
        character_to_lowercase_c(i:i)=char(ichar(string(i:i))+offset)
      ENDIF
    ENDDO !i

    RETURN
  END FUNCTION character_to_lowercase_c

  !
  !================================================================================================================================
  !

  FUNCTION character_to_lowercase_vs(STRING)

    !Argument variables
    TYPE(varying_string), INTENT(IN) :: STRING
    !Function variable
    CHARACTER(LEN=LEN(STRING)) :: CHARACTER_TO_LOWERCASE_VS
    !Local Variables
    INTEGER(INTG), PARAMETER :: OFFSET=(ichar("a")-ichar("A"))
    INTEGER(INTG) :: i

    character_to_lowercase_vs=char(string)
    DO i=1,len(string)
      IF(is_uppercase(char(extract(string,i,i)))) THEN
        character_to_lowercase_vs(i:i)=char(ichar(extract(string,i,i))+offset)
      ENDIF
    ENDDO !i

    RETURN
  END FUNCTION character_to_lowercase_vs

  !
  !================================================================================================================================
  !

  FUNCTION vstring_to_lowercase_c(STRING)

    !Argument variables
    CHARACTER(LEN=*), INTENT(IN) :: STRING
    !Function variable
    TYPE(varying_string) :: VSTRING_TO_LOWERCASE_C
    !Local Variables
    INTEGER(INTG), PARAMETER :: OFFSET=(ichar("a")-ichar("A"))
    INTEGER(INTG) :: i

    vstring_to_lowercase_c=string
    DO i=1,len(string)
      IF(is_uppercase(string(i:i))) THEN
        vstring_to_lowercase_c=insert(vstring_to_lowercase_c,i,char(ichar(string(i:i))+offset))
      ENDIF
    ENDDO !i

    RETURN
  END FUNCTION vstring_to_lowercase_c

  !
  !================================================================================================================================
  !

  FUNCTION vstring_to_lowercase_vs(STRING)

    !Argument variables
    TYPE(varying_string), INTENT(IN) :: STRING
    !Function variable
    TYPE(varying_string) :: VSTRING_TO_LOWERCASE_VS
    !Local Variables
    INTEGER(INTG), PARAMETER :: OFFSET=(ichar("a")-ichar("A"))
    INTEGER(INTG) :: i

    vstring_to_lowercase_vs=string
    DO i=1,len(string)
      IF(is_uppercase(char(extract(string,i,i)))) THEN
        vstring_to_lowercase_vs=insert(vstring_to_lowercase_vs,i,char(ichar(extract(string,i,i))+offset))
      ENDIF
    ENDDO !i

    RETURN
  END FUNCTION vstring_to_lowercase_vs

  !
  !================================================================================================================================
  !

  FUNCTION character_to_uppercase_c(STRING)

    !Argument variables 
    CHARACTER(LEN=*), INTENT(IN) :: STRING
    !Function variable
    CHARACTER(LEN=LEN(STRING)) :: CHARACTER_TO_UPPERCASE_C
    !Local Variables
    INTEGER(INTG), PARAMETER :: OFFSET=(ichar("A")-ichar("a"))
    INTEGER(INTG) :: i

    character_to_uppercase_c=string
    DO i=1,len(string)
      IF(is_lowercase(string(i:i))) THEN
        character_to_uppercase_c(i:i)=char(ichar(string(i:i))+offset)
      ENDIF
    ENDDO !i

    RETURN
  END FUNCTION character_to_uppercase_c

  !
  !================================================================================================================================
  !

  FUNCTION character_to_uppercase_vs(STRING)

    !Argument variables
    TYPE(varying_string), INTENT(IN) :: STRING
    !Function variable
    CHARACTER(LEN=LEN(STRING)) :: CHARACTER_TO_UPPERCASE_VS
    !Local Variables
    INTEGER(INTG), PARAMETER :: OFFSET=(ichar("A")-ichar("a"))
    INTEGER(INTG) :: i

    character_to_uppercase_vs=char(string)
    DO i=1,len(string)
      IF(is_lowercase(char(extract(string,i,i)))) THEN
        character_to_uppercase_vs(i:i)=char(ichar(extract(string,i,i))+offset)
      ENDIF
    ENDDO !i

    RETURN
  END FUNCTION character_to_uppercase_vs

  !
  !================================================================================================================================
  !

  FUNCTION vstring_to_uppercase_c(STRING)

    !Argument variables
    CHARACTER(LEN=*), INTENT(IN) :: STRING
    !Function variable
    TYPE(varying_string) :: VSTRING_TO_UPPERCASE_C
    !Local Variables
    INTEGER(INTG), PARAMETER :: OFFSET=(ichar("A")-ichar("a"))
    INTEGER(INTG) :: i

    vstring_to_uppercase_c=string
    DO i=1,len(string)
      IF(is_lowercase(string(i:i))) THEN
        vstring_to_uppercase_c=insert(vstring_to_uppercase_c,i,char(ichar(string(i:i))+offset))
      ENDIF
    ENDDO !i

    RETURN
  END FUNCTION vstring_to_uppercase_c

  !
  !================================================================================================================================
  !

  FUNCTION vstring_to_uppercase_vs(STRING)

    !Argument variables
    TYPE(varying_string), INTENT(IN) :: STRING
    !Function variable
    TYPE(varying_string) :: VSTRING_TO_UPPERCASE_VS
    !Local Variables
    INTEGER(INTG), PARAMETER :: OFFSET=(ichar("A")-ichar("a"))
    INTEGER(INTG) :: i

    vstring_to_uppercase_vs=string
    DO i=1,len(string)
      IF(is_lowercase(char(extract(string,i,i)))) THEN
        vstring_to_uppercase_vs=insert(vstring_to_uppercase_vs,i,char(ichar(extract(string,i,i))+offset))
      ENDIF
    ENDDO !i

    RETURN
  END FUNCTION vstring_to_uppercase_vs

  !
  !================================================================================================================================
  !
  
END MODULE strings