/[lmdze]/trunk/IOIPSL/Mathelp/cleanstr.f
ViewVC logotype

Contents of /trunk/IOIPSL/Mathelp/cleanstr.f

Parent Directory Parent Directory | Revision Log Revision Log


Revision 254 - (show annotations)
Mon Feb 5 10:39:38 2018 UTC (6 years, 3 months ago) by guez
File size: 2303 byte(s)
Move Sources/* to root directory.
1 module cleanstr_m
2
3 implicit none
4
5 contains
6
7 SUBROUTINE cleanstr(str)
8 !- We clean up the string by taking out the extra () and puting
9 !- everything in lower case except for the X describing the variable
10 use strlowercase_m, only: strlowercase
11 use mathelp, only: seps
12
13 CHARACTER(LEN=80) :: str
14
15 INTEGER :: ind, leng, ic, it
16 LOGICAL :: check = .FALSE.
17 !---------------------------------------------------------------------
18 leng = LEN_TRIM(str)
19 CALL strlowercase(str)
20
21 ind = INDEX(str, 'x')
22 IF (check) THEN
23 WRITE (*, *) 'cleanstr 1.0 : ind = ', ind, &
24 & ' str = ', str(1:leng), '---'
25 ENDIF
26
27 ! If the character before the x is not a letter then we can assume
28 ! that it is the variable and promote it to a capital letter
29
30 DO WHILE (ind > 0)
31 ic = 0
32 IF (ind > 1) ic = IACHAR(str(ind-1:ind-1))
33 IF (ic < 97 .OR. ic > 122) THEN
34 str(ind:ind) = 'X'
35 ENDIF
36 it = INDEX(str(ind+1:leng), 'x')
37 IF (it > 0) THEN
38 ind = ind+it
39 ELSE
40 ind = it
41 ENDIF
42 ENDDO
43
44 IF (check) WRITE (*, *) 'cleanstr 2.0 : str = ', str(1:leng), '---'
45
46 IF ( str(1:1) == '(' .AND. str(leng:leng) == ')' ) THEN
47 str = str(2:leng-1)
48 ENDIF
49
50 IF (check) WRITE (*, *) 'cleanstr 3.0 : str = ', str(1:leng), '---'
51
52 leng = LEN_TRIM(str)
53 ind = INDEX(str, '((X))')
54 IF (ind > 0) THEN
55 str=str(1:ind-1)//'(X)'//str(ind+5:leng)//' '
56 ENDIF
57
58 IF (check) WRITE (*, *) 'cleanstr 4.0 : str = ', str(1:leng), '---'
59
60 leng = LEN_TRIM(str)
61 ind = INDEX(str, '(X)')
62 IF (ind > 0 .AND. ind+3 < leng) THEN
63 IF ( (INDEX(seps, str(ind-1:ind-1)) > 0) &
64 & .AND. (INDEX(seps, str(ind+3:ind+3)) > 0) ) THEN
65 str=str(1:ind-1)//'X'//str(ind+3:leng)//' '
66 ENDIF
67 ENDIF
68
69 IF (check) WRITE (*, *) 'cleanstr 5.0 : str = ', str(1:leng), '---'
70
71 leng = LEN_TRIM(str)
72 ind = INDEX(str(1:leng), ' ')
73 DO WHILE (ind > 0)
74 str=str(1:ind-1)//str(ind+1:leng)//' '
75 leng = LEN_TRIM(str)
76 ind = INDEX(str(1:leng), ' ')
77 ENDDO
78
79 IF (check) WRITE (*, *) 'cleanstr 6.0 : str = ', str(1:leng), '---'
80 !----------------------
81 END SUBROUTINE cleanstr
82
83 end module cleanstr_m

  ViewVC Help
Powered by ViewVC 1.1.21