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
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
|
subroutine gridal (imajx,iminx,imajy,iminy,ixlab,iylab,iflg,x,y)
common /sysplt/ mmajx ,mmajy ,mminx ,mminy ,mxlab ,mylab ,
1 mflg ,mtype ,mxa ,mya ,mxb ,myb ,
2 mx ,my ,mtypex ,mtypey ,xxa ,yya ,
3 xxb ,yyb ,xxc ,yyc ,xxd ,yyd ,
4 xfactr ,yfactr ,xadd ,yadd ,xx ,yy ,
5 mfmtx(3) ,mfmty(3) ,mumx ,mumy ,
6 msizx ,msizy ,mxdec ,mydec ,mxor ,mop(19),
7 mname(19) ,mxold ,myold ,mxmax ,mymax ,
8 mxfac ,myfac ,modef ,mf2er ,mshftx ,mshfty ,
9 mmgrx ,mmgry ,mmnrx ,mmnry ,mfrend ,mfrlst ,
+ mcrout ,mpair1 ,mpair2 ,msblen ,mflcnt ,mjxmin ,
1 mjymin ,mjxmax ,mjymax ,mnxsto ,mnysto ,mxxsto ,
2 mxysto ,mprint ,msybuf(360) ,mncpw ,minst ,
3 mbufa ,mbuflu ,mfwa(12) ,mlwa(12) ,
4 mipair ,mbprs(16) ,mbufl ,munit ,mbswap ,
5 small
c
c non-compact version of gridal
c
c ray bovet ishft changed to ishfta patch
dimension nmaj(2),nmin(2),nlab(2),nflg(2),num(2) ,zza(2) ,
1 zzb(2) ,zzc(2) ,zzd(2) ,ichars(5) ,
2 ifmt(3,2) ,iz(2) ,iza(2) ,izb(2) ,imz(2) ,
3 izdec(2) ,isiz(2),imajl(2) ,
4 iminl(2) ,itype(2) ,zz(2) ,
5 ishfta(2) ,izaa(2),izbb(2),kz(4)
c ray bovet patch to avoid small integers being set to 0
integer x,y,xx,yy
c
c
c ray bovet ishft changed to ishfta patch
equivalence (xxa,zza(1)) ,(xxb,zzb(1)) ,(xxc,zzc(1)) ,
1 (xxd,zzd(1)) ,(mfmtx(1),ifmt(1,1)),
2 (mx,iz(1)) ,(mxa,iza(1)) ,(mxb,izb(1)) ,
3 (majx,nmaj(1)) ,(minx,nmin(1)) ,(mumx,num(1)) ,
4 (mxdec,izdec(1)) ,(msizx,isiz(1)),
5 (mmgrx,imajl(1)) ,(mmnrx,iminl(1)) ,
6 (mtypex,itype(1)) ,(xx,kz(1)) ,
7 (xx,zz(1)) ,(mshftx,ishfta(1))
c
c set up variables for loop
c
nmaj(1) = imajx
nmaj(2) = imajy
nmin(1) = iminx
nmin(2) = iminy
nlab(1) = ixlab
nlab(2) = iylab
nflg(1) = ishift(iflg,-2)-1
nflg(2) = iand(iflg,3)-1
izaa(1) = iza(1)
izaa(2) = iza(2)
izbb(1) = izb(1)
izbb(2) = izb(2)
if (nflg(1).le.0 .and. nflg(2).le.0) go to 101
xx = x
yy = y
call trans
if (nflg(2) .gt. 0) izaa(1) = mx
if (nflg(1) .gt. 0) izaa(2) = my
if (nflg(2) .gt. 0) izbb(1) = mx
if (nflg(1) .gt. 0) izbb(2) = my
101 continue
call optn (4hdpat,65535)
do 121 i=1,2
c
c i=1 for x axis with ticks in y direction
c i=2 for y axis with ticks in x direction
c
if (nlab(i)) 121,102,102
102 continue
c
c ior.ne.0 posibility for x only
c
ixor = (2-i)*90*mxor
imaj = max0(nmaj(i),1)
imin = max0(nmin(i),1)
begin = iza(i)
biginc = float(izb(i)-iza(i))/float(imaj)
smlinc = biginc/float(imin)
start = zzc(i)
dif = (zzd(i)-zzc(i))/float(imaj)
iop = 3-i
c
c iop is the opposit axis to i
c
idec = izdec(iop)
if (idec .eq. 0) idec = izaa(iop)-izbb(iop)-655
if (ixor .eq. i-1) go to 103
c
c labels and axis are orthogonal
c
icent = isign(1,idec-1)
go to 104
c
c labels and axis are parallel
c
103 icent = 0
104 continue
if (itype(i) .eq. 0) go to 105
fact = 10.**imaj
if (zzc(i) .gt. zzd(i)) fact = 1./fact
val = zzc(i)/fact
delval = val
if (imin.le.10 .and. imaj.eq.1) imin = 9
if (imin .ne. 9) imin = 1
imaj = abs(alog10(zzd(i)/zzc(i)))+1.0001
105 imajp1 = imaj+1
iminm1 = imin-1
do 119 j=1,imajp1
part = j-1
c
c draw major line or tick
c
call optn (4hintn,4hhigh)
if (itype(i) .ne. 0) go to 106
iz(i) = begin+part*biginc
go to 107
106 val = val*fact
zz(i) = val
kz(iop) = 1
call trans
delval = delval*fact
if (iz(i)-10 .gt. izb(i)) go to 120
107 continue
iz(iop) = izaa(iop)
minst = 0
call put42
if (nflg(i)) 108,109,109
108 iz(iop) = izb(iop)
minst = 1
call put42
go to 111
109 iz(iop) = izaa(iop)+imajl(iop)
minst = 1
call put42
if (nflg(i)) 110,110,111
110 iz(iop) = izb(iop)
minst = 0
call put42
iz(iop) = izb(iop)-imajl(iop)
minst = 1
call put42
111 continue
c
c form label if needed
c
if (nlab(i) .le. 0) go to 112
if (itype(i) .eq. 0) val = start+part*dif
call encode (num(i),ifmt(1,i),ichars,val)
c ray bovet ishft changed to ishfta patch
imz(i) = ishift(iz(i),-ishfta(i))
imz(iop) = max0(1,ishift(izaa(iop)-idec,-ishfta(iop)))
njust = num(i)
if (icent .eq. 0) call justfy (ichars,num(i),njust)
call pwrit (imz(1),imz(2),ichars,njust,isiz(i),ixor,icent)
c
c put in minor ticks
c
112 if (iminm1.le.0 .or. j.eq.imajp1) go to 119
call optn (4hintn,3hlow)
do 118 k=1,iminm1
if (itype(i) .ne. 0) go to 113
iz(i) = begin+part*biginc+float(k)*smlinc
go to 114
113 zz(i) = val+float(k)*delval
if (zzc(i) .gt. zzd(i)) zzi = val-float(k)*delval*.1
kz(iop) = 1
call trans
if (iz(i) .gt. izb(i)) go to 120
if (iz(i) .lt. iza(i)) go to 118
114 continue
iz(iop) = izaa(iop)
minst = 0
call put42
if (nflg(i)) 115,116,116
115 iz(iop) = izb(iop)
minst = 1
call put42
go to 118
116 iz(iop) = izaa(iop)+iminl(iop)
minst = 1
call put42
if (nflg(i)) 117,117,118
117 iz(iop) = izb(iop)
minst = 0
call put42
iz(iop) = izb(iop)-iminl(iop)
minst = 1
call put42
118 continue
119 continue
call optn (4hintn,4hhigh)
120 if (nflg(iop) .lt. 0) go to 121
c
c draw axis line
c
iz(i) = iza(i)
iz(iop) = izaa(iop)
minst = 0
call put42
iz(i) = izb(i)
iz(iop) = izaa(iop)
minst = 1
call put42
if (nflg(i) .gt. 0) go to 121
iz(i) = iza(i)
iz(iop) = izb(iop)
minst = 0
call put42
iz(i) = izb(i)
iz(iop) = izb(iop)
minst = 1
call put42
121 continue
return
end
|
