Screamer Project  V3.3.1
Screamer Structure
 All Files Functions Variables
mkcsvfl.f
Go to the documentation of this file.
1  subroutine csvvals
2 c
3 c-------Description-----------------------------------------------------
4 c
5 c Source File : csvvals.f
6 c
7 c Author/Date : Mark Kiefer, based on ufovals routine
8 c
9 c Purpose : Creates file which contains the points for the csv requests.
10 c
11 c Modifications:
12 c 1997-08-13 MLK: Create filename based on 'base_filename'
13 c 2012-04-10 RBS: Got rid of dangling commas finally
14 c 2012-04-10 RBS: Fixed the extra filename text
15 c 2013-12-10 RBS: Removed the format statements
16 c 2013-12-10 RBS: Increased the size of the output data to 1PE11.4
17 c 2014-02-08 RBS: Changed the output formation to 1pe12.5
18 c
19 c-------Include Files---------------------------------------------------
20 c
21  include 'zdemparm.h'
22  include 'zdempprm.h'
23  include 'zdemmax.h'
24  include 'zdemout.h'
25  include 'zdemcomm.h'
26  include 'zdemenv.h'
27 c
28 c-------Input Parameters------------------------------------------------
29 c NONE
30 c-------Output Parameters-----------------------------------------------
31 c NONE
32 c-------Constants-------------------------------------------------------
33 c
34  integer csv_unit
35  parameter(csv_unit = 24)
36 c
37 c-------Local Variables-------------------------------------------------
38 c
39  character csvfile*80,tempfile*80,filename*80
40 c
41 c-------Subroutine Body-------------------------------------------------
42 c
43 c Clear the output buffers, calculate the record size of the output
44 c parameter file, and "gather" all of the CSV output requests together.
45 c
46  call clear_outbuf
47  ibufsize = numout*2+2
48  call gather(iouttype, ocsv, maxout, indices, numcsv)
49 c
50 c Find start time and stop time, skip factor and nptscsv (these will
51 c be the same for all CSV output requests
52 c
53  tstart = tbegout(indices(1))
54  tstop = tendout(indices(1))
55  nskip = ifsteps(maxfpts, ht, tstart, tstop)
56  nptscsv = (((tstop - tstart) / ht) / nskip) + 1
57 c
58 c Create the CSV filename based on the input file name
59 c
60  csvfile = base_filename
61  call strip(csvfile, i_1st, i_last)
62 c
63 c strip off the text file extension
64 c
65  call strip_name(csvfile(i_1st:i_last),tempfile,lentmp)
66  filename = tempfile(1:lentmp)//'.csv'
67  open (unit=csv_unit, file=filename, status='unknown')
68 c
69 c write out the observer names out as titles
70 c
71  write (csv_unit, '(A,$)') 'Time'
72  do j = 1,numcsv
73  write (csv_unit, '(A, A12,$)') ',',lblout(indices(j))
74  end do
75  write (csv_unit,'( )')
76 c
77 c doing this gets rid of the dangling comma!!! Tricky
78 c
79 c
80 c Process CSV output requests
81 c
82  time_flag = half_step
83  ncycle = 0
84  ipntcnt = 0
85  fflag = oldfile
86  iunit = outunit
87  call open_outfile(iunit, fflag, ierr)
88 c
89 c Get the value at time 0.0
90 c
91  newrec = 1
92  ipntcnt = 1
93  call read_outfile(iunit, newrec, time_flag, indices(1),
94  + ibufsize, tmptime, tmpval, ierr)
95  timeout(ipntcnt,1) = tmptime
96  outdata(ipntcnt,1) = tmpval
97  newrec = 0
98  do i = 2, numcsv
99  call read_outfile(iunit, newrec, time_flag, indices(i),
100  + ibufsize, tmptime, tmpval, ierr)
101  outdata(ipntcnt,i) = tmpval
102  enddo
103 c
104 c Get values for the rest of the simulation
105 c
106  newrec = 1
107  call read_outfile(iunit, newrec, time_flag, indices(1),
108  + ibufsize, tmptime, tmpval, ierr)
109 c
110  do while (ierr .eq. 0)
111  ncycle = ncycle + 1
112  if (ncycle .ge. nskip) then
113  ipntcnt = ipntcnt + 1
114  timeout(ipntcnt,1) = tmptime
115  outdata(ipntcnt,1) = tmpval
116  newrec = 0
117  do i = 2, numcsv
118  call read_outfile(iunit, newrec, time_flag, indices(i),
119  + ibufsize, tmptime, tmpval, ierr)
120  outdata(ipntcnt,i) = tmpval
121  enddo
122  ncycle = 0
123  endif
124  newrec = 1
125  call read_outfile(iunit, newrec, time_flag, indices(1),
126  + ibufsize, tmptime, tmpval, ierr)
127  enddo
128  call close_outfile(iunit,ierr)
129 c
130 c Now write it all out.
131 c Write out all values at each time step: first line has time and first 100
132 c variables.
133 c
134  do i = 1, nptscsv
135 c
136 c Set the number of points to be printed in the first line of the group
137 c of values.
138 c
139  write (csv_unit, '(1pe12.5,$)') timeout(i,1)
140  do j = 1, numcsv
141  write (csv_unit, '(A,1pe12.5,$)') ',',outdata(i,j)
142  end do
143  write (csv_unit,'( )')
144 c
145 c doing this gets rid of the dangling comma!!! Tricky
146 c
147 c
148  end do !end of loop over time points
149 c
150 c
151 c Now close the file
152 c
153  close (unit=csv_unit)
154 c sets maximum label length to 15
155 c
156 c-------End of Subroutine-----------------------------------------------
157 c
158  return
159  end
c *****************************************************************************c Common blocks for SCREAMER output and tabling c numsfc character tendout
Definition: zdemout.h:59
subroutine csvvals
Definition: mkcsvfl.f:1
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 open_outfile(iunit, status, ierr)
Definition: opnoutfl.f:1
subroutine close_outfile(iunit, ierr)
Definition: clsoutfl.f:1
subroutine strip_name(text, name, start)
Definition: strpname.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 numcsv
Definition: zdemout.h:47
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
subroutine gather(inarray, intarget, maxin, outarray, numout)
Definition: gather.f:1
c This is a Fortran header file
Definition: sfc.h:3