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

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

Parent Directory Parent Directory | Revision Log Revision Log

Revision 104 - (show annotations)
Thu Sep 4 10:05:52 2014 UTC (9 years, 9 months ago) by guez
File size: 2780 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 module findsep_m
2
3 implicit none
4
5 contains
6
7 SUBROUTINE findsep (str, nbsep, f_char, f_pos, s_char, s_pos)
8 !- Subroutine finds all separators in a given string
9 !- It returns the following information about str :
10 !- f_char : The first separation character
11 !- (1 for before and 2 for after)
12 !- f_pos : The position of the first separator
13 !- s_char : The second separation character
14 !- (1 for before and 2 for after)
15 !- s_pos : The position of the second separator
16 USE errioipsl, ONLY : histerr
17 use mathelp, only: seps
18 use cleanstr_m, only: cleanstr
19
20 CHARACTER(LEN=80) :: str
21 INTEGER :: nbsep
22 CHARACTER(LEN=1), DIMENSION(2) :: f_char, s_char
23 INTEGER, DIMENSION(2) :: f_pos, s_pos
24
25 CHARACTER(LEN=70) :: str_tmp
26 LOGICAL :: f_found, s_found
27 INTEGER :: ind, xpos, leng, i
28
29 LOGICAL :: check = .FALSE.
30 !---------------------------------------------------------------------
31 IF (check) WRITE(*, *) 'findsep : call cleanstr: ', TRIM(str)
32
33 CALL cleanstr(str)
34
35 IF (check) WRITE(*, *) 'findsep : out of cleanstr: ', TRIM(str)
36
37 xpos = INDEX(str, 'X')
38 leng = LEN_TRIM(str)
39
40 f_pos(1:2) = (/ 0, leng+1 /)
41 f_char(1:2) = (/ '?', '?' /)
42 s_pos(1:2) = (/ 0, leng+1 /)
43 s_char(1:2) = (/ '?', '?' /)
44
45 nbsep = 0
46
47 f_found = .FALSE.
48 s_found = .FALSE.
49 IF (xpos > 1) THEN
50 DO i=xpos-1, 1, -1
51 ind = INDEX(seps, str(i:i))
52 IF (ind > 0) THEN
53 IF (.NOT.f_found) THEN
54 f_char(1) = str(i:i)
55 f_pos(1) = i
56 nbsep = nbsep+1
57 f_found = .TRUE.
58 ELSE IF (.NOT.s_found) THEN
59 s_char(1) = str(i:i)
60 s_pos(1) = i
61 nbsep = nbsep+1
62 s_found = .TRUE.
63 ENDIF
64 ENDIF
65 ENDDO
66 ENDIF
67
68 f_found = .FALSE.
69 s_found = .FALSE.
70 IF (xpos < leng) THEN
71 DO i=xpos+1, leng
72 ind = INDEX(seps, str(i:i))
73 IF (ind > 0) THEN
74 IF (.NOT.f_found) THEN
75 f_char(2) = str(i:i)
76 f_pos(2) = i
77 nbsep = nbsep+1
78 f_found = .TRUE.
79 ELSE IF (.NOT.s_found) THEN
80 s_char(2) = str(i:i)
81 s_pos(2) = i
82 nbsep = nbsep+1
83 s_found = .TRUE.
84 ENDIF
85 ENDIF
86 ENDDO
87 ENDIF
88
89 IF (nbsep > 4) THEN
90 WRITE(str_tmp, '("number :", I3)') nbsep
91 CALL histerr(3, 'findsep', &
92 & 'How can I find that many separators', str_tmp, str)
93 ENDIF
94
95 IF (check) WRITE(*, *) 'Finished findsep : ', nbsep, leng
96 !---------------------
97 END SUBROUTINE findsep
98
99 end module findsep_m
  ViewVC Help
Powered by ViewVC 1.1.21