aboutsummaryrefslogtreecommitdiff
path: root/orrs/src/conlab.f
blob: 53c8599e53897391539a0bade30ceae16af46aa3 (plain)
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
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
C
      SUBROUTINE CONLAB(IX,JX,II,JJ,X,Y,F,FCON,XWT,YWT,
     &           CH,NDIG,ISIDE)
      DIMENSION X(IX,JX), Y(IX,JX)
      DIMENSION F(IX,JX)
C---------------------------------------------------------------------
C     Puts numerical labels on the contour with value FCON at the
C     edge of the domain specified by ISIDE.  The number of digits
C     in the label(s) after the decimal point is given by NDIG.
C
C     Input:
C        IX JX     dimensions of arrays   X, Y, F
C        II JJ     array limits of arrays X, Y, F
C        X(i,j)    coordinates of grid point (i,j)
C        Y(i,j)  
C        F(i,j)    function value at grid point (i,j)
C        FCON      value of F on the contour to be generated
C        XWT YWT   plotting scale factors for X,Y:
C                       Xplot = X(i,j)*XWT
C                       Yplot = Y(i,j)*YWT
C        CH        absolute character height (no scaling is done)
C        NDIG      number of digits after decimal point in labels
C        ISIDE     domain side on which labels are to appear:
C
C           .     3     .
C
C           4           2
C
C           .     1     .
C
C
C     Output:      direct plotting calls using Versatec routines
C
C---------------------------------------------------------------------
      LOGICAL LABEL 
C
      DATA PI, RTOD / 3.141592654, 57.2957795 /
C
C---- total number of digits + decimal point
      RDIG = 3.25 + FLOAT(NDIG)
C
      IF(ISIDE.EQ.1) THEN
       JO = 1
       JP = 2
       KLO = 1
       KHI = II-1
      ELSE IF(ISIDE.EQ.2) THEN
       IO = II-1
       IP = II
       KLO = 1
       KHI = JJ-1
      ELSE IF(ISIDE.EQ.3) THEN
       JO = JJ-1
       JP = JJ
       KLO = 1
       KHI = II-1
      ELSE IF(ISIDE.EQ.4) THEN
       IO = 1
       IP = 2
       KLO = 1
       KHI = JJ-1
      ENDIF
C
C---- check domain edge specified by ISIDE if the contour touches it
      DO 10 K=KLO, KHI
C
        IF(ISIDE.EQ.1) THEN
         IO = K
         IP = K+1
        ELSE IF(ISIDE.EQ.2) THEN
         JO = K
         JP = K+1
        ELSE IF(ISIDE.EQ.3) THEN
         IO = K
         IP = K+1
        ELSE IF(ISIDE.EQ.4) THEN
         JO = K
         JP = K+1
        ENDIF
C
C------ flag indicating if contour crosses current cell
        LABEL = .FALSE.
C
C           op    3    pp
C
C           4           2
C
C           oo    1    po
C
        XOO = X(IO,JO)
        XOP = X(IO,JP)
        XPO = X(IP,JO)
        XPP = X(IP,JP)
C
        YOO = Y(IO,JO)
        YOP = Y(IO,JP)
        YPO = Y(IP,JO)
        YPP = Y(IP,JP)
C
        FOO = F(IO,JO)
        FOP = F(IO,JP)
        FPO = F(IP,JO)
        FPP = F(IP,JP)
C
C------ bottom edge (side 1)
        IF(FCON.GE.FOO .AND. FCON.LT.FPO .OR.
     &     FCON.LT.FOO .AND. FCON.GE.FPO     ) THEN
         IF(ISIDE.EQ.1) THEN
          XCON2 = XOO + (FCON-FOO)*(XPO-XOO)/(FPO-FOO)
          YCON2 = YOO + (FCON-FOO)*(YPO-YOO)/(FPO-FOO)
          LABEL = .TRUE.
         ELSE
          XCON1 = XOO + (FCON-FOO)*(XPO-XOO)/(FPO-FOO)
          YCON1 = YOO + (FCON-FOO)*(YPO-YOO)/(FPO-FOO)
         ENDIF 
        ENDIF
