qc2sky.f90

QC2sky有效的把TEQC生成的卫星相关信息图形化

!----------------------------------------------------------------
! QC2SKY - PLOTTING TOOL FOR TEQC USER
!
! Copyright (C) 2004 Marco Roggero <[e-mail]>
!
! This program is free software; you can redistribute it and/or
! modify it under the terms of the GNU General Public License
! as published by the Free Software Foundation; either version 2,
! or (at your option) any later version.
!
! This program is distributed in the hope that it will be useful,
! but WITHOUT ANY WARRANTY; without even the implied warranty of
! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
! GNU General Public License for more details.
!
! You should have received a copy of the GNU General Public License
! along with this program; if not, write to the Free Software
! Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
!----------------------------------------------------------------

program QC2SKY

use dflib

implicit integer*4      (a-n)
implicit real*8         (o-z)

type (windowconfig) wc
type (wxycoord) xy

logical status /.FALSE./

character*100   file,filename,f_azi,f_ele,f_iod,f_ion,f_mp1,f_mp2,f_sn1,f_sn2,f_out
character*40    buffer
character*8             tempc(64)
character*1             ev,back
real*8                  track(20000,64,8),temp(64,2)
integer*4               sv(64),res4,col(256)
integer*2               res2,px(1),py(1),event(20000,64)

equivalence (evr,evc)

1       format (<nsat>(F8.3,2X))
2       format (360(F8.3,1X))
3       format (<nsat>(A8,A1,1X))

pi      = 3.1415926535897932384626434d0

!================================================================
! INPUT PROGRAM ARGUMENTS
!================================================================

narg = NARGS( )

if (narg.eq.5) then
        call GETARG (1,buffer); read (buffer,*) file
        call GETARG (2,buffer); read (buffer,*) cut
        call GETARG (3,buffer); read (buffer,*) width
        call GETARG (4,buffer); read (buffer,*) back
        if (width.gt.9.d0) width = 9.d0
        width   = width/1000.d0

        !----------------------------------------------------------------
        !Setting graphs
        !----------------------------------------------------------------
        ! Set the x & y pixels to 1024X768 and font size to 8x12
        wc%numxpixels   = 1024
        wc%numypixels   = 768
        wc%numtextcols  = -1
        wc%numtextrows  = -1
        wc%numcolors    = -1
        wc%title                = "QC2SKY"C
        wc%fontsize             = #0008000C

        status  = SETWINDOWCONFIG (wc)
        if (.NOT.status) status = SETWINDOWCONFIG(wc)
        
        status  = GETWINDOWCONFIG (wc)
        
        npx     = wc.numxpixels
        npy     = wc.numypixels
        
        call      SETVIEWPORT   (INT2(npy/10), INT2(npy/10), INT2(npy/10+7*npy/10), INT2(npy/10+7*npy/10))
        res2    = SETWINDOW             (.TRUE.,         -1.d0, -1.d0, 1.d0, 1.d0) 
        
        ! Set background color
        select case (back)
                case ('B')
                        res4    = SETBKCOLORRGB (#000000)
                case ('b')
                        res4    = SETBKCOLORRGB (#000000)
        
                case ('W')
                        res4    = SETBKCOLORRGB (#FFFFFF)
                case ('w')
                        res4    = SETBKCOLORRGB (#FFFFFF)
                
                case default
                        res4    = SETBKCOLORRGB (#000000)
        
        end select
        
        ! Set palette
        do cr = #00,#FF,#08
        do cc = #00,#FF,#08
        ct              = (cr/#08)+(cc/#08)+#01
        col(ct) = RGBTOINTEGER (#FF,cr,cc)
        end do
        end do
        
        status  = REMAPALLPALETTERGB(col)
        
        ! Draw palette
        !do cr = #00,#FF,#08
        !do cc = #00,#FF,#08
        !ct             = (cr/#08)+(cc/#08)+#01
        !col(ct)        = RGBTOINTEGER (#FF,cr,cc)
        !res2   = SETCOLOR (int2(ct))
        !res2   = RECTANGLE_W($GFILLINTERIOR, -1.d0+2.d0*(ct-1.d0)/64.d0, 0.0d0, -1.d0+2.d0*ct/64.d0, 0.3d0)
        !end do
        !end do
        !pause
        
        !----------------------------------------------------------------
        ! Define and open TEQC output files 
        !----------------------------------------------------------------
        f_azi   = trim(file)//'.azi'
        f_ele   = trim(file)//'.ele'
        f_iod   = trim(file)//'.iod'
        f_ion   = trim(file)//'.ion'
        f_mp1   = trim(file)//'.mp1'
        f_mp2   = trim(file)//'.mp2'
        f_sn1   = trim(file)//'.sn1'
        f_sn2   = trim(file)//'.sn2'
        f_out   = trim(file)//'.out'
        
        open (1,file=f_azi,action='read')
        open (2,file=f_ele,action='read')
        open (3,file=f_iod,action='read')
        open (4,file=f_ion,action='read')
        open (5,file=f_mp1,action='read')
        open (6,file=f_mp2,action='read')
        open (7,file=f_sn1,action='read')
        open (8,file=f_sn2,action='read')

        open (9,file='log.ele',action='write')
        
        !----------------------------------------------------------------
        ! Read TEQC output
        !----------------------------------------------------------------
        !Skip header
        do f=1,8
        do n=1,4
        read (f,*)
        end do
        end do
        
        !Read *.azi & *.ele
        nepo    = 0
        do while (.not.(eof(1)))
                nepo    = nepo+1
                read (1,*) n,sv(1:n)
                read (2,*) 
                if (n.gt.0) nsat = n
                read (1,*) temp(1:nsat,1)
                read (2,*) temp(1:nsat,2)
                do n=1,nsat
                        temp(n,1)                       = temp(n,1)+180.d0
                        if (temp(n,1).lt.  0.d0) temp(n,1)=temp(n,1)+360.d0
                        if (temp(n,1).gt.360.d0) temp(n,1)=temp(n,1)-360.d0
                        track(nepo,sv(n),1)     = temp(n,1)
                        track(nepo,sv(n),2)     = temp(n,2)
                end do
		write (9,'(A2,F10.2,A3,31F8.2)') 'el', real(nepo), '  0', track(nepo,1:31,2)
		end do

        !Read and plot TEQC output
        do f=3,8
        
                        ! Draw graphic background
                        call      CLEARSCREEN ($GCLEARSCREEN ) 
        
                        res2    = SETCOLORRGB (#303000)
                        res2    = ELLIPSE_W ($GFILLINTERIOR, -1.d0, -1.d0, 1.d0, 1.d0)
                        res2    = SETCOLORRGB (#FFFF00)
                        res2    = ELLIPSE_W ($GBORDER,       -1.d0, -1.d0, 1.d0, 1.d0)
        
                        do n=cut,90,1
                                if (n.gt.0) then
                                        r = 1.d0-n/90.d0
                                else
                                        r = 1.d0
                                end if
                                res4    = RGBTOINTEGER(0, 0, 100*r)
                                res2    = SETCOLORRGB (res4)
                                res2    = ELLIPSE_W ($GFILLINTERIOR, -r, -r, r, r)
                        end do