1 | SUBROUTINE parseblk (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 | ! Get the rest of the line starting at the knumb'th string. |
---|
14 | ! A string is defined as a continuous set of non-blanks characters |
---|
15 | ! |
---|
16 | !** Interface: |
---|
17 | ! --------- |
---|
18 | ! *CALL* *parseblk (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 starting string (integer) |
---|
24 | ! klen : length of the input line (integer) |
---|
25 | ! |
---|
26 | ! Output: |
---|
27 | ! ------ |
---|
28 | ! cdtwo : extracted rest of line, including blanks (char string) |
---|
29 | ! kleng : length of the extracted string (integer) |
---|
30 | ! |
---|
31 | ! Workspace: |
---|
32 | ! --------- |
---|
33 | ! None |
---|
34 | ! |
---|
35 | ! Externals: |
---|
36 | ! --------- |
---|
37 | ! |
---|
38 | ! History: |
---|
39 | ! ------- |
---|
40 | ! Version Programmer Date Description |
---|
41 | ! ------- ---------- ---- ----------- |
---|
42 | ! 2.5 S. Valcke 00/09/08 Adapted from parse.f |
---|
43 | ! |
---|
44 | ! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% |
---|
45 | ! |
---|
46 | !* ---------------------------- Include files --------------------------- |
---|
47 | ! |
---|
48 | USE mod_unit |
---|
49 | ! |
---|
50 | !* ---------------------------- Argument declarations ------------------- |
---|
51 | ! |
---|
52 | INTEGER (kind=ip_intwp_p), INTENT ( in) :: knumb, klen |
---|
53 | CHARACTER (len=klen), INTENT ( inout) :: cdone |
---|
54 | CHARACTER (len=klen), INTENT ( out) :: cdtwo |
---|
55 | INTEGER (kind=ip_intwp_p), INTENT ( out) :: kleng |
---|
56 | ! |
---|
57 | !* ---------------------------- Local declarations ------------------- |
---|
58 | ! |
---|
59 | INTEGER (kind=ip_intwp_p) :: il, kleng_aux |
---|
60 | CHARACTER (len=klen) :: clline |
---|
61 | CHARACTER (len=klen) :: clwork |
---|
62 | CHARACTER (len=1), SAVE :: clblank = ' ', clcmt = '#' |
---|
63 | ! |
---|
64 | !* ---------------------------- Poema verses ---------------------------- |
---|
65 | ! |
---|
66 | ! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% |
---|
67 | ! |
---|
68 | !* 1. Skip line if it is a comment |
---|
69 | ! ---------------------------- |
---|
70 | ! |
---|
71 | 100 IF (cdone(1:1) .NE. clcmt) GO TO 120 |
---|
72 | READ (UNIT = nulin, FMT = 1001) clline |
---|
73 | cdone(1:klen) = clline(1:klen) |
---|
74 | GO TO 100 |
---|
75 | 120 CONTINUE |
---|
76 | 1001 FORMAT(A80) |
---|
77 | ! |
---|
78 | ! |
---|
79 | !* 2. Do the extraction job |
---|
80 | ! --------------------- |
---|
81 | ! |
---|
82 | !* - Fill cdtwo with blanks |
---|
83 | ! |
---|
84 | cdtwo = clblank |
---|
85 | ! |
---|
86 | !* Fill temporary string and remove leading blanks |
---|
87 | ! |
---|
88 | il = INDEX ( cdone, clblank) |
---|
89 | kleng_aux = 1 |
---|
90 | IF (INDEX ( cdone, clblank).EQ.1) THEN |
---|
91 | DO WHILE (cdone(il+1:il+1).EQ.clblank) |
---|
92 | kleng_aux = kleng_aux +1 |
---|
93 | il = il+1 |
---|
94 | IF (il+1.GT.klen) GO TO 130 |
---|
95 | ENDDO |
---|
96 | ENDIF |
---|
97 | 130 CONTINUE |
---|
98 | clwork = ADJUSTL ( cdone) |
---|
99 | ! |
---|
100 | !* - If there are no more characters, kleng=-1 |
---|
101 | ! |
---|
102 | IF ( LEN_TRIM ( clwork) .LE. 0) THEN |
---|
103 | kleng = -1 |
---|
104 | RETURN |
---|
105 | END IF |
---|
106 | ! |
---|
107 | !* - If this is the one we're looking for, skip |
---|
108 | ! otherwise go knumb-1 more sets of characters |
---|
109 | ! |
---|
110 | IF (knumb .GE. 2) THEN |
---|
111 | DO jl = 1, knumb-1 |
---|
112 | ii = INDEX ( clwork, clblank) - 1 |
---|
113 | il = ii + 1 |
---|
114 | DO WHILE (clwork(il:il).EQ.clblank) |
---|
115 | kleng_aux = kleng_aux +1 |
---|
116 | il = il + 1 |
---|
117 | IF (il.GT.klen) GO TO 140 |
---|
118 | ENDDO |
---|
119 | 140 CONTINUE |
---|
120 | kleng_aux = kleng_aux + ii |
---|
121 | clwork ( 1:ii) = clblank |
---|
122 | clwork = ADJUSTL ( clwork) |
---|
123 | ! |
---|
124 | !* - If there are no more characters, kleng=-1 |
---|
125 | ! |
---|
126 | IF (LEN_TRIM ( clwork) .LE. 0) THEN |
---|
127 | kleng = -1 |
---|
128 | RETURN |
---|
129 | END IF |
---|
130 | END DO |
---|
131 | END IF |
---|
132 | ! |
---|
133 | !* - Find the length of the rest of the line |
---|
134 | ! |
---|
135 | kleng = klen - kleng_aux |
---|
136 | ! |
---|
137 | !* - Copy to cdtwo |
---|
138 | ! |
---|
139 | cdtwo ( 1:kleng) = clwork ( 1: kleng) |
---|
140 | ! |
---|
141 | !* 3. End of routine |
---|
142 | ! -------------- |
---|
143 | ! |
---|
144 | RETURN |
---|
145 | END SUBROUTINE parseblk |
---|
146 | |
---|