Screamer Project  V3.3.1
Screamer Structure
 All Files Functions Variables
mksfcfl.f
Go to the documentation of this file.
1  subroutine sfcvals
2 c
3 c-------Description-----------------------------------------------------
4 c
5 c Source File : sfcvals.f
6 c
7 c Author : Mark Kiefer
8 c
9 c Purpose : Creates file which contains the points for the SFC requests.
10 c
11 c Modifications:
12 c 1/6/98, MLK: Original version
13 c
14 c The format of this file is:
15 c TITREG=screamer-title-line
16 c (unlimited no. of characters)
17 c DATHEU=date
18 c (10 characters: xx/yy/zz, e.g., 08/10/96)
19 c TYPEDO=REEL
20 c NBCOLO=number-of-data-columns
21 c (=number of SFC requests + 1)
22 c NBLIGN=number-of-data-points
23 c (=nptssfc)
24 c TITCOL=label-for-each-column-of-data
25 c (max of 15 characters per label, such as "Load Current")
26 c (This is the user-entered label or generated by SCREAMER)
27 c LABCOL=generic-labels-for-each-column-of-data
28 c (max of 15 characters per label, such as "Voltage")
29 c UNICOL=labels-for-units-of-measure-for-each-column
30 c (max of 15 characters per label, such as VOLTS, SEC)
31 c COMENT=version-of-SCREAMER-used
32 c DONNEE=
33 c time(1) data1(1) data2(1) .... dataN(1)
34 c time(2) data1(2) data2(2) .... dataN(2)
35 c ....
36 c time(NBLIGN) data1(NBLIGN) data2(NBLIGN) .... dataN(NBLIGN)
37 c (these lines contain the data, where N=NBCOLO-1)
38 c
39 c-------Include Files---------------------------------------------------
40 c
41  include 'zdemparm.h'
42  include 'zdempprm.h'
43  include 'zdemmax.h'
44  include 'zdemout.h'
45  include 'zdemcomm.h'
46  include 'zdemenv.h'
47  include 'version.h'
48 c
49 c-------Input Parameters------------------------------------------------
50 c NONE
51 c-------Output Parameters-----------------------------------------------
52 c NONE
53 c-------Constants-------------------------------------------------------
54 c
55  integer sfc_unit
56  parameter(sfc_unit = 24)
57 c
58 c-------Local Variables-------------------------------------------------
59 c
60  character sfcfile*80
61  integer imon, iday, iyr, i, ip, j, i1, i2
62  integer date_time(8)
63  character*10 dt_return (3)
64 c
65 c-------Labels----------------------------------------------------------
66 c
67  include 'sfc.h'
68 c
69 c-------Subroutine Body-------------------------------------------------
70 c
71 c Clear the output buffers, calculate the record size of the output
72 c parameter file, and "gather" all of the SFC output requests together.
73 c
74  call clear_outbuf
75  ibufsize = numout*2+2
76  call gather(iouttype, osfc, maxout, indices, numsfc)
77 c
78 c Find start time and stop time, skip factor and nptssfc (these will
79 c be the same for all SFC output requests
80 c
81  tstart = tbegout(indices(1))
82  tstop = tendout(indices(1))
83  nskip = ifsteps(maxfpts, ht, tstart, tstop)
84  nptssfc = (((tstop - tstart) / ht) / nskip) + 1
85 c
86 c Create the SFC filename based on the input file name
87 c
88  sfcfile = base_filename
89  call strip(sfcfile, i_1st, i_last)
90  iend = i_last - i_1st + 5
91  sfcfile(1:iend) = sfcfile(i_1st:i_last)//'.sfc'
92  open (unit=sfc_unit, file=sfcfile(1:iend), status='unknown')
93 c
94 c Process SFC output requests
95 c
96  time_flag = whole_step
97  ncycle = 0
98  ipntcnt_wh = 0
99  ipntcnt_hf = 0
100  fflag = oldfile
101  iunit = outunit
102  call open_outfile(iunit, fflag, ierr)
103 c
104 c Get the value at time 0.0
105 c
106  newrec = 1
107  ipntcnt = 1
108  call read_outfile(iunit, newrec, time_flag, indices(1),
109  + ibufsize, tmptime, tmpval, ierr)
110  timeout(ipntcnt,1) = tmptime
111  outdata(ipntcnt,1) = tmpval
112  newrec = 0
113  do i = 2, numsfc
114  call read_outfile(iunit, newrec, time_flag, indices(i),
115  + ibufsize, tmptime, tmpval, ierr)
116  outdata(ipntcnt,i) = tmpval
117  enddo
118 c
119 c Get values for the rest of the simulation
120 c
121  newrec = 1
122  call read_outfile(iunit, newrec, time_flag, indices(1),
123  + ibufsize, tmptime, tmpval, ierr)
124 c
125  do while (ierr .eq. 0)
126  ncycle = ncycle + 1
127  if (ncycle .ge. nskip) then
128  ipntcnt = ipntcnt + 1
129  timeout(ipntcnt,1) = tmptime
130  outdata(ipntcnt,1) = tmpval
131  newrec = 0
132  do i = 2, numsfc
133  call read_outfile(iunit, newrec, time_flag, indices(i),
134  + ibufsize, tmptime, tmpval, ierr)
135  outdata(ipntcnt,i) = tmpval
136  enddo
137  ncycle = 0
138  endif
139  newrec = 1
140  call read_outfile(iunit, newrec, time_flag, indices(1),
141  + ibufsize, tmptime, tmpval, ierr)
142  enddo
143  call close_outfile(iunit,ierr)
144 c
145 c Set TITCOL strings to output request title, if it exists
146 c
147  do j = 1, numsfc
148  i = indices(j)
149  ip = itypout(i)
150  call strip(lblout(i), istart, iend)
151  if (istart .eq. no_text) then
152  lblout(i)(1:sfc_len) = sfc_titcol(ip)(1:sfc_len)
153  end if
154  end do
155 c
156 c Now write it all out.
157 c
158  call strip(title, i1, i2)
159  write (sfc_unit, 1010) title(i1:i2)
160  call date_and_time(dt_return(1), dt_return(2),
161  & dt_return(3), date_time)
162  write (sfc_unit, 1000) date_time(2), date_time(3), date_time(1)
163  write (sfc_unit, 1012)
164  write (sfc_unit, 1006) numsfc+1
165  write (sfc_unit, 1007) nptssfc
166  write (sfc_unit, 1001)
167  & sfc_tlab, (lblout(indices(j)),j=1,numsfc)
168  write (sfc_unit, 1002)
169  & sfc_tlab, (sfc_labcol(itypout(indices(j))),j=1,numsfc)
170  write (sfc_unit, 1003)
171  & sfc_tuni, (sfc_unicol(itypout(indices(j))),j=1,numsfc)
172  write (sfc_unit, 1011) screamer_version
173  write (sfc_unit, 1013)
174 c
175 c Write out all values at each time step: first line has time and first 100
176 c variables.
177 c
178  do i = 1, nptssfc
179 c
180 c Set the number of points to be printed in the first line of the group
181 c of values.
182 c
183  write (sfc_unit, 1009) timeout(i,1), (outdata(i,j), j=1,numsfc)
184 c
185 c
186  end do !end of loop over time points
187 c
188 c
189 c Now close the file
190 c
191  close (unit=sfc_unit)
192 c
193 c-------FORMAT Statements-----------------------------------------------
194 c
195  1010 format('TITREG=',a)
196  1000 format('DATHEU=',i2.2,'/',i2.2,'/',i4.4)
197  1012 format('TYPEDO=REEL')
198  1006 format('NBCOLO=',i3)
199  1007 format('NBLIGN=',i5)
200  1001 format('TITCOL=',100(a15,';'))
201  1002 format('LABCOL=',100(a15,';'))
202  1003 format('UNICOL=',100(a15,';'))
203  1011 format('COMENT=',a)
204  1013 format('DONNEE=')
205  1009 format(1pe13.6, 100(' ',1pe13.6))
206 c
207 c-------End of Subroutine-----------------------------------------------
208 c
209  return
210  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
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 i3
Definition: zdemfmt.h:36
subroutine clear_outbuf
Definition: clsoutbf.f:1
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 & 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 itypout
Definition: zdemout.h:59
c *****************************************************************************c Common blocks for SCREAMER output and tabling c numsfc character numsfc
Definition: zdemout.h:59
subroutine gather(inarray, intarget, maxin, outarray, numout)
Definition: gather.f:1
subroutine sfcvals
Definition: mksfcfl.f:1
c This is a Fortran header file
Definition: sfc.h:3