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