aboutsummaryrefslogtreecommitdiff
path: root/sys/gio/ncarutil/conlib/concls.f
blob: 02d97a4deeb1f5bbb1709cdfa258b98b450f97ab (plain) (blame)
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
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
SUBROUTINE CONCLS (ZD,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  GENERATE CONTOUR LEVELS BASED ON THE INPUT DATA
C
      DIMENSION       ZD(1)
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
      SAVE
C
C  IF NOT USER SET COMPUTE CONTOUR LEVELS
C
      IF (.NOT.CON) GO TO  150
C
C  OTHERWISE GET HI AND LOW CONTOURS FOR MESSAGE
C
      HI = CL(1)
      FLO = CL(1)
      DO  110 I=1,NCL
         IF (HI .GE. CL(I)) GO TO  100
         HI = CL(I)
         GO TO  110
  100    IF (FLO .LE. CL(I)) GO TO  110
         FLO = CL(I)
  110 CONTINUE
C
C GET INCREMENT IF EQUAL SPACED CONTOURS
C
      IF (NCL .NE. 1) GO TO  120
      FINC = 0.
      RETURN
  120 FINC = ABS(CL(1)-CL(2))
      IF (NCL .EQ. 2) RETURN
      DO  130 I=3,NCL
         IF (FINC .NE. ABS(CL(I-1)-CL(I))) GO TO  140
  130 CONTINUE
      RETURN
  140 FINC = -1.
      RETURN
C
C  FIND HIGHEST AND LOWEST INPUT VALUES
C
  150 IF (CHILO) GO TO  180
      FLO = ZD(1)
      HI = ZD(1)
      DO  170 I=2,NDP
         IF (FLO .LE. ZD(I)) GO TO  160
         FLO = ZD(I)
         GO TO  170
  160    IF (HI .GE. ZD(I)) GO TO  170
         HI = ZD(I)
  170 CONTINUE
C
C  CALCULATE THE CONTOUR LEVEL INTERVAL
C
  180 IF (CINC) GO TO  200
      FINC = (HI-FLO)/15.
      IF (FINC .NE. 0.) GO TO  190
      CALL SETER (' CONCLS - CONSTANT INPUT FIELD',1,1)
      RETURN
C
C  ROUND FINC TO NICE NUMBER
C
  190 P = 10.**(IFIX(ALOG10(FINC)+500.)-500)
      FINC = AINT(FINC/P+0.1)*P
C
C  ROUND THE LOW VALUE TO START AT A NICE NUMBER
C
  200 IF (CHILO) GO TO  210
      FLO = AINT(FLO/FINC)*FINC
C
C  COMPUTE THE CONTOUR LEVELS
C
C  TEST IF BREAK POINT WITHIN RANGE OF HI TO FLO
C
  210 IF (BPSIZ.GE.FLO .AND. BPSIZ.LE.HI) GO TO  240
C
C  BREAK POINT OUT OF RANGE SO GENERATE CONTOURS BASED ON FLO
C
      DO  220 I=1,30
         CV = FLO+FLOAT(I-1)*FINC
         ICUR = I
         CL(I) = CV
         IF (CV .GE. HI) GO TO  230
  220 CONTINUE
  230 NCL = ICUR
      HI = CV
      RETURN
C
C  BREAK POINT WITHIN RANGE SO BASE CONTOURS ON IT
C
  240 DO  250 I=1,30
         CV = BPSIZ-FLOAT(I-1)*FINC
         IND = (30-I)+1
         CL(IND) = CV
         ICUR = I
         IF (CV .LE. FLO) GO TO  260
  250 CONTINUE
C
C  PUT THE CONTOURS IN THE CORRECT ORDER
C
  260 DO  270 I=1,ICUR
         IND = (30-ICUR)+I
         CL(I) = CL(IND)
  270 CONTINUE
C
C  ADD THE GREATER THAN BREAK POINT CONTOURS
C
      IEND = 30-ICUR
      ISAV = ICUR+1
      DO  280 I=1,IEND
         CV = BPSIZ+FLOAT(I)*FINC
         CL(ISAV) = CV
         ISAV = ISAV+1
         IF (CV .GE. HI) GO TO  290
  280 CONTINUE
C
C  SET NUMBER OF CONTOUR LEVELS AND UPDATE THE HIGH VALUE
C
  290 NCL = ISAV-1
      HI = CV
      RETURN
      END