Philippe 23/02/2016: lfi2cdf: modif for JPHEXT/=1
[MNH-git_open_source-lfs.git] / LIBTOOLS / tools / diachro / src / POS / ficstr.f
1 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
2 C AVRIL 2002 
3 C Ces routines ne sont presentes que pour les streamlines pour
4 C augmenter la dimension d'1 tableau 750 -> 1500
5 ccccc Intervention perso dans 2 routines des streamlines (Fin du fichier)
6 C ce parametre existe aussi ds stinit.f ou je suis intervenue
7 C Intervention totale ds stumxy.f
8 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
9 C
10 C       $Id$
11 C
12       BLOCK DATA STDATA
13 C
14 C This routine defines the default values of the Streamline parameters.
15 C
16 C ---------------------------------------------------------------------
17 C
18 C NOTE:
19 C Since implicit typing is used for all real and integer variables
20 C a consistent length convention has been adopted to help clarify the
21 C significance of the variables encountered in the code for this 
22 C utility. All local variable and subroutine parameter identifiers 
23 C are limited to 1,2,or 3 characters. Four character names identify  
24 C members of common blocks. Five and 6 character variable names 
25 C denote PARAMETER constants or subroutine or function names.
26 C
27 C Declare the ST common blocks.
28 C
29       PARAMETER (IPLVLS = 64)
30 C
31 C Integer and real common block variables
32 C
33 C
34       COMMON / STPAR /
35      +                IUD1       ,IVD1       ,IPD1       ,
36      +                IXD1       ,IXDM       ,IYD1       ,IYDN       ,
37      +                IXM1       ,IYM1       ,IXM2       ,IYM2       ,
38      +                IWKD       ,IWKU       ,ISET       ,IERR       ,
39      +                IXIN       ,IYIN       ,IMSK       ,ICPM       ,
40      +                NLVL       ,IPAI       ,ICTV       ,WDLV       ,
41      +                UVMN       ,UVMX       ,PMIN       ,PMAX       ,
42      +                ITHN       ,IPLR       ,ISST       ,
43      +                ICLR(IPLVLS)           ,TVLU(IPLVLS)
44 C
45       COMMON / STTRAN /
46      +                UVPS       ,
47      +                UVPL       ,UVPR       ,UVPB       ,UVPT       ,
48      +                UWDL       ,UWDR       ,UWDB       ,UWDT       ,
49      +                UXC1       ,UXCM       ,UYC1       ,UYCN 
50 C
51 C Stream algorithm parameters
52 C
53       COMMON / STSTRM /
54      +                ISGD       ,IAGD       ,RARL       ,ICKP       ,
55      +                ICKX       ,ITRP       ,ICYK       ,RVNL       ,
56      +                ISVF       ,RUSV       ,RVSV       ,RNDA       ,
57      +                ISPC       ,RPSV       ,RCDS       ,RSSP       ,
58      +                RDFM       ,RSMD       ,RAMD       ,IGBS
59 C
60 C Text related parameters
61 C Note: graphical text output is not yet implemented for the
62 C       Streamline utility.
63 C
64       COMMON / STTXP /
65      +                FCWM    ,ICSZ    ,
66      +                FMNS    ,FMNX    ,FMNY    ,IMNP    ,IMNC  ,
67      +                FMXS    ,FMXX    ,FMXY    ,IMXP    ,IMXC  ,
68      +                FZFS    ,FZFX    ,FZFY    ,IZFP    ,IZFC  ,
69      +                FILS    ,FILX    ,FILY    ,IILP    ,IILC 
70 C
71 C Character variable declartions
72 C
73       CHARACTER*160 CSTR
74       PARAMETER (IPCHSZ=80)
75       CHARACTER*(IPCHSZ)  CMNT,CMXT,CZFT,CILT
76 C
77 C Text string parameters
78 C
79       COMMON / STCHAR / CSTR,CMNT,CMXT,CZFT,CILT
80 C
81       SAVE /STPAR/, /STTRAN/, /STSTRM/, /STTXP/, /STCHAR/
82 C
83 C Internal buffer lengths
84 C
85 C IPNPTS - Number of points in the point buffer -- not less than 3
86 C IPLSTL - Streamline-crossover-check circular list length
87 C IPGRCT - Number of groups supported for area masking
88 C
89       PARAMETER (IPNPTS = 256, IPLSTL = 1500, IPGRCT = 64)
90 c     PARAMETER (IPNPTS = 256, IPLSTL = 750, IPGRCT = 64)
91 C
92 C --------------------------------------------------------------------
93 C
94 C The mapping common block: made available to user mapping routines
95 C
96       COMMON /STMAP/
97      +                IMAP       ,LNLG       ,INVX       ,INVY       ,
98      +                XLOV       ,XHIV       ,YLOV       ,YHIV       ,
99      +                WXMN       ,WXMX       ,WYMN       ,WYMX       ,
100      +                XVPL       ,XVPR       ,YVPB       ,YVPT       ,
101      +                XGDS       ,YGDS       ,NXCT       ,NYCT       ,
102      +                ITRT       ,FW2W       ,FH2H       ,
103      +                DFMG       ,VNML       ,RBIG       ,IBIG
104 C
105       SAVE /STMAP/
106 C
107 C Math constants
108 C
109       PARAMETER (PDTOR  = 0.017453292519943,
110      +           PRTOD  = 57.2957795130823,
111      +           P1XPI  = 3.14159265358979,
112      +           P2XPI  = 6.28318530717959,
113      +           P1D2PI = 1.57079632679489,
114      +           P5D2PI = 7.85398163397448) 
115 C
116 C ---------------------------------------------------------------------
117 C Old STRMLN interface common blocks
118 C
119       COMMON /STR02/  EXT , SIDE , XLT , YBT
120 C
121       COMMON /STR03/  INITA , INITB , AROWL , ITERP , ITERC , IGFLG
122      +             ,  IMSG , UVMSG , ICYC , DISPL , DISPC , CSTOP
123 C
124 C ---------------------------------------------------------------------
125 C
126 C Initialization of STPAR
127 C
128 C IUD1 -- 'UD1' -- First dimension of U
129 C
130       DATA     IUD1 / -1 /
131 C
132 C IVD1 -- 'VD1' -- First dimension of V
133 C
134       DATA     IVD1 / -1 /
135 C
136 C IPD1 -- 'PD1' -- First dimension of P
137 C
138       DATA     IPD1 / -1 /
139 C
140 C IXD1 -- 'XD1' -- Array index for start of data, first dimension
141 C
142       DATA     IXD1 / 1 /
143 C
144 C IXDM -- 'XDM' -- Array index for end of data, first dimension
145 C
146       DATA     IXDM / -1 /
147 C
148 C IYD1 -- 'YD1' -- Array index for start of data, second dimension
149 C
150       DATA     IYD1 / 1 /
151 C   
152 C IYDN -- 'YDN' -- Array index for end of data, second dimension
153 C
154       DATA     IYDN / -1 /
155 C
156 C IWKD -- 'WKD' -- Dimension of work array
157 C
158       DATA     IWKD / -1 /
159 C
160 C IWKU -- 'WKU' -- Amount of work array actually used (read-only)
161 C
162       DATA     IWKU / 0 /
163 C
164 C ISET -- 'SET' -- The Set call flag - Old NSET parameter
165 C
166       DATA     ISET / 1 /
167 C
168 C IERR -- 'ERR' -- Error code set by STRMLN (read-only)
169 C                  -101 - Cyclic flag set for non-cyclic data
170 C
171       DATA     IERR / 0 /
172 C
173 C
174 C IXIN -- 'XIN' -- The X Axis grid increment, must be > 0
175 C IYIN -- 'YIN' -- The Y Axis grid increment, must be > 0
176 C
177       DATA IXIN / 1 /
178       DATA IYIN / 1 /
179 C
180 C IXM1 -- (IXDM - 1) (not user accessible)
181 C IXM2 -- (IXDM - 2) (not user accessible)
182 C IYM1 -- (IYDN - 1) (not user accessible)
183 C IYM2 -- (IYDN - 2) (not user accessible)
184 C
185 C IMSK -- 'MSK' -- Mask streamlines to an area map: <1 -- no mapping,
186 C                  >=1 - mapping;
187 C
188       DATA IMSK / 0 /
189 C
190 C ICPM -- 'CPM' -- the compatibility mode. If >0 the FX,FY,
191 C                  functions are used. Additionally, when
192 C                  used in conjunction with the STRMLN routine, 
193 C                  has a meaningful range from -4 to +4 inclusive,
194 C                  where various combinations are allowed to use or
195 C                  ignore 1) the optional input parameters to
196 C                  VELVCT, 2) the data in STR01,STR02,STR03,STR04
197 C                  common, 3) FX, etc routines, as follows:
198 C
199 C                  -4: no FX, ignore params, ignore old common data
200 C                  -3: no FX, ignore params, use old common data
201 C                  -2: no FX, use params, ignore old common data
202 C                  -1: no FX, use params, use old common data
203 C                   0: default, same as -4 if STINIT,STREAM called,
204 C                      same as +1 if STRMLN or EZSTRM called
205 C                  +1: FX, use params, use old common data
206 C                  +2: FX, use params, ignore old common data
207 C                  +3: FX, ignore params, use old common data
208 C                  +4: FX, ignore params, ignore old common data
209 C
210 C                  FX means using FX,FY
211 C                  When parameters and common block values are
212 C                  used they override any values set using the
213 C                  STSETx routines
214 C
215       DATA ICPM / 0 /
216 C
217 C NLVL -- 'NLV' -- number of distinct colors to use for the
218 C                    independent variable mapping -- cannot exceed
219 C                    IPLVLS -- default: 16
220 C                    
221       DATA  NLVL /  0 /
222 C
223 C IPAI -- 'PAI' -- the current level -- must be set before 
224 C                   modifying an internal level array value
225 C
226       DATA   IPAI /   1     /
227 C
228 C ICTV -- 'CTV' -- compute thresholds flag:
229 C                  0 -- no vector coloring
230 C                  < 0: color vectors by magnitude
231 C                  > 0: color vectors by contents of scalar array P
232 C                  +-1: number of levels and threshold values already
233 C                       set
234 C                  >1,<1: use CTV equally spaced levels
235 C
236       DATA  ICTV /   0     /
237 C
238 C WDLV -- 'LWD' -- the width of a streamline
239
240       DATA  WDLV /   1.0   /
241 C
242 C UVMN -- 'VMN' -- the minimum displayed vector magnitude, read-only
243 C UVMX -- 'VMX' -- the maximum displayed vector magnitude, read-only
244 C PMIN -- 'PMN' -- the minimum scalar array value, read-only
245 C PMAX -- 'PMX' -- the maximum scalar array value, read-only
246 C
247       DATA UVMN / 0.0 /
248       DATA UVMX / 0.0 /
249       DATA PMIN / 0.0 /
250       DATA PMAX / 0.0 /
251 C
252 C ITHN -- 'THN' -- streamline thinning flag
253 C
254       DATA ITHN / 0 /
255 C
256 C IPLR -- 'PLR' -- Polar coordinates for UV array flag
257 C
258       DATA IPLR / 0 /
259 C
260 C ISST -- 'SST' -- Streamline statistics flag
261 C
262       DATA ISST / 0 /
263 C
264 C ICLR -- 'CLR' -- the GKS color index value
265 C
266       DATA  ICLR / IPLVLS * 1 /
267 C
268 C TVLU -- 'TVL' -- the list of threshold values
269 C
270       DATA  TVLU / IPLVLS * 0.0 /
271 C
272 C End of STPAR intialization
273 C
274 C --------------------------------------------------------------------
275 C
276 C STTRAN initialization 
277 C
278 C User coordinate system to viewport, UV array to user coordinates
279 C
280 C UVPS -- 'VPS' -- The viewport mode
281 C
282       DATA UVPS / 0.25 /
283 C
284 C UVPL -- 'VPL' -- Viewport left
285 C
286       DATA UVPL / 0.05 /
287 C
288 C UVPR -- 'VPR' -- Viewport right
289 C
290       DATA UVPR / 0.95 /
291 C
292 C UVPB -- 'VPB' -- Viewport bottom
293 C
294       DATA UVPB / 0.05 /
295 C
296 C UVPT -- 'VPT' -- Viewport top
297 C
298       DATA UVPT / 0.95 /
299 C
300 C UWDL -- 'WDL' -- Window left
301 C
302       DATA UWDL / 0.0 /
303 C
304 C UWDR -- 'WDR' -- Window right
305 C
306       DATA UWDR / 0.0 /
307 C
308 C UWDB -- 'WDB' -- Window bottom
309 C
310       DATA UWDB / 0.0 /
311 C
312 C UWDT -- 'WDT' -- Window top
313 C
314       DATA UWDT / 0.0 /
315 C
316 C UXC1 -- 'XC1' -- minimum X coord
317 C
318       DATA UXC1 / 0.0 /
319 C
320 C UXCM -- 'XCM' -- maximum Y coord
321 C
322       DATA UXCM / 0.0 /
323 C
324 C UYC1 -- 'YC1' -- minimum Y coord
325 C
326       DATA UYC1 / 0.0 /
327 C
328 C UYCN -- 'YCN' -- maximum Y coord
329 C
330       DATA UYCN / 0.0 /
331 C
332 C End of STTRAN
333 C ----------------------------------------------------------------------
334 C
335 C STSTRM - Parameters affecting the stream processing algorithm
336 C
337 C ISGD -- 'SGD' - Stream starting grid increment (INITA)
338 C
339       DATA ISGD / 2 /
340 C
341 C IAGD -- 'AGD' - Arrow placement grid increment (INITB)
342 C
343       DATA IAGD / 2 /
344 C
345 C RARL -- 'ARL' - Length of one side of arrow as fraction 
346 C                 of the viewport width (replaces AROWL)
347 C
348       DATA RARL / 0.012 /
349 C
350 C ICKP -- 'CKP' - Check progress after this many iterations (ITERP)
351 C
352       DATA ICKP / 35 /
353 C
354 C ICKX -- 'CKX' - Check streamline crossover after this many 
355 C                 iterations (ITERC). (If negative crossover is 
356 C                 checked at each entrance to a new grid cell)
357 C
358       DATA ICKX / -99 /
359 C
360 C ITRP -- 'TRP' - Interpolaton method (IGFLG)
361 C                 0 - Use 16 point bessel where possible
362 C                 non 0 - use bi-linear interpolation everywhere
363 C
364       DATA ITRP / 0 /
365 C
366 C ICYK -- 'CYK' - Cyclical data flag (ICYC) If non-zero, instructs
367 C                 the utility to use cyclic interpolation formulas.
368 C                 If set and data is non-cyclic the error flag is set.
369 C
370       DATA ICYK / 0 /
371 C
372 C RVNL -- 'VNL' - Normalization factor for the differential magnitude.
373 C                 This controls number of steps in compatibility mode
374 C                 only when the FX,FY mapping routines are used. See 
375 C                 parameter 'DFM' for step control when STMPXY and
376 C                 associated routines are used
377 C
378       DATA RVNL / 0.33 /
379 C
380 C ISVF -- 'SVF' - Special value flag  (IMSG)
381 C                 0 - no special values
382 C                 non 0 - there may be special values, use only
383 C                         bi-linear interpolation
384       DATA ISVF / 0 /
385 C
386 C RUSV -- 'USV' -- The U array special value (UVMSG)
387 C
388       DATA RUSV / 1.0E12 /
389 C
390 C RVSV -- 'VSV' -- The V array special value (UVMSG)
391 C
392       DATA RVSV / 1.0E12 /
393 C
394 C RNDA -- assigned the NDC value of the arrow size.
395 C
396 C ISPC -- 'SPC' -- Special color -- 
397 C                      < 0: no P special value
398 C                      = 0: don't draw streamline that has a P spec val
399 C                      > 0: draw P special values using color SPC
400 C
401       DATA ISPC / -1 /
402 C
403 C RPSV -- 'PSV' -- The P array special value
404
405       DATA RPSV / 1.0E12 /
406 C
407 C RCDS -- 'CDS' - The critical displacement as a multiple of 'DFM'.
408 C                 Replaces DISPC. If the streamline has not moved
409 C                 CDS*DFM units in NDC space after ICKP iterations,
410 C                 the streamline is terminated
411 C
412       DATA RCDS / 2.0 /
413 C
414 C RSSP -- 'SSP' - Stream spacing value as a fraction of the viewport
415 C                 width; replaces CSTOP. Checked when a new grid box is
416 C                 entered.
417 C
418       DATA RSSP / 0.015 /
419 C
420 C RDFM -- 'DFM' - Differential magnitude as a fraction of the viewport
421 C                 width. Smaller values result in more steps and a more
422 C                 accurate approximation of the streamline.
423 C
424       DATA RDFM / 0.02 /
425 C
426 C RSMD -- 'SMD' - Streamline minimum distance as a fraction of the 
427 C                 viewport width.
428 C
429       DATA RSMD / 0.0 /
430 C
431 C RAMD -- 'AMD' - Arrow minimum distance as a fraction of the 
432 C                 viewport width.
433 C
434       DATA RAMD / 0.0 /
435 C
436 C IGBS -- 'GBS' - Grid based spacing flag
437 C
438       DATA IGBS / 0 /
439 C
440 C End of STSTRM
441 C --------------------------------------------------------------------
442 C
443 C STTXP - Text parameters 
444 C
445 C ICCM -- internal - maximum length of character strings
446 C
447       DATA ICSZ / IPCHSZ /
448 C
449 C FZFS -- 'ZFS' -- size of text for zero field string as FVPW
450 C FZFX -- 'ZFX' -- X position of zero field string as FVPW
451 C FZFY -- 'ZFY' -- Y position of zero field string as FVPW
452 C IZFP -- 'ZFP' -- zero field string position flag
453 C IZFC -- 'ZFC' -- color of text for zero field label
454
455       DATA FZFS / 0.033 /
456       DATA FZFX / 0.5 /
457       DATA FZFY / 0.5 /
458       DATA IZFP / 0 /
459       DATA IZFC / -1 /
460 C
461 C ---------------------------------------------------------------------
462 C
463 C Beginning of STCHAR initialization
464 C
465       DATA CZFT / 'ZERO FIELD' /
466 C
467 C End of STCHAR initialization
468 C
469 C
470 C ---------------------------------------------------------------------
471 C
472 C STMAP initialization
473 C
474 C IMAP -- 'MAP' -- the mapping transformation to use
475 C
476       DATA  IMAP / 0 /
477 C
478 C ITRT -- 'TRT' -- Transform type flag: 
479 C                      0  - transform position only
480 C                      1  - transform position and angle
481 C                     -1  - transform position, angle, and magnitude
482 C
483       DATA ITRT / 1 /
484 C
485 C XVPL,XVPT,YVPB,YVPT -- the viewport values (NDC boundaries)
486 C
487 C WXMN,WXMX,WYMN,WYMX -- the window minimum and maximum values
488 C                        (User coordinate space)
489 C
490 C XLOV,XHIV,YLOV,YHIV -- the mapped array endpoint values
491 C                        (Data coordinate space)
492 C
493 C XGDS,YGDS -- size in data coordinates of a grid box
494 C
495 C NXCT,NYCT -- number of points in X and Y used for the plot
496 C
497 C DFMG -- The magnitude of the diffential increment in NDC space
498 C
499 C LNLG -- the log scale mapping flag from SET call
500 C
501 C INVX,INVY -- inverse flags for the window boundaries
502 C
503 C IWCT - unused
504 C
505 C FW2W,FH2H -- fraction of viewport to fraction of viewspace
506 C
507 C RBIG,IBIG -- maximum expressible real and integer values
508 C
509 C ---------------------------------------------------------------------
510 C
511 C STRMLN compatibility common blocks
512 C
513 C Beginning of STR02 initialization
514 C
515       DATA EXT  / 0.25 /
516       DATA SIDE / 0.90  /
517       DATA XLT  / 0.05 /
518       DATA YBT  / 0.05 /
519 C
520 C End of STR02 initialization
521 C
522 C Beginning of STR03 initialization
523 C
524       DATA INITA  / 2 /
525       DATA INITB  / 2  /
526       DATA AROWL  / 0.33 /
527       DATA ITERP  / 35 /
528       DATA ITERC  / -99 /
529       DATA IGFLG  / 0 /
530       DATA ICYC   / 0 /
531       DATA IMSG   / 0 /
532       DATA UVMSG  / 1.E+36 /
533       DATA DISPL  / 0.33 /
534       DATA DISPC  / 0.67 /
535       DATA CSTOP  / 0.50 /
536 C
537 C End of STR03 initialization
538 C
539       END
540 C
541 C       $Id$
542 C
543       SUBROUTINE STDRAW  (U,V,UX,VY,IAM,STUMSL)
544 C
545 C This routine draws the streamlines.
546 C
547       DIMENSION  U(IUD1,*)             ,V(IVD1,*)
548       DIMENSION  UX(IXDM,IYDN)         ,VY(IXDM,IYDN)
549       DIMENSION  IAM(*)
550       EXTERNAL STUMSL
551 C
552 C Input parameters:
553 C
554 C U,V    - Vector component arrays
555 C UX,UY  - Work arrays
556 C IAM    - Mask array
557 C STUMSL - User-defined masked streamline drawing routine
558 C
559 C The work array has been broken up into two arrays for clarity.  The
560 C top half of WORK (called UX) will have the normalized (and
561 C possibly transformed) U components and will be used for book
562 C keeping.  the lower half of the WORK array (called VY) will
563 C contain the normalized (and possibly transformed) V components.
564 C
565 C ---------------------------------------------------------------------
566 C
567 C NOTE:
568 C Since implicit typing is used for all real and integer variables
569 C a consistent length convention has been adopted to help clarify the
570 C significance of the variables encountered in the code for this 
571 C utility. All local variable and subroutine parameter identifiers 
572 C are limited to 1,2,or 3 characters. Four character names identify  
573 C members of common blocks. Five and 6 character variable names 
574 C denote PARAMETER constants or subroutine or function names.
575 C
576 C Declare the ST common blocks.
577 C
578       PARAMETER (IPLVLS = 64)
579 C
580 C Integer and real common block variables
581 C
582 C
583       COMMON / STPAR /
584      +                IUD1       ,IVD1       ,IPD1       ,
585      +                IXD1       ,IXDM       ,IYD1       ,IYDN       ,
586      +                IXM1       ,IYM1       ,IXM2       ,IYM2       ,
587      +                IWKD       ,IWKU       ,ISET       ,IERR       ,
588      +                IXIN       ,IYIN       ,IMSK       ,ICPM       ,
589      +                NLVL       ,IPAI       ,ICTV       ,WDLV       ,
590      +                UVMN       ,UVMX       ,PMIN       ,PMAX       ,
591      +                ITHN       ,IPLR       ,ISST       ,
592      +                ICLR(IPLVLS)           ,TVLU(IPLVLS)
593 C
594       COMMON / STTRAN /
595      +                UVPS       ,
596      +                UVPL       ,UVPR       ,UVPB       ,UVPT       ,
597      +                UWDL       ,UWDR       ,UWDB       ,UWDT       ,
598      +                UXC1       ,UXCM       ,UYC1       ,UYCN 
599 C
600 C Stream algorithm parameters
601 C
602       COMMON / STSTRM /
603      +                ISGD       ,IAGD       ,RARL       ,ICKP       ,
604      +                ICKX       ,ITRP       ,ICYK       ,RVNL       ,
605      +                ISVF       ,RUSV       ,RVSV       ,RNDA       ,
606      +                ISPC       ,RPSV       ,RCDS       ,RSSP       ,
607      +                RDFM       ,RSMD       ,RAMD       ,IGBS
608 C
609 C Text related parameters
610 C Note: graphical text output is not yet implemented for the
611 C       Streamline utility.
612 C
613       COMMON / STTXP /
614      +                FCWM    ,ICSZ    ,
615      +                FMNS    ,FMNX    ,FMNY    ,IMNP    ,IMNC  ,
616      +                FMXS    ,FMXX    ,FMXY    ,IMXP    ,IMXC  ,
617      +                FZFS    ,FZFX    ,FZFY    ,IZFP    ,IZFC  ,
618      +                FILS    ,FILX    ,FILY    ,IILP    ,IILC 
619 C
620 C Character variable declartions
621 C
622       CHARACTER*160 CSTR
623       PARAMETER (IPCHSZ=80)
624       CHARACTER*(IPCHSZ)  CMNT,CMXT,CZFT,CILT
625 C
626 C Text string parameters
627 C
628       COMMON / STCHAR / CSTR,CMNT,CMXT,CZFT,CILT
629 C
630       SAVE /STPAR/, /STTRAN/, /STSTRM/, /STTXP/, /STCHAR/
631 C
632 C Internal buffer lengths
633 C
634 C IPNPTS - Number of points in the point buffer -- not less than 3
635 C IPLSTL - Streamline-crossover-check circular list length
636 C IPGRCT - Number of groups supported for area masking
637 C
638       PARAMETER (IPNPTS = 256, IPLSTL = 1500, IPGRCT = 64)
639 c     PARAMETER (IPNPTS = 256, IPLSTL = 750, IPGRCT = 64)
640 C
641 C --------------------------------------------------------------------
642 C
643 C The mapping common block: made available to user mapping routines
644 C
645       COMMON /STMAP/
646      +                IMAP       ,LNLG       ,INVX       ,INVY       ,
647      +                XLOV       ,XHIV       ,YLOV       ,YHIV       ,
648      +                WXMN       ,WXMX       ,WYMN       ,WYMX       ,
649      +                XVPL       ,XVPR       ,YVPB       ,YVPT       ,
650      +                XGDS       ,YGDS       ,NXCT       ,NYCT       ,
651      +                ITRT       ,FW2W       ,FH2H       ,
652      +                DFMG       ,VNML       ,RBIG       ,IBIG
653 C
654       SAVE /STMAP/
655 C
656 C Math constants
657 C
658       PARAMETER (PDTOR  = 0.017453292519943,
659      +           PRTOD  = 57.2957795130823,
660      +           P1XPI  = 3.14159265358979,
661      +           P2XPI  = 6.28318530717959,
662      +           P1D2PI = 1.57079632679489,
663      +           P5D2PI = 7.85398163397448) 
664 C
665 C ---------------------------------------------------------------------
666 C
667 C Local declarations
668 C
669 C Point and list buffers
670 C
671 C The XLS and YLS arrays serve as a circular list. they
672 C are used to prevent lines from crossing one another.
673 C
674       DIMENSION PX(IPNPTS), PY(IPNPTS)
675       DIMENSION XLS(IPLSTL), YLS(IPLSTL)
676 C
677 C Parameters:
678 C
679 C IPZERO, IPONE, IPTWO - the numbers 0,1,2
680 C PRZERO - the number 0.0
681 C PTHREE - the number 3.0
682 C PSMALL - a small floating point number, large enough to be 
683 C          detectable by any standard processor
684 C PMXITR - maximum iteration count for figuring when determining
685 C          the streamline edge
686 C
687       PARAMETER (IPZERO=0, IPONE=1, IPTWO=2, PRZERO=0.0, PTHREE=3.0)
688       PARAMETER (PSMALL=0.000001, PMXITR=32)
689 C
690 C Local variables
691 C
692 C VSM      - A small value in comparison to the normalized vector mag.
693 C ISK      - Number of bits to skip in bit routines
694 C IS1      - ISK + 1
695 C SSP      - Stream spacing value in fractional (ND) coordinates
696 C CDS      - Critical displacement in fractional (ND) coordinates
697 C LCT      - Count of streamlines drawn
698 C ITO      - Total number of points used to draw all the streamlines
699 C LCU      - Amount of list currently in use
700 C LCK      - Current list index
701 C IDR      - drawing direction 0 + direction 1 - direction
702 C SGN      - multiplier to change sign based on drawing direction
703 C IPC      - number of points currently in the point buffer
704 C ICT      - count of iterations in current streamline
705 C I,J      - Grid indices
706 C UIJ,VIJ  - individual vector components
707 C CVF      - component-wise vector normalizing factor
708 C LST      - flag indicating the last point in a streamline
709 C IUX      - integer storage for retrieved bits
710 C ISV, JSV - saved grid indices where stream starts in + direction
711 C NBX      - count of grid boxes for current streamline
712 C LBC      - box checking variable
713 C X, Y     - current X,Y coordinates (grid coordinates
714 C DU, DV   - Current normalized interpolated vector components
715 C XDA, YDA - Current position in data coordinates
716 C XUS, YUS - Current position in user coordinates
717 C XND, YND - Current position in NDC space
718 C XNS, YNS - value of XND and YND saved at the start of the streamline 
719 C                           and after each progress check
720 C XN1, YN1 - Previous position in NDC space
721 C TA       - The tangent angle in NDC space
722 C DUV      - The differential normalized interpolated vector magnitude
723 C CSA,SNA  - Cosine and sine of the tangent angle
724 C XN2,YN2  - The previous previous position in NDC space
725 C TMG      - Temporary magnitude 
726 C XT,YT    - Temporary x and y values
727 C XU1,YU1  - Previous X and Y user coordinate values
728 C NCT      - Iteration count for determining the streamline edge
729 C LI       - Index into circular crossover checking list
730 C IZO      - Zero field flag
731 C
732 C --------------------------------------------------------------------
733 C
734 C Initialize local variables.
735 C
736 C Bit manipulation values
737 C
738 c     print *,' ++entree STDRAW'
739       VSM = R1MACH(3)*VNML
740       ISK = I1MACH(5) - 2
741       IS1 = ISK + 1
742 C
743 C Stream spacing (setting depends on whether grid relative sizing is
744 C in effect) and critical displacement
745 C
746       IF (IGBS.EQ.0) THEN
747          SSP=RSSP*FW2W
748       ELSE
749          SSP=RSSP*FW2W/REAL(IXDM)
750       END IF
751       CDS=RCDS*DFMG
752       SMD=RSMD*FW2W
753       AMD=RAMD*FW2W
754 C
755 C Stream and arrow counters
756 C
757       LCT=0
758       ITO=0
759       IAC=0
760 C
761 C Crossover list variables
762 C
763       LCU = 1
764       LCK = 1
765       XLS(1) = 0.0
766       YLS(1) = 0.0
767 C
768 C Current streamline variables
769 C
770       IDR = 0
771       SGN = 1.0
772       IPC = 0
773       ICT = 0
774       IUC = 0
775       JSV = IYD1
776 C
777 C
778 C Compute the X and Y normalized (and possibly transformed)
779 C displacement components (UX and VY).
780 C
781       IZO = 1
782       DO  40 J=IYD1,IYDN
783          DO  30 I=IXD1,IXDM
784 C
785             CALL STMPUV(U(I,J),V(I,J),UIJ,VIJ,IST)
786             IF (UIJ.NE.0. .OR. VIJ.NE.0.) THEN
787                IZO = 0
788                CVF = VNML/SQRT(UIJ*UIJ + VIJ*VIJ)
789                UIJ = CVF*UIJ
790                VIJ = CVF*VIJ
791             END IF
792 C
793 C Bookkeeping is done in the least significant bits of the UX array.
794 C When UIJ is exactly zero this can present some problems.
795 C To get around this problem, set it to a relatively small number.
796 C
797             IF (UIJ.EQ.0.0) UIJ = VSM
798 C
799 C Mask out the least significant two bits as flags for each grid box
800 C A grid box is any region surrounded by four grid points.
801 C Flag 1 indicates whether any streamline has previously passed
802 C through this box.
803 C Flag 2 indicates whether any directional arrow has already
804 C appeared in this box.
805 C Judicious use of these flags prevents overcrowding of
806 C streamlines and directional arrows.
807 C
808             CALL SBYTES(UIJ,IPZERO,ISK,2,0,1)
809 C
810             IF (MOD(I,ISGD).NE.0 .OR. MOD(J,ISGD).NE.0) THEN
811                CALL SBYTES(UIJ,IPONE,IS1,1,0,1)
812             END IF
813             IF (MOD(I,IAGD).NE.0 .OR. MOD(J,IAGD).NE.0) THEN
814                CALL SBYTES(UIJ,IPONE,ISK,1,0,1)
815             END IF
816 C
817             UX(I,J) = UIJ
818             VY(I,J) = VIJ
819 C
820  30      CONTINUE
821  40   CONTINUE
822 C
823 C If Zero field bail out
824 C
825       IF (IZO .EQ. 1) THEN
826          LCT = 0
827          ITO = 0
828          GO TO 190
829       END IF
830 C
831 C
832 C Start a streamline. Experience has shown that a pleasing picture
833 C will be produced if new streamlines are started only in grid
834 C boxes that previously have not had other streamlines pass through
835 C them. As long as a reasonably dense pattern of available boxes
836 C is initially prescribed, the order of scanning the grid pts. for
837 C available boxes is immaterial.
838 C
839  50   CONTINUE
840 C
841 C First ensure that the point buffer is clear
842 C
843       IF (IPC.GT.1) CALL STLNSG(PX,PY,IPC,IAM,STUMSL)
844 C
845       LST=0
846 C
847 C Find an available box for starting a streamline.
848 C
849       IF (IDR .EQ. 0) THEN
850 C
851          LCT=LCT+1
852          ITO = ITO+ICT
853          ICT = 0
854          DO  70 J=JSV,IYM1
855             DO  60 I=IXD1,IXM1
856                CALL GBYTES(UX(I,J),IUX,ISK,2,0,1)
857                IF (IAND(IUX,IPONE) .EQ. IPZERO) GO TO 80
858  60         CONTINUE
859  70      CONTINUE
860 C
861 C Must be no available boxes for starting a streamline.
862 C This is the final exit from the streamline drawing loop
863 C
864          GO TO 190
865 C
866  80      CONTINUE
867 C
868 C Initialize parameters for starting a streamline.
869 C Turn the box off for starting a streamline.
870 C If the special value parameter is turned on, check to see if 
871 C this box has missing data. If so, find a new starting box.
872 C
873          CALL SBYTES(UX(I,J),IPONE,IS1,1,0,1)
874          IF (ISVF .NE. 0) THEN
875             CALL STSVCK(U,V,I,J,IST)
876             IF (IST .NE. 0) GO TO 50
877          END IF
878 C
879          ISV = I
880          JSV = J
881          IDR = 1
882          SGN = +1.0
883          IUC = 0
884          DST = 0.0
885 C
886       ELSE
887 C
888 C Come to here to draw in the opposite direction
889 C
890          IDR = 0
891          SGN = -1.
892          I = ISV
893          J = JSV
894          DST = 0.0
895          ITO = ITO+ICT
896       END IF
897 C
898 C Initiate the drawing sequence, resetting counters.
899 C Start all streamlines in the center of a box.
900 C Find the initial normalized interpolated vector components.
901 C
902       NBX = 0
903       IF (IDR.NE.0) LBC = LCK+1
904       IF (LBC.GT.IPLSTL) LBC = 1
905       X = FLOAT(I)+0.5
906       Y = FLOAT(J)+0.5
907       CALL  STDUDV(UX,VY,I,J,X,Y,DU,DV)
908       XDA=XLOV+(X-1.0)*XGDS
909       YDA=YLOV+(Y-1.0)*YGDS
910       DU=DU*SGN
911       DV=DV*SGN
912 C
913 C Get initial point in the various coordinate systems
914 C and the tangent angle of the stream. If the compatibility flag
915 C is positive the FX,FY routines must be used.
916 C
917       IF (ICPM.LE.0) THEN
918 C
919          XDA=XLOV+(X-1.0)*XGDS
920          YDA=YLOV+(Y-1.0)*YGDS
921          CALL HLUSTMPXY(XDA,YDA,XUS,YUS,IST)
922          IF (IST .LT. 0) GO TO 50
923          XND=CUFX(XUS)
924          YND=CUFY(YUS)
925          XN1=XND
926          YN1=YND
927          CALL HLUSTMPTA(XDA,YDA,XUS,YUS,XND,YND,DU,DV,TA,IST)
928          IF (IST .LT. 0) GO TO 50
929 C
930       ELSE
931 C
932          XUS=FX(X,Y)
933          IF (XUS.LT.WXMN .OR. XUS.GT.WXMX) GO TO 50 
934          YUS=FY(X,Y)
935          IF (YUS.LT.WYMN .OR. YUS.GT.WYMX) GO TO 50 
936          XND=CUFX(XUS)
937          YND=CUFY(YUS)
938          TA=ATAN2(DV,DU)
939 C
940       END IF
941 C
942       XNS=XND
943       YNS=YND
944       ICT=1
945       IPC=1
946       PX(IPC)=XUS
947       PY(IPC)=YUS
948 C      
949 C Check grid box directional arrow eligibility
950 C If a minimum arrow distance is set then the first arrow is not drawn
951 C
952       IF (AMD.LE.0.0) THEN
953          CALL GBYTES(UX(I,J),IUX,ISK,2,0,1)
954 C
955          IF (IDR.NE.0 .AND. IAND(IUX,IPTWO).EQ.0) THEN
956             IAC=IAC+1
957             CALL STARDR(XUS,YUS,XND,YND,TA,IAM,STUMSL,IST)
958             IF (IST.EQ.0) THEN
959                CALL SBYTES(UX(I,J),IPONE,ISK,1,0,1)
960             END IF
961 C
962          END IF
963       END IF
964 C
965       ADS = 0.0
966 C
967 C Loop to this point until streamline ends
968 C
969  110  CONTINUE
970 C
971 C Check to see if the streamline has entered a new grid box.
972 C
973       IF (I.EQ.IFIX(X) .AND. J.EQ.IFIX(Y)) THEN
974 C
975 C Must be in same box --  Clear the point buffer if required
976 C
977          IF (IPC .EQ. IPNPTS) THEN
978 c           print *,' IPC IPNPTS ',IPC,IPNPTS
979             CALL STLNSG(PX,PY,IPNPTS,IAM,STUMSL)
980             PX(1)=PX(IPNPTS)
981             PY(1)=PY(IPNPTS)
982             IPC=1
983          ENDIF
984 C
985 C Determine the interpolated normalized vector at this point
986 C
987          CALL STDUDV (UX,VY,I,J,X,Y,DU,DV)
988          IF (DU.EQ.0.0 .AND. DV.EQ.0.0) GO TO 50
989 C
990 C Processing diverges depending on the compatibility mode
991 C
992          IF (ICPM .LE. 0) THEN
993 C
994 C Get the tangent angle of the streamline at the current point
995 C in NDC space
996 C
997             CALL HLUSTMPTA(XDA,YDA,XUS,YUS,XND,YND,DU,DV,TA,IST)
998             IF (IST.NE.0) GO TO 50
999 ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
1000             IF (XUS.LT.WXMN .OR. XUS.GT.WXMX) GO TO 50
1001             IF (YUS.LT.WYMN .OR. YUS.GT.WYMX) GO TO 50
1002 ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
1003 C            
1004          ELSE
1005 C
1006 C A new point is found in grid space, then transformed into
1007 C user and NDC space. There is no transformation of the tangent
1008 C angle.
1009             X=X+SGN*DU
1010             Y=Y+SGN*DV
1011             XUS=FX(X,Y)
1012             IF (XUS.LT.WXMN .OR. XUS.GT.WXMX) GO TO 50 
1013             YUS=FY(X,Y)
1014             IF (YUS.LT.WYMN .OR. YUS.GT.WYMX) GO TO 50 
1015             XND=CUFX(XUS)
1016             YND=CUFY(YUS)
1017             TA=ATAN2(DV,DU)
1018 C
1019          END IF
1020 C
1021 C Count the point and add it to the point buffer
1022 C
1023          ICT=ICT+1
1024          IPC=IPC+1
1025          PX(IPC)=XUS
1026          PY(IPC)=YUS
1027 C
1028          IF (ICPM.LT.1) THEN
1029 C
1030             IF (LST .EQ. 1) GO TO 50
1031 C
1032 C The increment in NDC space needs to be proportional to the
1033 C magnitude of the interpolated vector, in order to ensure that
1034 C progress checking works at points of convergence or divergence.
1035 C The square enhances the effectiveness of the technique.
1036 C
1037             DUV=(DU*DU+DV*DV)/(VNML*VNML)
1038             CSA=COS(TA)*SGN
1039             SNA=SIN(TA)*SGN
1040 C
1041 C The current point is adjusted one third of the distance back to
1042 C the previous point. Empirically, in most cases, this seems to
1043 C decrease the inaccuracy resulting from the use of a finite valued
1044 C differential step.
1045 C
1046             XN2=XN1
1047             YN2=YN1
1048             XN1=XND+(XN2-XND)/PTHREE
1049             YN1=YND+(YN2-YND)/PTHREE
1050             XND=XN1+CSA*DFMG*DUV
1051             YND=YN1+SNA*DFMG*DUV
1052             XD = XND - XN1
1053             YD = YND - YN1
1054             DST = DST + SQRT(XD*XD+YD*YD)
1055 C
1056 C If the increment takes the line outside the viewport, find an
1057 C interpolated point on the grid edge. Set a flag indicating
1058 C the end of the stream
1059 C
1060             IF (XND .LT. XVPL) THEN
1061                XND = XVPL
1062                IF (ABS(CSA).GT.0.1) THEN
1063                   TMG = (XND-XN1)/CSA
1064                   YND = YN1+SNA*TMG
1065                ENDIF
1066                LST = 1
1067             ELSE IF (XND .GT. XVPR) THEN
1068                XND = XVPR
1069                IF (ABS(CSA).GT.0.1) THEN
1070                   TMG = (XND-XN1)/CSA
1071                   YND = YN1+SNA*TMG
1072                ENDIF
1073                LST = 1
1074             ELSE IF (YND .LT. YVPB) THEN
1075                YND = YVPB
1076                IF (ABS(SNA).GT.0.1) THEN
1077                   TMG = (YND-YN1)/SNA
1078                   XND = XN1+CSA*TMG
1079                END IF
1080                LST = 1
1081             ELSE IF (YND .GT. YVPT) THEN
1082                YND = YVPT
1083                IF (ABS(SNA).GT.0.1) THEN
1084                   TMG = (YND-YN1)/SNA
1085                   XND = XN1+CSA*TMG
1086                END IF
1087                LST = 1
1088             END IF
1089 C
1090 C Now that the new point has been found in NDC space, find its
1091 C coordinates in user, data, and grid space.
1092 C
1093             XU1=XUS
1094             YU1=YUS
1095             XUS=CFUX(XND)
1096             YUS=CFUY(YND)
1097 C
1098 C Even if the point is within NDC and User boundaries it can still be 
1099 C outside the data area. In this case we use an iterative technique to
1100 C determine the end of the streamline.
1101 C
1102             CALL HLUSTIMXY(XUS,YUS,XDA,YDA,IST)
1103             IF (IST.GE.0) THEN
1104                X=(XDA-XLOV)/XGDS+1.0
1105                Y=(YDA-YLOV)/YGDS+1.0
1106             ELSE
1107                NCT=1
1108 C
1109 C Loop to this point dividing the distance in half at each step
1110 C
1111  120           CONTINUE
1112                XT=XU1+(XUS-XU1)/2.0
1113                YT=YU1+(YUS-YU1)/2.0
1114                IF (NCT.GE.PMXITR) GO TO 50
1115                IF (ABS(XUS-XU1).LE.PSMALL .AND. 
1116      +              ABS(YUS-YU1).LE.PSMALL) THEN
1117                   XUS=XU1
1118                   YUS=YU1
1119                   CALL HLUSTIMXY(XUS,YUS,XDA,YDA,IST)
1120                   IF (IST.LT.0) GO TO 50
1121                ELSE
1122                   CALL HLUSTIMXY(XT,YT,XDA,YDA,IST)
1123                   NCT=NCT+1
1124                   IF (IST.LT.0) THEN
1125                      XUS=XT
1126                      YUS=YT
1127                   ELSE
1128                      XU1=XT
1129                      YU1=YT
1130                   END IF
1131                   GO TO 120
1132                END IF
1133 C
1134                XND=CUFX(XUS)
1135                YND=CUFY(YUS)
1136                LST=1
1137             END IF
1138 C
1139 C
1140 C If on the top or right edge of the grid space, decrease the X and/or
1141 C Y value by a small amount so the interpolation routine still works.
1142 C
1143             IF (IFIX(X).GE.IXDM) X=FLOAT(IXDM)-PSMALL
1144             IF (IFIX(Y).GE.IYDN) Y=FLOAT(IYDN)-PSMALL
1145 C
1146          END IF
1147 C
1148 C Check streamline progress every 'ICKP' iterations.
1149 C
1150          IF (MOD(ICT,ICKP).EQ.0) THEN
1151             IF (ABS(XND-XNS).LT.CDS 
1152      +           .AND. ABS(YND-YNS).LT.CDS) THEN
1153                GO TO 50
1154             END IF
1155             XNS=XND
1156             YNS=YND
1157          END IF
1158 C
1159 C If the circular list does not need to be checked for
1160 C streamline crossover, return to the top of the main loop.
1161 C
1162          IF (ICKX.LT.0 .OR. MOD(ICT,ICKX).NE.0) GO TO 110
1163 C
1164       ELSE
1165 C
1166 C Must have entered a new grid box  check for the following :
1167 C (1) Are the new points on the grid?
1168 C (2) Check for missing data if msg data flag (ISVF) has been set.
1169 C (3) Is this box eligible for a directional arrow?
1170 C (4) Location of this entry versus other streamline entries
1171 C
1172          I = IFIX(X)
1173          J = IFIX(Y)
1174          NBX = NBX+1
1175 C
1176 C Check (1) (Only performed in compatibility mode)
1177 C
1178          IF (ICPM.GT.0) THEN
1179             IF (I.LT.IXD1 .OR. I.GT.IXM1 
1180      +           .OR. J.LT.IYD1 .OR. J.GT.IYM1) THEN
1181                GO TO  50
1182             END IF
1183          END IF
1184 C
1185 C Check (2)
1186 C
1187          IF (ISVF.NE.0) THEN
1188             CALL STSVCK(U,V,I,J,IST)
1189             IF (IST .NE. 0) GO TO 50
1190          END IF
1191 C
1192 C Check (3) -- postpone actually drawing the arrow until after the 
1193 C crossover check, if crossover detected the arrow will not be drawn.
1194 C
1195          IDA = 0
1196          CALL GBYTES(UX(I,J),IUX,ISK,2,0,1)
1197          IF (IAND(IUX,IPTWO) .EQ. 0) THEN
1198             IF (DST-ADS .GT. AMD) THEN
1199                ADS = DST
1200                IDA = 1
1201             END IF
1202          END IF
1203 C
1204       END IF
1205 C
1206 C Check (4) (performed any time streamline crossover is checked)
1207 C
1208       DO 140 LI=1,LCU
1209          IF (ABS(XND-XLS(LI)) .LE. SSP .AND.
1210      +        ABS(YND-YLS(LI)) .LE. SSP) THEN
1211             IF (LBC.LE.LCK .AND.
1212      +           (LI.LT.LBC .OR. LI.GT.LCK)) THEN
1213                GO TO 50
1214             ELSE IF (LBC.GT.LCK .AND. 
1215      +              (LI.LT.LBC .AND. LI.GT.LCK)) THEN
1216                GO TO 50
1217             END IF
1218          END IF
1219  140  CONTINUE
1220 C
1221       LCU = MIN0(LCU+1,IPLSTL)
1222       LCK = LCK+1
1223 c     IF (LCK.GT.IPLSTL)print *,'***attention LCK= ',IPLSTL
1224       IF (LCK.GT.IPLSTL) LCK = 1
1225       XLS(LCK) = XND
1226       YLS(LCK) = YND
1227       CALL SBYTES(UX(I,J),IPONE,IS1,1,0,1)
1228       IF (NBX.GE.5) THEN
1229          LBC = LBC+1
1230          IF (LBC.GT.IPLSTL) LBC = 1
1231       END IF
1232 C
1233       IF (IDA.EQ.1) THEN
1234          CALL STARDR(XUS,YUS,XND,YND,TA,IAM,STUMSL,IST)
1235          IAC = IAC + 1
1236          IF (IST .EQ. 0) THEN
1237             CALL SBYTES(UX(I,J),IPONE,ISK,1,0,1)
1238          END IF
1239          IDA = 0
1240       END IF
1241
1242 C
1243 C Return to top of drawing loop
1244 C
1245       GO TO 110
1246 C
1247 C
1248 C Final exit
1249 C
1250   190 CONTINUE
1251 C
1252       IF (IZO .EQ. 1) THEN
1253          CALL STZERO
1254       END IF
1255 C
1256 C Plot statistics
1257 C
1258       IF (ISST.EQ.1) THEN
1259          LUN=I1MACH(2)
1260          WRITE(LUN,*) 'STREAM Statistics'
1261          WRITE(LUN,*) '                Streamlines plotted:',LCT
1262          WRITE(LUN,*) '      Total differential step count:',ITO
1263          WRITE(LUN,*) ' '
1264       END IF
1265 C
1266 C Set the workspace used parameter
1267 C
1268       IWKU = 2*IXDM*IYDN
1269 C
1270       RETURN
1271       END
1272 C
1273 C ---------------------------------------------------------------------
1274 C
1275       SUBROUTINE STARDR(XUS,YUS,XND,YND,TA,IAM,STUMSL,IST)
1276 C
1277 C This routine draws the arrow. Calculations are in fractional
1278 C coordinates to ensure uniform arrows irrespective of the 
1279 C mapping in effect.
1280 C A small fraction of the differential change is used to find the
1281 C tangent angle at the current position. Once the angle is known the
1282 C arrow can be drawn at a fixed size independent of the mapping
1283 C routine currently employed.
1284 C
1285 C Input parameters:
1286 C
1287 C XUS,YUS - current position in user space
1288 C XND,YND - current position in NDC space
1289 C TA    - Angle in NDC
1290 C IAM   - Area mask array
1291 C STUMSL - User defined masked streamline drawing routine
1292 C
1293 C Output parameters:
1294 C
1295 C IST - Status code, indicates success or failure
1296 C
1297       DIMENSION  IAM(*)
1298       EXTERNAL STUMSL
1299 C
1300 C ---------------------------------------------------------------------
1301 C
1302 C NOTE:
1303 C Since implicit typing is used for all real and integer variables
1304 C a consistent length convention has been adopted to help clarify the
1305 C significance of the variables encountered in the code for this 
1306 C utility. All local variable and subroutine parameter identifiers 
1307 C are limited to 1,2,or 3 characters. Four character names identify  
1308 C members of common blocks. Five and 6 character variable names 
1309 C denote PARAMETER constants or subroutine or function names.
1310 C
1311 C Declare the ST common blocks.
1312 C
1313       PARAMETER (IPLVLS = 64)
1314 C
1315 C Integer and real common block variables
1316 C
1317 C
1318       COMMON / STPAR /
1319      +                IUD1       ,IVD1       ,IPD1       ,
1320      +                IXD1       ,IXDM       ,IYD1       ,IYDN       ,
1321      +                IXM1       ,IYM1       ,IXM2       ,IYM2       ,
1322      +                IWKD       ,IWKU       ,ISET       ,IERR       ,
1323      +                IXIN       ,IYIN       ,IMSK       ,ICPM       ,
1324      +                NLVL       ,IPAI       ,ICTV       ,WDLV       ,
1325      +                UVMN       ,UVMX       ,PMIN       ,PMAX       ,
1326      +                ITHN       ,IPLR       ,ISST       ,
1327      +                ICLR(IPLVLS)           ,TVLU(IPLVLS)
1328 C
1329       COMMON / STTRAN /
1330      +                UVPS       ,
1331      +                UVPL       ,UVPR       ,UVPB       ,UVPT       ,
1332      +                UWDL       ,UWDR       ,UWDB       ,UWDT       ,
1333      +                UXC1       ,UXCM       ,UYC1       ,UYCN 
1334 C
1335 C Stream algorithm parameters
1336 C
1337       COMMON / STSTRM /
1338      +                ISGD       ,IAGD       ,RARL       ,ICKP       ,
1339      +                ICKX       ,ITRP       ,ICYK       ,RVNL       ,
1340      +                ISVF       ,RUSV       ,RVSV       ,RNDA       ,
1341      +                ISPC       ,RPSV       ,RCDS       ,RSSP       ,
1342      +                RDFM       ,RSMD       ,RAMD       ,IGBS
1343 C
1344 C Text related parameters
1345 C Note: graphical text output is not yet implemented for the
1346 C       Streamline utility.
1347 C
1348       COMMON / STTXP /
1349      +                FCWM    ,ICSZ    ,
1350      +                FMNS    ,FMNX    ,FMNY    ,IMNP    ,IMNC  ,
1351      +                FMXS    ,FMXX    ,FMXY    ,IMXP    ,IMXC  ,
1352      +                FZFS    ,FZFX    ,FZFY    ,IZFP    ,IZFC  ,
1353      +                FILS    ,FILX    ,FILY    ,IILP    ,IILC 
1354 C
1355 C Character variable declartions
1356 C
1357       CHARACTER*160 CSTR
1358       PARAMETER (IPCHSZ=80)
1359       CHARACTER*(IPCHSZ)  CMNT,CMXT,CZFT,CILT
1360 C
1361 C Text string parameters
1362 C
1363       COMMON / STCHAR / CSTR,CMNT,CMXT,CZFT,CILT
1364 C
1365       SAVE /STPAR/, /STTRAN/, /STSTRM/, /STTXP/, /STCHAR/
1366 C
1367 C Internal buffer lengths
1368 C
1369 C IPNPTS - Number of points in the point buffer -- not less than 3
1370 C IPLSTL - Streamline-crossover-check circular list length
1371 C IPGRCT - Number of groups supported for area masking
1372 C
1373       PARAMETER (IPNPTS = 256, IPLSTL = 1500, IPGRCT = 64)
1374 c     PARAMETER (IPNPTS = 256, IPLSTL = 750, IPGRCT = 64)
1375 C
1376 C --------------------------------------------------------------------
1377 C
1378 C The mapping common block: made available to user mapping routines
1379 C
1380       COMMON /STMAP/
1381      +                IMAP       ,LNLG       ,INVX       ,INVY       ,
1382      +                XLOV       ,XHIV       ,YLOV       ,YHIV       ,
1383      +                WXMN       ,WXMX       ,WYMN       ,WYMX       ,
1384      +                XVPL       ,XVPR       ,YVPB       ,YVPT       ,
1385      +                XGDS       ,YGDS       ,NXCT       ,NYCT       ,
1386      +                ITRT       ,FW2W       ,FH2H       ,
1387      +                DFMG       ,VNML       ,RBIG       ,IBIG
1388 C
1389       SAVE /STMAP/
1390 C
1391 C Math constants
1392 C
1393       PARAMETER (PDTOR  = 0.017453292519943,
1394      +           PRTOD  = 57.2957795130823,
1395      +           P1XPI  = 3.14159265358979,
1396      +           P2XPI  = 6.28318530717959,
1397      +           P1D2PI = 1.57079632679489,
1398      +           P5D2PI = 7.85398163397448) 
1399 C
1400 C ---------------------------------------------------------------------
1401 C
1402 C Point buffers
1403 C
1404       DIMENSION AX(3), AY(3)
1405 C
1406 C Local variables
1407 C
1408 C AX, AY   - Arrow head point buffers
1409 C DXW, DYW - Change in X,Y in window coordinates
1410 C XF, YF   - Arrow head position in the fractional system
1411 C DXF,DYF  - Incremental change in the fractional system
1412 C PHI      - Tangent angle
1413 C K        - Loop index and sign factor for each edge of the arrow
1414 C KK       - Index for the arrow head array, within the loop
1415 C D30      - Half the angle of the point of the arrow head (about 30 o)
1416 C XX,YY    - Ends of the arrow in window coordinates
1417 C
1418 C Parameters:
1419 C
1420 C PHFANG - Half the angle of the arrow head (0.5 in radians is 
1421 C          approximately equivalent to 30 degrees)
1422 C PLWFCT - Linewidth factor, arrow size is increased by this 
1423 C          much when the linewidth is greater than 1.0
1424
1425       PARAMETER (PHFANG=0.5, PLWFCT=0.15)
1426 C
1427 C ---------------------------------------------------------------------
1428 C
1429 c     print *,' ++entree STARDR'
1430       IST=0
1431 C
1432       AX(2) = XUS
1433       AY(2) = YUS
1434       FLW = 1.0 + PLWFCT*MAX(0.0,WDLV-1.0)
1435 C
1436       DO 10 K = -1,1,2
1437 C
1438 C K serves as a sign determining factor; KK indexes the point array.
1439 C
1440          KK=K+2
1441          D30 = -(P1D2PI-TA)+FLOAT(K)*PHFANG
1442          XX = +RNDA*FLW*SIN(D30)+XND
1443          YY = -RNDA*FLW*COS(D30)+YND
1444          AX(KK) = CFUX(XX)
1445          AY(KK) = CFUY(YY)
1446 C
1447  10   CONTINUE
1448 C
1449       CALL STLNSG(AX,AY,3,IAM,STUMSL)
1450       
1451 C
1452 C Done
1453 C
1454       RETURN
1455       END
1456 C
1457 C ---------------------------------------------------------------------
1458 C
1459       SUBROUTINE STLNSG(X,Y,IPC,IAM,STUMSL)
1460 C
1461 C This routine draws a single streamline segment based on the current
1462 C contents of the point buffers. If masking is in effect the area
1463 C line drawing subroutine, ARDRLN is called. Otherwise CURVE is
1464 C invoked. 
1465 C  
1466 C Input parameters:
1467 C
1468 C X,Y - Point arrays
1469 C IPC - Number of points
1470 C IAM   - Area mask array
1471 C STUMSL - User-defined masked streamline drawing routine
1472 C
1473       DIMENSION X(IPC), Y(IPC)
1474       DIMENSION  IAM(*)
1475       EXTERNAL STUMSL
1476 C
1477 C ---------------------------------------------------------------------
1478 C
1479 C NOTE:
1480 C Since implicit typing is used for all real and integer variables
1481 C a consistent length convention has been adopted to help clarify the
1482 C significance of the variables encountered in the code for this 
1483 C utility. All local variable and subroutine parameter identifiers 
1484 C are limited to 1,2,or 3 characters. Four character names identify  
1485 C members of common blocks. Five and 6 character variable names 
1486 C denote PARAMETER constants or subroutine or function names.
1487 C
1488 C Declare the ST common blocks.
1489 C
1490       PARAMETER (IPLVLS = 64)
1491 C
1492 C Integer and real common block variables
1493 C
1494 C
1495       COMMON / STPAR /
1496      +                IUD1       ,IVD1       ,IPD1       ,
1497      +                IXD1       ,IXDM       ,IYD1       ,IYDN       ,
1498      +                IXM1       ,IYM1       ,IXM2       ,IYM2       ,
1499      +                IWKD       ,IWKU       ,ISET       ,IERR       ,
1500      +                IXIN       ,IYIN       ,IMSK       ,ICPM       ,
1501      +                NLVL       ,IPAI       ,ICTV       ,WDLV       ,
1502      +                UVMN       ,UVMX       ,PMIN       ,PMAX       ,
1503      +                ITHN       ,IPLR       ,ISST       ,
1504      +                ICLR(IPLVLS)           ,TVLU(IPLVLS)
1505 C
1506       COMMON / STTRAN /
1507      +                UVPS       ,
1508      +                UVPL       ,UVPR       ,UVPB       ,UVPT       ,
1509      +                UWDL       ,UWDR       ,UWDB       ,UWDT       ,
1510      +                UXC1       ,UXCM       ,UYC1       ,UYCN 
1511 C
1512 C Stream algorithm parameters
1513 C
1514       COMMON / STSTRM /
1515      +                ISGD       ,IAGD       ,RARL       ,ICKP       ,
1516      +                ICKX       ,ITRP       ,ICYK       ,RVNL       ,
1517      +                ISVF       ,RUSV       ,RVSV       ,RNDA       ,
1518      +                ISPC       ,RPSV       ,RCDS       ,RSSP       ,
1519      +                RDFM       ,RSMD       ,RAMD       ,IGBS
1520 C
1521 C Text related parameters
1522 C Note: graphical text output is not yet implemented for the
1523 C       Streamline utility.
1524 C
1525       COMMON / STTXP /
1526      +                FCWM    ,ICSZ    ,
1527      +                FMNS    ,FMNX    ,FMNY    ,IMNP    ,IMNC  ,
1528      +                FMXS    ,FMXX    ,FMXY    ,IMXP    ,IMXC  ,
1529      +                FZFS    ,FZFX    ,FZFY    ,IZFP    ,IZFC  ,
1530      +                FILS    ,FILX    ,FILY    ,IILP    ,IILC 
1531 C
1532 C Character variable declartions
1533 C
1534       CHARACTER*160 CSTR
1535       PARAMETER (IPCHSZ=80)
1536       CHARACTER*(IPCHSZ)  CMNT,CMXT,CZFT,CILT
1537 C
1538 C Text string parameters
1539 C
1540       COMMON / STCHAR / CSTR,CMNT,CMXT,CZFT,CILT
1541 C
1542       SAVE /STPAR/, /STTRAN/, /STSTRM/, /STTXP/, /STCHAR/
1543 C
1544 C Internal buffer lengths
1545 C
1546 C IPNPTS - Number of points in the point buffer -- not less than 3
1547 C IPLSTL - Streamline-crossover-check circular list length
1548 C IPGRCT - Number of groups supported for area masking
1549 C
1550       PARAMETER (IPNPTS = 256, IPLSTL = 1500, IPGRCT = 64)
1551 c     PARAMETER (IPNPTS = 256, IPLSTL = 750, IPGRCT = 64)
1552 C
1553       DIMENSION IAI(IPGRCT),IAG(IPGRCT)
1554       DIMENSION XO(IPNPTS), YO(IPNPTS)
1555 C
1556 C ---------------------------------------------------------------------
1557 C
1558 c     print *,' ++entree STLNSG'
1559       IF (IMSK.LT.1) THEN
1560          CALL CURVE(X,Y,IPC)
1561          CALL SFLUSH
1562       ELSE
1563          CALL ARDRLN(IAM, X, Y, IPC, XO, YO, IPC, 
1564      +        IAI, IAG, IPGRCT, STUMSL)
1565       END IF
1566 C
1567 C Done
1568
1569       RETURN
1570       END
1571 C
1572 C ---------------------------------------------------------------------
1573 C
1574       SUBROUTINE STSVCK(U,V,I,J,IST)
1575 C
1576       DIMENSION  U(IUD1,*), V(IVD1,*)
1577 C
1578 C Checks for special values in the vicinity of I,J
1579 C
1580 C Input parameters
1581 C
1582 C U,V - vector field components array
1583 C I,J - current array position
1584 C
1585 C Output parameters:
1586 C
1587 C IST - status value, 0 if no special values in neighborhood
1588 C
1589 C ---------------------------------------------------------------------
1590 C
1591 C NOTE:
1592 C Since implicit typing is used for all real and integer variables
1593 C a consistent length convention has been adopted to help clarify the
1594 C significance of the variables encountered in the code for this 
1595 C utility. All local variable and subroutine parameter identifiers 
1596 C are limited to 1,2,or 3 characters. Four character names identify  
1597 C members of common blocks. Five and 6 character variable names 
1598 C denote PARAMETER constants or subroutine or function names.
1599 C
1600 C Declare the ST common blocks.
1601 C
1602       PARAMETER (IPLVLS = 64)
1603 C
1604 C Integer and real common block variables
1605 C
1606 C
1607       COMMON / STPAR /
1608      +                IUD1       ,IVD1       ,IPD1       ,
1609      +                IXD1       ,IXDM       ,IYD1       ,IYDN       ,
1610      +                IXM1       ,IYM1       ,IXM2       ,IYM2       ,
1611      +                IWKD       ,IWKU       ,ISET       ,IERR       ,
1612      +                IXIN       ,IYIN       ,IMSK       ,ICPM       ,
1613      +                NLVL       ,IPAI       ,ICTV       ,WDLV       ,
1614      +                UVMN       ,UVMX       ,PMIN       ,PMAX       ,
1615      +                ITHN       ,IPLR       ,ISST       ,
1616      +                ICLR(IPLVLS)           ,TVLU(IPLVLS)
1617 C
1618       COMMON / STTRAN /
1619      +                UVPS       ,
1620      +                UVPL       ,UVPR       ,UVPB       ,UVPT       ,
1621      +                UWDL       ,UWDR       ,UWDB       ,UWDT       ,
1622      +                UXC1       ,UXCM       ,UYC1       ,UYCN 
1623 C
1624 C Stream algorithm parameters
1625 C
1626       COMMON / STSTRM /
1627      +                ISGD       ,IAGD       ,RARL       ,ICKP       ,
1628      +                ICKX       ,ITRP       ,ICYK       ,RVNL       ,
1629      +                ISVF       ,RUSV       ,RVSV       ,RNDA       ,
1630      +                ISPC       ,RPSV       ,RCDS       ,RSSP       ,
1631      +                RDFM       ,RSMD       ,RAMD       ,IGBS
1632 C
1633 C Text related parameters
1634 C Note: graphical text output is not yet implemented for the
1635 C       Streamline utility.
1636 C
1637       COMMON / STTXP /
1638      +                FCWM    ,ICSZ    ,
1639      +                FMNS    ,FMNX    ,FMNY    ,IMNP    ,IMNC  ,
1640      +                FMXS    ,FMXX    ,FMXY    ,IMXP    ,IMXC  ,
1641      +                FZFS    ,FZFX    ,FZFY    ,IZFP    ,IZFC  ,
1642      +                FILS    ,FILX    ,FILY    ,IILP    ,IILC 
1643 C
1644 C Character variable declartions
1645 C
1646       CHARACTER*160 CSTR
1647       PARAMETER (IPCHSZ=80)
1648       CHARACTER*(IPCHSZ)  CMNT,CMXT,CZFT,CILT
1649 C
1650 C Text string parameters
1651 C
1652       COMMON / STCHAR / CSTR,CMNT,CMXT,CZFT,CILT
1653 C
1654       SAVE /STPAR/, /STTRAN/, /STSTRM/, /STTXP/, /STCHAR/
1655 C
1656 C Internal buffer lengths
1657 C
1658 C IPNPTS - Number of points in the point buffer -- not less than 3
1659 C IPLSTL - Streamline-crossover-check circular list length
1660 C IPGRCT - Number of groups supported for area masking
1661 C
1662       PARAMETER (IPNPTS = 256, IPLSTL = 1500, IPGRCT = 64)
1663 c     PARAMETER (IPNPTS = 256, IPLSTL = 750, IPGRCT = 64)
1664 C
1665 C ---------------------------------------------------------------------
1666 C
1667 c     print *,' ++entree STSVCK'
1668       IST = 0
1669 C
1670       IF (I.EQ.IXDM .OR. J.EQ.IYDN) THEN
1671          IF (U(I,J).EQ.RUSV) THEN
1672             IST = -1
1673          ELSE IF (V(I,J).EQ.RVSV) THEN
1674             IST = -1
1675          END IF
1676          RETURN
1677       END IF
1678
1679       IF (U(I,J).EQ.RUSV) THEN
1680          IST = -1
1681       ELSE IF (U(I,J+1).EQ.RUSV) THEN
1682          IST = -1
1683       ELSE IF (U(I+1,J).EQ.RUSV) THEN
1684          IST = -1
1685       ELSE IF (U(I+1,J+1).EQ.RUSV) THEN
1686          IST = -1
1687       ELSE IF (V(I,J).EQ.RVSV) THEN
1688          IST = -1
1689       ELSE IF (V(I,J+1).EQ.RVSV) THEN
1690          IST = -1
1691       ELSE IF (V(I+1,J).EQ.RVSV) THEN
1692          IST = -1
1693       ELSE IF (V(I+1,J+1).EQ.RVSV) THEN
1694          IST = -1
1695       END IF
1696 C
1697 C Done
1698 C
1699       RETURN
1700       END
1701 C
1702 C ---------------------------------------------------------------------
1703 C
1704       SUBROUTINE STMPUV(UI,VI,UO,VO,IST)
1705 C
1706 C Maps the U,V vector component values
1707 C
1708 C Input parameters:
1709 C
1710 C UI,VI  - Input values of U,V
1711 C
1712 C     Output parameters:
1713 C
1714 C UO,VO  - Output mapped component values
1715 C IST    - Status value
1716
1717 C ---------------------------------------------------------------------
1718 C
1719 C NOTE:
1720 C Since implicit typing is used for all real and integer variables
1721 C a consistent length convention has been adopted to help clarify the
1722 C significance of the variables encountered in the code for this 
1723 C utility. All local variable and subroutine parameter identifiers 
1724 C are limited to 1,2,or 3 characters. Four character names identify  
1725 C members of common blocks. Five and 6 character variable names 
1726 C denote PARAMETER constants or subroutine or function names.
1727 C
1728 C Declare the ST common blocks.
1729 C
1730       PARAMETER (IPLVLS = 64)
1731 C
1732 C Integer and real common block variables
1733 C
1734 C
1735       COMMON / STPAR /
1736      +                IUD1       ,IVD1       ,IPD1       ,
1737      +                IXD1       ,IXDM       ,IYD1       ,IYDN       ,
1738      +                IXM1       ,IYM1       ,IXM2       ,IYM2       ,
1739      +                IWKD       ,IWKU       ,ISET       ,IERR       ,
1740      +                IXIN       ,IYIN       ,IMSK       ,ICPM       ,
1741      +                NLVL       ,IPAI       ,ICTV       ,WDLV       ,
1742      +                UVMN       ,UVMX       ,PMIN       ,PMAX       ,
1743      +                ITHN       ,IPLR       ,ISST       ,
1744      +                ICLR(IPLVLS)           ,TVLU(IPLVLS)
1745 C
1746       COMMON / STTRAN /
1747      +                UVPS       ,
1748      +                UVPL       ,UVPR       ,UVPB       ,UVPT       ,
1749      +                UWDL       ,UWDR       ,UWDB       ,UWDT       ,
1750      +                UXC1       ,UXCM       ,UYC1       ,UYCN 
1751 C
1752 C Stream algorithm parameters
1753 C
1754       COMMON / STSTRM /
1755      +                ISGD       ,IAGD       ,RARL       ,ICKP       ,
1756      +                ICKX       ,ITRP       ,ICYK       ,RVNL       ,
1757      +                ISVF       ,RUSV       ,RVSV       ,RNDA       ,
1758      +                ISPC       ,RPSV       ,RCDS       ,RSSP       ,
1759      +                RDFM       ,RSMD       ,RAMD       ,IGBS
1760 C
1761 C Text related parameters
1762 C Note: graphical text output is not yet implemented for the
1763 C       Streamline utility.
1764 C
1765       COMMON / STTXP /
1766      +                FCWM    ,ICSZ    ,
1767      +                FMNS    ,FMNX    ,FMNY    ,IMNP    ,IMNC  ,
1768      +                FMXS    ,FMXX    ,FMXY    ,IMXP    ,IMXC  ,
1769      +                FZFS    ,FZFX    ,FZFY    ,IZFP    ,IZFC  ,
1770      +                FILS    ,FILX    ,FILY    ,IILP    ,IILC 
1771 C
1772 C Character variable declartions
1773 C
1774       CHARACTER*160 CSTR
1775       PARAMETER (IPCHSZ=80)
1776       CHARACTER*(IPCHSZ)  CMNT,CMXT,CZFT,CILT
1777 C
1778 C Text string parameters
1779 C
1780       COMMON / STCHAR / CSTR,CMNT,CMXT,CZFT,CILT
1781 C
1782       SAVE /STPAR/, /STTRAN/, /STSTRM/, /STTXP/, /STCHAR/
1783 C
1784 C Internal buffer lengths
1785 C
1786 C IPNPTS - Number of points in the point buffer -- not less than 3
1787 C IPLSTL - Streamline-crossover-check circular list length
1788 C IPGRCT - Number of groups supported for area masking
1789 C
1790       PARAMETER (IPNPTS = 256, IPLSTL = 1500, IPGRCT = 64)
1791 c     PARAMETER (IPNPTS = 256, IPLSTL = 750, IPGRCT = 64)
1792 C
1793 C --------------------------------------------------------------------
1794 C
1795 C The mapping common block: made available to user mapping routines
1796 C
1797       COMMON /STMAP/
1798      +                IMAP       ,LNLG       ,INVX       ,INVY       ,
1799      +                XLOV       ,XHIV       ,YLOV       ,YHIV       ,
1800      +                WXMN       ,WXMX       ,WYMN       ,WYMX       ,
1801      +                XVPL       ,XVPR       ,YVPB       ,YVPT       ,
1802      +                XGDS       ,YGDS       ,NXCT       ,NYCT       ,
1803      +                ITRT       ,FW2W       ,FH2H       ,
1804      +                DFMG       ,VNML       ,RBIG       ,IBIG
1805 C
1806       SAVE /STMAP/
1807 C
1808 C Math constants
1809 C
1810       PARAMETER (PDTOR  = 0.017453292519943,
1811      +           PRTOD  = 57.2957795130823,
1812      +           P1XPI  = 3.14159265358979,
1813      +           P2XPI  = 6.28318530717959,
1814      +           P1D2PI = 1.57079632679489,
1815      +           P5D2PI = 7.85398163397448) 
1816 C
1817 C Statement functions for field tranformations
1818 C
1819       FU(X,Y) = X
1820       FV(X,Y) = Y
1821 C
1822 C ---------------------------------------------------------------------
1823 C
1824 c     print *,' ++entree STMPUV'
1825       IST = 0
1826 C
1827 C Input array polar mode
1828 C
1829       IF (IPLR .LT. 1) THEN
1830          UT=UI
1831          VT=VI
1832       ELSE IF (IPLR .EQ. 1) THEN
1833          UT = UI*COS(PDTOR*VI)
1834          VT = UI*SIN(PDTOR*VI)
1835       ELSE IF (IPLR .GT. 1) THEN
1836          UT = UI*COS(VI)
1837          VT = UI*SIN(VI)
1838       END IF
1839 C
1840 C Allow mapping using FU,FV functions
1841 C
1842       UO = FU(UT,VT)
1843       VO = FV(UT,VT)
1844 C
1845 C Done
1846 C
1847       RETURN
1848       END
1849 C
1850 C ---------------------------------------------------------------------
1851 C
1852       SUBROUTINE STZERO
1853 C
1854 C ---------------------------------------------------------------------
1855 C
1856 C NOTE:
1857 C Since implicit typing is used for all real and integer variables
1858 C a consistent length convention has been adopted to help clarify the
1859 C significance of the variables encountered in the code for this 
1860 C utility. All local variable and subroutine parameter identifiers 
1861 C are limited to 1,2,or 3 characters. Four character names identify  
1862 C members of common blocks. Five and 6 character variable names 
1863 C denote PARAMETER constants or subroutine or function names.
1864 C
1865 C Declare the ST common blocks.
1866 C
1867       PARAMETER (IPLVLS = 64)
1868 C
1869 C Integer and real common block variables
1870 C
1871 C
1872       COMMON / STPAR /
1873      +                IUD1       ,IVD1       ,IPD1       ,
1874      +                IXD1       ,IXDM       ,IYD1       ,IYDN       ,
1875      +                IXM1       ,IYM1       ,IXM2       ,IYM2       ,
1876      +                IWKD       ,IWKU       ,ISET       ,IERR       ,
1877      +                IXIN       ,IYIN       ,IMSK       ,ICPM       ,
1878      +                NLVL       ,IPAI       ,ICTV       ,WDLV       ,
1879      +                UVMN       ,UVMX       ,PMIN       ,PMAX       ,
1880      +                ITHN       ,IPLR       ,ISST       ,
1881      +                ICLR(IPLVLS)           ,TVLU(IPLVLS)
1882 C
1883       COMMON / STTRAN /
1884      +                UVPS       ,
1885      +                UVPL       ,UVPR       ,UVPB       ,UVPT       ,
1886      +                UWDL       ,UWDR       ,UWDB       ,UWDT       ,
1887      +                UXC1       ,UXCM       ,UYC1       ,UYCN 
1888 C
1889 C Stream algorithm parameters
1890 C
1891       COMMON / STSTRM /
1892      +                ISGD       ,IAGD       ,RARL       ,ICKP       ,
1893      +                ICKX       ,ITRP       ,ICYK       ,RVNL       ,
1894      +                ISVF       ,RUSV       ,RVSV       ,RNDA       ,
1895      +                ISPC       ,RPSV       ,RCDS       ,RSSP       ,
1896      +                RDFM       ,RSMD       ,RAMD       ,IGBS
1897 C
1898 C Text related parameters
1899 C Note: graphical text output is not yet implemented for the
1900 C       Streamline utility.
1901 C
1902       COMMON / STTXP /
1903      +                FCWM    ,ICSZ    ,
1904      +                FMNS    ,FMNX    ,FMNY    ,IMNP    ,IMNC  ,
1905      +                FMXS    ,FMXX    ,FMXY    ,IMXP    ,IMXC  ,
1906      +                FZFS    ,FZFX    ,FZFY    ,IZFP    ,IZFC  ,
1907      +                FILS    ,FILX    ,FILY    ,IILP    ,IILC 
1908 C
1909 C Character variable declartions
1910 C
1911       CHARACTER*160 CSTR
1912       PARAMETER (IPCHSZ=80)
1913       CHARACTER*(IPCHSZ)  CMNT,CMXT,CZFT,CILT
1914 C
1915 C Text string parameters
1916 C
1917       COMMON / STCHAR / CSTR,CMNT,CMXT,CZFT,CILT
1918 C
1919       SAVE /STPAR/, /STTRAN/, /STSTRM/, /STTXP/, /STCHAR/
1920 C
1921 C Internal buffer lengths
1922 C
1923 C IPNPTS - Number of points in the point buffer -- not less than 3
1924 C IPLSTL - Streamline-crossover-check circular list length
1925 C IPGRCT - Number of groups supported for area masking
1926 C
1927       PARAMETER (IPNPTS = 256, IPLSTL = 1500, IPGRCT = 64)
1928 c     PARAMETER (IPNPTS = 256, IPLSTL = 750, IPGRCT = 64)
1929 C --------------------------------------------------------------------
1930 C
1931 C The mapping common block: made available to user mapping routines
1932 C
1933       COMMON /STMAP/
1934      +                IMAP       ,LNLG       ,INVX       ,INVY       ,
1935      +                XLOV       ,XHIV       ,YLOV       ,YHIV       ,
1936      +                WXMN       ,WXMX       ,WYMN       ,WYMX       ,
1937      +                XVPL       ,XVPR       ,YVPB       ,YVPT       ,
1938      +                XGDS       ,YGDS       ,NXCT       ,NYCT       ,
1939      +                ITRT       ,FW2W       ,FH2H       ,
1940      +                DFMG       ,VNML       ,RBIG       ,IBIG
1941 C
1942       SAVE /STMAP/
1943 C
1944 C Math constants
1945 C
1946       PARAMETER (PDTOR  = 0.017453292519943,
1947      +           PRTOD  = 57.2957795130823,
1948      +           P1XPI  = 3.14159265358979,
1949      +           P2XPI  = 6.28318530717959,
1950      +           P1D2PI = 1.57079632679489,
1951      +           P5D2PI = 7.85398163397448) 
1952 C
1953 c     print *,' ++entree STZERO'
1954       IF (CZFT(1:1) .EQ. ' ') THEN
1955          RETURN
1956       END IF
1957 C
1958       CALL GQPLCI(IER,IOC)
1959       CALL GQTXCI(IER,IOT)
1960 C
1961 C Turn clipping off and SET to an identity transform
1962 C
1963       CALL GQCLIP(IER,ICL,IAR)
1964       CALL GSCLIP(0)
1965       CALL GETSET(VPL,VPR,VPB,VPT,WDL,WDR,WDB,WDT,ILG)
1966       CALL SET(0.0,1.0,0.0,1.0,0.0,1.0,0.0,1.0,1)
1967 C     
1968       XF = XVPL + FZFX * FW2W
1969       YF = YVPB + FZFY * FH2H
1970       CALL VVTXLN(CZFT,IPCHSZ,IB,IE)
1971       CALL VVTXIQ(CZFT(IB:IE),FZFS*FW2W,W,H)
1972       CALL VVTXPO(IZFP,XF,YF,W,H,XW,YW)
1973       IF (IZFC .GE. 0) THEN
1974          CALL GSTXCI(IZFC)
1975          CALL GSPLCI(IZFC)
1976       ELSE
1977          CALL  GSPLCI(IOT)
1978       END IF
1979 C     
1980       CALL PLCHHQ(XW,YW,CZFT(IB:IE),FZFS*FW2W,0.0,0.0)
1981 C     
1982       CALL GSTXCI(IOT)
1983       CALL GSPLCI(IOC)
1984 C     
1985 C     Restore clipping and the set transformation.
1986 C     
1987       CALL GSCLIP(ICL)
1988       CALL SET(VPL,VPR,VPB,VPT,WDL,WDR,WDB,WDT,ILG)
1989 C
1990 C Done
1991 C
1992       RETURN
1993       END
1994
1995
1996
1997 C
1998 C       $Id$
1999 C
2000       SUBROUTINE STDUDV (UX,VY,I,J,X,Y,DU,DV)
2001 C
2002 C Input parameters:
2003 C
2004 C UX,VY  - the arrays containing normalized vector field data
2005 C I,J    - the current grid indices
2006 C X,Y    - the X,Y position relative to the grid
2007 C
2008 C Output parameters:
2009 C
2010 C DU,DV  - Interpolated value of the vector field components
2011 C          at the specified point 
2012 C
2013 C Interpolation routine to calculate the displacemant components.
2014 C The philosphy here is to utilize as many points as possible
2015 C (within reason) in order to obtain a pleasing and accurate plot.
2016 C Interpolation schemes desired by other users may easily be
2017 C substituted if desired.
2018 C
2019       DIMENSION UX(IXDM,*), VY(IXDM,*)
2020 C
2021 C ---------------------------------------------------------------------
2022 C
2023 C NOTE:
2024 C Since implicit typing is used for all real and integer variables
2025 C a consistent length convention has been adopted to help clarify the
2026 C significance of the variables encountered in the code for this 
2027 C utility. All local variable and subroutine parameter identifiers 
2028 C are limited to 1,2,or 3 characters. Four character names identify  
2029 C members of common blocks. Five and 6 character variable names 
2030 C denote PARAMETER constants or subroutine or function names.
2031 C
2032 C Declare the ST common blocks.
2033 C
2034       PARAMETER (IPLVLS = 64)
2035 C
2036 C Integer and real common block variables
2037 C
2038 C
2039       COMMON / STPAR /
2040      +                IUD1       ,IVD1       ,IPD1       ,
2041      +                IXD1       ,IXDM       ,IYD1       ,IYDN       ,
2042      +                IXM1       ,IYM1       ,IXM2       ,IYM2       ,
2043      +                IWKD       ,IWKU       ,ISET       ,IERR       ,
2044      +                IXIN       ,IYIN       ,IMSK       ,ICPM       ,
2045      +                NLVL       ,IPAI       ,ICTV       ,WDLV       ,
2046      +                UVMN       ,UVMX       ,PMIN       ,PMAX       ,
2047      +                ITHN       ,IPLR       ,ISST       ,
2048      +                ICLR(IPLVLS)           ,TVLU(IPLVLS)
2049 C
2050       COMMON / STTRAN /
2051      +                UVPS       ,
2052      +                UVPL       ,UVPR       ,UVPB       ,UVPT       ,
2053      +                UWDL       ,UWDR       ,UWDB       ,UWDT       ,
2054      +                UXC1       ,UXCM       ,UYC1       ,UYCN 
2055 C
2056 C Stream algorithm parameters
2057 C
2058       COMMON / STSTRM /
2059      +                ISGD       ,IAGD       ,RARL       ,ICKP       ,
2060      +                ICKX       ,ITRP       ,ICYK       ,RVNL       ,
2061      +                ISVF       ,RUSV       ,RVSV       ,RNDA       ,
2062      +                ISPC       ,RPSV       ,RCDS       ,RSSP       ,
2063      +                RDFM       ,RSMD       ,RAMD       ,IGBS
2064 C
2065 C Text related parameters
2066 C Note: graphical text output is not yet implemented for the
2067 C       Streamline utility.
2068 C
2069       COMMON / STTXP /
2070      +                FCWM    ,ICSZ    ,
2071      +                FMNS    ,FMNX    ,FMNY    ,IMNP    ,IMNC  ,
2072      +                FMXS    ,FMXX    ,FMXY    ,IMXP    ,IMXC  ,
2073      +                FZFS    ,FZFX    ,FZFY    ,IZFP    ,IZFC  ,
2074      +                FILS    ,FILX    ,FILY    ,IILP    ,IILC 
2075 C
2076 C Character variable declartions
2077 C
2078       CHARACTER*160 CSTR
2079       PARAMETER (IPCHSZ=80)
2080       CHARACTER*(IPCHSZ)  CMNT,CMXT,CZFT,CILT
2081 C
2082 C Text string parameters
2083 C
2084       COMMON / STCHAR / CSTR,CMNT,CMXT,CZFT,CILT
2085 C
2086       SAVE /STPAR/, /STTRAN/, /STSTRM/, /STTXP/, /STCHAR/
2087 C
2088 C Internal buffer lengths
2089 C
2090 C IPNPTS - Number of points in the point buffer -- not less than 3
2091 C IPLSTL - Streamline-crossover-check circular list length
2092 C IPGRCT - Number of groups supported for area masking
2093 C
2094       PARAMETER (IPNPTS = 256, IPLSTL = 1500, IPGRCT = 64)
2095 c     PARAMETER (IPNPTS = 256, IPLSTL = 750, IPGRCT = 64)
2096 C
2097 C FDLI  - Double linear interpolation formula
2098 C FBESL - Bessel 16 pt interpolation formula ( most used formula )
2099 C FQUAD - Quadratic interpolation formula
2100 C
2101       FDLI(Z,Z1,Z2,Z3,DX,DY) = (1.-DX)*((1.-DY)*Z +DY*Z1)
2102      +                         +     DX *((1.-DY)*Z2+DY*Z3)
2103       FBESL(Z,ZP1,ZP2,ZM1,DZ)=Z+DZ*(ZP1-Z+0.25*(DZ-1.)*((ZP2-ZP1-Z+ZM1)
2104      +                        +0.666667*(DZ-0.5)*(ZP2-3.*ZP1+3.*Z-ZM1)))
2105       FQUAD(Z,ZP1,ZM1,DZ)=Z+0.5*DZ*(ZP1-ZM1+DZ*(ZP1-2.*Z+ZM1))
2106 C
2107 C ---------------------------------------------------------------------
2108 C
2109 c     print *,' ++entree STDUDV'
2110       DX = X-AINT(X)
2111       DY = Y-AINT(Y)
2112       ITF = 1
2113       IM1 = I-1
2114       IP2 = I+2
2115 C
2116 C Determine which interpolation formula to use 
2117 C depending on I,J location or the special flags
2118 C
2119       IF (I.GE.IXDM .OR. J.GE.IYDN) THEN
2120 C
2121 C This branch should never be taken if STDRAW is correct, but is 
2122 C included for safety
2123 C
2124          RETURN
2125 C
2126       ELSE IF(ISVF.NE.0 .OR. ITRP.NE.0) THEN
2127          ITF = 1
2128       ELSE IF (J.GT.IYD1 .AND. J.LT.IYM1 
2129      +        .AND. I.GT.IXD1 .AND. I.LT.IXM1) THEN
2130          ITF = 2
2131       ELSE IF (J.EQ.IYM1 .AND. I.GT.IXD1 .AND. I.LT.IXM1) THEN
2132          ITF = 3
2133       ELSE IF (J.EQ.IYD1) THEN
2134          ITF = 1
2135       ELSE IF (ICYK.NE.1) THEN
2136          IF (I.EQ.IXD1) THEN
2137             ITF = 1
2138          ELSE IF (I.EQ.IXM1) THEN
2139             ITF = 4
2140          END IF
2141       ELSE IF (I.EQ.IXD1 .AND. J.LT.IYM1) THEN 
2142          IM1 = IXM1
2143          ITF = 2
2144       ELSE IF (I.EQ.IXM1 .AND. J.LT.IYM1) THEN
2145          IP2 = IXD1+1
2146          ITF = 2
2147       ELSE IF (J.EQ.IYM1 .AND. I.EQ.IXD1) THEN
2148          IM1 = IXM1
2149          ITF = 3
2150       ELSE IF (J.EQ.IYM1 .AND. I.EQ.IXM1) THEN
2151          IP2 = IXD1+1
2152          ITF = 3
2153       END IF
2154 C
2155       IF (ITF .EQ. 1) THEN
2156 C
2157 C Double linear interpolation formula. This scheme works at all points
2158 C but the resulting streamlines are not as pleasing as those drawn
2159 C by FBESL or FQUAD. Currently this is utilized
2160 C only at certain boundary points or if ITRP is not equal to zero,
2161 C or if special value processing is turned on.
2162 C
2163          DU = FDLI(UX(I,J),UX(I,J+1),UX(I+1,J),UX(I+1,J+1),DX,DY)
2164          DV = FDLI(VY(I,J),VY(I,J+1),VY(I+1,J),VY(I+1,J+1),DX,DY)
2165 C
2166       ELSE IF (ITF .EQ. 2) THEN
2167 C
2168 C 16 point bessel interpolation scheme.
2169 C
2170          UJM1 = FBESL(UX(I,J-1),UX(I+1,J-1),UX(IP2,J-1),UX(IM1,J-1),DX)
2171          UJ   = FBESL(UX(I,J),UX(I+1,J),UX(IP2,J),UX(IM1,J),DX)
2172          UJP1 = FBESL(UX(I,J+1),UX(I+1,J+1),UX(IP2,J+1),UX(IM1,J+1),DX)
2173          UJP2 = FBESL(UX(I,J+2),UX(I+1,J+2),UX(IP2,J+2),UX(IM1,J+2),DX)
2174          DU   = FBESL(UJ,UJP1,UJP2,UJM1,DY)
2175          VJM1 = FBESL(VY(I,J-1),VY(I+1,J-1),VY(IP2,J-1),VY(IM1,J-1),DX)
2176          VJ   = FBESL(VY(I,J),VY(I+1,J),VY(IP2,J),VY(IM1,J),DX)
2177          VJP1 = FBESL(VY(I,J+1),VY(I+1,J+1),VY(IP2,J+1),VY(IM1,J+1),DX)
2178          VJP2 = FBESL(VY(I,J+2),VY(I+1,J+2),VY(IP2,J+2),VY(IM1,J+2),DX)
2179          DV   = FBESL(VJ,VJP1,VJP2,VJM1,DY)
2180 C
2181       ELSE IF (ITF .EQ. 3) THEN
2182 C
2183 C 12 point interpolation scheme applicable to one row from top boundary
2184 C
2185          UJM1 = FBESL(UX(I,J-1),UX(I+1,J-1),UX(IP2,J-1),UX(IM1,J-1),DX)
2186          UJ   = FBESL(UX(I,J),UX(I+1,J),UX(IP2,J),UX(IM1,J),DX)
2187          UJP1 = FBESL(UX(I,J+1),UX(I+1,J+1),UX(IP2,J+1),UX(IM1,J+1),DX)
2188          DU   = FQUAD(UJ,UJP1,UJM1,DY)
2189          VJM1 = FBESL(VY(I,J-1),VY(I+1,J-1),VY(IP2,J-1),VY(IM1,J-1),DX)
2190          VJ   = FBESL(VY(I,J),VY(I+1,J),VY(IP2,J),VY(IM1,J),DX)
2191          VJP1 = FBESL(VY(I,J+1),VY(I+1,J+1),VY(IP2,J+1),VY(IM1,J+1),DX)
2192          DV   = FQUAD(VJ,VJP1,VJM1,DY)
2193 C
2194       ELSE IF (ITF .EQ. 4) THEN
2195 C
2196 C 9 point interpolation scheme for use in the non-cyclic case
2197 C at I=IXM1; J > IYD1 and J <= IYM1
2198 C
2199          UJP1 = FQUAD(UX(I,J+1),UX(I+1,J+1),UX(IM1,J+1),DX)
2200          UJ   = FQUAD(UX(I,J),UX(I+1,J),UX(IM1,J),DX)
2201          UJM1 = FQUAD(UX(I,J-1),UX(I+1,J-1),UX(IM1,J-1),DX)
2202          DU   = FQUAD(UJ,UJP1,UJM1,DY)
2203          VJP1 = FQUAD(VY(I,J+1),VY(I+1,J+1),VY(IM1,J+1),DX)
2204          VJ   = FQUAD(VY(I,J),VY(I+1,J),VY(IM1,J),DX)
2205          VJM1 = FQUAD(VY(I,J-1),VY(I+1,J-1),VY(IM1,J-1),DX)
2206          DV   = FQUAD(VJ,VJP1,VJM1,DY)
2207 C
2208       END IF
2209 C
2210 C Done
2211 C
2212       RETURN
2213       END
2214 C
2215 C
2216 C
2217 C-----------------------------------------------------------------------
2218 C
2219       SUBROUTINE STGETC (CNM,CVL)
2220 C
2221       CHARACTER*(*) CNM,CVL
2222 C
2223 C This subroutine is called to retrieve the character value of a
2224 C specified parameter.
2225 C
2226 C CNM is the name of the parameter whose value is to be retrieved.
2227 C
2228 C CVL is a character variable in which the desired value is to be
2229 C returned by STGETC.
2230 C
2231 C ---------------------------------------------------------------------
2232 C
2233 C NOTE:
2234 C Since implicit typing is used for all real and integer variables
2235 C a consistent length convention has been adopted to help clarify the
2236 C significance of the variables encountered in the code for this 
2237 C utility. All local variable and subroutine parameter identifiers 
2238 C are limited to 1,2,or 3 characters. Four character names identify  
2239 C members of common blocks. Five and 6 character variable names 
2240 C denote PARAMETER constants or subroutine or function names.
2241 C
2242 C Declare the ST common blocks.
2243 C
2244       PARAMETER (IPLVLS = 64)
2245 C
2246 C Integer and real common block variables
2247 C
2248 C
2249       COMMON / STPAR /
2250      +                IUD1       ,IVD1       ,IPD1       ,
2251      +                IXD1       ,IXDM       ,IYD1       ,IYDN       ,
2252      +                IXM1       ,IYM1       ,IXM2       ,IYM2       ,
2253      +                IWKD       ,IWKU       ,ISET       ,IERR       ,
2254      +                IXIN       ,IYIN       ,IMSK       ,ICPM       ,
2255      +                NLVL       ,IPAI       ,ICTV       ,WDLV       ,
2256      +                UVMN       ,UVMX       ,PMIN       ,PMAX       ,
2257      +                ITHN       ,IPLR       ,ISST       ,
2258      +                ICLR(IPLVLS)           ,TVLU(IPLVLS)
2259 C
2260       COMMON / STTRAN /
2261      +                UVPS       ,
2262      +                UVPL       ,UVPR       ,UVPB       ,UVPT       ,
2263      +                UWDL       ,UWDR       ,UWDB       ,UWDT       ,
2264      +                UXC1       ,UXCM       ,UYC1       ,UYCN 
2265 C
2266 C Stream algorithm parameters
2267 C
2268       COMMON / STSTRM /
2269      +                ISGD       ,IAGD       ,RARL       ,ICKP       ,
2270      +                ICKX       ,ITRP       ,ICYK       ,RVNL       ,
2271      +                ISVF       ,RUSV       ,RVSV       ,RNDA       ,
2272      +                ISPC       ,RPSV       ,RCDS       ,RSSP       ,
2273      +                RDFM       ,RSMD       ,RAMD       ,IGBS
2274 C
2275 C Text related parameters
2276 C Note: graphical text output is not yet implemented for the
2277 C       Streamline utility.
2278 C
2279       COMMON / STTXP /
2280      +                FCWM    ,ICSZ    ,
2281      +                FMNS    ,FMNX    ,FMNY    ,IMNP    ,IMNC  ,
2282      +                FMXS    ,FMXX    ,FMXY    ,IMXP    ,IMXC  ,
2283      +                FZFS    ,FZFX    ,FZFY    ,IZFP    ,IZFC  ,
2284      +                FILS    ,FILX    ,FILY    ,IILP    ,IILC 
2285 C
2286 C Character variable declartions
2287 C
2288       CHARACTER*160 CSTR
2289       PARAMETER (IPCHSZ=80)
2290       CHARACTER*(IPCHSZ)  CMNT,CMXT,CZFT,CILT
2291 C
2292 C Text string parameters
2293 C
2294       COMMON / STCHAR / CSTR,CMNT,CMXT,CZFT,CILT
2295 C
2296       SAVE /STPAR/, /STTRAN/, /STSTRM/, /STTXP/, /STCHAR/
2297 C
2298 C Internal buffer lengths
2299 C
2300 C IPNPTS - Number of points in the point buffer -- not less than 3
2301 C IPLSTL - Streamline-crossover-check circular list length
2302 C IPGRCT - Number of groups supported for area masking
2303 C
2304       PARAMETER (IPNPTS = 256, IPLSTL = 1500, IPGRCT = 64)
2305 c     PARAMETER (IPNPTS = 256, IPLSTL = 750, IPGRCT = 64)
2306 C
2307 C --------------------------------------------------------------------
2308 C
2309 C The mapping common block: made available to user mapping routines
2310 C
2311       COMMON /STMAP/
2312      +                IMAP       ,LNLG       ,INVX       ,INVY       ,
2313      +                XLOV       ,XHIV       ,YLOV       ,YHIV       ,
2314      +                WXMN       ,WXMX       ,WYMN       ,WYMX       ,
2315      +                XVPL       ,XVPR       ,YVPB       ,YVPT       ,
2316      +                XGDS       ,YGDS       ,NXCT       ,NYCT       ,
2317      +                ITRT       ,FW2W       ,FH2H       ,
2318      +                DFMG       ,VNML       ,RBIG       ,IBIG
2319 C
2320       SAVE /STMAP/
2321 C
2322 C Math constants
2323 C
2324       PARAMETER (PDTOR  = 0.017453292519943,
2325      +           PRTOD  = 57.2957795130823,
2326      +           P1XPI  = 3.14159265358979,
2327      +           P2XPI  = 6.28318530717959,
2328      +           P1D2PI = 1.57079632679489,
2329      +           P5D2PI = 7.85398163397448) 
2330 C
2331 C ---------------------------------------------------------------------
2332 C
2333 C Check for a parameter name that is too short.
2334 C
2335 c     print *,' ++entree STGETC'
2336       IF (LEN(CNM).LT.3) THEN
2337         CSTR(1:36)='STGETC - PARAMETER NAME TOO SHORT - '
2338         CSTR(37:36+LEN(CNM))=CNM
2339         CALL SETER (CSTR(1:36+LEN(CNM)),1,1)
2340         RETURN
2341       END IF
2342 C
2343 C Get the proper parameter.
2344 C
2345       IF (CNM(1:3).EQ.'ZFT'.OR.CNM(1:3).EQ.'zft') THEN
2346          CALL VVTXLN(CZFT,IPCHSZ,IB,IE)
2347          CVL=CZFT(IB:IE)
2348       ELSE
2349 C
2350          CSTR(1:36)='STGETC - PARAMETER NAME NOT KNOWN - '
2351          CSTR(37:39)=CNM(1:3)
2352          CALL SETER (CSTR(1:39),3,1)
2353          RETURN
2354 C
2355       END IF
2356 C
2357 C
2358 C Done.
2359 C
2360       RETURN
2361 C
2362       END
2363 C
2364 C       $Id$
2365 C
2366 C
2367 C-----------------------------------------------------------------------
2368 C
2369       SUBROUTINE STGETR (CNM,RVL)
2370 C
2371       CHARACTER*(*) CNM
2372 C
2373 C This subroutine is called to retrieve the real value of a specified
2374 C parameter.
2375 C
2376 C CNM is the name of the parameter whose value is to be retrieved.
2377 C
2378 C RVL is a real variable in which the desired value is to be returned
2379 C by STGETR.
2380 C
2381 C ---------------------------------------------------------------------
2382 C
2383 C NOTE:
2384 C Since implicit typing is used for all real and integer variables
2385 C a consistent length convention has been adopted to help clarify the
2386 C significance of the variables encountered in the code for this 
2387 C utility. All local variable and subroutine parameter identifiers 
2388 C are limited to 1,2,or 3 characters. Four character names identify  
2389 C members of common blocks. Five and 6 character variable names 
2390 C denote PARAMETER constants or subroutine or function names.
2391 C
2392 C Declare the ST common blocks.
2393 C
2394       PARAMETER (IPLVLS = 64)
2395 C
2396 C Integer and real common block variables
2397 C
2398 C
2399       COMMON / STPAR /
2400      +                IUD1       ,IVD1       ,IPD1       ,
2401      +                IXD1       ,IXDM       ,IYD1       ,IYDN       ,
2402      +                IXM1       ,IYM1       ,IXM2       ,IYM2       ,
2403      +                IWKD       ,IWKU       ,ISET       ,IERR       ,
2404      +                IXIN       ,IYIN       ,IMSK       ,ICPM       ,
2405      +                NLVL       ,IPAI       ,ICTV       ,WDLV       ,
2406      +                UVMN       ,UVMX       ,PMIN       ,PMAX       ,
2407      +                ITHN       ,IPLR       ,ISST       ,
2408      +                ICLR(IPLVLS)           ,TVLU(IPLVLS)
2409 C
2410       COMMON / STTRAN /
2411      +                UVPS       ,
2412      +                UVPL       ,UVPR       ,UVPB       ,UVPT       ,
2413      +                UWDL       ,UWDR       ,UWDB       ,UWDT       ,
2414      +                UXC1       ,UXCM       ,UYC1       ,UYCN 
2415 C
2416 C Stream algorithm parameters
2417 C
2418       COMMON / STSTRM /
2419      +                ISGD       ,IAGD       ,RARL       ,ICKP       ,
2420      +                ICKX       ,ITRP       ,ICYK       ,RVNL       ,
2421      +                ISVF       ,RUSV       ,RVSV       ,RNDA       ,
2422      +                ISPC       ,RPSV       ,RCDS       ,RSSP       ,
2423      +                RDFM       ,RSMD       ,RAMD       ,IGBS
2424 C
2425 C Text related parameters
2426 C Note: graphical text output is not yet implemented for the
2427 C       Streamline utility.
2428 C
2429       COMMON / STTXP /
2430      +                FCWM    ,ICSZ    ,
2431      +                FMNS    ,FMNX    ,FMNY    ,IMNP    ,IMNC  ,
2432      +                FMXS    ,FMXX    ,FMXY    ,IMXP    ,IMXC  ,
2433      +                FZFS    ,FZFX    ,FZFY    ,IZFP    ,IZFC  ,
2434      +                FILS    ,FILX    ,FILY    ,IILP    ,IILC 
2435 C
2436 C Character variable declartions
2437 C
2438       CHARACTER*160 CSTR
2439       PARAMETER (IPCHSZ=80)
2440       CHARACTER*(IPCHSZ)  CMNT,CMXT,CZFT,CILT
2441 C
2442 C Text string parameters
2443 C
2444       COMMON / STCHAR / CSTR,CMNT,CMXT,CZFT,CILT
2445 C
2446       SAVE /STPAR/, /STTRAN/, /STSTRM/, /STTXP/, /STCHAR/
2447 C
2448 C Internal buffer lengths
2449 C
2450 C IPNPTS - Number of points in the point buffer -- not less than 3
2451 C IPLSTL - Streamline-crossover-check circular list length
2452 C IPGRCT - Number of groups supported for area masking
2453 C
2454       PARAMETER (IPNPTS = 256, IPLSTL = 1500, IPGRCT = 64)
2455 c     PARAMETER (IPNPTS = 256, IPLSTL = 750, IPGRCT = 64)
2456 C
2457 C --------------------------------------------------------------------
2458 C
2459 C The mapping common block: made available to user mapping routines
2460 C
2461       COMMON /STMAP/
2462      +                IMAP       ,LNLG       ,INVX       ,INVY       ,
2463      +                XLOV       ,XHIV       ,YLOV       ,YHIV       ,
2464      +                WXMN       ,WXMX       ,WYMN       ,WYMX       ,
2465      +                XVPL       ,XVPR       ,YVPB       ,YVPT       ,
2466      +                XGDS       ,YGDS       ,NXCT       ,NYCT       ,
2467      +                ITRT       ,FW2W       ,FH2H       ,
2468      +                DFMG       ,VNML       ,RBIG       ,IBIG
2469 C
2470       SAVE /STMAP/
2471 C
2472 C Math constants
2473 C
2474       PARAMETER (PDTOR  = 0.017453292519943,
2475      +           PRTOD  = 57.2957795130823,
2476      +           P1XPI  = 3.14159265358979,
2477      +           P2XPI  = 6.28318530717959,
2478      +           P1D2PI = 1.57079632679489,
2479      +           P5D2PI = 7.85398163397448) 
2480 C
2481 C ---------------------------------------------------------------------
2482 C
2483 C Check for a parameter name that is too short.
2484 C
2485 c     print *,' ++entree STGETR'
2486       IF (LEN(CNM).LT.3) THEN
2487         CSTR(1:46)='STGETI OR STGETR - PARAMETER NAME TOO SHORT - '
2488         CSTR(47:46+LEN(CNM))=CNM
2489         CALL SETER (CSTR(1:46+LEN(CNM)),1,1)
2490         RETURN
2491       END IF
2492 C
2493 C Check for incorrect use of the index parameter.
2494 C
2495       IF (CNM(1:3).EQ.'CLR'.OR.CNM(1:3).EQ.'clr'
2496      +    .OR.CNM(1:3).EQ.'TVL'.OR.CNM(1:3).EQ.'tvl') THEN
2497          IF (IPAI.LT.1.OR.IPAI.GT.NLVL) THEN
2498             CSTR(1:46)='STGETI OR STGETR - GETTING XXX - PAI INCORRECT'
2499             CSTR(28:30)=CNM(1:3)
2500             CALL SETER (CSTR(1:46),2,1)
2501             RETURN
2502          END IF
2503       END IF
2504 C
2505 C Get the appropriate parameter value.
2506 C
2507 C ---------------------------------------------------------------------
2508 C
2509 C Values in STPAR
2510 C
2511       IF (CNM(1:3).EQ.'UD1'.OR. CNM(1:3).EQ.'ud1') THEN
2512          RVL=REAL(IUD1)
2513       ELSE IF (CNM(1:3).EQ.'VD1'.OR. CNM(1:3).EQ.'vd1') THEN
2514          RVL=REAL(IVD1)
2515       ELSE IF (CNM(1:3).EQ.'PD1'.OR. CNM(1:3).EQ.'pd1') THEN
2516          RVL=REAL(IPD1)
2517       ELSE IF (CNM(1:3).EQ.'XD1'.OR. CNM(1:3).EQ.'xd1') THEN
2518          RVL=REAL(IXD1)
2519       ELSE IF (CNM(1:3).EQ.'XDM'.OR. CNM(1:3).EQ.'xdm') THEN
2520          RVL=REAL(IXDM)
2521       ELSE IF (CNM(1:3).EQ.'YD1'.OR. CNM(1:3).EQ.'yd1') THEN
2522          RVL=REAL(IYD1)
2523       ELSE IF (CNM(1:3).EQ.'YDN'.OR. CNM(1:3).EQ.'ydn') THEN
2524          RVL=REAL(IYDN)
2525       ELSE IF (CNM(1:3).EQ.'WKD'.OR.CNM(1:3).EQ.'wkd') THEN
2526         RVL=REAL(IWKD)
2527       ELSE IF (CNM(1:3).EQ.'WKU'.OR.CNM(1:3).EQ.'wku') THEN
2528         RVL=REAL(IWKU)
2529       ELSE IF (CNM(1:3).EQ.'SET'.OR. CNM(1:3).EQ.'set') THEN
2530          RVL=REAL(ISET)
2531       ELSE IF (CNM(1:3).EQ.'ERR'.OR. CNM(1:3).EQ.'err') THEN
2532          RVL=REAL(IERR)
2533       ELSE IF (CNM(1:3).EQ.'XIN'.OR.CNM(1:3).EQ.'xin') THEN
2534         RVL=IXIN
2535       ELSE IF (CNM(1:3).EQ.'YIN'.OR.CNM(1:3).EQ.'yin') THEN
2536         RVL=IYIN
2537       ELSE IF (CNM(1:3).EQ.'MSK'.OR. CNM(1:3).EQ.'msk') THEN
2538          RVL=REAL(IMSK)
2539       ELSE IF (CNM(1:3).EQ.'CPM'.OR. CNM(1:3).EQ.'cpm') THEN
2540          RVL=REAL(ICPM)
2541       ELSE IF (CNM(1:3).EQ.'NLV'.OR.CNM(1:3).EQ.'nlv') THEN
2542         RVL=REAL(NLVL)
2543       ELSE IF (CNM(1:3).EQ.'PAI'.OR.CNM(1:3).EQ.'pai') THEN
2544         RVL=REAL(IPAI)
2545       ELSE IF (CNM(1:3).EQ.'CTV'.OR.CNM(1:3).EQ.'ctv') THEN
2546         RVL=REAL(ICTV)
2547       ELSE IF (CNM(1:3).EQ.'LWD'.OR.CNM(1:3).EQ.'lwd') THEN
2548         RVL=WDLV
2549       ELSE IF (CNM(1:3).EQ.'VMN'.OR.CNM(1:3).EQ.'vmn') THEN
2550         RVL=UVMN
2551       ELSE IF (CNM(1:3).EQ.'VMX'.OR.CNM(1:3).EQ.'vmx') THEN
2552         RVL=UVMX
2553       ELSE IF (CNM(1:3).EQ.'PMN'.OR.CNM(1:3).EQ.'pmn') THEN
2554         RVL=PMIN
2555       ELSE IF (CNM(1:3).EQ.'PMX'.OR.CNM(1:3).EQ.'pmx') THEN
2556         RVL=PMAX
2557       ELSE IF (CNM(1:3).EQ.'THN'.OR. CNM(1:3).EQ.'thn') THEN
2558          RVL=REAL(ITHN)
2559       ELSE IF (CNM(1:3).EQ.'PLR'.OR. CNM(1:3).EQ.'plr') THEN
2560          RVL=REAL(IPLR)
2561       ELSE IF (CNM(1:3).EQ.'SST'.OR. CNM(1:3).EQ.'sst') THEN
2562          RVL=REAL(ISST)
2563       ELSE IF (CNM(1:3).EQ.'CLR'.OR.CNM(1:3).EQ.'clr') THEN
2564          RVL=REAL(ICLR(IPAI))
2565       ELSE IF (CNM(1:3).EQ.'TVL'.OR.CNM(1:3).EQ.'tvl') THEN
2566          RVL=TVLU(IPAI)
2567 C
2568 C ---------------------------------------------------------------------
2569 C
2570 C Values in STTRAN
2571 C
2572       ELSE IF (CNM(1:3).EQ.'VPS'.OR. CNM(1:3).EQ.'vps') THEN
2573          RVL=REAL(UVPS)
2574       ELSE IF (CNM(1:3).EQ.'VPL'.OR.CNM(1:3).EQ.'vpl') THEN
2575          RVL=UVPL
2576       ELSE IF (CNM(1:3).EQ.'VPR'.OR.CNM(1:3).EQ.'vpr') THEN
2577          RVL=UVPR
2578       ELSE IF (CNM(1:3).EQ.'VPB'.OR.CNM(1:3).EQ.'vpb') THEN
2579          RVL=UVPB
2580       ELSE IF (CNM(1:3).EQ.'VPT'.OR.CNM(1:3).EQ.'vpt') THEN
2581          RVL=UVPT
2582       ELSE IF (CNM(1:3).EQ.'WDL'.OR.CNM(1:3).EQ.'wdl') THEN
2583          RVL=UWDL
2584       ELSE IF (CNM(1:3).EQ.'WDR'.OR.CNM(1:3).EQ.'wdr') THEN
2585          RVL=UWDR
2586       ELSE IF (CNM(1:3).EQ.'WDB'.OR.CNM(1:3).EQ.'wdb') THEN
2587          RVL=UWDB
2588       ELSE IF (CNM(1:3).EQ.'WDT'.OR.CNM(1:3).EQ.'wdt') THEN
2589          RVL=UWDT
2590       ELSE IF (CNM(1:3).EQ.'XC1'.OR.CNM(1:3).EQ.'xc1') THEN
2591          RVL=UXC1
2592       ELSE IF (CNM(1:3).EQ.'XCM'.OR.CNM(1:3).EQ.'xcm') THEN
2593          RVL=UXCM
2594       ELSE IF (CNM(1:3).EQ.'YC1'.OR.CNM(1:3).EQ.'yc1') THEN
2595          RVL=UYC1
2596       ELSE IF (CNM(1:3).EQ.'YCN'.OR.CNM(1:3).EQ.'ycn') THEN
2597          RVL=UYCN
2598 C
2599 C ---------------------------------------------------------------------
2600 C
2601 C Values in STSTRM
2602 C
2603       ELSE IF (CNM(1:3).EQ.'SGD'.OR. CNM(1:3).EQ.'sgd') THEN
2604          RVL=REAL(ISGD)
2605       ELSE IF (CNM(1:3).EQ.'AGD'.OR. CNM(1:3).EQ.'agd') THEN
2606          RVL=REAL(IAGD)
2607       ELSE IF (CNM(1:3).EQ.'ARL'.OR. CNM(1:3).EQ.'arl') THEN
2608          RVL=RARL
2609       ELSE IF (CNM(1:3).EQ.'CKP'.OR. CNM(1:3).EQ.'ckp') THEN
2610          RVL=REAL(ICKP)
2611       ELSE IF (CNM(1:3).EQ.'CKX'.OR. CNM(1:3).EQ.'ckx') THEN
2612          RVL=REAL(ICKX)
2613       ELSE IF (CNM(1:3).EQ.'TRP'.OR. CNM(1:3).EQ.'trp') THEN
2614          RVL=REAL(ITRP)
2615       ELSE IF (CNM(1:3).EQ.'CYK'.OR. CNM(1:3).EQ.'cyk') THEN
2616          RVL=REAL(ICYK)
2617       ELSE IF (CNM(1:3).EQ.'VNL'.OR. CNM(1:3).EQ.'vnl') THEN
2618          RVL=RVNL
2619       ELSE IF (CNM(1:3).EQ.'SVF'.OR. CNM(1:3).EQ.'svf') THEN
2620          RVL=REAL(ISVF)
2621       ELSE IF (CNM(1:3).EQ.'USV'.OR. CNM(1:3).EQ.'usv') THEN
2622          RVL=RUSV
2623       ELSE IF (CNM(1:3).EQ.'VSV'.OR. CNM(1:3).EQ.'vsv') THEN
2624          RVL=RVSV
2625       ELSE IF (CNM(1:3).EQ.'PSV'.OR. CNM(1:3).EQ.'psv') THEN
2626          RVL=RPSV
2627       ELSE IF (CNM(1:3).EQ.'SPC'.OR. CNM(1:3).EQ.'spc') THEN
2628          RVL=REAL(ISPC)
2629       ELSE IF (CNM(1:3).EQ.'CDS'.OR. CNM(1:3).EQ.'cds') THEN
2630          RVL=RCDS
2631       ELSE IF (CNM(1:3).EQ.'SSP'.OR. CNM(1:3).EQ.'ssp') THEN
2632          RVL=RSSP
2633       ELSE IF (CNM(1:3).EQ.'DFM'.OR. CNM(1:3).EQ.'dfm') THEN
2634          RVL=RDFM
2635       ELSE IF (CNM(1:3).EQ.'SMD'.OR. CNM(1:3).EQ.'smd') THEN
2636          RVL=RSMD
2637       ELSE IF (CNM(1:3).EQ.'AMD'.OR. CNM(1:3).EQ.'amd') THEN
2638          RVL=RAMD
2639       ELSE IF (CNM(1:3).EQ.'GBS'.OR. CNM(1:3).EQ.'gbs') THEN
2640          RVL=REAL(IGBS)
2641 C
2642 C ---------------------------------------------------------------------
2643 C
2644 C Values in STTXP
2645 C
2646 C character attributes
2647 C
2648 C
2649       ELSE IF (CNM(1:3).EQ.'ZFS'.OR.CNM(1:3).EQ.'zfs') THEN
2650          RVL=FZFS
2651       ELSE IF (CNM(1:3).EQ.'ZFX'.OR.CNM(1:3).EQ.'zfx') THEN
2652          RVL=FZFX
2653       ELSE IF (CNM(1:3).EQ.'ZFY'.OR.CNM(1:3).EQ.'zfy') THEN
2654          RVL=FZFY
2655       ELSE IF (CNM(1:3).EQ.'ZFP'.OR. CNM(1:3).EQ.'zfp') THEN
2656          RVL=REAL(IZFP)
2657       ELSE IF (CNM(1:3).EQ.'ZFC'.OR. CNM(1:3).EQ.'zfc') THEN
2658          RVL=REAL(IZFC)
2659 C
2660 C ---------------------------------------------------------------------
2661 C
2662 C Values in STMAP
2663 C
2664       ELSE IF (CNM(1:3).EQ.'MAP'.OR. CNM(1:3).EQ.'map') THEN
2665          RVL=REAL(IMAP)
2666       ELSE IF (CNM(1:3).EQ.'TRT'.OR. CNM(1:3).EQ.'trt') THEN
2667          RVL=REAL(ITRT)
2668       ELSE IF (CNM(1:3).EQ.'VPL'.OR.CNM(1:3).EQ.'vpl') THEN
2669          RVL=XVPL
2670       ELSE IF (CNM(1:3).EQ.'VPR'.OR.CNM(1:3).EQ.'vpr') THEN
2671          RVL=XVPR
2672       ELSE IF (CNM(1:3).EQ.'VPB'.OR.CNM(1:3).EQ.'vpb') THEN
2673          RVL=YVPB
2674       ELSE IF (CNM(1:3).EQ.'VPT'.OR.CNM(1:3).EQ.'vpt') THEN
2675          RVL=YVPT
2676       ELSE IF (CNM(1:3).EQ.'XMN'.OR.CNM(1:3).EQ.'xmn') THEN
2677          RVL=WXMN
2678       ELSE IF (CNM(1:3).EQ.'XMX'.OR.CNM(1:3).EQ.'xmx') THEN
2679          RVL=WXMX
2680       ELSE IF (CNM(1:3).EQ.'YMN'.OR.CNM(1:3).EQ.'ymn') THEN
2681          RVL=WYMN
2682       ELSE IF (CNM(1:3).EQ.'YMX'.OR.CNM(1:3).EQ.'ymx') THEN
2683          RVL=WYMX
2684       ELSE IF (CNM(1:3).EQ.'XLV'.OR.CNM(1:3).EQ.'xlv') THEN
2685          RVL=XLOV
2686       ELSE IF (CNM(1:3).EQ.'XHV'.OR.CNM(1:3).EQ.'xhv') THEN
2687          RVL=XHIV
2688       ELSE IF (CNM(1:3).EQ.'YLV'.OR.CNM(1:3).EQ.'ylv') THEN
2689          RVL=YLOV
2690       ELSE IF (CNM(1:3).EQ.'YHV'.OR.CNM(1:3).EQ.'yhv') THEN
2691          RVL=YHIV
2692       ELSE IF (CNM(1:3).EQ.'NXC'.OR. CNM(1:3).EQ.'nxc') THEN
2693          RVL=REAL(NXCT)
2694       ELSE IF (CNM(1:3).EQ.'NYC'.OR. CNM(1:3).EQ.'nyc') THEN
2695          RVL=REAL(NYCT)
2696       ELSE IF (CNM(1:3).EQ.'LLG'.OR. CNM(1:3).EQ.'llg') THEN
2697          RVL=REAL(LNLG)
2698       ELSE IF (CNM(1:3).EQ.'IVX'.OR. CNM(1:3).EQ.'ivx') THEN
2699          RVL=REAL(INVX)
2700       ELSE IF (CNM(1:3).EQ.'IVY'.OR. CNM(1:3).EQ.'ivy') THEN
2701          RVL=REAL(INVY)
2702       ELSE IF (CNM(1:3).EQ.'RBG'.OR. CNM(1:3).EQ.'rbg') THEN
2703          RVL=REAL(RBIG)
2704       ELSE IF (CNM(1:3).EQ.'IBG'.OR. CNM(1:3).EQ.'ibg') THEN
2705          RVL=REAL(IBIG)
2706 C
2707 C ---------------------------------------------------------------------
2708 C
2709       ELSE
2710          CSTR(1:46)='STGETI OR STGETR - PARAMETER NAME NOT KNOWN - '
2711          CSTR(47:49)=CNM(1:3)
2712          CALL SETER (CSTR(1:49),3,1)
2713          RETURN
2714       END IF
2715 C
2716 C Done.
2717 C
2718       RETURN
2719 C
2720       END
2721 C
2722 C       $Id$
2723 C
2724       SUBROUTINE STREAM (U,V,P,IAM,STUMSL,WRK)
2725 C
2726       DIMENSION  U(IUD1,*), V(IVD1,*), P(IPD1,*), IAM(*), WRK(*)
2727 C
2728       EXTERNAL STUMSL
2729 C
2730 C Input parameters:
2731 C
2732 C U,V    - arrays containing vector field data
2733 C P      - 2-d scalar data array. (dummy - not implemented yet)
2734 C IAM    - An area map array, may be dummied if 'MSK' is zero
2735 C STUMSL - User modifiable masked drawing function; also may
2736 C          be dummied if 'MSK is zero
2737 C WRK    - workspace 
2738 C
2739 C ---------------------------------------------------------------------
2740 C
2741 C NOTE:
2742 C Since implicit typing is used for all real and integer variables
2743 C a consistent length convention has been adopted to help clarify the
2744 C significance of the variables encountered in the code for this 
2745 C utility. All local variable and subroutine parameter identifiers 
2746 C are limited to 1,2,or 3 characters. Four character names identify  
2747 C members of common blocks. Five and 6 character variable names 
2748 C denote PARAMETER constants or subroutine or function names.
2749 C
2750 C Declare the ST common blocks.
2751 C
2752       PARAMETER (IPLVLS = 64)
2753 C
2754 C Integer and real common block variables
2755 C
2756 C
2757       COMMON / STPAR /
2758      +                IUD1       ,IVD1       ,IPD1       ,
2759      +                IXD1       ,IXDM       ,IYD1       ,IYDN       ,
2760      +                IXM1       ,IYM1       ,IXM2       ,IYM2       ,
2761      +                IWKD       ,IWKU       ,ISET       ,IERR       ,
2762      +                IXIN       ,IYIN       ,IMSK       ,ICPM       ,
2763      +                NLVL       ,IPAI       ,ICTV       ,WDLV       ,
2764      +                UVMN       ,UVMX       ,PMIN       ,PMAX       ,
2765      +                ITHN       ,IPLR       ,ISST       ,
2766      +                ICLR(IPLVLS)           ,TVLU(IPLVLS)
2767 C
2768       COMMON / STTRAN /
2769      +                UVPS       ,
2770      +                UVPL       ,UVPR       ,UVPB       ,UVPT       ,
2771      +                UWDL       ,UWDR       ,UWDB       ,UWDT       ,
2772      +                UXC1       ,UXCM       ,UYC1       ,UYCN 
2773 C
2774 C Stream algorithm parameters
2775 C
2776       COMMON / STSTRM /
2777      +                ISGD       ,IAGD       ,RARL       ,ICKP       ,
2778      +                ICKX       ,ITRP       ,ICYK       ,RVNL       ,
2779      +                ISVF       ,RUSV       ,RVSV       ,RNDA       ,
2780      +                ISPC       ,RPSV       ,RCDS       ,RSSP       ,
2781      +                RDFM       ,RSMD       ,RAMD       ,IGBS
2782 C
2783 C Text related parameters
2784 C Note: graphical text output is not yet implemented for the
2785 C       Streamline utility.
2786 C
2787       COMMON / STTXP /
2788      +                FCWM    ,ICSZ    ,
2789      +                FMNS    ,FMNX    ,FMNY    ,IMNP    ,IMNC  ,
2790      +                FMXS    ,FMXX    ,FMXY    ,IMXP    ,IMXC  ,
2791      +                FZFS    ,FZFX    ,FZFY    ,IZFP    ,IZFC  ,
2792      +                FILS    ,FILX    ,FILY    ,IILP    ,IILC 
2793 C
2794 C Character variable declartions
2795 C
2796       CHARACTER*160 CSTR
2797       PARAMETER (IPCHSZ=80)
2798       CHARACTER*(IPCHSZ)  CMNT,CMXT,CZFT,CILT
2799 C
2800 C Text string parameters
2801 C
2802       COMMON / STCHAR / CSTR,CMNT,CMXT,CZFT,CILT
2803 C
2804       SAVE /STPAR/, /STTRAN/, /STSTRM/, /STTXP/, /STCHAR/
2805 C
2806 C Internal buffer lengths
2807 C
2808 C IPNPTS - Number of points in the point buffer -- not less than 3
2809 C IPLSTL - Streamline-crossover-check circular list length
2810 C IPGRCT - Number of groups supported for area masking
2811 C
2812       PARAMETER (IPNPTS = 256, IPLSTL = 1500, IPGRCT = 64)
2813 c     PARAMETER (IPNPTS = 256, IPLSTL = 750, IPGRCT = 64)
2814 C
2815 C --------------------------------------------------------------------
2816 C
2817 C The mapping common block: made available to user mapping routines
2818 C
2819       COMMON /STMAP/
2820      +                IMAP       ,LNLG       ,INVX       ,INVY       ,
2821      +                XLOV       ,XHIV       ,YLOV       ,YHIV       ,
2822      +                WXMN       ,WXMX       ,WYMN       ,WYMX       ,
2823      +                XVPL       ,XVPR       ,YVPB       ,YVPT       ,
2824      +                XGDS       ,YGDS       ,NXCT       ,NYCT       ,
2825      +                ITRT       ,FW2W       ,FH2H       ,
2826      +                DFMG       ,VNML       ,RBIG       ,IBIG
2827 C
2828       SAVE /STMAP/
2829 C
2830 C Math constants
2831 C
2832       PARAMETER (PDTOR  = 0.017453292519943,
2833      +           PRTOD  = 57.2957795130823,
2834      +           P1XPI  = 3.14159265358979,
2835      +           P2XPI  = 6.28318530717959,
2836      +           P1D2PI = 1.57079632679489,
2837      +           P5D2PI = 7.85398163397448) 
2838 C
2839 C -----------------------------------------------------------------
2840 C
2841 C Check for valid area map and area group overflow if masking is enabled
2842 C
2843 c     print *,' ++entree STREAM'
2844       IF (IMSK.GT.0) THEN
2845          IF (IAM(7).GT.IPGRCT) THEN
2846             CSTR(1:29)='STREAM - TOO MANY AREA GROUPS'
2847             CALL SETER (CSTR(1:29),1,1)
2848             RETURN
2849          END IF
2850          IF (IAM(7).LE.0) THEN
2851             CSTR(1:25)='STREAM - INVALID AREA MAP'
2852             CALL SETER (CSTR(1:29),2,1)
2853             RETURN
2854          END IF
2855       END IF
2856 C
2857 C Save the line color, text color and linewidth.
2858 C Then set up the new linewidth values
2859
2860       CALL GQPLCI(IER,IOC)
2861       CALL GQTXCI(IER,IOT)
2862       CALL GQLWSC(IER,ROW)
2863       CALL GSLWSC(WDLV)
2864 C
2865 C Calculation of NDC sizing values varies based on whether grid 
2866 C relative sizing is in effect.
2867 C
2868       IF (IGBS .EQ. 0) THEN
2869          RNDA=RARL*FW2W
2870          DFMG=RDFM*FW2W
2871       ELSE
2872          RNDA=RARL*FW2W/REAL(IXDM)
2873          DFMG=RDFM*FW2W/REAL(IXDM)
2874       END IF
2875 C
2876 C If not using the FX,FY routines, then the vector normalization
2877 C value is fixed. 
2878 C
2879       IF (ICPM.LT.1) THEN
2880          VNML=0.3333333
2881       ELSE
2882          VNML=RVNL
2883       END IF
2884 C
2885 C Draw the streamlines.
2886 C Break the work array into two parts.  See STDRAW for further
2887 C comments on this.
2888 C
2889       CALL STDRAW (U,V,WRK(1),WRK(IXDM*IYDN+1),IAM,STUMSL)
2890 C
2891 C Reset the polyline color, text color, and the linewidth
2892 C
2893       CALL GSPLCI(IOC)
2894       CALL GSLWSC(ROW)
2895       CALL GSTXCI(IOT)
2896 C
2897       RETURN
2898       END
2899 C
2900 C --------------------------------------------------------------------
2901 C Original disucussion of the STRMLN algorithm follows:
2902 C
2903 C HISTORY                Written and standardized in November 1973.
2904 C
2905 C                        Converted to FORTRAN 77 and GKS in June, 1984.
2906 C
2907 C
2908 C PORTABILITY            FORTRAN 77
2909 C
2910 C ALGORITHM              Wind components are normalized to the value
2911 C                        of DISPL. The least significant two
2912 C                        bits of the work array are
2913 C                        utilized as flags for each grid box. Flag 1
2914 C                        indicates whether any streamline has
2915 C                        previously passed through this box.  Flag 2
2916 C                        indicates whether a directional arrow has
2917 C                        already appeared in a box. Judicious use
2918 C                        of these flags prevents overcrowding of
2919 C                        streamlines and directional arrows.
2920 C                        Experience indicates that a final pleasing
2921 C                        picture is produced when streamlines are
2922 C                        initiated in the center of a grid box. The
2923 C                        streamlines are drawn in one direction then
2924 C                        in the opposite direction.
2925 C
2926 C REFERENCE              The techniques utilized here are described
2927 C                        in an article by Thomas Whittaker (U. of
2928 C                        Wisconsin) which appeared in the notes and
2929 C                        correspondence section of Monthly Weather
2930 C                        Review, June 1977.
2931 C
2932 C TIMING                 Highly variable
2933 C                          It depends on the complexity of the
2934 C                          flow field and the parameters:  DISPL,
2935 C                          DISPC , CSTOP , INITA , INITB , ITERC ,
2936 C                          and IGFLG. (See below for a discussion
2937 C                          of these parameters.) If all values
2938 C                          are default, then a simple linear
2939 C                          flow field for a 40 x 40 grid will
2940 C                          take about 0.4 seconds on the CRAY1-A;
2941 C                          a fairly complex flow field will take about
2942 C                          1.5 seconds on the CRAY1-A.
2943 C
2944 C
2945 C INTERNAL PARAMETERS
2946 C
2947 C                        NAME     DEFAULT         FUNCTION
2948 C                        ----     -------         --------
2949 C
2950 C                        EXT       0.25   Lengths of the sides of the
2951 C                                         plot are proportional to
2952 C                                         IPTSX and JPTSY except in
2953 C                                         the case when MIN(IPTSX,JPT)
2954 C                                         / MAX(IPTSX,JPTSY) .LT. EXT;
2955 C                                         in that case a square
2956 C                                         graph is plotted.
2957 C
2958 C                        SIDE      0.90   Length of longer edge of
2959 C                                         plot. (See also EXT.)
2960 C
2961 C                        XLT       0.05   Left hand edge of the plot.
2962 C                                         (0.0 = left edge of frame)
2963 C                                         (1.0 = right edge of frame)
2964 C
2965 C                        YBT       0.05   Bottom edge of the plot.
2966 C                                         (0.0 = bottom ; 1.0 = top)
2967 C
2968 C                                         (YBT+SIDE and XLT+SIDE must
2969 C                                         be .LE. 1. )
2970 C
2971 C                        INITA     2      Used to precondition grid
2972 C                                         boxes to be eligible to
2973 C                                         start a streamline.
2974 C                                         For example, a value of 4
2975 C                                         means that every fourth
2976 C                                         grid box is eligible ; a
2977 C                                         value of 2 means that every
2978 C                                         other grid box is eligible.
2979 C                                         (see INITB)
2980 C
2981 C                        INITB     2      Used to precondition grid
2982 C                                         boxes to be eligible for
2983 C                                         direction arrows.
2984 C                                         If the user changes the
2985 C                                         default values of INITA
2986 C                                         and/or INITB, it should
2987 C                                         be done such that
2988 C                                         MOD(INITA,INITB) = 0 .
2989 C                                         For a dense grid try
2990 C                                         INITA=4 and INITB=2 to
2991 C                                         reduce the CPU time.
2992 C
2993 C                        AROWL     0.33   Length of direction arrow.
2994 C                                         For example, 0.33 means
2995 C                                         each directional arrow will
2996 C                                         take up a third of a grid
2997 C                                         box.
2998 C
2999 C                        ITERP     35     Every 'ITERP' iterations
3000 C                                         the streamline progress
3001 C                                         is checked.
3002 C
3003 C                        ITERC     -99    The default value of this
3004 C                                         parameter is such that
3005 C                                         it has no effect on the
3006 C                                         code. When set to some
3007 C                                         positive value, the program
3008 C                                         will check for streamline
3009 C                                         crossover every 'ITERC'
3010 C                                         iterations. (The routine
3011 C                                         currently does this every
3012 C                                         time it enters a new grid
3013 C                                         box.)
3014 C                                         Caution:  When this
3015 C                                         parameter is activated,
3016 C                                         CPU time will increase.
3017 C
3018 C                        IGFLG     0      A value of zero means that
3019 C                                         the sixteen point Bessel
3020 C                                         Interpolation Formula will
3021 C                                         be utilized where possible;
3022 C                                         when near the grid edges,
3023 C                                         quadratic and bi-linear
3024 C                                         interpolation  will be
3025 C                                         used. This mixing of
3026 C                                         interpolation schemes can
3027 C                                         sometimes cause slight
3028 C                                         raggedness near the edges
3029 C                                         of the plot.  If IGFLG.NE.0,
3030 C                                         then only the bilinear
3031 C                                         interpolation formula
3032 C                                         is used; this will generally
3033 C                                         result in slightly faster
3034 C                                         plot times but a less
3035 C                                         pleasing plot.
3036 C
3037 C                        IMSG      0      If zero, then no missing
3038 C                                         U and V components are
3039 C                                         present.
3040 C                                         If .NE. 0, STRMLN will
3041 C                                         utilize the
3042 C                                         bi-linear interpolation
3043 C                                         scheme and terminate if
3044 C                                         any data points are missing.
3045 C
3046 C                        UVMSG     1.E+36 Value assigned to a missing
3047 C                                         point.