fsc1004-concatenacao_string.f95

 MODULE string_type
    IMPLICIT NONE
    TYPE string80
       INTEGER length
       CHARACTER(LEN=80)   :: string_data
    END TYPE string80
    INTERFACE ASSIGNMENT(=)
       MODULE PROCEDURE c_to_s_assign, s_to_c_assign
    END INTERFACE
    INTERFACE OPERATOR(//)
       MODULE PROCEDURE string_concat
    END INTERFACE
 CONTAINS
    SUBROUTINE c_to_s_assign(s, c)
       TYPE (string80), INTENT(OUT)    :: s
       CHARACTER(LEN=*), INTENT(IN)  :: c
       s%string_data = c
       s%length = LEN(c)
    END SUBROUTINE c_to_s_assign
    SUBROUTINE s_to_c_assign(c, s)
       TYPE (string80), INTENT(IN)     :: s
       CHARACTER(LEN=*), INTENT(OUT) :: c
       c = s%string_data(1:s%length)
    END SUBROUTINE s_to_c_assign
    TYPE(string80) FUNCTION string_concat(s1, s2)
       TYPE(string80), INTENT(IN) :: s1, s2
       TYPE(string80) :: s
       INTEGER :: n1, n2
       CHARACTER(160) :: ctot
       n1 = LEN_TRIM(s1%string_data)
       n2 = LEN_TRIM(s2%string_data)
       IF (n1+n2 <= 80) then
          s%string_data = s1%string_data(1:n1)//s2%string_data(1:n2)
       ELSE  ! This is an error condition which should be handled - for now just truncate
          ctot = s1%string_data(1:n1)//s2%string_data(1:n2)
          s%string_data = ctot(1:80)
       ENDIF
       s%length = LEN_TRIM(s%string_data)
       string_concat = s
    END FUNCTION string_concat
 END MODULE string_type
 
 PROGRAM main
 USE string_type
 TYPE(string80) :: s1, s2, s3
 CALL c_to_s_assign(s1,'My name is')
 CALL c_to_s_assign(s2,' Linus Torvalds')
 s3 = s1//s2
 WRITE(*,*) 'Result: ',s3%string_data
 WRITE(*,*) 'Length: ',s3%length
 END PROGRAM