Screamer Project  V3.3.1
Screamer Structure
 All Files Functions Variables
mkfilfl.f
Go to the documentation of this file.
1  subroutine filvals
2 c
3 c-------Description-----------------------------------------------------
4 c
5 c Source File : mkfilfl.f
6 c
7 c Author/Date : Mark Kiefer, 1265 (original version)
8 c Major rewrite by Kelley Fugelso, 1265 (SEA) 01/90
9 c
10 c Purpose : Creates storage files which contains the recorded points
11 c for each file request.
12 c The naming algorithm is:
13 c NAME.F##
14 c where NAME is the data file name and ## is the file index.
15 c
16 c The format of the file is:
17 c line 1: I4,X,A75
18 c where I4 is the number of points in the file and A75 is
19 c the branch/block label with the variable name.
20 c lines 2 to npoints+1: 1p2e12.3
21 c
22 c Called by : Program ZDEM$MAIN
23 c
24 c Calls : Subroutine STRIP, Subroutine CLEAR_OUTBUF,
25 c Subroutine GATHER, Subroutine OPEN_OUTFILE,
26 c Subroutine READ_OUTFILE, Subroutine CLOSE_OUTFILE,
27 c Subroutine INT_TO_TEXT
28 c
29 c Modifications:
30 c 03/07/95, MLK: Change include filenames to be 8 characters or less
31 c added "no_text" parameter
32 c 08/13/97, MLK: Create filename based on 'base_filename'
33 c
34 c-------Include Files---------------------------------------------------
35 c
36  include 'zdemparm.h'
37  include 'zdempprm.h'
38  include 'zdemmax.h'
39  include 'zdemout.h'
40  include 'zdemcomm.h'
41  include 'zdemenv.h'
42 c
43 c-------Input Parameters------------------------------------------------
44 c
45 c NONE
46 c
47 c-------Output Parameters-----------------------------------------------
48 c
49 c NONE
50 c
51 c-------Local Variables-------------------------------------------------
52 c
53  integer no_text
54  parameter(no_text = 0)
55  character ti*2, t1*2, t2*2
56  character header*73, filfile*80
57 c
58 c-------Subroutine Body-------------------------------------------------
59 c
60 c Create a template for the file name from the input data file name
61 c
62  filfile = base_filename
63  call strip(filfile, i_1st, i_last)
64  iend1 = i_last - i_1st + 3
65  iend2 = iend1 + 1
66  filfile(1:iend1) = filfile(i_1st:i_last)//'.f'
67  filfile(iend2:80) = ' '
68 c
69 c Clear the output buffers, calculate the record size of the output
70 c parameter file, and "gather" all of the FILE output requests together.
71 c
72  call clear_outbuf
73  ibufsize = numout*2+2
74  call gather(iouttype, ofile, maxout, indices, numfil)
75 c
76 c Loop over all of the file requests, creating one output file for each
77 c
78  do i = 1, numfil
79 c
80  time_flag = itimeflg(indices(i))
81  ncycle = 0
82  tstart = tbegout(indices(i))
83  tstop = tendout(indices(i))
84  nskip = ifsteps(maxfpts, ht, tstart, tstop)
85  ipntcnt = 0
86  fflag = oldfile
87  iunit = outunit
88  call open_outfile(iunit, fflag, ierr)
89 c
90 c Get the value at time 0.0
91 c
92  newrec = 1
93  call read_outfile(iunit, newrec, time_flag, indices(i),
94  + ibufsize, tmptime, tmpval, ierr)
95  if (tstart .eq. 0.0) then
96  ipntcnt = 1
97  timeout(ipntcnt,1) = tmptime
98  outdata(ipntcnt,1) = tmpval
99  call read_outfile(iunit, newrec, time_flag, indices(i),
100  + ibufsize, tmptime, tmpval, ierr)
101  endif
102 c
103 c Read the values for this parameter, saving only those which fall
104 c on a "save cycle"
105 c
106  do while (ierr .eq. 0)
107  if ((tmptime.ge.tstart).and.(tmptime.le.tstop)) then
108  ncycle = ncycle + 1
109  if (ncycle .ge. nskip) then
110  ipntcnt = ipntcnt + 1
111  timeout(ipntcnt,1) = tmptime
112  outdata(ipntcnt,1) = tmpval
113  ncycle = 0
114  endif
115  endif
116  call read_outfile(iunit, newrec, time_flag, indices(i),
117  + ibufsize, tmptime, tmpval, ierr)
118  enddo
119  call close_outfile(iunit,ierr)
120 c
121 c Translate ifile to text and append it to the filename to the the full
122 c file specification (less version number).
123 c
124  call int_to_text(i, ti)
125  call strip(ti, i1, i2)
126  iend = iend2 + i2 - i1
127  filfile(iend2:iend) = ti(i1:i2)
128 c
129 c Now open the output request file.
130 c
131  open (unit=22, file=filfile(1:iend), status='NEW')
132 c
133 c Set up the header with block and branch indicies, block type, and plot type
134 c if no comment line entered, else use the comment line.
135 c
136  call strip(lblout(indices(i)), istart, iend)
137  if (istart .eq. no_text) then
138  call int_to_text(ixbrnout(indices(i)), t1)
139  call int_to_text(ixblkout(indices(i)), t2)
140  itype = iblkout(indices(i))
141  if (itype .eq. transline) then
142  header(1:24) = 'Brn '//t1//', Blk '//t2//': trline {'
143  else if (itype .eq. pisection) then
144  header(1:24) = 'Brn '//t1//', Blk '//t2//': pisect {'
145  else if (itype .eq. rcground) then
146  header(1:24) = 'Brn '//t1//', Blk '//t2//': RCgrnd {'
147  else if (itype .eq. voltsource) then
148  header(1:24) = 'Brn '//t1//', Blk '//t2//': Vsourc {'
149  else if (itype .eq. vendsource) then
150  header(1:24) = 'Brn '//t1//', Blk '//t2//': EVsrce {'
151  else if (itype .eq. currsource) then
152  header(1:24) = 'Brn '//t1//', Blk '//t2//': Isourc {'
153  else if (itype .eq. cendsource) then
154  header(1:24) = 'Brn '//t1//', Blk '//t2//': Isourc {'
155  else if (itype .eq. csclsource) then
156  header(1:24) = 'Brn '//t1//', Blk '//t2//': SCLsrc {'
157  else if ((itype .eq. mitline) .or.
158  & (itype .eq. pmitline)) then
159  header(1:24) = 'Brn '//t1//', Blk '//t2//': MITL {'
160  else if (itype .eq. adder) then
161  header(1:24) = 'Brn '//t1//', Blk '//t2//': Adder {'
162  else if (itype .eq. rlseries) then
163  header(1:24) = 'Brn '//t1//', Blk '//t2//': RLsers {'
164  end if
165 c
166 c Set the label for the plot type. (ylblfil is 11 characters)
167 c
168  header(25:37) = ylblout(indices(i))//'} '
169  header(38:73) = ' '
170 c
171 c Use the comment line as the header
172 c
173  else
174  header(1:73) = lblout(indices(i))(1:73)
175  end if
176 c
177 c Write the number of points and the header to the file.
178 c
179  write (22, 1000) ipntcnt, header
180 c
181 c Now write the points to this file
182 c
183  do j = 1, ipntcnt
184  write (22, 2000) timeout(j,1), outdata(j,1)
185  end do
186 c
187 c Now close the file
188 c
189  close (unit=22)
190 c
191  end do
192 c-------FORMAT Statements-----------------------------------------------
193 c
194  1000 format (i4, 3x, a73)
195  2000 format (1p2e12.3)
196 c
197 c-------End of Subroutine-----------------------------------------------
198 c
199  return
200  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 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
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
c *****************************************************************************c Common blocks for SCREAMER output and tabling c numfil
Definition: zdemout.h:47
subroutine filvals
Definition: mkfilfl.f:1
subroutine gather(inarray, intarget, maxin, outarray, numout)
Definition: gather.f:1
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