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
|
SUBROUTINE CONREO (MAJLNS)
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 THIS ROUTINE PUTS THE MAJOR (LABELED) LEVELS IN THE BEGINNING OF CL
C AND THE MINOR (UNLABELED) LEVELS IN END OF CL. THE NUMBER OF MAJOR
C LEVELS IS RETURNED IN MAJLNS. PV IS USED AS A WORK SPACE. MINGAP IS
C THE NUMBER OF MINOR GAPS (ONE MORE THAN THE NUMBER OF MINOR LEVELS
C BETWEEN MAJOR LEVELS).
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 /CONRA7/ TITLE ,ICNT ,ITLSIZ
COMMON /CONR11/ NREP ,NCRT ,ISIZEL ,
1 MINGAP ,ISIZEM ,
2 TENS
LOGICAL REPEAT ,EXTRAP ,PER ,MESS ,
1 LOOK ,PLDVLS ,GRD ,LABON ,
2 PMIMX ,FRADV ,EXTRI ,CINC ,
3 TITLE ,LISTOP ,CHILO ,CON
COMMON /CONR17/ NDASH, IDASH, EDASH
CHARACTER*10 NDASH, IDASH, EDASH
C
SAVE
C
NL = NCL
IF (NL.LE.4 .OR. MINGAP.LE.1) GO TO 160
NML = MINGAP-1
IF (NL.LE.10) NML = 1
C
C CHECK FOR BREAK POINT IN THE LIST OF CONTOURS FOR A MAJOR LINE
C
NMLP1 = NML+1
DO 10 I=1,NL
ISAVE = I
IF (CL(I).EQ.BPSIZ) GO TO 40
10 CONTINUE
C
C NO BREAKPOINT FOUND SO TRY FOR A NICE NUMBER
C
L = NL/2
L = ALOG10( ABS( CL(L) ) )+1.
Q = 10.**L
DO 30 J=1,3
Q = Q/10.
DO 20 I=1,NL
ISAVE = I
IF (AMOD( ABS( CL(I) + 1.E-9*CL(I) )/Q,FLOAT(NMLP1) ).LE.
1 .0001) GO TO 40
20 CONTINUE
30 CONTINUE
ISAVE = NL/2
C
C PUT MAJOR LEVELS IN PV
C
40 ISTART = MOD(ISAVE,NMLP1)
IF (ISTART.EQ.0) ISTART = NMLP1
NMAJL = 0
DO 50 I=ISTART,NL,NMLP1
NMAJL = NMAJL+1
PV(NMAJL) = CL(I)
50 CONTINUE
MAJLNS = NMAJL
L = NMAJL
C
C PUT MINOR LEVELS IN PV
C
IC = NML/2 + 1
L = MAJLNS+1
DO 100 LOOP=1,NML
IC1 = IC
DO 90 IWCH=1,2
IF (LOOP.EQ.1) GO TO 60
IC1 = IC+(LOOP-1)
IF (IWCH.EQ.2) IC1 = IC-(LOOP-1)
IF (IC1.GE.NMLP1) GO TO 90
IF (IC1.LE.0) GO TO 90
60 DO 70 K=ISTART,NL,NMLP1
IND = K+IC1
IF (IND.GT.NL) GO TO 80
PV(L) = CL(IND)
L = L+1
70 CONTINUE
80 IF (LOOP.EQ.1) GO TO 100
90 CONTINUE
100 CONTINUE
C
C IF MAJOR LINES DID NOT START ON THE FIRST ENTRY PICK UP THE MISSING
C LEVELS
C
IF (ISTART.EQ.1) GO TO 140
DO 130 LOOP=1,NML
IC1 = IC
DO 120 IWCH=1,2
IF (LOOP.EQ.1) GO TO 110
IC1 = IC+(LOOP-1)
IF (IWCH.EQ.2) IC1 = IC-(LOOP-1)
110 IF (IC1.GE.ISTART) GO TO 120
IF (IC1.LE.0) GO TO 120
PV(L) = CL(IC1)
L = L+1
IF (LOOP.EQ.1) GO TO 130
120 CONTINUE
130 CONTINUE
C
C PUT REORDERED ARRAY BACK IN ORIGINAL PLACE
C
140 DO 150 I=1,NL
CL(I) = PV(I)
150 CONTINUE
RETURN
160 MAJLNS = NL
RETURN
END
|
