1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
|
SUBROUTINE CONSTP (XD,YD,NDP)
C
C +-----------------------------------------------------------------+
C | |
C | Copyright (C) 1986 by UCAR |
C | University Corporation for Atmospheric Research |
C | All Rights Reserved |
C | |
C | NCARGRAPHICS Version 1.00 |
C | |
C +-----------------------------------------------------------------+
C
C
C
C COMPUTE STEP SIZE IN X AND Y DIRECTION
C
C
C
COMMON /CONRA1/ CL(30) ,NCL ,OLDZ ,PV(210) ,
1 FINC ,HI ,FLO
COMMON /CONRA2/ REPEAT ,EXTRAP ,PER ,MESS ,
1 ISCALE ,LOOK ,PLDVLS ,GRD ,
2 CINC ,CHILO ,CON ,LABON ,
3 PMIMX ,SCALE ,FRADV ,EXTRI ,
4 BPSIZ ,LISTOP
COMMON /CONRA3/ IREC
COMMON /CONRA4/ NCP ,NCPSZ
COMMON /CONRA5/ NIT ,ITIPV
COMMON /CONRA6/ XST ,YST ,XED ,YED ,
1 STPSZ ,IGRAD ,IG ,XRG ,
2 YRG ,BORD ,PXST ,PYST ,
3 PXED ,PYED ,ITICK
COMMON /CONRA7/ TITLE ,ICNT ,ITLSIZ
COMMON /CONRA8/ IHIGH ,INMAJ ,INLAB ,INDAT ,
1 LEN ,IFMT ,LEND ,
2 IFMTD ,ISIZEP ,INMIN
COMMON /CONRA9/ ICOORD(500),NP ,MXXY ,TR ,
1 BR ,TL ,BL ,CONV ,
2 XN ,YN ,ITLL ,IBLL ,
3 ITRL ,IBRL ,XC ,YC ,
4 ITLOC(210) ,JX ,JY ,ILOC ,
5 ISHFCT ,XO ,YO ,IOC ,NC
COMMON /CONR10/ NT ,NL ,NTNL ,JWIPT ,
1 JWIWL ,JWIWP ,JWIPL ,IPR ,
2 ITPV
COMMON /CONR11/ NREP ,NCRT ,ISIZEL ,
1 MINGAP ,ISIZEM ,
2 TENS
COMMON /CONR12/ IXMAX ,IYMAX ,XMAX ,YMAX
LOGICAL REPEAT ,EXTRAP ,PER ,MESS ,
1 LOOK ,PLDVLS ,GRD ,LABON ,
2 PMIMX ,FRADV ,EXTRI ,CINC ,
3 TITLE ,LISTOP ,CHILO ,CON
COMMON /CONR15/ ISTRNG
CHARACTER*64 ISTRNG
COMMON /CONR16/ FORM
CHARACTER*10 FORM
COMMON /CONR17/ NDASH, IDASH, EDASH
CHARACTER*10 NDASH, IDASH, EDASH
C
C
DIMENSION XD(1) ,YD(1)
C
SAVE
C
C FIND SMALLEST AND LARGST X AND Y
C
XST = XD(1)
XED = XD(1)
YST = YD(1)
YED = YD(1)
DO 130 I=2,NDP
IF (XST .LE. XD(I)) GO TO 100
XST = XD(I)
GO TO 110
100 IF (XED .GE. XD(I)) GO TO 110
XED = XD(I)
110 IF (YST .LE. YD(I)) GO TO 120
YST = YD(I)
GO TO 130
120 IF (YED .GE. YD(I)) GO TO 130
YED = YD(I)
130 CONTINUE
C
C COMPUTE STEP SIZE
C
XRG = (ABS(XED-XST))
YRG = (ABS(YED-YST))
SQRG = XRG
IF (SQRG .LT. YRG) SQRG = YRG
STPSZ = SQRG/FLOAT(IGRAD-1)
C
C COMPUTE PARAMETERS FOR SET CALL
C
DIFX = XRG/SQRG
DIFY = YRG/SQRG
PXST = .5-(BORD*DIFX)/2.
PXED = .5+(BORD*DIFX)/2.
PYST = .5-(BORD*DIFY)/2.
PYED = .5+(BORD*DIFY)/2.
XRG = XRG/FLOAT(ITICK)
YRG = YRG/FLOAT(ITICK)
C
C TEST IF THE ASPECT RATIO FOR THE COORDINATES IS REASONABLE.
C REASONABLE IS CURRENTLY DEFINED AS 5 TO 1.
C IF IT IS NOT REASONABLE THEN A POOR PLOT MAY BE GENERATED
C SO IT IS NICE THE WARN THE USER WHEN THIS HAPPENS.
C
TEST = XRG/YRG
IF (TEST.LE.5. .AND. TEST.GE.0.2) RETURN
C
C WARN THE USER ON THE STANDARD OUTPUT UNIT THAT THE PLOT MAY
C NOT BE TOO GOOD.
C
C SET RECOVERY MODE
C
CALL ENTSR(IROLD,IREC)
C
C FLAG THE ERROR
C
CALL SETER(' ASPECT RATIO OF X AND Y GREATER THAN 5 TO 1',
1 1,1)
C
CALL EPRIN
C
C CLEAR THE ERROR
C
CALL ERROF
C
C RESET USER ERROR MODE
C
CALL ENTSR(IDUM,IROLD)
C
RETURN
END
|
