📄 qc2sky.f90
字号:
do n=0,90,10
if (n.gt.0) then
r = 1.d0-n/90.d0
else
r = 1.d0
end if
res2 = SETCOLORRGB (#AA0000)
res2 = ELLIPSE_W ($GBORDER, -r, -r, r, r)
end do
r = 1.d0-cut/90.d0
res2 = SETCOLORRGB (#0000FF)
res2 = ELLIPSE_W ($GBORDER, -r, -r, r, r)
res2 = SETCOLORRGB (#AA0000)
call MOVETO_W (-1.d0, 0.d0, xy)
call LINETO_W ( 1.d0, 0.d0)
call MOVETO_W ( 0.d0,-1.d0, xy)
call LINETO_W ( 0.d0, 1.d0)
select case (f)
case (3)
scale = ct
filename = trim(file)//'iod.bmp'
case (4)
scale = ct/16.d0
filename = trim(file)//'ion.bmp'
case (5)
scale = ct/2.d0
filename = trim(file)//'mp1.bmp'
case (6)
scale = ct/2.d0
filename = trim(file)//'mp2.bmp'
case (7)
scale = ct/128.d0 !8.d0
filename = trim(file)//'sn1.bmp'
case (8)
scale = ct/128.d0 !8.d0
filename = trim(file)//'sn2.bmp'
end select
nepo = 0
do while (.not.(eof(f)))
nepo = nepo+1
read (f,*) n,sv(1:n)
if (n.ge.0) nsat = n
if (nsat.gt.0) then
temp(:,1) = 0.d0
read (f,3) tempc(1:2*nsat)
do n=1,nsat
read (tempc(2*n-1),* ) v
read (tempc(2*n ),'(A1)') ev
track(nepo,sv(n),f) = dabs(v)
oa = track(nepo,sv(n),1)
oe = track(nepo,sv(n),2)
call AE2XY (oa,oe,x,y)
if (int2(scale*track(nepo,sv(n),f)).lt.ct) then
res2 = SETCOLOR (int2(scale*track(nepo,sv(n),f)))
else
res2 = SETCOLORRGB (#FFFFFF)
end if
if (width.gt.1.d-3) then
res2 = ELLIPSE_W ($GFILLINTERIOR, x-width, y+width, x+width, y-width)
else
res4 = SETPIXEL_W (x,y)
end if
!Plot events
if ((ev.ne.' ').and.(f.lt.7)) then
event(nepo,sv(n)) = 1
res2 = SETCOLORRGB (#00FF00)
res2 = ELLIPSE_W ($GBORDER, x-12.d-3, y+12.d-3, x+12.d-3, y-12.d-3)
end if
end do
end if
end do
res4 = SAVEIMAGE_W (filename, -1.d0, 1.d0, 1.d0, -1.d0)
end do
!Plot horizon
call SETVIEWPORT (INT2(npy/10), INT2(npy/10), INT2(npy/10+12*npy/10), INT2(npy/10+6*npy/10))
res2 = SETWINDOW (.TRUE., 0.d0, 90.d0, 360.d0, 0.d0)
! Draw graphic background
call CLEARSCREEN ($GCLEARSCREEN )
res2 = SETCOLORRGB (#303000)
res2 = RECTANGLE_W ($GFILLINTERIOR, 0.d0, 90.d0, 360.d0, 0.d0)
res2 = SETCOLORRGB (#FFFF00)
res2 = Rectangle_W ($GBORDER, 0.d0, 90.d0, 360.d0, 0.d0)
do r=cut,90,1
res4 = RGBTOINTEGER(0, 0, 90-r)
res2 = SETCOLORRGB (res4)
res2 = RECTANGLE_W ($GFILLINTERIOR, 0.d0, 90.d0, 360.d0, r)
end do
do r=cut,90,10
res2 = SETCOLORRGB (#AA0000)
call MOVETO_W ( 0.d0, r, xy)
res2 = LINETO_W (360.d0, r)
end do
r = cut
res2 = SETCOLORRGB (#0000FF)
call MOVETO_W ( 0.d0, r, xy)
res2 = LINETO_W (360.d0, r)
res2 = SETCOLORRGB (#AA0000)
call MOVETO_W ( 0.d0, 0.d0, xy)
call LINETO_W ( 0.d0,90.d0)
call MOVETO_W ( 90.d0, 0.d0, xy)
call LINETO_W ( 90.d0,90.d0)
call MOVETO_W (180.d0, 0.d0, xy)
call LINETO_W (180.d0,90.d0)
call MOVETO_W (270.d0, 0.d0, xy)
call LINETO_W (270.d0,90.d0)
call MOVETO_W (360.d0, 0.d0, xy)
call LINETO_W (360.d0,90.d0)
f = 7
scale = ct/128.d0
width = width*1.d2
do n=1,nepo
do m=1,31
if (track(n,m,f).gt.0.d0) then
oa = track(n,m,1)+180
oe = track(n,m,2)
if (oa.gt.360.d0) oa = oa-360.d0
if (int2(scale*track(n,m,f)).lt.ct) then
res2 = SETCOLOR (int2(scale*track(n,m,f)))
else
res2 = SETCOLORRGB (#FFFFFF)
end if
res2 = ELLIPSE_W ($GFILLINTERIOR, oa-width, oe+width, oa+width, oe-width)
!Plot events
if (event(n,m).eq.1) then
res2 = SETCOLORRGB (#00FF00)
res2 = ELLIPSE_W ($GBORDER, oa-16.d-1, oe+10.d-1, oa+16.d-1, oe-10.d-1)
end if
end if
end do
end do
filename = trim(file)//'hor.bmp'
res4 = SAVEIMAGE_W (filename, 0.d0, 90.d0, 360.d0, 0.d0)
close (1)
close (2)
close (3)
close (4)
close (5)
close (6)
close (7)
close (8)
close (9)
result = RAISEQQ (SIG$TERM) !Termination request
else
print (*),'QC2SKY - PLOTTING TOOL FOR TEQC USER'
print (*),' '
print (*),'-------------------------------------------------------------------------'
print (*),'Copyright (C) 2004 Marco Roggero <roggero@atlantic.polito.it>'
print (*),' '
print (*),'This program is free software; you can redistribute it and/or modify'
print (*),'it under the terms of the GNU General Public License as published by the'
print (*),'Free Software Foundation; either version 2, or (at your option) any'
print (*),'later version.'
print (*),' '
print (*),'This program is distributed in the hope that it will be useful, but'
print (*),'WITHOUT ANY WARRANTY; without even the implied warranty of'
print (*),'MERCHANTIBILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU'
print (*),'General Public License for more details.'
print (*),'-------------------------------------------------------------------------'
print (*),' '
print (*),'qc2sky +filename cutoff linewidth background'
print (*),' '
print (*),'where:'
print (*),' '
print (*),' filename TEQC output file, without extension'
print (*),' cutoff cut-off angle [degree]'
print (*),' linewidth line width [1-9]'
print (*),' background background color [b(lack), w(hite)]'
print (*),' '
print (*),'Example:'
print (*),' '
print (*),' qc2sky 24572220 10 4 b'
end if
end program
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -