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
|
SUBROUTINE CONPDV (XD,YD,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 PLOT THE DATA VALUES ON THE CONTOUR MAP
C CURRENTLY UP TO 10 CHARACTERS FOR EACH VALUE ARE DISPLAYED
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
COMMON /RANINT/ IRANMJ, IRANMN, IRANTX
COMMON /RAQINT/ IRAQMJ, IRAQMN, IRAQTX
COMMON /RASINT/ IRASMJ, IRASMN, IRASTX
C
C
CHARACTER*10 ISTR
DIMENSION XD(1) ,YD(1) ,ZD(1)
C
SAVE
C
C DATA TO CONVERT 0-32767 COORIDNATES TO 1-1024 VALUES
C
DATA TRANS/32./
C
C SET INTENSITY
C
IF (INDAT .NE. 1) THEN
CALL GSTXCI (INDAT)
ELSE
CALL GSTXCI (IRANTX)
ENDIF
C
C SET FORMAT IF NONE SPECIFIED
C
IF (LEN .NE. 0) GO TO 110
FORM = '(G10.3)'
LEN = LEND
IFMT = IFMTD
C
C LOOP AND PLOT ALL VALUES
C
110 DO 120 K=1,NDP
CALL FL2INT (XD(K),YD(K),MX,MY)
MX = IFIX(FLOAT(MX)/TRANS)+1
MY = IFIX(FLOAT(MY)/TRANS)+1
C
C + NOAO - FTN internal write rewritten as call to encode for IRAF
C
C WRITE(ISTR,FORM)ZD(K)
call encode (len, form, istr, zd(k))
C
C - NOAO
C
C POSITION STRINGS PROPERLY IF COORDS ARE IN PAU'S
C
CALL GQCNTN(IER,ICN)
CALL GSELNT(0)
XC = CPUX(MX)
YC = CPUY(MY)
C
CALL WTSTR(XC,YC,ISTR,ISIZEP,0,0)
CALL GSELNT(ICN)
120 CONTINUE
IF (INDAT .NE. 1) THEN
CALL GSTXCI (IRANTX)
ENDIF
RETURN
END
|
