Screamer Project  V3.3.1
Screamer Structure
 All Files Functions Variables
rdvector.f
Go to the documentation of this file.
1  subroutine read_vector (vals,num_vals,eofflg,nlines,numerr)
2 c
3 c-------Description--------------------------------------------------
4 c
5 c Author/Date: Rick Spielman 2014-05-01
6 c
7 c Purpose: This subroutine reads in a series of values from an input
8 c list using the switch_time SWI option
9 c
10 c Called by: Subroutine READSCREAMERPARAM
11 c
12 c Calls: Subroutine GET_NEXT_LINE
13 c Subroutine TEXT_TO_REAL
14 c Subroutine PRINT_BAD_LINE
15 c
16 c Modification
17 c
18 c-------Include Files---------------------------------------------------
19 c
20  include 'zdemmax.h'
21  include 'zdemparm.h' ! Contains keywords
22 c
23 c-------Input Parameters------------------------------------------------
24 c
25  integer numerr ! Current number of error while reading*/
26 c ! SCREAMER input deck */
27 c
28 c-------Output Parameters-----------------------------------------------
29 c
30  real vals(*) ! Vector which holds data values */
31  integer num_vals, ! # of values in array VALS */
32  + eofflg, ! End-of-file flag */
33  + nlines ! Current line # in SCREAMER input deck*/
34 c
35 c-------Constants-------------------------------------------------------
36 c
37  integer noerr, error, notext
38  parameter(noerr = 0, error = 1, notext = 0)
39  integer max_fields
40  parameter(max_fields = 10)
41 c
42 c-------Local Variables-------------------------------------------------
43 c
44  character currline*120 ! Text of current line from SCR inp.dck*/
45  integer flag1 ! Error flag for TEXT_TO_REAL call */
46  character field(max_fields)*80, ! Fields from current line of */
47  + ! text of SCREAMER input deck */
48  + keyword*(keyword_len) ! First non-numeric entry after*/
49  + ! list of values in table */
50 c
51 c-------Subroutine Body-------------------------------------------------
52 c
53 c Set the counter for the number of elements read and the limit check to
54 c no error
55 c
56  num_vals = 0
57  limit = noerr
58 c
59 c Get the line.
60 c
61  200 continue
62  call get_next_line(currline, field, nlines, eofflg, max_fields)
63  if (eofflg .eq. error) return
64 c
65  if (num_vals .lt. max_switch_points) then
66 c
67 c Attempt to convert each field into a real number.
68 c
69  call text_to_real(field(1), vals(num_vals+1), flag1)
70 c
71 c If we failed to convert a number, see if we had the last entry keyword.
72 c If so, then set the number of parameters entered, else signal an error.
73 c If we did fail, this will cause the subroutine to exit.
74 c
75  if (flag1 .eq. noerr) then
76  num_vals = num_vals + 1
77  else
78  keyword = field(1)(1:keyword_len)
79  if (keyword .ne. k_last_entry) then
80  call print_bad_line(currline, nlines, numerr)
81  end if
82  go to 1000
83  end if
84 c
85 c If we have read in the maximum number of data, check this line
86 c for LAST keyword. If not LAST do not use anything on the line.
87 c
88  else
89  keyword = field(1)(1:keyword_len)
90 c
91  if (keyword .ne. k_last_entry) then
92  numerr = numerr + 1
93  limit = error
94  else
95  go to 1000
96  end if
97 c
98  end if
99  go to 200
100 c
101 c If we were over the limit, send a message and tell what the current limit
102 c is.
103 c
104  1000 continue
105  eofflg = noerr
106 c
107  if (limit .eq. error) then
108  write(9,'(A/A,i3,A)')
109  & '0', 'Error, too many table values entered, only ',
110  & max_switch_points, ' points allowed!'
111  end if
112 c Test routine
113  print '(6F10.5)'
114  & , vals(1), vals(2), vals(3),vals(4), vals(5),vals(6)
115 c
116  return
117  end
subroutine get_next_line(currline, field, nlines, eofflg, max_fields)
Definition: getnxtln.f:1
subroutine read_vector(vals, num_vals, eofflg, nlines, numerr)
Definition: rdvector.f:1
subroutine print_bad_line(currline, nlines, numerr)
Definition: prtbadln.f:1
subroutine text_to_real(text, rvalue, flag)
Definition: txt2real.f:1