C
C------ left edge (side 4)
        IF(FCON.GE.FOO .AND. FCON.LT.FOP .OR.
     &     FCON.LT.FOO .AND. FCON.GE.FOP     ) THEN
         IF(ISIDE.EQ.4) THEN
          XCON2 = XOO + (FCON-FOO)*(XOP-XOO)/(FOP-FOO)
          YCON2 = YOO + (FCON-FOO)*(YOP-YOO)/(FOP-FOO)
          LABEL = .TRUE.
         ELSE
          XCON1 = XOO + (FCON-FOO)*(XOP-XOO)/(FOP-FOO)
          YCON1 = YOO + (FCON-FOO)*(YOP-YOO)/(FOP-FOO)
         ENDIF 
        ENDIF
C
C------ right edge (side 2)
        IF(FCON.GE.FPO .AND. FCON.LT.FPP .OR.
     &     FCON.LT.FPO .AND. FCON.GE.FPP     ) THEN
         IF(ISIDE.EQ.2) THEN
          XCON2 = XPO + (FCON-FPO)*(XPP-XPO)/(FPP-FPO)
          YCON2 = YPO + (FCON-FPO)*(YPP-YPO)/(FPP-FPO)
          LABEL = .TRUE.
         ELSE
          XCON1 = XPO + (FCON-FPO)*(XPP-XPO)/(FPP-FPO)
          YCON1 = YPO + (FCON-FPO)*(YPP-YPO)/(FPP-FPO)
         ENDIF 
        ENDIF
C
C------ top edge (side 3)
        IF(FCON.GE.FOP .AND. FCON.LT.FPP .OR.
     &     FCON.LT.FOP .AND. FCON.GE.FPP     ) THEN
         IF(ISIDE.EQ.3) THEN
          XCON2 = XOP + (FCON-FOP)*(XPP-XOP)/(FPP-FOP)
          YCON2 = YOP + (FCON-FOP)*(YPP-YOP)/(FPP-FOP)
          LABEL = .TRUE.
         ELSE
          XCON1 = XOP + (FCON-FOP)*(XPP-XOP)/(FPP-FOP)
          YCON1 = YOP + (FCON-FOP)*(YPP-YOP)/(FPP-FOP)
         ENDIF 
        ENDIF
C
        IF(LABEL) THEN
C
C------- a contour reaching the domain edge has been found - set coordinates
C        of contour on the cell edges
         X1 = XWT*XCON1
         X2 = XWT*XCON2
         Y1 = YWT*YCON1
         Y2 = YWT*YCON2
C
         DX = X2 - X1
         DY = Y2 - Y1
C
C------- contour angle
         ACON = ATAN2( DY , DX )
         SA = SIN(ACON)
         CA = COS(ACON)
C
C------- if contour points to the right ...
         IF(ABS(ACON) .LT. 0.5*PI) THEN
C
C-------- set angle and lower left coordinates of number
          ANUM = RTOD*ACON
          XN = X2 + CH*CA + 0.5*CH*SA
          YN = Y2 + CH*SA - 0.5*CH*CA
C
C------- if contour points to the left ...
         ELSE
C
C-------- add +/- 180 degrees to number angle to make it read right to left
          ANUM = RTOD*ACON - SIGN(180.0,ACON)
C
C-------- set lower left coordinates of number
          XN = X2 + CH*RDIG*CA - 0.5*CH*SA
          YN = Y2 + CH*RDIG*SA + 0.5*CH*CA
C
         ENDIF
C
C------- draw number
         CALL NUMBER(XN,YN,CH,FCON,ANUM,NDIG)
C
        ENDIF
C
   10 CONTINUE
C
      RETURN
      END ! CONLAB