1! { dg-do run }
2! { dg-additional-options "-fbounds-check" }
3MODULE cp_units
4
5  INTEGER, PARAMETER :: default_string_length=80, dp=KIND(0.0D0)
6
7  LOGICAL, PRIVATE, PARAMETER          :: debug_this_module=.TRUE.
8  CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'cp_units'
9  INTEGER, SAVE, PRIVATE               :: last_unit_id=0, last_unit_set_id=0
10
11  INTEGER, PARAMETER, PUBLIC :: cp_unit_max_kinds=8, cp_unit_basic_desc_length=15,&
12       cp_unit_desc_length=cp_unit_max_kinds*cp_unit_basic_desc_length, cp_ukind_max=9
13
14CONTAINS
15
16  FUNCTION cp_to_string(i) RESULT(res)
17    INTEGER, INTENT(in)                      :: i
18    CHARACTER(len=6)                         :: res
19
20    INTEGER                                  :: iostat
21    REAL(KIND=dp)                            :: tmp_r
22
23    IF (i>999999 .OR. i<-99999) THEN
24       tmp_r=i
25       WRITE (res,fmt='(es6.1)',iostat=iostat) tmp_r
26    ELSE
27       WRITE (res,fmt='(i6)',iostat=iostat) i
28    END IF
29    IF (iostat/=0) THEN
30       STOP 7
31    END IF
32  END FUNCTION cp_to_string
33
34  SUBROUTINE cp_unit_create(string)
35    CHARACTER(len=*), INTENT(in)             :: string
36
37    CHARACTER(len=*), PARAMETER :: routineN = 'cp_unit_create', &
38      routineP = moduleN//':'//routineN
39
40    CHARACTER(default_string_length)         :: desc
41    CHARACTER(LEN=40)                        :: formatstr
42    INTEGER                                  :: i_high, i_low, i_unit, &
43                                                len_string, next_power
44    INTEGER, DIMENSION(cp_unit_max_kinds)    :: kind_id, power, unit_id
45    LOGICAL                                  :: failure
46
47    failure=.FALSE.
48    unit_id=0
49    kind_id=0
50    power=0
51    i_low=1
52    i_high=1
53    len_string=LEN(string)
54    i_unit=0
55    next_power=1
56    DO WHILE(i_low<len_string)
57       IF (string(i_low:i_low)/=' ') EXIT
58       i_low=i_low+1
59    END DO
60    i_high=i_low
61    DO WHILE(i_high<=len_string)
62       IF ( string(i_high:i_high)==' '.OR.string(i_high:i_high)=='^'.OR.&
63            string(i_high:i_high)=='*'.OR.string(i_high:i_high)=='/') EXIT
64       i_high=i_high+1
65    END DO
66    DO WHILE(.NOT.failure)
67       IF (i_high<=i_low.OR.i_low>len_string) EXIT
68       i_unit=i_unit+1
69       IF (i_unit>cp_unit_max_kinds) THEN
70          EXIT
71       END IF
72       power(i_unit)=next_power
73       ! parse op
74       i_low=i_high
75       DO WHILE(i_low<=len_string)
76          IF (string(i_low:i_low)/=' ') EXIT
77          i_low=i_low+1
78       END DO
79       i_high=i_low
80       DO WHILE(i_high<=len_string)
81          IF ( string(i_high:i_high)==' '.OR.string(i_high:i_high)=='^'.OR.&
82               string(i_high:i_high)=='*'.OR.string(i_high:i_high)=='/') EXIT
83          i_high=i_high+1
84       END DO
85       IF (i_high<i_low.OR.i_low>len_string) EXIT
86
87       IF (i_high<=len_string) THEN
88          IF (string(i_low:i_high)=='^') THEN
89             i_low=i_high+1
90             DO WHILE(i_low<=len_string)
91                IF (string(i_low:i_low)/=' ') EXIT
92                i_low=i_low+1
93             END DO
94             i_high=i_low
95             DO WHILE(i_high<=len_string)
96                SELECT CASE(string(i_high:i_high))
97                CASE('+','-','0','1','2','3','4','5','6','7','8','9')
98                   i_high=i_high+1
99                CASE default
100                   EXIT
101                END SELECT
102             END DO
103             IF (i_high<=i_low.OR.i_low>len_string) THEN
104                write(6,*) "BUG : XXX"//string//"XXX integer expected"
105                STOP 1
106                EXIT
107             END IF
108          END IF
109       ENDIF
110    END DO
111  END SUBROUTINE cp_unit_create
112
113END MODULE cp_units
114
115USE cp_units
116CALL cp_unit_create("fs^-1")
117END
118