Screamer Project  V3.3.1
Screamer Structure
 All Files Functions Variables
mktblfl.f
Go to the documentation of this file.
1  subroutine tabvals
2 c
3 c-------Description-----------------------------------------------------
4 c
5 c Source File : WAS ud5:[klfugel.screamer.scrref]tabvals.for
6 c
7 c Author/Date : Mark Kiefer, 1265 (original version)
8 c Major rewrite by Kelley Fugelso, 1265 (SEA) 01/90
9 c Mac mods December 10, 1992; hnw
10 c
11 c Purpose : Creates files which contain the points for each table request.
12 c Puts them in correct SCREAMER table format.
13 c The naming algorithm is:
14 c NAME.T##
15 c where NAME is the data file name and ## is the plot index.
16 c
17 c The format of the file is:
18 c line 1: ! title
19 c line 2: ! user comment or circuit location
20 c line 3: ! number of points
21 c line 4: 1pe10.3, ' 0.0'
22 c where 1pe10.3 is the scale and 0.0 is the delay.
23 c lines 5 to npoints+4: 4x, 1p2e12.3
24 c
25 c Called by : Program ZDEM$MAIN
26 c
27 c Calls : Subroutine STRIP, Subroutine CLEAR_OUTBUF,
28 c Subroutine GATHER, Subroutine OPEN_OUTFILE,
29 c Subroutine READ_OUTFILE, Subroutine CLOSE_OUTFILE,
30 c Subroutine INT_TO_TEXT
31 c
32 c Modifications:
33 c 03/07/95, MLK: Change include filenames to be 8 characters or less
34 c added "no_text" parameter
35 c 08/13/97, MLK: Create filename based on 'base_filename'
36 c
37 c-------Include Files---------------------------------------------------
38 c
39  include 'zdemparm.h'
40  include 'zdempprm.h'
41  include 'zdemmax.h'
42  include 'zdemout.h'
43  include 'zdemcomm.h'
44  include 'zdemenv.h'
45 c
46 c-------Input Parameters------------------------------------------------
47 c NONE
48 c-------Output Parameters-----------------------------------------------
49 c NONE
50 c------Constants-------------------------------------------------------
51 c
52  integer table_unit
53  parameter(table_unit = 22)
54 c
55 c-------Local Variables-------------------------------------------------
56 c
57  integer no_text
58  parameter(no_text = 0)
59  character ti*2, t1*2, t2*2
60  character header*79, tabfile*80
61 c
62 c-------Subroutine Body-------------------------------------------------
63 c
64 c Create a "template" for naming files based on the input file name
65 c
66  tabfile = base_filename
67  call strip(tabfile, i_1st, i_last)
68  iend1 = i_last - i_1st + 3
69  iend2 = iend1 + 1
70  tabfile(1:iend1) = tabfile(i_1st:i_last)//'.t'
71  tabfile(iend2:80) = ' '
72 c
73 c Clear the output buffers, calculate the record size of the output
74 c parameter file, and "gather" all of the TABLE output requests together.
75 c
76  call clear_outbuf
77  ibufsize = numout*2+2
78  call gather(iouttype, otable, maxout, indices, numtab)
79 c
80 c Loop over all of the TABLE requests, creating one output file for each
81 c
82  do i = 1, numtab
83 c
84  time_flag = itimeflg(indices(i))
85  ncycle = 0
86  tstart = tbegout(indices(i))
87  tstop = tendout(indices(i))
88  nskip = ifsteps(max_table_points, ht, tstart, tstop)
89  ipntcnt = 0
90  fflag = oldfile
91  iunit = outunit
92  call open_outfile(iunit, fflag, ierr)
93 c
94 c Get the value at time 0.0
95 c
96  newrec = 1
97  call read_outfile(iunit, newrec, time_flag, indices(i),
98  + ibufsize, tmptime, tmpval, ierr)
99  if (tstart .eq. 0.0) then
100  ipntcnt = 1
101  timeout(ipntcnt,1) = tmptime
102  outdata(ipntcnt,1) = tmpval
103  call read_outfile(iunit, newrec, time_flag, indices(i),
104  + ibufsize, tmptime, tmpval, ierr)
105  endif
106 c
107  do while (ierr .eq. 0)
108  if ((tmptime.ge.tstart).and.(tmptime.le.tstop)) then
109  ncycle = ncycle + 1
110  if (ncycle .ge. nskip) then
111  ipntcnt = ipntcnt + 1
112  timeout(ipntcnt,1) = tmptime
113  outdata(ipntcnt,1) = tmpval
114  ncycle = 0
115  endif
116  endif
117  call read_outfile(iunit, newrec, time_flag, indices(i),
118  + ibufsize, tmptime, tmpval, ierr)
119  enddo
120  call close_outfile(iunit,ierr)
121 c
122 c Translate i to text and append it to the filename to the the full
123 c file specification
124 c
125  call int_to_text(i, ti)
126  call strip(ti, i1, i2)
127  iend = iend2 + i2 - i1
128  tabfile(iend2:iend) = ti(i1:i2)
129 c
130 c Now open the file.
131 c
132  open (unit=table_unit, file=tabfile(1:iend), status='NEW')
133 c
134 c
135 c Now print the title as the first line, but comment it out by using a '!'
136 c as the first character.
137 c
138  write (table_unit, 1000) title(1:79)
139 c
140 c Set up the header with block and branch indicies, block type, and plot type
141 c if no comment line entered, else use the comment line. Print this as the
142 c second line, again using a '!' as the first character.
143 c
144  call strip(lblout(indices(i)), istart, iend)
145  if (istart .eq. no_text) then
146  call int_to_text(ixbrnout(indices(i)), t1)
147  call int_to_text(ixblkout(indices(i)), t2)
148  itype = iblkout(indices(i))
149  header(1:22) = 'Branch '//t1//', Block '//t2//': '
150  if (itype .eq. transline) then
151  header(23:44) = 'transmission line '
152  else if (itype .eq. pisection) then
153  header(23:44) = 'pisection '
154  else if (itype .eq. rcground) then
155  header(23:44) = 'rcground '
156  else if (itype .eq. voltsource) then
157  header(23:44) = 'voltage source '
158  else if (itype .eq. vendsource) then
159  header(23:44) = 'end-brn voltage source'
160  else if (itype .eq. currsource) then
161  header(23:44) = 'current source '
162  else if (itype .eq. cendsource) then
163  header(23:44) = 'end-brn current source'
164  else if (itype .eq. csclsource) then
165  header(23:44) = 'SCL current source '
166  else if ((itype .eq. mitline) .or.
167  & (itype .eq. pmitline)) then
168  header(23:44) = 'MITL '
169  else if (itype .eq. adder) then
170  header(23:44) = 'adder '
171  else if (itype .eq. rlseries) then
172  header(23:44) = 'rlseries '
173  end if
174 c
175 c Set the label for the plot type. (ylbltab is 11 characters)
176 c
177  header(45:57) = '{'//ylblout(indices(i))//'}'
178  header(58:79) = ' '
179 c
180 c Use the comment line as the header.
181 c
182  else
183  header(1:79) = lblout(indices(i))(1:79)
184  end if
185 c
186  write (table_unit, 1000) header(1:79)
187 c
188 c Write the third line which shows the number of points in the table.
189 c
190  write (table_unit, 2000) ipntcnt
191 c
192 c Find the scale factor so that all points lie between -1 and 1.
193 c
194  scale = abs(outdata(1,1))
195  do j = 2, ipntcnt
196  aval = abs(outdata(j,1))
197  scale = amax1(aval, scale)
198  end do
199  if (scale .gt. 0.0) then
200  rscale = 1.0 / scale
201  else
202  rscale = 1.0
203  endif
204 c
205 c Write the scale and delay to the file.
206 c
207  write (table_unit, 3000) scale
208 c
209 c Now write the points to this file, dividing by the scale.
210 c
211  do j = 1, ipntcnt
212  write (table_unit, 4000) timeout(j,1), outdata(j,1)*rscale
213  end do
214 c
215 c Write the last line to signal end of table.
216 c
217  write (table_unit, 5000)
218 c
219 c Now close the file
220 c
221  close (unit=table_unit)
222 c
223  end do
224 c
225 c-------FORMAT Statements-----------------------------------------------
226 c
227  1000 format (' ', '!', a79)
228  2000 format (' ', '!', i4, ' points in the table')
229  3000 format (' ', 1pe10.3, ' 0.0')
230  4000 format (' ', 4x, 1p2e12.3)
231  5000 format (' ', ' Last-entry')
232 c
233 c-------End of Subroutine-----------------------------------------------
234 c
235  return
236  end
c *****************************************************************************c Common blocks for SCREAMER output and tabling c numsfc character tendout
Definition: zdemout.h:59
c *****************************************************************************c Common blocks for SCREAMER output and tabling c numsfc character timeout
Definition: zdemout.h:59
c *****************************************************************************c Common blocks for SCREAMER output and tabling c & numout
Definition: zdemout.h:47
subroutine read_outfile(iunit, newrec, timeflag, ipoint, ibufsize, ttime, value, ierr)
Definition: rdoutfl.f:1
subroutine clear_outbuf
Definition: clsoutbf.f:1
subroutine tabvals
Definition: mktblfl.f:1
subroutine int_to_text(int, text)
Definition: int2txt.f:1
c *****************************************************************************c Common blocks for SCREAMER output and tabling c numsfc character & ylblout
Definition: zdemout.h:59
subroutine open_outfile(iunit, status, ierr)
Definition: opnoutfl.f:1
c *****************************************************************************c Common blocks for SCREAMER output and tabling c numtab
Definition: zdemout.h:47
subroutine close_outfile(iunit, ierr)
Definition: clsoutfl.f:1
c *****************************************************************************c Common blocks for SCREAMER output and tabling c numsfc character & ixblkout
Definition: zdemout.h:59
c *****************************************************************************c Common blocks for SCREAMER output and tabling c numsfc character & lblout
Definition: zdemout.h:59
c *****************************************************************************c Common blocks for SCREAMER output and tabling c numsfc character iouttype
Definition: zdemout.h:59
c *****************************************************************************c Common blocks for SCREAMER output and tabling c numsfc character & outdata
Definition: zdemout.h:59
c *****************************************************************************c Common blocks for SCREAMER output and tabling c numsfc character indices
Definition: zdemout.h:59
c *****************************************************************************c Common blocks for SCREAMER output and tabling c numsfc character & tbegout
Definition: zdemout.h:59
subroutine strip(text, start, end)
Definition: strpblnk.f:1
c *****************************************************************************c Common blocks for SCREAMER output and tabling c maxout
Definition: zdemout.h:40
integer function ifsteps(maxpts, dt, tstart, tstop)
Definition: findskip.f:1
c *****************************************************************************c Common blocks for SCREAMER output and tabling c numsfc character & itimeflg
Definition: zdemout.h:59
subroutine gather(inarray, intarget, maxin, outarray, numout)
Definition: gather.f:1
c *****************************************************************************c Various format statements for read_screamer_data output c To get these into made format to be characters c for each line corrected spelling errors in format added statement for Zflow Plasma Loss Model added format for CSV output type fixed more lines longer than characters added format for Measure Zflow Block and forward c reverse current directions in Zflow plasma loss c and Zflow POS models added format for SFC output type c removed from all code calls c c c c c a80 c i10 c No grids on plots c Do not write files containing the plotted points c Execute only one cycle c Do not echo the setup parameters and indicies c c &exitting c a13 c c c c c c c c102 c &described as a function of time c c c &described as a function of time c c c &function of time c c shell c &min A K c &trapped field c153 c c c Sin c c c remaining calls in rdscrelem c Tabular a10 Cond scale
Definition: zdemfmt.h:111
c *****************************************************************************c Common blocks for SCREAMER output and tabling c numsfc character ixbrnout
Definition: zdemout.h:59
c *****************************************************************************c Common blocks for SCREAMER output and tabling c numsfc character & iblkout
Definition: zdemout.h:59
c This is a Fortran header file
Definition: sfc.h:3