FMS  2025.03
Flexible Modeling System
parse.inc
1 !***********************************************************************
2 !* GNU Lesser General Public License
3 !*
4 !* This file is part of the GFDL Flexible Modeling System (FMS).
5 !*
6 !* FMS is free software: you can redistribute it and/or modify it under
7 !* the terms of the GNU Lesser General Public License as published by
8 !* the Free Software Foundation, either version 3 of the License, or (at
9 !* your option) any later version.
10 !*
11 !* FMS is distributed in the hope that it will be useful, but WITHOUT
12 !* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
13 !* FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
14 !* for more details.
15 !*
16 !* You should have received a copy of the GNU Lesser General Public
17 !* License along with FMS. If not, see <http://www.gnu.org/licenses/>.
18 !***********************************************************************
19 
20 
21  character(*), parameter :: SPACE = ' '
22  character(*), parameter :: DELIM = space//','
23  integer :: parse
24  integer :: is, ie, id, k
25  integer :: ts, last, i
26 
27  parse = 0; ts = 1; last=len_trim(text)
28  do
29  i=scan(text(ts:last),'=') ! location of the next equal sign in the input test
30  if (i == 0) return
31  ! find the last non-space character before the equal sign
32  do ie = ts+i-2,ts,-1
33  if (scan(text(ie:ie),space)==0) exit
34  enddo
35  ! find the last delimeter preceding spaces and equal sign
36  do is = ie,ts,-1
37  if (scan(text(is:is),delim)>0) exit
38  enddo
39  if (trim(label)==text(is+1:ie)) exit ! from outer loop: found the label
40  ! for the next iteration of the loop
41  ts = ts+i+1 ! shift the beginning of the line
42  enddo
43 
44  is = ts+i
45  do k = 1, size(values(:))
46 
47  ! position of ending pointer
48  id = scan( text(is:last), ',' )
49  if (id == 0) then
50  ie = last ! no trailing comma, use end of text string
51  else
52  ie = is+id-2
53  endif
54 
55  ! decode value
56  ! print *, 'k,is,ie,id,last=',k,is,ie,id,last
57  ! print *, 'DECODE: ', text(is:ie)
58  read ( text(is:ie), *, err=99, end=99 ) values(k)
59  parse = parse+1 ! parse is the number of values decoded
60 
61  if (ie == last) exit ! end of text string ... DONE
62  is = is+id ! move starting pointer after ","
63  if (is > last) exit ! end of text string ... DONE
64  enddo
65  return
66 
67 99 continue
68  call mpp_error (fatal,'in parse, error decoding "'//trim(label)//'" in text "'//text//'"')