| Type | Intent | Optional | Attributes | Name | ||
|---|---|---|---|---|---|---|
| character(len=*) | :: | cla_input_str |
subroutine cla_init_str(cla_input_str) implicit none character(len=*) :: cla_input_str integer :: i,n,k character(CLALEN) :: outs cla_cla = trim(adjustl(cla_input_str)) cla_cla_len = len_trim(cla_cla) ! Replace whitespace with single space: outs = cla_cla n = 0 ; k=cla_cla_len ! k=index last non-blank (may be null) DO i = 1,k-1 ! dont process last char yet n = n+1 ; outs(n:n) = cla_cla(i:i) IF (cla_cla(i:i+1) == ' ') n = n-1 ! backup/discard consecutive output blank END DO n = n+1 ; outs(n:n) = cla_cla(k:k) ! last non-blank char output (may be null) IF (n < k) outs(n+1:) = ' ' ! pad trailing blanks cla_cla = outs cla_cla_len = len_trim(cla_cla) ! Allocate a zero size registry, just so that it gets ! associated. cla_num = 0 allocate(cla_registry(0)) allocate(cla_posarg_registry(0)) cla_kindstr(cla_int) = 'integer' cla_kindstr(cla_float) = 'float' cla_kindstr(cla_char) = 'character' cla_kindstr(cla_xchar) = 'xcharacter' !NOT IMPLEMENTED cla_kindstr(cla_logical) = 'logical' cla_kindstr(cla_flag) = 'flag' cla_empty='THIS_IS_THE_EMPTY_STRING' cla_true_str(1)='true' cla_true_str(2)='on' cla_true_str(3)='1' cla_true_str(4)='t' cla_true_str(5)='T' cla_true_str(6)='.true.' end subroutine cla_init_str