source: CPL/oasis3/trunk/src/mod/oasis3/src/parse.f90 @ 1677

Last change on this file since 1677 was 1677, checked in by aclsce, 12 years ago

Imported oasis3 (tag ipslcm5a) from cvs server to svn server (igcmg project).

File size: 3.4 KB
Line 
1SUBROUTINE parse (cdone, cdtwo, knumb, klen, kleng)
2  USE mod_kinds_oasis
3!****
4!               *****************************
5!               * OASIS ROUTINE  -  LEVEL T *
6!               * -------------     ------- *
7!               *****************************
8!
9!**** *parse*  - Parsing routine
10!
11!     Purpose:
12!     -------
13!     Find the knumb'th string in cdone and put it in cdtwo.
14!     A string is defined as a continuous set of non-blanks characters
15!
16!**   Interface:
17!     ---------
18!       *CALL*  *parse (cdone, cdtwo, knumb, klen, kleng)*
19!
20!     Input:
21!     -----
22!                cdone : line to be parsed (char string)
23!                knumb : rank within the line of the extracted string (integer)
24!                klen  : length of the input line (integer)
25!
26!     Output:
27!     ------
28!                cdtwo : extracted character string (char string)
29!                kleng : length of the extracted string (integer)
30!
31!     Workspace:
32!     ---------
33!     None
34!
35!     Externals:
36!     ---------
37!
38!     Reference:
39!     ---------
40!     See OASIS manual (1995)
41!
42!     History:
43!     -------
44!       Version   Programmer     Date      Description
45!       -------   ----------     ----      ----------- 
46!       2.0       L. Terray      95/09/01  created
47!                 O. Marti     2000/11/08  simplify by using F90
48!                                          CHARACTER functions
49!
50! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
51!
52!* ---------------------------- Include files ---------------------------
53!
54  USE mod_unit
55!
56!* ---------------------------- Argument declarations -------------------
57!
58  INTEGER (kind=ip_intwp_p), INTENT ( in) :: knumb, klen
59  CHARACTER (len=klen), INTENT ( inout) :: cdone 
60  CHARACTER (len=klen), INTENT ( out) :: cdtwo
61  INTEGER (kind=ip_intwp_p), INTENT ( out) :: kleng
62!
63!* ---------------------------- Local declarations -------------------
64!
65  CHARACTER (len=klen) :: clline
66  CHARACTER (len=klen) :: clwork
67  CHARACTER (len=1), SAVE :: clblank = ' ', clcmt = '#'
68!
69!* ---------------------------- Poema verses ----------------------------
70!
71! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
72!
73!*    1. Skip line if it is a comment
74!        ----------------------------
75!
76100 IF (cdone(1:1) .NE. clcmt) GO TO 120
77  READ (UNIT = nulin, FMT = 1001) clline 
78  cdone(1:klen) = clline(1:klen)
79  GO TO 100
80120 CONTINUE
811001 FORMAT(A80)
82!
83!
84!*    2. Do the extraction job
85!        ---------------------
86!
87!* - Fill cdtwo with blanks
88!
89  cdtwo = clblank
90!
91!* Fill temporary string and remove leading blanks
92!
93  clwork = ADJUSTL ( cdone)
94!
95!* - If there are no more characters, kleng=-1
96!
97  IF ( LEN_TRIM ( clwork) .LE. 0) THEN
98      kleng = -1
99      RETURN
100  END IF
101!
102!* - If this is the one we're looking for, skip
103!    otherwise go knumb-1 more sets of characters
104!
105  IF (knumb .GE. 2) THEN
106      DO jl = 1, knumb-1
107        ii = INDEX ( clwork, clblank) - 1
108        clwork ( 1:ii) = clblank
109        clwork = ADJUSTL ( clwork)
110!
111!* - If there are no more characters, kleng=-1
112!
113        IF (LEN_TRIM ( clwork) .LE. 0) THEN
114            kleng = -1
115            RETURN
116        END IF
117      END DO
118  END IF
119!
120!* - Find the length of this set of characters
121!
122  kleng = INDEX ( clwork, clblank) - 1
123!
124!* - Copy to cdtwo
125!
126  cdtwo ( 1:kleng) = clwork ( 1: kleng)
127!
128!
129!*    3. End of routine
130!        --------------
131!
132  RETURN
133END SUBROUTINE parse
134
135
136
137
Note: See TracBrowser for help on using the repository browser.