Screamer Project  V3.3.1
Screamer Structure
 All Files Functions Variables
mkufofl.f
Go to the documentation of this file.
1  subroutine ufovals
2 c
3 c-------Description-----------------------------------------------------
4 c
5 c Source File : ufovals.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 file which contains the points for the ufo requests.
12 c
13 c Modifications:
14 c 03/07/95, MLK: Change include filenames to be 8 characters or less
15 c added "no_text" parameter
16 c 1997-08013 MLK: Create filename based on 'base_filename'
17 c 2013-12-09 RBS: Fixed the extra filename text, added two character
18 c lengths*80 like mkcsvfl
19 c 2013-12-10 RBS: Added two spaces in front of time
20 c 2013-12-10 RBS: Removed the format calls for consistency
21 c 2014-02-08 RBS: Changed the output format to 1pe13.5
22 c 2014-03-12 RBS: Changed the time label to Time(s)
23 c
24 c-------Include Files---------------------------------------------------
25 c
26  include 'zdemparm.h'
27  include 'zdempprm.h'
28  include 'zdemmax.h'
29  include 'zdemout.h'
30  include 'zdemcomm.h'
31  include 'zdemenv.h'
32 c
33 c-------Input Parameters------------------------------------------------
34 c NONE
35 c-------Output Parameters-----------------------------------------------
36 c NONE
37 c-------Constants-------------------------------------------------------
38 c
39  integer ufo_unit
40  parameter(ufo_unit = 24)
41 c
42 c-------Local Variables-------------------------------------------------
43 c
44  character ufofile*80,tempfile*80,filename*80
45 c
46 c-------Subroutine Body-------------------------------------------------
47 c
48 c Clear the output buffers, calculate the record size of the output
49 c parameter file, and "gather" all of the UFO output requests together.
50 c
51  call clear_outbuf
52  ibufsize = numout*2+2
53  call gather(iouttype, oufo, maxout, indices, numufo)
54 c
55 c Find start time and stop time, skip factor and nptsufo (these will
56 c be the same for all UFO output requests
57 c
58  tstart = tbegout(indices(1))
59  tstop = tendout(indices(1))
60  nskip = ifsteps(maxfpts, ht, tstart, tstop)
61  nptsufo = (((tstop - tstart) / ht) / nskip) + 1
62 c
63 c Create the UFO filename based on the input file name
64 c
65  ufofile = base_filename
66  call strip(ufofile, i_1st, i_last)
67 c
68 c strip off the text file extension
69 c
70  call strip_name(ufofile(i_1st:i_last),tempfile,lentemp)
71  filename = tempfile(1:lentemp)//'.ufo'
72  open (unit=ufo_unit, file=filename, status='unknown')
73 c
74 c
75 C write out the observer names out as titles
76 C
77  write (ufo_unit, '(101(A13))')
78  & ' Time(s) ',(lblout(indices(j))(1:10), j=1,numufo)
79 C
80 c
81 c Process UFO output requests
82 c
83  time_flag = half_step
84  ncycle = 0
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  ipntcnt = 1
94  call read_outfile(iunit, newrec, time_flag, indices(1),
95  + ibufsize, tmptime, tmpval, ierr)
96  timeout(ipntcnt,1) = tmptime
97  outdata(ipntcnt,1) = tmpval
98  newrec = 0
99  do i = 2, numufo
100  call read_outfile(iunit, newrec, time_flag, indices(i),
101  + ibufsize, tmptime, tmpval, ierr)
102  outdata(ipntcnt,i) = tmpval
103  enddo
104 c
105 c Get values for the rest of the simulation
106 c
107  newrec = 1
108  call read_outfile(iunit, newrec, time_flag, indices(1),
109  + ibufsize, tmptime, tmpval, ierr)
110 c
111  do while (ierr .eq. 0)
112  ncycle = ncycle + 1
113  if (ncycle .ge. nskip) then
114  ipntcnt = ipntcnt + 1
115  timeout(ipntcnt,1) = tmptime
116  outdata(ipntcnt,1) = tmpval
117  newrec = 0
118  do i = 2, numufo
119  call read_outfile(iunit, newrec, time_flag, indices(i),
120  + ibufsize, tmptime, tmpval, ierr)
121  outdata(ipntcnt,i) = tmpval
122  enddo
123  ncycle = 0
124  endif
125  newrec = 1
126  call read_outfile(iunit, newrec, time_flag, indices(1),
127  + ibufsize, tmptime, tmpval, ierr)
128  enddo
129  call close_outfile(iunit,ierr)
130 c
131 c Now write it all out.
132 c Write out all values at each time step: first line has time and first 100
133 c variables.
134 c
135  do i = 1, nptsufo
136 c
137 c Set the number of points to be printed in the first line of the group
138 c of values.
139 c
140  write (ufo_unit, '(101(1pe13.5))')
141  & timeout(i,1),(outdata(i,j), j=1,numufo)
142 c
143  end do !end of loop over time points
144 c
145 c
146 c Now close the file
147 c
148  close (unit=ufo_unit)
149 c
150 c-------End of Subroutine-----------------------------------------------
151 c
152  return
153  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 ufovals
Definition: mkufofl.f:1
subroutine clear_outbuf
Definition: clsoutbf.f:1
subroutine open_outfile(iunit, status, ierr)
Definition: opnoutfl.f:1
c *****************************************************************************c Common blocks for SCREAMER output and tabling c & numufo
Definition: zdemout.h:47
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 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