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

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

Parent Directory Parent Directory | Revision Log Revision Log

Revision 104 - (hide annotations)
Thu Sep 4 10:05:52 2014 UTC (9 years, 9 months ago) by guez
File size: 2303 byte(s) 
Removed procedure sortvarc0. Called sortvarc with an additional
argument resetvarc instead. (Following LMDZ.) Moved current time
computations and some printing statements from sortvarc to
caldyn. Could then remove arguments itau and time_0 of sortvarc, and
could remove "use dynetat0". Better to keep "dynetat0.f" as a gcm-only
file.

Moved some variables from module ener to module sortvarc.

Split file "mathelp.f" into single-procedure files.

Removed unused argument nadv of adaptdt. Removed dimension arguments
of bernoui.

Removed unused argument nisurf of interfoce_lim. Changed the size of
argument lmt_sst of interfoce_lim from klon to knon. Removed case when
newlmt is false.

dynredem1 is called only once in each run, either ce0l or gcm. So
variable nb in call to nf95_put_var was always 1. Removed variable nb.

Removed dimension arguments of calcul_fluxs. Removed unused arguments
precip_rain, precip_snow, snow of calcul_fluxs. Changed the size of
all the arrays in calcul_fluxs from klon to knon.

Removed dimension arguments of fonte_neige. Changed the size of all
the arrays in fonte_neige from klon to knon.

Changed the size of arguments tsurf and tsurf_new of interfsurf_hq
from klon to knon. Changed the size of argument ptsrf of soil from
klon to knon.
1 guez 104 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