NCEPLIBS-w3emc  2.11.0
w3fp05.f
Go to the documentation of this file.
1 C> @file
2 C> @brief Printer contour subroutine.
3 C> @author Ralph Jones @date 1989-10-13
4 
5 C> Prints a two-dimensional grid of any shape, with
6 C> contouring, if desired. grid values are scaled according to
7 C> to constants specified by the programer, rounded, and printed
8 C> as 4,3, or 2 digit integers with sign, the sign marking the
9 C> grid position of the printed number. if contouring is requested,
10 C> bessel's interpolation formula is used to optain the contour lines.
11 C> contours are indicated by alphabetic characters ranging from a to
12 C> h or numeric characters from 0 to 9. contour origin and interval
13 C> are specified by the programmer in terms of printed values.
14 C>
15 C> Program history log:
16 C> - Ralph Jones 1989-10-13
17 C> - Ralph Jones 1992-05-02 Add save
18 C>
19 C> @param[in] RDATA Real array of grid data to be printed.
20 C> @param[in] KTBL Integer array with shape of array.
21 C> @param[in] CNST Real array of four elements, used in
22 C> scaling for printing and contouring.
23 C> @param[in] TITLE Is a array of 132 characters or less of
24 C> hollerith data, 1st char. must be blank.
25 C> printed at bottom of the map.
26 C> @param[in] KRECT 1 if grid is rectangular, 0 otherwise.
27 C> @param[in] KCONTR 1 for contouring , 0 otherwise.
28 C> @param[in] LINEV 0 is for 6 lines per vertical inch,
29 C> non-zero 8 lines per vertical inch.
30 C> @param[in] IWIDTH Number of characters in print line,
31 C> 132 is standard printer.
32 C>
33 C> @note Normal subroutine return, unless number of rows is greater than 200,
34 C> prints error message and exits.
35 C>
36 C> @author Ralph Jones @date 1989-10-13
37  SUBROUTINE w3fp05(RDATA,KTBL,CNST,TITLE,KRECT,KCONTR,LINEV,IWIDTH)
38 C
39  REAL CNST(4)
40  REAL RDATA(1)
41  REAL RWA(28)
42  REAL RWB(28)
43  REAL RWC(28)
44  REAL RWD(28)
45  REAL VDJA(29)
46  REAL VDJB(28)
47  REAL VDJC(28)
48 C
49  INTEGER KALFA(16)
50  INTEGER KALPH(20)
51  INTEGER KHTBL(10)
52  INTEGER KLINE(126)
53  INTEGER KLINES(132)
54  INTEGER KNUMB(20)
55  INTEGER KRLOC(200)
56  INTEGER KTBL(407)
57  INTEGER OUTPUT
58  INTEGER PAGNL
59  INTEGER PAGNR
60  INTEGER PAGN3
61  INTEGER PCCNT
62  INTEGER PCFST
63  INTEGER PGCNT
64  INTEGER PGCNTA
65  INTEGER PGFST
66  INTEGER PGFSTA
67  INTEGER PGMAX
68 C
69  LOGICAL DONE
70  LOGICAL LCNTR
71  LOGICAL RECT
72 C
73  CHARACTER*1 TITLE(*)
74 C
75  equivalence(crmx,vdja(29))
76  equivalence(kline(1),klines(8))
77  equivalence(vdjc(1),rwa(1))
78 C
79 C ... THE VAULUE CRMX IS MACHINE DEPENDENT, IT SHOULD BE
80 C ... SET TO A VALUE A LITTLE LESS THAN THE LARGEST POSITIVE
81 C ... FLOATING POINT NUMBER FOR THE COMPUTER.
82 C
83  SAVE
84 C
85  DATA crmx /10.e70/
86  DATA kalfa/
87  a 1ha,1h ,1hb,1h ,1hc,1h ,1hd,1h ,1he,1h ,1hf,
88  b 1h ,1hg,1h ,1hh,1h /
89  DATA khastr/1h*/
90  DATA khblnk/1h /
91  DATA khdolr/1h$/
92  DATA khmns /1h-/
93  DATA khplus/1h+/
94  DATA khrstr/1h1/
95  DATA khtbl /1h0,1h1,1h2,1h3,1h4,1h5,1h6,1h7,1h8,1h9/
96 C
97 C ... LIMNRW IS LIMIT ON NUMBER OF ROWS ALLOWED
98 C ... AND IS DIMENSION OF KRLOC ...
99 C
100  DATA limnrw/200/
101  DATA knumb /1h0,1h ,1h1,1h ,1h2,1h ,1h3,1h ,1h4,1h ,
102  1 1h5,1h ,1h6,1h ,1h7,1h ,1h8,1h ,1h9,1h /
103  DATA output/6/
104  DATA r5 /.2/
105  DATA r50 /.02/
106 C
107  8000 FORMAT (1h0,10x,44herror from w3fp05 ... number of rows in your,
108  1 9h array = ,i4,24h which exceeds limit of ,i4)
109  8100 FORMAT (1ht)
110  8200 FORMAT (1hs)
111  8300 FORMAT (1h /1h /1h )
112  8400 FORMAT (1h /1h )
113  8500 FORMAT (132a1)
114  8600 FORMAT (132a1)
115 C
116 C COMPUTE VALUES FOR PRINTER WIDTH
117 C
118  IF (iwidth.GE.132.OR.iwidth.LE.0) pgmax = 25
119  IF (iwidth.GE.1.AND.iwidth.LE.22) pgmax = 3
120  IF (iwidth.GT.22.AND.iwidth.LT.132) pgmax = (iwidth-7)/5
121  pagn3 = pgmax + 3
122  lw = pgmax * 5 + 7
123  vdja(pagn3 + 1) = crmx
124  mxpg = pgmax * 5 + 7
125 C
126  IF (linev .EQ. 0) GO TO 100
127 C ...OTHERWISE LINEV IS NON-ZERO, SO 8 LINES/INCH IS DESIRED...
128  linate = 1
129  r4 = 0.250
130  r32 = 0.03125
131  con2 = 10.0
132  nbtwn = 3
133  GO TO 200
134 C
135  100 CONTINUE
136  linate = 2
137  r4 = 0.33333333
138  r32 = 1.0/18.0
139  con2 = 6.0
140  nbtwn = 2
141 C
142  200 CONTINUE
143  pgcnta = 0
144  pgfsta = 0
145  rect = .false.
146  done = .false.
147  kz = 0
148  kza = 1000
149  a = cnst(1)
150  kca = 2*(1-krect)
151 C TO SET NO. OF DIGITS TO BE PRINTED
152 C WHICH IS A FUNCTION OF THE TENS POSITION IN KCONTR
153  nodig = iabs(kcontr/10)
154  nodig = 3 - nodig
155 C WHERE C(NODIG) + 1 IS NO. OF DIGITS TO BE PRINTED
156  IF (nodig.LT.1 .OR. nodig.GT.3) nodig = 3
157 C ANY OUT-OF-RANGE WILL GET 4 DIGITS
158  lcntr = .false.
159  nconq = iabs(mod(kcontr,10))
160  IF (nconq .EQ. 0) GO TO 400
161  IF (nconq .LE. 2) GO TO 300
162 C OTHERWISE RESET NCONQ
163  nconq = 0
164  GO TO 400
165  300 CONTINUE
166  lcntr = .true.
167 C WITH NCONQ=1 FOR LETTERS,AND =2 FOR NUMBERS IN CONTOUR BANDS
168  400 CONTINUE
169  IF (nconq .EQ. 2) GO TO 600
170 C OTHERWISE SET AS LETTERS
171 C
172  kcow = 16
173  DO 500 j = 1,kcow
174  kalph(j) = kalfa(j)
175  500 CONTINUE
176  GO TO 800
177 C
178  600 CONTINUE
179  kcow = 20
180  DO 700 j = 1,kcow
181  kalph(j) = knumb(j)
182  700 CONTINUE
183 C
184 800 CONTINUE
185  radj = 4 * kcow
186  kd=1
187 C *** SET UP TABLE OF INDICES CORRESPONDING TO FIRST ITEM IN EACH ROW
188 C *** THIS IS KRLOC
189 C *** PICK OUT SIZE AND ROW NUMBER OF LARGEST ROW (KCMX AND KCLMX)
190 C *** KZA LEFT-JUSTIFIES MAP IF ALL ROWS HAVE COMMON MINIMAL OFFSET
191  IF (ktbl(1 ).EQ.(-1)) GO TO 1100
192 C *** ONE-DIMENSIONAL FORM
193  ktf=3
194  kza=0
195  imin = ktbl(2)
196  jmax = ktbl(3)+ktbl(1)-1
197  nrws = ktbl(1)
198  IF (nrws .GT. limnrw) GO TO 1200
199  kc = kca * (nrws-1) + 1
200 C
201  DO 1000 j = 1,nrws
202  k = nrws-j+1
203  krloc(k) = kd
204  IF (ktbl(kc+4)+ktbl(kc+3).LE.kz ) GO TO 900
205  kclmx = k
206  imax = ktbl(kc+4)+ktbl(kc+3)
207  kz = imax
208  kcmx = krloc(k)+ktbl(kc+4)
209  900 CONTINUE
210  kd = kd+ktbl(kc+4)
211  kc = kc-kca
212  1000 CONTINUE
213  GO TO 1600
214 C *** TWO-DIMENSIONAL FORM
215 C *** THE TWO-DIMENSIONAL FORM IS COMPILER-DEPENDENT
216 C *** IT DEPENDS ON THE TWO-DIMENSIONAL ARRAY BEING STORED COLUMN-WISE
217 C *** THAT IS, WITH THE FIRST INDEX VARYING THE FASTEST
218  1100 CONTINUE
219  imin = ktbl(6)
220  jmin = ktbl(7)
221  nrws = ktbl(5)
222  IF (nrws .LE. limnrw) GO TO 1300
223 C ... ELSE, NRWS EXCEEDS LIMIT ALLOWED ...
224  1200 CONTINUE
225  WRITE (output,8000) nrws,limnrw
226  GO TO 7400
227 C
228  1300 CONTINUE
229  jmax = ktbl(7) +ktbl(5)-1
230  kc = 1
231  DO 1500 j = 1,nrws
232  krloc(j) = ktbl(2)*(ktbl(4)-j)+ktbl(kc+7)+1
233  IF (ktbl(kc+7)+ktbl(kc+8).LE.kz) GO TO 1400
234  imax = ktbl(kc+7)+ktbl(kc+8)
235  kz = imax
236  kcmx = krloc(j)+ktbl(kc+8)
237  kclmx = j
238  1400 CONTINUE
239  IF (ktbl(kc+7).LT.kza) kza = ktbl(kc+7)
240  kc = kc + kca
241  1500 CONTINUE
242  imax = imax-kza
243  ktf = 7
244  1600 CONTINUE
245  pagnl = 0
246  pagnr = pgmax
247  IF (.NOT.lcntr) GO TO 1700
248  adc = (cnst(1)-cnst(4))/cnst(3)+radj
249  bc = cnst(2)/cnst(3)
250 C *** PRINT I-LABELS ACROSS TOP OF MAP
251  1700 CONTINUE
252 C *** WHICH PREPARES CDC512 PRINTER FOR 8 LINES PER INCH
253  IF (linate.EQ.1) WRITE (output,8100)
254 C ...WHICH PREPARES PRINTER FOR 6 LINES PER INCH
255  IF (linate.EQ.2) WRITE (output,8200)
256  klines(1) = khrstr
257  assign 1800 to kbr
258  GO TO 6900
259 C
260  1800 CONTINUE
261  IF (.NOT.lcntr) GO TO 2000
262 C *** INITIALIZE CONTOUR WORKING AREA
263  DO 1900 j=1,pagn3
264  rwc(j)=crmx
265  rwd(j)=crmx
266  1900 CONTINUE
267 C *** SET UP CONTOUR DATA AND PAGE LIMITERS FOR FIRST TWO ROWS
268 C
269  2000 CONTINUE
270  kra = 1
271  kc = ktf+1
272  assign 2100 to kbr
273  GO TO 5900
274 C
275  2100 CONTINUE
276  kra = 2
277  kc = kc+kca
278  assign 2200 to kbr
279  GO TO 5900
280 C
281  2200 CONTINUE
282  kr = 0
283 C *** TEST IF THIS IS LAST PAGE
284  IF (imax.GT.pgmax-1) GO TO 2300
285  lmr = imax*5 + 2
286  done = .true.
287 C *** DO LEFT J-LABELS
288  2300 CONTINUE
289  jcurr = jmax
290 C
291  2400 CONTINUE
292  kr = kr + 1
293  kra = kr+2
294  kc = kc+kca
295  kta = mod(jcurr,10)
296  ktb = mod(jcurr,100)/10
297  ktc = mod(jcurr,1000)/100
298  IF (kr .EQ. 1 .OR. (.NOT. lcntr)) GO TO 2500
299  GO TO 2600
300  2500 CONTINUE
301  IF (linate.EQ.1) WRITE (output,8300)
302  IF (linate.EQ.2) WRITE (output,8400)
303  2600 CONTINUE
304  klines(2) = khplus
305  klines(1) = khblnk
306  IF (jcurr.LT.0) klines(2)=khmns
307  kta=iabs(kta)
308  ktb=iabs(ktb)
309  ktc = iabs(ktc)
310  IF (ktc .EQ. 0) GO TO 2700
311  klines(3) = khtbl(ktc+1)
312  klines(4) = khtbl(ktb+1)
313  klines(5) = khtbl(kta+1)
314  GO TO 2800
315 C
316  2700 CONTINUE
317  klines(3) = khtbl(ktb+1)
318  klines(4) = khtbl(kta+1)
319  klines(5) = khblnk
320 C
321  2800 CONTINUE
322  DO 2900 j = 6,mxpg
323  klines(j) = khblnk
324  2900 CONTINUE
325  IF (.NOT.done) GO TO 3000
326 C *** DO RIGHT J-LABELS IF LAST PAGE OF MAP
327  kline(lmr) = klines(2)
328  kline(lmr+1) = klines(3)
329  kline(lmr+2) = klines(4)
330  kline(lmr+3) = klines(5)
331 C *** FETCH AND CONVERT GRID VALUES TO A1 FORMAT FOR WHOLE LINE
332  3000 CONTINUE
333  krx = krloc(kr)
334  klx = 5*pgfst+1
335  IF (pgcnt.EQ.0) GO TO 4000
336  DO 3800 kk = 1,pgcnt
337  temp = rdata(krx)*cnst(2)+a
338  ktemp = abs(temp)+.5
339  kline(klx) = khplus
340  IF (temp.LT.0.0) kline(klx) = khmns
341  GO TO (3300,3200,3100),nodig
342  3100 CONTINUE
343  kta = mod(ktemp,10000)/1000
344 C
345  3200 CONTINUE
346  ktb = mod(ktemp,1000)/100
347 C
348  3300 CONTINUE
349  ktc = mod(ktemp,100)/10
350  ktd = mod(ktemp,10)
351  GO TO (3400,3500,3600),nodig
352  3400 CONTINUE
353  kline(klx+1) = khtbl(ktc+1)
354  kline(klx+2) = khtbl(ktd+1)
355  GO TO 3700
356  3500 CONTINUE
357  kline(klx+1) = khtbl(ktb+1)
358  kline(klx+2) = khtbl(ktc+1)
359  kline(klx+3) = khtbl(ktd+1)
360  GO TO 3700
361  3600 CONTINUE
362  kline(klx+1) = khtbl(kta+1)
363  kline(klx+2) = khtbl(ktb+1)
364  kline(klx+3) = khtbl(ktc+1)
365  kline(klx+4) = khtbl(ktd+1)
366  3700 CONTINUE
367  klx = klx + 5
368  krx = krx+1
369  3800 CONTINUE
370 C *** FOLLOWING CHECKS FOR POLE POINT AND INSERTS PROPER CHARACTER.
371  IF (jcurr.NE.0) GO TO 4000
372  IF (imin.LT.(-25).OR.imin.GT.0) GO TO 4000
373  kx = -imin
374  IF (kx.LT.pgfst.AND.kx.GT.pgcnt+pgfst) GO TO 4000
375  kx = 5*kx
376  IF (kline(kx+1).EQ.khmns) GO TO 3900
377  kline(kx) = khdolr
378  GO TO 4000
379  3900 CONTINUE
380  kline(kx+1) = khastr
381 C *** PRINT LINE OF MAP DATA
382  4000 CONTINUE
383  WRITE (output,8500) (klines(ii),ii=1,mxpg)
384  krloc(kr) = krx
385  jcurr = jcurr - 1
386 C *** TEST BOTTOM OF MAP
387  IF (kr.EQ.nrws) GO TO 5700
388 C *** SET UP CONTOUR DATA AND PAGE LIMITERS FOR NEXT ROW
389  assign 4100 to kbr
390  GO TO 5900
391 C
392  4100 CONTINUE
393  IF (.NOT.lcntr) GO TO 2400
394 C *** DO CONTOURING
395  DO 4200 jj=1,mxpg
396  klines(jj)=khblnk
397  4200 CONTINUE
398 C *** VERTICAL INTERPOLATIONS
399  DO 4700 kk = 1,pagn3
400  IF (rwb(kk).LT.crmx.AND.rwc(kk).LT.crmx) GO TO 4300
401  vdjb(kk) = crmx
402  vdjc(kk) = crmx
403  GO TO 4600
404  4300 CONTINUE
405  IF (rwa(kk).LT.crmx.AND.rwd(kk).LT.crmx) GO TO 4400
406  vdjc(kk) = 0.
407  GO TO 4500
408  4400 CONTINUE
409  vdjc(kk) = r32*(rwa(kk)+rwd(kk)-rwb(kk)-rwc(kk))
410  4500 CONTINUE
411  vdjb(kk) = r4*(rwc(kk)-rwb(kk)-con2*vdjc(kk))
412  4600 CONTINUE
413  vdja(kk)=rwb(kk)
414  4700 CONTINUE
415 C ...DO 2 OR 3 ROWS OF CONTOURING BETWEEN GRID ROWS...
416  DO 5600 ll = 1,nbtwn
417  DO 4800 kk = 1,pagn3
418  vdjb(kk) = vdjc(kk) + vdjb(kk)
419  vdja(kk) = vdjb(kk) + vdja(kk)
420  4800 CONTINUE
421 C ...WHERE VDJA HAS THE INTERPOLATED VALUE FOR THIS INTER-ROW
422 C *** HORIZONTAL INTERPOLATIONS
423  hdc = 0.0
424  IF (vdja(1).GE.crmx) GO TO 4900
425  hdc = r50*(vdja(4)+vdja(1)-vdja(2)-vdja(3))
426  4900 CONTINUE
427  kxb = 0
428  DO 5200 kk = 1,pgmax
429  IF (vdja(kk+1).GE.crmx) GO TO 5100
430  hda = vdja(kk+1)
431  IF (vdja(kk+2).GE.crmx) GO TO 5500
432  IF (vdja(kk+3).GE.crmx) hdc = 0.
433  hdb = r5*(vdja(kk+2)-vdja(kk+1)-15.*hdc)
434 C *** COMPUTE AND STORE CONTOUR CHARACTERS, 5 PER POINT
435  khda=hda
436  kdb = iabs(mod(khda,kcow))
437  kline(kxb+1) = kalph(kdb+1)
438  DO 5000 jj=2,5
439  hdb = hdb+hdc
440  hda = hda+hdb
441  khda = hda
442  kdb = iabs(mod(khda,kcow))
443  kxa = kxb+jj
444  kline(kxa) = kalph(kdb+1)
445  5000 CONTINUE
446  hdc = r50*(vdja(kk+4)+vdja(kk+1)-vdja(kk+2)-vdja(kk+3))
447  IF (vdja(kk+4).GE.crmx) hdc = 0.
448  5100 CONTINUE
449  kxb = kxb+5
450  5200 CONTINUE
451  5300 CONTINUE
452  WRITE (output,8500) (klines(ii),ii=1,mxpg)
453  DO 5400 kk = 1,mxpg
454  klines(kk) = khblnk
455  5400 CONTINUE
456  GO TO 5600
457 C
458  5500 CONTINUE
459  khda = hda
460  kdb = iabs(mod(khda,kcow))
461  kline(kxb+1) = kalph(kdb+1)
462  GO TO 5300
463  5600 CONTINUE
464  GO TO 2400
465 C
466  5700 CONTINUE
467  IF (linate.EQ.1) WRITE (output,8300)
468  IF (linate.EQ.2) WRITE (output,8400)
469  klines(1) = khblnk
470 C *** PRINT I-LABELS ACROSS BOTTOM OF PAGE
471  assign 5800 to kbr
472  GO TO 6900
473 C
474  5800 CONTINUE
475  IF (linate.EQ.1) WRITE (output,8300)
476  IF (linate.EQ.2) WRITE (output,8400)
477 C *** PRINT TITLE
478  WRITE (output,8600) (title(ii),ii=1,lw)
479 C *** TEST END OF MAP
480  IF (krloc(kclmx).EQ.kcmx) RETURN
481 C *** ADJUST PAGE LINE BOUNDARIES
482 C
483  IF (imax.GT.pgmax)imax = imax-pgmax
484  imin = ka
485  pagnl = pagnl + pgmax
486  pagnr = pagnr + pgmax
487  GO TO 1700
488 C *** ROUTINE TO PRE-STORE ROWS FOR CONTOURING AND COMPUTE LINE LIMITERS
489 C
490  5900 CONTINUE
491  pgfst = pgfsta
492  pgcnt = pgcnta
493  IF (kra.GT.nrws) GO TO 6800
494  krfst = ktbl(kc)-kza
495  krcnt = ktbl(kc+1)
496  kfx = krloc(kra)
497  IF (rect) GO TO 6100
498  IF (krfst-pagnl.LE.(-1)) GO TO 6400
499  pcfst = krfst-pagnl+1
500  IF (pcfst.GE.pagn3) GO TO 6700
501  pgfsta = pcfst-1
502  pccnt = min(pagnr-krfst+2,krcnt)
503  IF (pgfsta.EQ.0) GO TO 6600
504  pgcnta = min(pagnr-krfst,krcnt)
505  IF (pgcnta.GT.0) GO TO 6000
506  pgcnta = 0
507  GO TO 6100
508  6000 CONTINUE
509  rect = krect.EQ.1.AND.pgcnta.LE.krcnt
510  6100 CONTINUE
511  IF (.NOT.lcntr) GO TO kbr,(1800,2100,2200,4100,5800)
512  DO 6200 kk = 1,pagn3
513  rwa(kk) = rwb(kk)
514  rwb(kk) = rwc(kk)
515  rwc(kk) = rwd(kk)
516  rwd(kk) = crmx
517  6200 CONTINUE
518 C
519  IF (pccnt.EQ.0) GO TO kbr,(1800,2100,2200,4100,5800)
520  kpc = pcfst+1
521  kpd = pccnt
522  DO 6300 kk = 1,pccnt
523  rwd(kpc) = rdata(kfx)*bc+adc
524  kfx = kfx+1
525  kpc = kpc + 1
526  6300 CONTINUE
527  GO TO kbr,(1800,2100,2200,4100,5800)
528 C
529  6400 CONTINUE
530  pcfst = 0
531  pgfsta = 0
532  kfx = kfx-1
533  pccnt = krfst+krcnt-pagnl+1
534  IF (pccnt.LT.pagn3) GO TO 6500
535  pccnt = pagn3
536  pgcnta = pgmax
537  GO TO 6100
538  6500 CONTINUE
539  IF (pccnt.GT.0) GO TO 6600
540  pgcnta = 0
541  pccnt = 0
542  GO TO 6100
543 C
544  6600 CONTINUE
545  pgcnta = min(pgmax,krcnt+krfst-pagnl)
546  GO TO 6100
547 C
548  6700 CONTINUE
549  pgcnta = 0
550  6800 CONTINUE
551  pccnt = 0
552  GO TO 6100
553 C
554 C *** ROUTINE TO PRINT I-LABELS
555 C
556  6900 CONTINUE
557  DO 7000 kk = 2,mxpg
558  klines(kk) = khblnk
559  7000 CONTINUE
560 C
561 C
562  kk = 1
563  ka = imin
564  lbl = min(imax,pgmax)
565 C
566  DO 7300 jj = 1,lbl
567  kline(kk) = khplus
568  IF (ka.LT.0) kline(kk) = khmns
569  kta = iabs(mod(ka,100))/10
570  ktb = iabs(mod(ka,10))
571  ktc = iabs(mod(ka,1000))/100
572  IF (ktc .EQ. 0) GO TO 7100
573  kline(kk+1) = khtbl(ktc+1)
574  kline(kk+2) = khtbl(kta+1)
575  kline(kk+3) = khtbl(ktb+1)
576  GO TO 7200
577 C
578  7100 CONTINUE
579  kline(kk+1) = khtbl(kta+1)
580  kline(kk+2) = khtbl(ktb+1)
581 C
582  7200 CONTINUE
583  kk = kk + 5
584  ka = ka+1
585  7300 CONTINUE
586 C
587  WRITE (output,8500) (klines(ii),ii=1,mxpg)
588 C
589  GO TO kbr,(1800,2100,2200,4100,5800)
590 C
591  7400 RETURN
592 C
593  END
w3fp05
subroutine w3fp05(RDATA, KTBL, CNST, TITLE, KRECT, KCONTR, LINEV, IWIDTH)
Prints a two-dimensional grid of any shape, with contouring, if desired.
Definition: w3fp05.f:38