GNU WOCSS (gwocss)  2.2.4-pre
GNU version of Winds On Critical Streamline Surfaces (WOCSS)
Functions/Subroutines
output.f File Reference

Go to the source code of this file.

Functions/Subroutines

subroutine putout (CHDDHR, CHFNAM, MINJUL, NCALL)
 

Function/Subroutine Documentation

subroutine putout ( character*6  CHDDHR,
character*12  CHFNAM,
  MINJUL,
integer*4  NCALL 
)

Definition at line 3 of file output.f.

Referenced by wocss().

3 C********************************************************************
4 C
5 C WRITES OUTPUT FILES IN CM/SEC BINARY INTEGER FORM (DOBIN=.TRUE.),
6 C ONE FILE FOR EACH LEVEL OR ASCII FORM (DOBIN=.FALSE) -- ALSO INTEGER
7 C CM/SEC. IF ASCII, GRID POINTS MAY BE SKIPPED. FOR NSKIP=1, ALL
8 C VALUES ARE WRITTEN, NSKIP =2, EVERY SECOND ROW AND COLUMN ETC.
9 C
10 C AS OF 2/02, THE OUTPUT CODE WAS REVISED TO BE IN A SEPARATE
11 C SUBROUTINE AND TO INCLUDE THE OPTION OF PROVIDING FILES THAT GIVE
12 C WIND PROFILES AT UP TO 10 SEPARATE LOCATIONS.
13 C
14 C FLUDWIG, 2/02
15 C
16  include 'NGRIDS.PAR'
17 C
18  include 'ANCHOR.CMM'
19  include 'FLOWER.CMM'
20  include 'LIMITS.CMM'
21  include 'STALOC.CMM'
22  include 'TSONDS.CMM'
23 C
24  CHARACTER*2 chpro(nhoriz)
25  CHARACTER*3 chdir,chspd,chric
26  CHARACTER*6 chddhr
27  CHARACTER*12 chfnam
28 C
29  INTEGER*4 ncall,minutz(111)
30  INTEGER*4 iutmp1(nxgrd,nygrd),ivtmp1(nxgrd,nygrd)
31  INTEGER*4 iptmp1(nxgrd,nygrd),ittmp1(nxgrd,nygrd)
32 C
33  LOGICAL dotopo
34 C
35  SAVE
36 C
37  DATA dotopo /.true./
38  DATA chpro,chdir,chspd,chric /'01','02','03','04','05','06',
39  $ '07','08','09','10','11','12','13','14','15','16',
40  $ '17','18','19','20','21','22','23','24','25','26',
41  $ '27', '28','29','30','DIR','SPD',' RI'/
42 C
43  IF (ncall.GE.0) THEN
44  minutz(ncall)=minjul
45 C
46  IF (dobin) THEN
47 C
48 C BINARY OUTPUT FILES -- EACH COMPONENT IN SEPARATE FILE
49 C
50 C
51 C HORIZONTAL COMPONENTS (CM/S)
52 C
53 C WRITE (*,*) CHPVEX//'U'//CHMESH//'KM.'//CHDDHR
54 C
55  OPEN(35,file='U'//chmesh//'KM.'//chddhr,
56  $ status='UNKNOWN')
57 C
58  WRITE (35) iugraf
59  CLOSE (35)
60 C
61  OPEN(35,file='V'//chmesh//'KM.'//chddhr,
62  $ status='UNKNOWN')
63  WRITE (35) ivgraf
64  CLOSE (35)
65 C
66 C VERTICAL COMPONENT (CM/S)
67 C
68  IF (dowcmp) THEN
69  OPEN(35,file='W'//chmesh//'KM.'//chddhr,
70  $ form='UNFORMATTED', status='UNKNOWN')
71 C
72  WRITE (35) iwgraf
73  CLOSE (35)
74  END IF
75 C
76 C 10*(POTENTIAL TEMPERATURE) K
77 C
78  IF (dothet) THEN
79  OPEN(35,file='PT'//chmesh//'KM.'//chddhr,
80  $ form='UNFORMATTED', status='UNKNOWN')
81 C
82  WRITE (35) iptgrf
83  CLOSE (35)
84  END IF
85 C
86 C PRESSURE (MB, HP)
87 C
88  IF (dopres) THEN
89  OPEN(35,file='PR'//chmesh//'KM.'//chddhr,
90  $ form='UNFORMATTED', status='UNKNOWN')
91 C
92  WRITE (35) iprgrf
93  CLOSE (35)
94  END IF
95 C
96 C 100*(BULK RICHARDSON NUMBER)
97 C
98  IF (dobri) THEN
99  OPEN(35,file='RI'//chmesh//'KM.'//chddhr,
100  $ form='UNFORMATTED', status='UNKNOWN')
101 C
102  WRITE (35) irngrf
103  CLOSE (35)
104  END IF
105 C
106  IF (dobvpd) THEN
107  OPEN(35,file='BV'//chmesh//'KM.'//chddhr,
108  $ form='UNFORMATTED', status='UNKNOWN')
109 C
110  WRITE (35) ibvgrf
111  CLOSE (35)
112  END IF
113  ELSE
114 C
115 C ASCII OUTPUT FILES
116 C
117  IF (.NOT.dowvsz) THEN
118 C
119 C
120 C GETTING FIELD OF OBSERVED U,V PRESS AND THETA -- 0 WHERE NO OBS
121 C
122  CALL setint(0,iutmp1,nxgrd,nygrd)
123  CALL setint(0,ivtmp1,nxgrd,nygrd)
124  CALL setint(0,iptmp1,nxgrd,nygrd)
125  CALL setint(0,ittmp1,nxgrd,nygrd)
126 C
127 C FILL IN OBS WHERE AVAILABLE
128 C
129  DO 115 iob=1,numnws
130  IF (nint(ucomp(iob)) .NE. -9999) THEN
131  kx=nint(xg(iob))
132  ky=nint(yg(iob))
133  IF (kx.GT.0 .AND. kx.LE. nxgrd
134  $ .AND. ky.GT.0 .AND. ky.LE. nygrd) THEN
135  iutmp1(kx,ky)=nint(100.0*ucomp(iob))
136  ivtmp1(kx,ky)=nint(100.0*vcomp(iob))
137  END IF
138  END IF
139  IF (nint(tempc(iob)).NE.-9999) THEN
140  kx=nint(xg(iob))
141  ky=nint(yg(iob))
142  IF (kx.GT.0 .AND. kx.LE. nxgrd
143  $ .AND. ky.GT.0 .AND. ky.LE. nygrd) THEN
144  IF (nint(altim(iob)) .NE. -9999) THEN
145  ppp=cvt2p(altim(iob),sfcht(kx,ky))
146  ELSE
147  ppp=float(iprgrf(kx,ky,1))
148  END IF
149  ttt=tempc(iob)
150  ittmp1(kx,ky)=nint(10.0*tpot(ppp,ttt))
151  END IF
152  END IF
153  IF (nint(altim(iob)).NE.-9999) THEN
154  kx=nint(xg(iob))
155  ky=nint(yg(iob))
156  IF (kx.GT.0 .AND. kx.LE. nxgrd
157  $ .AND. ky.GT.0 .AND. ky.LE. nygrd) THEN
158  iptmp1(kx,ky)=
159  $ nint(cvt2p(altim(iob),sfcht(kx,ky)))
160  END IF
161  END IF
162 115 CONTINUE
163 C
164 C THE FOLLOWING CODE IS DISABLED. IT IS USED TO OUTPUT INPUT
165 C VALUES FOR COMPARISON WITH THE ANALYSIS
166 C***************************
167  doobs=.false.
168  IF (doobs) THEN
169  WRITE (*,*) chpvex//'UFOBS'//chmesh//'KM-ALLZ.'//
170  $ chddhr
171 C
172  OPEN (50,file='UFOBS'//chmesh//'KM-ALLZ.'//
173  $ chddhr,form='FORMATTED',status='UNKNOWN')
174 C
175  OPEN (51,file='VFOBS'//chmesh//'KM-ALLZ.'//
176  $ chddhr,form='FORMATTED',status='UNKNOWN')
177 C
178  OPEN(40,file='PTOBS'//chmesh//'KM-ALLZ.'//
179  $ chddhr,form='FORMATTED',status='UNKNOWN')
180 C
181  OPEN(41,file='PROBS'//chmesh//'KM-ALLZ.'//
182  $ chddhr,form='FORMATTED',status='UNKNOWN')
183 C
184  DO 68 iy=nascy0,nascy0-1+nryty,nskip
185 C
186  WRITE(50,6008) (iutmp1(ix,iy),
187  $ ix=nascx0,nascx0-1+nrytx,nskip)
188  WRITE(51,6008) (ivtmp1(ix,iy),
189  $ ix=nascx0,nascx0-1+nrytx,nskip)
190  WRITE(40,6008) (ittmp1(ix,iy),
191  $ ix=nascx0,nascx0-1+nrytx,nskip)
192  WRITE(41,6008) (iptmp1(ix,iy),
193  $ ix=nascx0,nascx0-1+nrytx,nskip)
194 68 CONTINUE
195  END IF
196 C
197 C***************************
198 C
199  CLOSE (40)
200  CLOSE (41)
201  CLOSE (50)
202  CLOSE (51)
203 C
204 C WRITE TOPOGRAPHY AND GRIDDED OBSERVATIONS FOR THIS OUTPUT SET.
205 C NORTHENMOST ROWS WRITTEN FIRST FOR PLOTTING PUPOSES WITH TRANSFORM.
206 C
207 C
208  WRITE(*,*) dotopo
209  IF (dotopo) THEN
210 C
211 C WRITE (*,*) CHPVEX//'LOCLTOPO'//CHMESH//'KM.DAT'
212 C
213  OPEN(31,file=chpvex//'LOCLTOPO'//chmesh//'KM.DAT',
214  $ status='UNKNOWN')
215 C
216  DO 168 iy=nascy0-1+nryty,nascy0,-nskip
217  WRITE(31,6008) (nint(sfcht(ix,iy)),
218  $ ix=nascx0,nascx0-1+nrytx,nskip)
219 168 CONTINUE
220  CLOSE (31)
221  dotopo=.false.
222  END IF
223 C
224 C IF NOT WRITING ASCII WIND PROFILE FILES, WRITE COMPONENTS FOR
225 C EACH LEVEL AT EACH TIME. WRITE TOPOGRAPHY AND GRIDDED OBSERVATIONS
226 C FOR THIS OUTPUT SET. NORTHENMOST ROWS WRITTEN FIRST FOR PLOTTING
227 C PUPOSES WITH TRANSFORM.
228 C
229 C
230  OPEN (46,file=chpvex//'UF'//
231  $ chmesh//'KM-ALLZ.'//chddhr,form='FORMATTED',
232  $ status='UNKNOWN')
233 C
234  OPEN (47,file=chpvex//'VF'//
235  $ chmesh//'KM-ALLZ.'//chddhr,form='FORMATTED',
236  $ status='UNKNOWN')
237 C
238  IF (dowcmp) THEN
239  OPEN (35,file=chpvex//'WF'//
240  $ chmesh//'KM-ALLZ.'//chddhr,form='FORMATTED',
241  $ status='UNKNOWN')
242  END IF
243 
244  IF (dothet) THEN
245  OPEN (36,file=chpvex//'PT'//
246  $ chmesh//'KM-ALLZ.'//chddhr,form='FORMATTED',
247  $ status='UNKNOWN')
248  END IF
249 C
250  IF (dopres) THEN
251  OPEN (37,file=chpvex//'PR'//
252  $ chmesh//'KM-ALLZ.'//chddhr,form='FORMATTED',
253  $ status='UNKNOWN')
254  END IF
255 C
256  IF (dobri) THEN
257  OPEN (38,file=chpvex//'RIF'//
258  $ chmesh//'KM-ALLZ.'//chddhr,form='FORMATTED',
259  $ status='UNKNOWN')
260  END IF
261 
262  IF (dobvpd) THEN
263  OPEN (39,file=chpvex//'BV'//
264  $ chmesh//'KM-ALLZ.'//chddhr,form='FORMATTED',
265  $ status='UNKNOWN')
266  END IF
267 C
268  DO 195 iz=1,nflat
269 C
270  DO 185 iy=nascy0-1+nryty,nascy0,-nskip
271 C
272  WRITE(46,6008) (iugraf(ix,iy,iz),
273  $ ix=nascx0,nascx0-1+nrytx,nskip)
274  WRITE(47,6008) (ivgraf(ix,iy,iz),
275  $ ix=nascx0,nascx0-1+nrytx,nskip)
276 C
277  IF (dowcmp) WRITE(35,6008) (iwgraf(ix,iy,iz),
278  $ ix=nascx0,nascx0-1+nrytx,nskip)
279 C
280  IF (dothet) WRITE(36,6008) (iptgrf(ix,iy,iz),
281  $ ix=nascx0,nascx0-1+nrytx,nskip)
282 C
283  IF (dopres) WRITE(37,6008) (iprgrf(ix,iy,iz),
284  $ ix=nascx0,nascx0-1+nrytx,nskip)
285 C
286  IF (dobri) WRITE(38,6008) (irngrf(ix,iy,iz),
287  $ ix=nascx0,nascx0-1+nrytx,nskip)
288 C
289  IF (dobvpd) WRITE(39,6008) (ibvgrf(ix,iy,iz),
290  $ ix=nascx0,nascx0-1+nrytx,nskip)
291 C
292 185 CONTINUE
293 195 CONTINUE
294  CLOSE (46)
295  CLOSE (47)
296  IF (dowcmp) CLOSE (35)
297  IF (dothet) CLOSE (36)
298  IF (dopres) CLOSE (37)
299  IF (dobri) CLOSE (38)
300  IF (dobvpd) CLOSE (39)
301 C
302  ELSE
303 C
304 C FILL ARRAYS FOR PROFILE FILES
305 C
306  DO 150 ip=1,npfyls
307  ipx=jprylx(ip)
308  ipy=jpryly(ip)
309  DO 140 ll=1,nflat
310  iuprf(ip,ll,ncall)=iugraf(ipx,ipy,ll)
311  ivprf(ip,ll,ncall)=ivgraf(ipx,ipy,ll)
312  riprf(ip,ll,ncall)=float(irngrf(ipx,ipy,ll))
313 140 CONTINUE
314 150 CONTINUE
315 C
316  END IF
317 C
318  END IF
319  ELSE
320 C*************DISABLED CODE**************
321 C IF DOING WIND PROFILES, WE ARE DONE CALCULATING AND STORING, NOW
322 C WRITE
323 C
324  DO 175 ip=1,npfyls
325  OPEN(46,file=chpvex//'WNDPROF'//chpro(ip),
326  $ form='FORMATTED', status='UNKNOWN')
327 C
328 C WRITE WIND PROFILES (ROW) VS TIME (COL)
329 C
330  WRITE (46,6004) (chdir,chpro(ii),chspd,
331  $ chpro(ii),chric,chpro(ii),ii=1,-ncall)
332  DO 170 iz=1,nflat
333  WRITE (46,6006) zchooz(iz),
334  $ (dd(float(iuprf(ip,iz,it)),float(ivprf(ip,iz,it))),
335  $ 0.01*sp(float(iuprf(ip,iz,it)),
336  $ float(ivprf(ip,iz,it))),
337  $ 1000.*riprf(ip,iz,it),it=1,-ncall)
338 170 CONTINUE
339 175 CONTINUE
340  CLOSE (46)
341 C
342 C WRITE WIND TIME SERIES (COL) VS HEIGHT (ROW)
343 C
344  DO 275 ip=1,npfyls
345  OPEN(47,file=chpvex//'WNDTSER'// chpro(ip),
346  $ form='FORMATTED', status='UNKNOWN')
347  WRITE (47,6005) (chdir,chpro(ii),
348  $ chspd,chpro(ii),chric,chpro(ii),ii=1,nflat)
349 
350  DO 270 it=1,-ncall
351  WRITE (47,6007) minutz(it),
352  $ (dd(float(iuprf(ip,iz,it)),float(ivprf(ip,iz,it))),
353  $ 0.01*sp(float(iuprf(ip,iz,it)),
354  $ float(ivprf(ip,iz,it))),
355  $ 1000.*riprf(ip,iz,it),iz=1,nflat)
356 270 CONTINUE
357 275 CONTINUE
358  CLOSE (47)
359 C*******************END DISABLED CODE*************************
360  END IF
361 C
362  WRITE(*,*) ' FINISHED ',chfnam
363 C
364  CLOSE (12)
365 C
366 6004 FORMAT (1x,' MSL ',55(1x,a3,a2,1x,a3,a2,1x,a3,a2))
367 6005 FORMAT (1x,' MIN ',55(1x,a3,a2,1x,a3,a2,1x,a3,a2))
368 6006 FORMAT (1x,f6.0,55(f6.0,2f6.1))
369 6007 FORMAT (1x,i8,55(f6.0,2f6.1))
370 6008 FORMAT (1x,111i6)
371 C
372  RETURN
373 C
cvt2p
real function cvt2p(ALTIM, ELEV)
Definition: utils.f:129
sp
real function sp(UU, VV)
Definition: utils.f:19
dd
real function dd(UU, VV)
Definition: utils.f:30
tpot
real function tpot(PP, TT)
Definition: utils.f:66
setint
subroutine setint(IVALUE, IARRAY, NUM1, NUM2)
Definition: utils.f:240

Here is the call graph for this function:

Here is the caller graph for this function:

Generated on Tue Sep 22 2015 23:54:04 for GNU WOCSS (gwocss) by   doxygen 1.8.10