kceles.f File Reference

Go to the source code of this file.

Functions/Subroutines
subroutine	kcelei (tlat, tlon, dtgmt, height)
subroutine	kgcrc (fai, al, h, u, v, w)
subroutine	ksidet (year, month, day, time, st)
subroutine	kmjd (year, month, day, time, mjd)
subroutine	ksided (time, st0, st)
subroutine	kside0 (ed, st0)
subroutine	ktu (iyear, month, day, ed)
subroutine	khtoe (st, hx, hy, hz, ex, ey, ez)
subroutine	ketoh (st, ex, ey, ez, hx, hy, hz)
subroutine	ketod (delta, alfa, ex, ey, ez)
subroutine	kdtoe (ex, ey, ez, delta, alfa)
subroutine	kdtoh (hx, hy, hz, teta, fai)
subroutine	kadthi (astox)
subroutine	kadth (ax, ay, az, hx, hy, hz)
subroutine	khtad (hx, hy, hz, ax, ay, az)
subroutine	kdhtoh (del, h, w1, w2, w3)
subroutine	kdztoh (del, w3, h, icon)
subroutine	kdzth2 (del, w3, h, icon)
subroutine	keqtog (dec, ra, glat, glon)
subroutine	kgtoeq (glat, glon, dec, ra)
subroutine	kgdted (gx, gy, gz, ex, ey, ez)
subroutine	kmjdym (mjd, y, m, d, time)
subroutine	kdcmjd (mjd, iy, im, id, ihr, imn, sec)
subroutine	kmjdst (mjd, st)
subroutine	kmjdtj (mjd, jd)
subroutine	kjtmjd (jd, mjd)
subroutine	kpmtrx (mjd, pij)
subroutine	kmtoj2 (mjd, t)
subroutine	kj2tox (pij, ex2, ey2, ez2, ex, ey, ez)
subroutine	kxtoj2 (pij, ex, ey, ez, ex2, ey2, ez2)
subroutine	kmoon (mjd, elat, elon, rmoon)
real *8 function	ksind (x)
real *8 function	kcosd (x)
subroutine	kctoq (mjd, cx, cy, cz, ex, ey, ez)
subroutine	kqtoc (mjd, ex, ey, ez, cx, cy, cz)
subroutine	kmobec (mjd, cose, sine)
subroutine	ksuneq (mjd, ex, ey, ez)
subroutine	ksun (mjd, slon, rsun)
subroutine	kadbp (nftch, dx, dy, dz, dt, wt, u, v, w, tz, icon)
subroutine	knormv (a1, b1, c1, fn1)
subroutine	kvtoa (vx, vy, vz, teta, fai)
subroutine	kdtoa (vx, vy, vz, teta, fai)
subroutine	kdifva (a1, a2, b1, b2, c1, c2, difax,
subroutine	komeg0 (odec, ora)
subroutine	koangl (odec, ora, dec, ra, teta)
subroutine	kgcttc (mjd, ex, ey, ez, rs, tex, tey, tez)
subroutine	kmoont (mjd, ex, ey, ez)
subroutine	kb50j2 (dec, ra, dec2, ra2)
subroutine	kj2b50 (dec2, ra2, dec, ra)
subroutine	kj90j2 (dec, ra, dec2, ra2)
subroutine	kj2j90 (dec2, ra2, dec, ra)
subroutine	kjxjy (mjd1, mjd2, dec1, ra1, dec2, ra2)

Function/Subroutine Documentation

kadbp()

subroutine kadbp	(		nftch,
		dimension(nftch)	dx,
		dimension(nftch)	dy,
		dimension(nftch)	dz,
		dimension(nftch)	dt,
		dimension(nftch)	wt,
			u,
			v,
			w,
			tz,
			icon
	)

Definition at line 1251 of file kceles.f.

References a, d, d0, dx, h, i, o, p, r, and z.

      implicit real*8  (a-h, o-z)
      dimension dt(nftch),dx(nftch),dy(nftch),dz(nftch),wt(nftch)
!----------------------------------------------------------------------
      sww=0.d0
      swx=0.d0
      swy=0.d0
      swz=0.d0
      swt=0.d0
      sxy=0.d0
      syz=0.d0
      szx=0.d0
      sxt=0.d0
      syt=0.d0
      sx2=0.d0
      sy2=0.d0
       do   i=1,nftch
        sww=sww+wt(i)
        swx=swx+dx(i)*wt(i)
        swy=swy+dy(i)*wt(i)
        swz=swz+dz(i)*wt(i)
        swt=swt+dt(i)*wt(i)
        sxy=sxy+dx(i)*dy(i)*wt(i)
        syz=syz+dy(i)*dz(i)*wt(i)
        szx=szx+dz(i)*dx(i)*wt(i)
        sxt=sxt+dx(i)*dt(i)*wt(i)
        syt=syt+dy(i)*dt(i)*wt(i)
        sx2=sx2+dx(i)*dx(i)*wt(i)
        sy2=sy2+dy(i)*dy(i)*wt(i)
       enddo
!
      a1=sww*sx2-swx*swx
      a2=sww*sxy-swx*swy
      a3=sww*szx-swx*swz
      a4=sww*sxt-swx*swt
      b1=a2
      b2=sww*sy2-swy*swy
      b3=sww*syz-swy*swz
      b4=sww*syt-swy*swt
      ab=a1*b2-a2*b1
      if(abs(ab).gt.1.d-6) then
        p=(a2*b3-a3*b2)/ab
        q=(a2*b4-a4*b2)/ab
        r=(a3*b1-a1*b3)/ab
        s=(a4*b1-a1*b4)/ab
        aa=p*p+r*r+1.0d0
        bb=0.6*(p*q+r*s)
        cc=0.09*(q*q+s*s)-1.0d0
        t1=-0.5d0*bb/aa
        t2=bb*bb-4.d0*aa*cc
        if(t2.lt.0.d0) then
!             % solution is imaginary %
          icon=2
        else
!             % solvable ] %
          t2=0.5d0*sqrt(t2)/aa
          w=t1+t2
          if(w.lt.0.d0) w=t1-t2
          u=p*w+0.3d0*q
          v=r*w+0.3d0*s
          tz=(u*swx+v*swy+w*swz+0.3d0*swt)/(0.3d0*sww)
          if(abs(u).le.1.0d0 .and. abs(v).le.1.0d0) then
            icon=0
          else
!                 % solution is not normalized %
            icon=1
          endif
        endif
!            direction cosines cannot be determined
      else
        icon=3
      endif
      return

kadth()

subroutine kadth	(		ax,
			ay,
			az,
			hx,
			hy,
			hz
	)

Definition at line 384 of file kceles.f.

References a, cossx, h, o, sinsx, and z.

         implicit real*8 (a-h, o-z)
#include  "Zkcele.h"
          hx=ax*cossx - ay*sinsx
          hy=ax*sinsx + ay*cossx
          hz=az

kadthi()

subroutine kadthi

(

astox

)

Definition at line 378 of file kceles.f.

References a, cos, cossx, h, o, sinsx, and z.

Referenced by cinitobs().

         implicit real*8 (a-h, o-z)
#include  "Zkcele.h"
          cossx=cos(astox*torad)
          sinsx=sin(astox*torad)

Here is the caller graph for this function:

kb50j2()

subroutine kb50j2	(		dec,
			ra,
			dec2,
			ra2
	)

Definition at line 1572 of file kceles.f.

References a, d0, h, kdtoe(), ketod(), o, and z.

        implicit real*8 (a-h, o-z)
             call ketod(dec, ra, ex, ey, ez)
!            write(*,*) ' ex, ,, ', ex, ey, ez
             ex2=.9999256782d0*ex-0.011182061d0*ey-0.0048579477d0*ez
             ey2=0.0111820609d0*ex+.9999374784d0*ey-0.0000271765d0*ez
             ez2=0.0048579479d0*ex-0.0000271474d0*ey+.9999881997d0*ez
!            write(*,*) ' ex2 ,, ', ex2, ey2, ez2
             call kdtoe(ex2, ey2, ez2, dec2, ra2)

Here is the call graph for this function:

kcelei()

subroutine kcelei	(		tlat,
			tlon,
			dtgmt,
			height
	)

Definition at line 125 of file kceles.f.

References a, cos, coslat, dtgmts, h, heighs, height, kgcrc(), o, sinlat, tlats, tlons, ug, vg, and z.

Referenced by cinitobs().

!
!   tlat: input. latitude of the place in deg. (+for northern hemisph..
!   tlon: input. longitude of the place in deg. (+ for east, - for west
!   dtgmt: input. time difference from gmt of the place. in hour.
!          + for earlier time
!  height: input. height of the place above the sea level (m).
!
         implicit real*8 (a-h, o-z)
#include  "Zkcele.h"
!
             tlons=tlon
             tlats=tlat
             coslat=cos(tlats*torad)
             sinlat=sin(tlats*torad)
!
             dtgmts=dtgmt
             heighs=height
!                get geocentric rectangular coordinate of the
!                place. (ug, vg, wg)
             call kgcrc(tlats, tlons, heighs, ug, vg, wg)
!                correction to geocenter (in japan)
             ug=ug-136.
             vg=vg+521.
             wg=wg+681.
             return
       entry kceleq(tla, tlo, dt, h)
!            inquire current const for kcelei
           tlo=tlons
           tla=tlats
           dt=dtgmts
           h=heighs
           return

Here is the call graph for this function:

Here is the caller graph for this function:

kcosd()

real*8 function kcosd

(

x

)

Definition at line 1091 of file kceles.f.

References a, cos, h, o, x, and z.

!                cos x with x in degree
         implicit real*8 (a-h, o-z)
#include  "Zkcele.h"
         kcosd=cos(x*torad)

kctoq()

subroutine kctoq	(	real*8	mjd,
			cx,
			cy,
			cz,
			ex,
			ey,
			ez
	)

Definition at line 1108 of file kceles.f.

References a, h, kmobec(), o, and z.

Referenced by kmoont(), and ksuneq().

!
          implicit real*8 (a-h, o-z)
          real*8  mjd
!           get mean obliquity of the ecliptic
          call kmobec(mjd, cose, sine)
          ex=cx
          ey=cy*cose - cz*sine
          ez=cy*sine + cz*cose

Here is the call graph for this function:

Here is the caller graph for this function:

kdcmjd()

subroutine kdcmjd	(	real*8	mjd,
			iy,
			im,
			id,
			ihr,
			imn,
			sec
	)

Definition at line 695 of file kceles.f.

References a, d0, h, n, o, time(), and z.

         implicit real*8 (a-h, o-z)
!     input  mjd :  modified julian day (fractional) real*8
!     output  iy : year  im month id day of month
        real*8  mjd
!
        time =(mjd- int(mjd))*24.0d0
        ihr  = int(time)
        time =(time - ihr)*60.d0
        imn  = int(time)
        sec  =(time - imn)*60.d0
!
        jd= int(mjd + 2400001.0d0)
        l = jd + 68569
        n = 4*l/146097
        l = l - (146097*n+3)/4
        iy = 4000*(l+1)/1461001
        l = l - 1461*iy/4+31
        im = 80*l/2447
        id = l - 2447*im/80
        l = im/11
        im = im + 2 - 12*l
        iy = 100*(n-49) + iy + l

Here is the call graph for this function:

kdhtoh()

subroutine kdhtoh	(		del,
			h,
			w1,
			w2,
			w3
	)

Definition at line 408 of file kceles.f.

References a, cos, coslat, d0, h, o, sinlat, tofai, and z.

Referenced by cinisprimang(), csprimapsang(), and csprimpsang().

!
       implicit real*8 (a-h, o-z)
#include  "Zkcele.h"
           data delsv/-100.d0/
           save delsv, cosd, sind
!
           if(del .ne. delsv) then
               cosd=cos(del*torad)
               sind=sin(del*torad)
               delsv=del
           endif
           fai=h*tofai *torad
           sinfai=sin(fai)
           cosfai=cos(fai)
           w1=sinlat*cosd*cosfai - coslat*sind
           w2=cosd*sinfai
           w3=coslat*cosd*cosfai + sinlat*sind

Here is the caller graph for this function:

kdifva()

subroutine kdifva	(		a1,
			a2,
			b1,
			b2,
			c1,
			c2,
			difax
	)

Definition at line 1366 of file kceles.f.

References a, d0, h, o, and z.

     * difay, difa)
         implicit real*8 (a-h, o-z)
#include  "Zkcele.h"
!
            tetap(ww1, ww2)= asin( ww1/ sqrt(abs(1.d0-ww2**2)))* todeg
!              component of angle difference
            tmp= a1*a2+b1*b2+c1*c2
            if(tmp .ge. 1.00d0) then
                difa=-1.d0
            else
                difax= tetap(a1,b1) - tetap(a2, b2)
                difay= tetap(b1,a1) - tetap(b2, a2)
                difa=acos( tmp  )*todeg
            endif

kdtoa()

subroutine kdtoa	(		vx,
			vy,
			vz,
			teta,
			fai
	)

Definition at line 1342 of file kceles.f.

References a, d, d0, h, o, and z.

Referenced by kdtoe(), kdtoh(), keqtog(), and kvtoa().

         implicit real*8 (a-h, o-z)
#include  "Zkcele.h"
           if(vz .gt. 1.d0) then
              teta=0.
           else
              teta=acos(vz)
           endif
           if(abs(teta) .lt. 1.d-4) then
               fai=0.
           else
               fai=atan2(vy, vx)
           endif
!            to degree
           teta=todeg*teta
           fai=todeg*fai

Here is the caller graph for this function:

kdtoe()

subroutine kdtoe	(		ex,
			ey,
			ez,
			delta,
			alfa
	)

Definition at line 354 of file kceles.f.

References a, d0, f, h, kdtoa(), o, t, and z.

Referenced by kb50j2(), kgtoeq(), kj2b50(), kj2j90(), kj90j2(), and kjxjy().

         implicit real*8 (a-h, o-z)
!       this can be used to get other latitude and longitude
!       from direction cosines.     (say ecliptic coordinate)
            call kdtoa(ex, ey, ez, t, f)
            delta=90.d0-t
            alfa=mod(f+360.d0, 360.d0)

Here is the call graph for this function:

Here is the caller graph for this function:

kdtoh()

subroutine kdtoh	(		hx,
			hy,
			hz,
			teta,
			fai
	)

Definition at line 362 of file kceles.f.

References a, d0, f, h, kdtoa(), o, t, and z.

         implicit real*8 (a-h, o-z)
            call kdtoa(hx, hy, hz, t, f)
            teta=90.d0-t
            fai=mod(360.d0-f, 360.d0)

Here is the call graph for this function:

kdzth2()

subroutine kdzth2	(		del,
			w3,
			h,
			icon
	)

Definition at line 488 of file kceles.f.

References a, cos, coslat, d, d0, h, o, sinlat, toh, and z.

Referenced by cinisprimang().

!      ************
!
         implicit real*8 (a-h, o-z)
#include  "Zkcele.h"
           data delsv/-100.d0/
           save delsv, cosd, sind

           if(del .ne. delsv) then
               cosd=cos(del*torad)
               sind=sin(del*torad)
               delsv=del
           endif
           if(cosd .eq. 0.d0 .or. coslat .eq. 0.d0) then
              if(abs(w3-sinlat*sind) .le. 1.d-5) then
                 h=12.d0
                 icon=0
              elseif(w3 .lt. sinlat*sind) then
                 w3=sinlat*sind
                 h=12.d0
                 icon=1
              else
                 icon=2
              endif
           else
              cosx=( w3 - sind*sinlat )/cosd/coslat
              if(abs(cosx) .le. 1.d0) then
                 icon=0
                 fai=acos(cosx)*todeg
                 h=fai*toh
              elseif(abs(w3- sinlat*sind) .le. 1.d-5) then
                 icon=0
                 h=12.d0
              elseif(w3 .lt. sinlat*sind) then
                 h=12.d0
                 w3=sinlat*sind
                 icon=1
              else
                 icon=2
              endif
           endif

Here is the caller graph for this function:

kdztoh()

subroutine kdztoh	(		del,
			w3,
			h,
			icon
	)

Definition at line 435 of file kceles.f.

References a, cos, coslat, d, d0, h, o, sinlat, toh, and z.

!      ************
!
         implicit real*8 (a-h, o-z)
#include  "Zkcele.h"
           data delsv/-100.d0/
           save delsv, cosd, sind

           if(del .ne. delsv) then
               cosd=cos(del*torad)
               sind=sin(del*torad)
               delsv=del
           endif
           if(cosd .eq. 0. .or. coslat .eq. 0.) then
              if(abs(w3-sinlat*sind) .le. 1.d-5) then
                 h=12.d0
                 icon=0
              else
                 icon=1
              endif
           else
              cosx=( w3 - sind*sinlat )/cosd/coslat
              if(abs(cosx) .le. 1.d0) then
                 icon=0
                 fai=acos(cosx)*todeg
                 h=fai*toh
              elseif(abs(w3- sinlat*sind) .le. 1.d-5) then
                 icon=0
                 h=12.d0
              else
                 icon=1
              endif
           endif

keqtog()

subroutine keqtog	(		dec,
			ra,
			glat,
			glon
	)

Definition at line 538 of file kceles.f.

References a, d0, h, kdtoa(), ketod(), o, and z.

         implicit real*8 (a-h, o-z)
!
             call ketod(dec, ra, ex, ey, ez)
             call kedtgd(ex, ey, ez, gx, gy, gz)
             call kdtoa(gx, gy, gz, glat, glon)
             glat=90.d0-glat
             glon=mod(glon+360.d0, 360.d0)

Here is the call graph for this function:

ketod()

subroutine ketod	(		delta,
			alfa,
			ex,
			ey,
			ez
	)

Definition at line 330 of file kceles.f.

References a, cos, h, o, and z.

Referenced by kb50j2(), keqtog(), kgtoeq(), kj2b50(), kj2j90(), kj90j2(), kjxjy(), kmoont(), koangl(), komeg0(), and ksuneq().

         implicit real*8 (a-h, o-z)
!           convert r.a and declination into direction cos
!       this can be used to get other direction cosines
!       from latitude and longitude (say ecliptic coordinate)
#include  "Zkcele.h"
          cosa=cos(alfa*torad)
          sina=sin(alfa*torad)
          cosd=cos(delta*torad)
          sind=sin(delta*torad)
!
          ex=cosd*cosa
          ey=cosd*sina
          ez=sind
          return
       entry khtod(h, a, hx, hy, hz)
          cosh=cos(h*torad)
          sinh=sin(h*torad)
          cosa=cos(a*torad)
          sina=sin(a*torad)
          hx=cosh*cosa
          hy=-cosh*sina
          hz=sinh

Here is the caller graph for this function:

ketoh()

subroutine ketoh	(		st,
			ex,
			ey,
			ez,
			hx,
			hy,
			hz
	)

Definition at line 321 of file kceles.f.

References a, cos, coslat, h, o, sinlat, and z.

         implicit real*8 (a-h, o-z)
#include  "Zkcele.h"
           coss=cos(st*torad)
           sins=sin(st*torad)
           hx=ex*sinlat*coss + ey*sinlat*sins - ez*coslat
           hy=-ex*sins + ey*coss
           hz= ex*coslat*coss  + ey*coslat*sins + ez * sinlat

kgcrc()

subroutine kgcrc	(		fai,
			al,
			h,
			u,
			v,
			w
	)

Definition at line 162 of file kceles.f.

References a, ae, d0, h, o, and z.

Referenced by kcelei().

!           fai: input. latitude  in deg.
!           al: input. longitude in deg.
!           h: input. height in m
!           u, v, w: output. coordinate of the place in the geocentric
!                  rectangular system.
!                   (in m).
           implicit real*8 (a-h, o-z)
           real*8 ksind, kcosd
           real*8 n
!                besselian ellipsoid
          data ae/6377.397155d03/
          data e2/0.006674372230614d0/
!
          sinf=ksind(fai)
          n=ae/sqrt(1.d0 - e2*sinf**2)
          cosf=kcosd(fai)
          u=(n+h)*cosf * kcosd(al)
          v=(n+h)*cosf * ksind(al)
          w=(n*(1.d0-e2)+h) * sinf

Here is the caller graph for this function:

kgcttc()

subroutine kgcttc	(	real*8	mjd,
			ex,
			ey,
			ez,
			rs,
			tex,
			tey,
			tez
	)

Definition at line 1481 of file kceles.f.

References a, b, c, h, kmjdst(), knormv(), o, tlons, ug, vg, and z.

Referenced by kmoont().

           implicit real*8 (a-h, o-z)
#include  "Zkcele.h"
             real*8 mjd, ksind, kcosd
!             get mean greenwich siderial time in degree
             call kmjdst(mjd, st)
             st=st-tlons
             csg=kcosd(st)
             sng=ksind(st)
!              get geocentric equatorial coord. of the observation
!              place
             a=ug*csg - vg*sng
             b=ug*sng + vg*csg
             c=wg
!              convert the object position into topocentric coord.
             da=ex*rs - a
             db=ey*rs - b
             dc=ez*rs - c
!                normalize the vector, da,db,dc
             call knormv(da, db, dc, dummy)
             tex=da
             tey=db
             tez=dc

Here is the call graph for this function:

Here is the caller graph for this function:

kgdted()

subroutine kgdted	(		gx,
			gy,
			gz,
			ex,
			ey,
			ez
	)

Definition at line 560 of file kceles.f.

References a, cos, d0, f, false, h, o, parameter(), t, and z.

Referenced by kgtoeq().

!
         implicit real*8 (a-h, o-z)
#include  "Zkcele.h"
           logical first/.true./
           parameter(
     +     t=(12.d0+49d0/60.d0)*15.d0*torad, f=62.6d0*torad)
!
           if(first) then
               first=.false.
               cos33=cos(33.d0*torad)
               sin33=sin(33.d0*torad)
               sint=sin(t)
               cost=cos(t)
               sinf=sin(f)
               cosf=cos(f)
               a11=-sint
               a12=-cost*cosf
               a13=cost*sinf
               a21=cost
               a22=-sint*cosf
               a23=sint*sinf
               a32=sinf
               a33=cosf
               b11=-sint
               b12=cost
               b21=-cosf*cost
               b22=-cosf*sint
               b23=sinf
               b31=sinf*cost
               b32=sinf*sint
               b33=cosf
           endif
           gxp=cos33*gx + sin33*gy
           gyp=-sin33*gx + cos33*gy
           gzp=gz
           ex=a11*gxp +a12*gyp + a13*gzp
           ey=a21*gxp +a22*gyp + a23*gzp
           ez=         a32*gyp + a33*gzp
           return
! ---------------------  e to g ----------------------
      entry kedtgd(ex, ey, ez, gx, gy, gz)
           if(first) then
               first=.false.
               cos33=cos(33.d0*torad)
               sin33=sin(33.d0*torad)
               sint=sin(t)
               cost=cos(t)
               sinf=sin(f)
               cosf=cos(f)
               a11=-sint
               a12=-cost*cosf
               a13=cost*sinf
               a21=cost
               a22=-sint*cosf
               a23=sint*sinf
               a32=sinf
               a33=cosf
               b11=-sint
               b12=cost
               b21=-cosf*cost
               b22=-cosf*sint
               b23=sinf
               b31=sinf*cost
               b32=sinf*sint
               b33=cosf
           endif
           gxp=b11*ex + b12*ey
           gyp=b21*ex + b22*ey + b23*ez
           gzp=b31*ex + b32*ey + b33*ez
           gx= cos33*gxp -sin33*gyp
           gy= sin33*gxp + cos33*gyp
           gz=gzp
           return

Here is the call graph for this function:

Here is the caller graph for this function:

kgtoeq()

subroutine kgtoeq	(		glat,
			glon,
			dec,
			ra
	)

Definition at line 548 of file kceles.f.

References a, h, kdtoe(), ketod(), kgdted(), o, and z.

         implicit real*8 (a-h, o-z)
             call ketod(glat, glon, gx, gy, gz)
             call kgdted(gx, gy, gz, ex, ey, ez)
             call kdtoe(ex, ey, ez, dec, ra)

Here is the call graph for this function:

khtad()

subroutine khtad	(		hx,
			hy,
			hz,
			ax,
			ay,
			az
	)

Definition at line 392 of file kceles.f.

References a, cossx, h, o, sinsx, and z.

Referenced by csprimapsang(), and csprimpsang().

         implicit real*8 (a-h, o-z)
#include  "Zkcele.h"
          ax=hx*cossx + hy*sinsx
          ay=-hx*sinsx + hy*cossx
          az=hz

Here is the caller graph for this function:

khtoe()

subroutine khtoe	(		st,
			hx,
			hy,
			hz,
			ex,
			ey,
			ez
	)

Definition at line 312 of file kceles.f.

References a, cos, coslat, h, o, sinlat, and z.

         implicit real*8 (a-h, o-z)
#include  "Zkcele.h"
           coss=cos(st*torad)
           sins=sin(st*torad)
           ex=hx*coss*sinlat - hy * sins + hz*coss*coslat
           ey=hx*sins*sinlat + hy*coss + hz * sins*coslat
           ez=-hx*coslat  + hz*sinlat

kj2b50()

subroutine kj2b50	(		dec2,
			ra2,
			dec,
			ra
	)

Definition at line 1584 of file kceles.f.

References a, d0, h, kdtoe(), ketod(), o, and z.

        implicit real*8 (a-h, o-z)
             call ketod(dec2, ra2, ex2, ey2, ez2)
!            write(*,*) ' ex2, ,, ', ex2, ey2, ez2
           ex=.9999257080d0*ex2+0.0111789382d0*ey2+0.0048590039d0*ez2
           ey=-0.0111789382d0*ex2+.9999375133d0*ey2-0.0000271579d0*ez2
           ez=-0.0048590038d0*ex2-0.0000271626d0*ey2+.9999881946d0*ez2
!            write(*,*) ' ex ,, ', ex, ey, ez
           call kdtoe(ex, ey, ez, dec, ra)

Here is the call graph for this function:

kj2j90()

subroutine kj2j90	(		dec2,
			ra2,
			dec,
			ra
	)

Definition at line 1616 of file kceles.f.

References a, d0, h, kdtoe(), ketod(), o, and z.

        implicit real*8 (a-h, o-z)
             call ketod(dec2, ra2, ex2, ey2, ez2)
!            write(*,*) ' ex2, ,, ', ex2, ey2, ez2
           ex=.99999732d0*ex2+0.00212430d0*ey2+0.00092315d0*ez2
           ey=-0.00212430d0*ex2+.99999774d0*ey2-0.00000098d0*ez2
           ez=-0.00092315d0*ex2-0.00000098d0*ey2+.99999957d0*ez2
!            write(*,*) ' ex ,, ', ex, ey, ez
           call kdtoe(ex, ey, ez, dec, ra)

Here is the call graph for this function:

kj2tox()

subroutine kj2tox	(	dimension(3,3)	pij,
			ex2,
			ey2,
			ez2,
			ex,
			ey,
			ez
	)

Definition at line 885 of file kceles.f.

References a, h, o, and z.

Referenced by kjxjy().

!
!    pij(3,3): input.   precession matrix obtained in kpmtrx
!    ex2,...ez2: input. directional cosines in j2000 ephemeris
!    ex,...ez: output.  directional cosines at x
!
       implicit real*8 (a-h,o-z)
       dimension pij(3,3)
!
       ex= pij(1,1)*ex2 + pij(1,2)*ey2 + pij(1,3)*ez2
       ey= pij(2,1)*ex2 + pij(2,2)*ey2 + pij(2,3)*ez2
       ez= pij(3,1)*ex2 + pij(3,2)*ey2 + pij(3,3)*ez2

Here is the caller graph for this function:

kj90j2()

subroutine kj90j2	(		dec,
			ra,
			dec2,
			ra2
	)

Definition at line 1604 of file kceles.f.

References a, d0, h, kdtoe(), ketod(), o, and z.

        implicit real*8 (a-h, o-z)
             call ketod(dec, ra, ex, ey, ez)
!            write(*,*) ' ex, ,, ', ex, ey, ez
             ex2=.99999732d0*ex-0.00212430d0*ey-0.00092315d0*ez
             ey2=0.00212430d0*ex+.99999774d0*ey-0.00000098d0*ez
             ez2=0.00092315d0*ex-0.00000098d0*ey+.99999957d0*ez
!            write(*,*) ' ex2 ,, ', ex2, ey2, ez2
             call kdtoe(ex2, ey2, ez2, dec2, ra2)

Here is the call graph for this function:

kjtmjd()

subroutine kjtmjd	(	real*8	jd,
		real*8	mjd
	)

Definition at line 772 of file kceles.f.

References d0.

           real*8 jd, mjd
           mjd=jd-2400000.5d0

kjxjy()

subroutine kjxjy	(	real*8	mjd1,
		real*8	mjd2,
			dec1,
			ra1,
			dec2,
			ra2
	)

Definition at line 1642 of file kceles.f.

References a, h, kdtoe(), ketod(), kj2tox(), kpmtrx(), kxtoj2(), o, and z.

            implicit real*8 (a-h, o-z)
            real*8 mjd1, mjd2
            dimension pij1(3,3), pij2(3,3)
!
!              compute precession matrix
            call kpmtrx(mjd1, pij1)
!
!           do 100 j=1, 3
!              write(*,*) (pij1(i, j), i=1, 3)
! 100       continue
            call kpmtrx(mjd2, pij2)
!           do 200 i=1, 3
!              write(*,*) (pij2(i, j), j=1, 3)
! 200       continue
!                 get vectors
            call ketod(dec1, ra1, ex1, ey1, ez1)
!                 convert     x-->j2000
            call kxtoj2(pij1, ex1, ey1, ez1, ex2, ey2, ez2)
!                 convert  j2000--->y
            call kj2tox(pij2, ex2, ey2, ez2,  ex, ey, ez)
!               convert to dec, ra
            call kdtoe(ex, ey, ez, dec2, ra2)

Here is the call graph for this function:

kmjd()

subroutine kmjd	(	integer*4	year,
		integer*4	month,
		integer*4	day,
			time,
		real*8	mjd
	)

Definition at line 223 of file kceles.f.

References a, d0, dtgmts, h, ktu(), o, time(), and z.

         implicit real*8 (a-h, o-z)
#include  "Zkcele.h"
           integer*4  year, month, day
           real*8 mjd
           call ktu(year, month, day, ed)
!                  get modified julian day
           mjd=ed + (time-dtgmts)/24.d0 + 15019.5d0

Here is the call graph for this function:

kmjdst()

subroutine kmjdst	(	real*8	mjd,
			st
	)

Definition at line 750 of file kceles.f.

References a, d0, h, kmtoj2(), o, parameter(), t, tlons, and z.

Referenced by kgcttc().

         implicit real*8 (a-h, o-z)
#include  "Zkcele.h"
          real*8 mjd
          parameter(c1=(50.54841d0/3600.d0 + 41.d0/60.+18.d0),
     *    c2=8640184.812866d0/3600.d0,
     *    c3=0.0931047d0/3600.d0, c4=-0.0000062d0/3600.d0)
!             get j2000 time
          call kmtoj2(mjd, t)
          am=   ((c4*t+ c3)*t + c2)*t + c1
!            approximate ut1 (dut1  is < 1 sec) if mjd is correct
          ut1=( mjd - int(mjd) )*24.d0
          st=( ut1+ 12.d0 + am )*15.d0 + tlons
          st=mod(st, 360.d0)
          if(st .lt. 0.d0) then
             st=st+360.d0
          endif

Here is the call graph for this function:

Here is the caller graph for this function:

kmjdtj()

subroutine kmjdtj	(	real*8	mjd,
		real*8	jd
	)

Definition at line 768 of file kceles.f.

References d0.

           real*8 mjd, jd
           jd=mjd+2400000.5d0

kmjdym()

subroutine kmjdym	(	real*8	mjd,
		integer*4	y,
		integer*4	m,
		integer*4	d,
			time
	)

Definition at line 641 of file kceles.f.

References a, d0, h, o, time(), and z.

!           not used in janzos.   see kdcmjd
         implicit real*8 (a-h, o-z)
          real*8  mjd,  jd
          integer*4 y, m, d, a, b, c, e, f, g, h
          time=(mjd- int(mjd))*24.d0
          jd=mjd+ 2400000.5d0
          a=int(jd)+68569
          b=int( a/36524.25)
          c=a - int(36524.25d0*b+0.75d0)
          e=int( (c+1)/365.2425d0)
          f= c - int(365.25d0*e)+31
          g=int(f/30.59d0)
          d=f -int(30.59d0*g)+ 0.5d0 + (jd -int(jd))
          h=int(g/11.d0)
          m=g-12*h+2
          y=100*(b-49)+ e + h
          if(d .eq. 32) then
             d=1
             y=y+1
             m=1
          endif

Here is the call graph for this function:

kmobec()

subroutine kmobec	(	real*8	mjd,
			cose,
			sine
	)

Definition at line 1140 of file kceles.f.

References a, cos, d0, h, kmtoj2(), o, t, and z.

Referenced by kctoq(), and kqtoc().

          implicit real*8 (a-h, o-z)
#include  "Zkcele.h"
          real*8  mjd
!              get cos and sin of inclination angle of the
!              mean ecliptic plane.
!               get time from j2000.
           call kmtoj2(mjd, t)
!           eps=(((0.0000005036d0*t -0.000000164d0)*t - 0.01300417d0)*t
           eps=(((0.0000005036d0*t -0.00000164d0)*t - 0.01300417d0)*t
     *         +23.439291d0)*torad
           cose=cos(eps)
           sine=sin(eps)

Here is the call graph for this function:

Here is the caller graph for this function:

kmoon()

subroutine kmoon	(	real*8	mjd,
			elat,
			elon,
			rmoon
	)

Definition at line 955 of file kceles.f.

References a, ae, b, d0, h, i, o, t, and z.

Referenced by kmoont().

          implicit real*8 (a-h, o-z)
#include  "Zkcele.h"
          real*8 mjd, ksind, kcosd
!
          real*8 c(62), d(62), e(62)
          real*8 f(46), g(46), h(46)
!
          data  c/
     1               1.2740d0,  0.6583d0,  0.2136d0,  0.1856d0,
     2    0.1143d0,  0.0588d0,  0.0572d0,  0.0533d0,  0.0459d0,
     3    0.0410d0,  0.0348d0,  0.0305d0,  0.0153d0,  0.0125d0,
     4    0.0110d0,  0.0107d0,  0.0100d0,  0.0085d0,  0.0079d0,
     5    0.0068d0,  0.0052d0,  0.0050d0,  0.0048d0,  0.0040d0,
     6    0.0040d0,  0.0040d0,  0.0039d0,  0.0037d0,  0.0027d0,
     7    0.0026d0,  0.0024d0,  0.0024d0,  0.0022d0,  0.0021d0,
     8    0.0021d0,  0.0021d0,  0.0020d0,  0.0018d0,  0.0016d0,
     9    0.0012d0,  0.0011d0,  0.0009d0,  0.0008d0,  0.0008d0,
     a    0.0007d0,  0.0007d0,  0.0007d0,  0.0006d0,  0.0005d0,
     b    0.0005d0,  0.0005d0,  0.0005d0,  0.0004d0,  0.0004d0,
     c    0.0004d0,  0.0004d0,  0.0003d0,  0.0003d0,  0.0003d0,
     d    0.0003d0,  0.0003d0,  0.0003d0/
!
          data  d/
     1               107.248d0,  51.668d0, 317.831d0, 176.531d0,
     2    292.463d0,  86.16 d0, 103.78 d0,  30.58 d0, 124.86 d0,
     3    342.38 d0,  25.83 d0, 155.45 d0, 240.79 d0, 271.38 d0,
     4    226.45 d0,  55.58 d0, 296.75 d0,  34.5  d0, 290.7  d0,
     5    228.2  d0, 133.1  d0, 202.4  d0,  68.6  d0,  34.1  d0,
     6      9.5  d0,  93.8  d0, 103.3  d0,  65.1  d0, 321.3  d0,
     7    174.8  d0,  82.7  d0,   4.7  d0, 121.4  d0, 134.4  d0,
     8    173.1  d0, 100.3  d0, 248.6  d0,  98.1  d0, 344.1  d0,
     9     52.1  d0, 250.3  d0,  81.0  d0, 207.0  d0,  31.0  d0,
     a    346.0  d0, 294.0  d0,  90.0  d0, 237.0  d0,  82.0  d0,
     b    276.0  d0,  73.0  d0, 112.0  d0, 116.0  d0,  25.0  d0,
     c    181.0  d0,  18.0  d0,  60.0  d0,  13.0  d0,  13.0  d0,
     d    152.0  d0, 317.0  d0, 348.0  d0/
!
           data  e/
     1           -4133.3536d0,  8905.3422d0,  9543.9773d0,  359.9905d0,
     2 9664.0404d0,   638.635d0, -3773.363d0,13677.331d0, -8545.352d0,
     3 4411.998d0,  4452.671d0,  5131.979d0,  758.698d0, 14436.029d0,
     4 -4892.052d0,-13038.696d0,14315.966d0,-8266.71d0, -4493.34d0,
     5 9265.33d0,   319.32d0,   4812.66d0,    -19.34 d0,13317.34d0,
     6 18449.32d0,  -1.33 d0,  17810.68d0,   5410.62d0, 9183.99d0,
     7 -13797.39d0,  998.63d0, 9224.66d0,  -8185.36d0,  9903.97d0,
     8  719.98 d0, -3413.37d0, -19.34d0, 4013.29d0, 18569.38d0,
     9 -12678.71d0, 19208.02d0, - 8586.0d0, 14037.3d0,-7906.7d0,
     a 4052.0 d0,   -4853.3d0,  278.6 d0,   1118.7d0, 22582.7d0,
     b 19088.0d0,  -17450.7d0, 5091.3d0,   -398.7d0, -120.1d0,
     c 9584.7  d0, 720.d0,     -3814.0d0, -3494.7d0,18089.3d0,
     d 5492.0d0,   -40.7d0,    23221.3d0/
!
         data f/
     1            0.2806d0, 0.2777d0, 0.1732d0, 0.0554d0,
     2  0.0463d0, 0.0326d0, 0.0172d0, 0.0093d0, 0.0088d0,
     3  0.0082d0, 0.0043d0, 0.0042d0, 0.0034d0, 0.0025d0,
     4  0.0022d0, 0.0021d0, 0.0019d0, 0.0018d0, 0.0018d0,
     5  0.0017d0, 0.0016d0, 0.0015d0, 0.0015d0, 0.0014d0,
     6  0.0013d0, 0.0013d0, 0.0012d0, 0.0012d0, 0.0011d0,
     7  0.0010d0, 0.0008d0, 0.0008d0, 0.0007d0, 0.0006d0,
     8  0.0006d0, 0.0005d0, 0.0005d0, 0.0004d0, 0.0004d0,
     9  0.0004d0, 0.0004d0, 0.0004d0, 0.0003d0, 0.0003d0,
     a  0.0003d0, 0.0003d0/
!
         data g/
     1           215.147d0,  77.316d0,   4.563d0, 308.98 d0,
     2 343.48d0, 287.90d0,  194.06 d0,  25.6  d0,  98.4  d0,
     3   1.1 d0, 322.4 d0,  266.8  d0, 188.0  d0, 312.5  d0,
     4 291.4 d0, 340.0 d0,  218.6  d0, 291.8  d0,  52.8  d0,
     5 168.7 d0,  73.8 d0,  262.1  d0,  31.7  d0, 260.8  d0,
     6 239.7 d0,  30.4 d0,  304.9  d0,  12.4  d0, 173.0  d0,
     7 312.9 d0,   1.0 d0,  190.0  d0,  22.0  d0, 117.0  d0,
     8  47.0 d0,  22.0 d0,  150.0  d0, 119.0  d0, 246.0  d0,
     9 301.0 d0, 126.0 d0,  104.0  d0, 340.0  d0, 270.0  d0,
     a 358.0 d0, 148.0 d0/
!
         data h/
     1            9604.0088d0,  60.0316d0, -4073.3220d0, 8965.374d0,
     2   698.667d0, 13737.362d0,14375.997d0, -8845.31d0,-4711.96d0,
     3 -3713.33d0,  5470.66d0, 18509.35d0,  -4433.31d0, 8605.38d0,
     4  13377.37d0,  1058.66d0, 9244.02d0, -8206.68d0, 5192.01d0,
     5  14496.06d0,   420.02d0, 9284.69d0, 9964.00d0, - 299.96d0,
     6  4472.03d0,    379.35d0, 4812.68d0, -4851.36d0,19147.99d0,
     7 -12978.66d0, 17870.7d0, 9724.1d0, 13098.7d0, 5590.7d0,
     8 -13617.3d0,  -8485.3d0, 4193.4d0, -9483.9d0, 23282.3d0,
     9  10242.6d0,   9325.4d0,  14097.4d0, 22642.7d0,18149.4d0,
     a  -3353.3d0,  19268.0d0/
!
          t=(mjd-42412.d0)/365.25d0
          t=t + (0.0317d0*t+1.43d0)*1.d-6
!
          a = 0.0040d0*ksind(93.8d0  - 1.33d0*t)
     *       +0.0020d0*ksind(248.6d0 - 19.34d0*t)
     *       +0.0006d0*ksind(66.d0   + 0.2d0*t)
     *       +0.0006d0*ksind(249.d0  -19.3d0*t)
!
          b= 0.0267d0*ksind(68.64d0  - 19.341d0*t)
     *      +0.0043d0*ksind(342.d0   - 19.36d0*t)
     *      +0.0040d0*ksind( 93.8d0  -  1.33 d0*t)
     *      +0.0020d0*ksind(248.6d0  - 19.34d0*t)
     *      +0.0005d0*ksind(358.d0 -   19.4d0*t)
!               longitude
          tmp=124.8754d0+4812.67881d0*t +
     *        6.2887d0*ksind(338.915d0+ 4771.9886d0*t+a)
!
           do   i=1, 62
              tmp=tmp+ c(i)*ksind( d(i) + e(i)*t )
           enddo
          elon=mod(tmp,360.d0)
!               latitude
          tmp=5.1282d0*ksind(236.231d0 + 4832.0202d0*t+b)
!
           do   i=1, 46
              tmp=tmp+ f(i)*ksind( g(i) + h(i)*t )
           enddo
          elat=tmp
!
          sinpi= 0.9507d0
     *          + 0.0518d0*kcosd(338.92d0 + 4771.989d0*t)
     *          + 0.0095d0*kcosd(287.2 d0 - 4133.35 d0*t)
     *          + 0.0078d0*kcosd( 51.7 d0 + 8905.34 d0*t)
     *          + 0.0028d0*kcosd(317.8 d0 + 9543.98 d0*t)
     *          + 0.0009d0*kcosd( 31.0 d0 +13677.3  d0*t)
     *          + 0.0005d0*kcosd(305.0 d0 - 8545.4  d0*t)
     *          + 0.0004d0*kcosd(284.0 d0 - 3773.4  d0*t)
     *          + 0.0003d0*kcosd(342.0 d0 + 4412.0  d0*t)
!
          rmoon=ae/(sinpi*torad)

Here is the caller graph for this function:

kmoont()

subroutine kmoont	(	real*8	mjd,
			ex,
			ey,
			ez
	)

Definition at line 1540 of file kceles.f.

References a, h, kctoq(), ketod(), kgcttc(), kmoon(), o, and z.

          implicit real*8 (a-h, o-z)
!         common /$$$/ ex1, ey1, ez1
          real*8 mjd
!             get ecliptic latitude  and longitude of the moon
          call kmoon(mjd,  elat, elon, rmoon)
!             convert to direction cosine in geocentric ecliptic
          call ketod( elat, elon, cx, cy, cz)
!             convert to geocentric equatorial coordinate
          call kctoq(mjd, cx, cy, cz, ex, ey, ez)
!$$$$$$$$$$$$$$$
!          call kdtoe(ex, ey, ez, dec, ra)
!          write(*,*) ' dec=', dec, ' ra=', ra
!          ex1=ex
!          ey1=ey
!          ez1=ez
!$$$$$$$$$$$$$$
!             convert to topocentric coord.
          call kgcttc(mjd, ex, ey, ez, rmoon, ex, ey, ez)

Here is the call graph for this function:

kmtoj2()

subroutine kmtoj2	(	real*8	mjd,
		real*8	t
	)

Definition at line 871 of file kceles.f.

References d0.

Referenced by kmjdst(), kmobec(), and kpmtrx().

!       days from 2000y01m1.5d (julian day,2451545.0)
!        in unit of 100 julian years
         real*8  t, mjd
         t  = (mjd - 51544.5d0)/36525d0

Here is the caller graph for this function:

knormv()

subroutine knormv	(	real*8	a1,
		real*8	b1,
		real*8	c1,
		real*8	fn1
	)

Definition at line 1327 of file kceles.f.

Referenced by kgcttc().

            real*8 a1, b1, c1, fn1
            fn1=sqrt( a1**2+b1**2+c1**2)
            a1=a1/fn1
            b1=b1/fn1
            c1=c1/fn1

Here is the caller graph for this function:

koangl()

subroutine koangl	(		odec,
			ora,
			dec,
			ra,
			teta
	)

Definition at line 1423 of file kceles.f.

References a, h, ketod(), o, and z.

         implicit real*8 (a-h, o-z)
#include  "Zkcele.h"
           call ketod(odec, ora, ex, ey, ez)
           call ketod(dec, ra, rx, ry, rz)
           cost=ex*rx + ey*ry + ez*rz
           teta=acos(cost)* todeg

Here is the call graph for this function:

komeg0()

subroutine komeg0	(		odec,
			ora
	)

Definition at line 1399 of file kceles.f.

References a, d0, h, ketod(), komega, o, parameter(), pi, and z.

         implicit real*8 (a-h, o-z)
#include  "Zkcele.h"
           parameter(coeff=pi*2.)
           save ex, ey, ez
           call ketod(odec, ora, ex, ey, ez)
           return
       entry komega(dec, ra, omega)
           call ketod(dec, ra, rx, ry, rz)
           cost=ex*rx + ey*ry + ez*rz
           omega= coeff * (1.d0- cost)
           return
       entry komeg1(dec, ra, teta)
           call ketod(dec, ra, rx, ry, rz)
           cost=ex*rx + ey*ry + ez*rz
           teta=acos(cost)* todeg

Here is the call graph for this function:

kpmtrx()

subroutine kpmtrx	(	real*8	mjd,
		dimension(3,3)	pij
	)

Definition at line 841 of file kceles.f.

References a, cos, d0, h, kmtoj2(), o, parameter(), pi, t, and z.

Referenced by kjxjy().

       implicit real*8 (a-h,o-z)
       real*8 mjd
       dimension pij(3,3)
       parameter(pi=3.14159265358979324d0,
     *            torad=pi/3600.d0/180.d0)
!       days from 2000y01m1.5d (julian day,2451545.0)
!        in unit of 100 julian years
       call kmtoj2(mjd, t)
       t2 = t*t
       t3 = t*t2
!
       zeta = 2306.2181d0*t + 0.30188d0*t2 + 0.017998d0*t3
       za =   2306.2181d0*t + 1.09468d0*t2 + 0.018203d0*t3
       teta = 2004.3109d0*t - 0.42665d0*t2 - 0.041833d0*t3
!
       zeta = zeta* torad
       za = za* torad
       teta = teta*torad
!
       pij(1,1) = cos(zeta)*cos(teta)*cos(za) -sin(zeta)*sin(za)
       pij(1,2) =-sin(zeta)*cos(teta)*cos(za) -cos(zeta)*sin(za)
       pij(1,3) =                           -sin(teta)*cos(za)
       pij(2,1) = cos(zeta)*cos(teta)*sin(za) +sin(zeta)*cos(za)
       pij(2,2) =-sin(zeta)*cos(teta)*sin(za) +cos(zeta)*cos(za)
       pij(2,3) =                           -sin(teta)*sin(za)
       pij(3,1) = cos(zeta)*sin(teta)
       pij(3,2) =-sin(zeta)*sin(teta)
       pij(3,3) = cos(teta)

Here is the call graph for this function:

Here is the caller graph for this function:

kqtoc()

subroutine kqtoc	(	real*8	mjd,
			ex,
			ey,
			ez,
			cx,
			cy,
			cz
	)

Definition at line 1120 of file kceles.f.

References a, h, kmobec(), o, and z.

          implicit real*8 (a-h, o-z)
          real*8  mjd
!           get mean obliquity of the ecliptic
         call kmobec(mjd, cose, sine)
         cx=ex
         cy=ey*cose + ez*sine
         cz=-ey*sine + ez*cose

Here is the call graph for this function:

kside0()

subroutine kside0	(		ed,
			st0
	)

Definition at line 263 of file kceles.f.

References a, d0, h, o, parameter(), and z.

Referenced by ksidet().

         implicit real*8 (a-h, o-z)
!                consts.. to get siderial time in degree.
           parameter(
     1      c1= (45.836d0/3600.d0+38.d0/60.d0 + 6.0d0)*15.d0,
     2      c2= 8640184.542d0/3600.d0 *15.d0,
     3      c3= 0.0929d0/3600.d0*15.d0 )
!
!
           tu=ed/36525.d0
           sd=( c3*tu + c2)* tu + c1
           st0=mod(sd, 360.d0)

Here is the call graph for this function:

Here is the caller graph for this function:

ksided()

subroutine ksided	(		time,
			st0,
			st
	)

Definition at line 249 of file kceles.f.

References a, d0, dtgmts, h, o, time(), tlons, and z.

         implicit real*8 (a-h, o-z)
#include  "Zkcele.h"
!              elapsed time from 0ut  in deg.
           et= (time-dtgmts)*15.d0
           std= st0 + tlons + sidcor* et
!               mod(360)
           st=  mod(std, 360.d0)

Here is the call graph for this function:

ksidet()

subroutine ksidet	(	integer*4	year,
		integer*4	month,
		integer*4	day,
			time,
			st
	)

Definition at line 201 of file kceles.f.

References a, d0, dtgmts, h, kside0(), ktu(), o, time(), tlons, and z.

         implicit real*8 (a-h, o-z)
#include  "Zkcele.h"
           integer*4  year, month, day
!
           call ktu(year, month, day, ed)
           call kside0(ed, st0)
!              elapsed time from  0ut  in deg.
           et= (time-dtgmts)*15.d0
           std= st0 + tlons + sidcor* et
!               mod(360)
           st=  mod(std, 360.d0)

Here is the call graph for this function:

ksind()

real*8 function ksind

(

x

)

Definition at line 1085 of file kceles.f.

References a, h, o, x, and z.

!                sin x with x in degree
         implicit real*8 (a-h, o-z)
#include  "Zkcele.h"
         ksind=sin(x*torad)

ksun()

subroutine ksun	(	real*8	mjd,
			slon,
			rsun
	)

Definition at line 1212 of file kceles.f.

References a, b, c, d, d0, e, f, g, h, i, o, t, and z.

Referenced by ksuneq().

          implicit real*8 (a-h, o-z)
#include  "Zkcele.h"
          real*8 mjd, ksind, kcosd
!
          t=(mjd-42412.d0)/365.25d0
          t=t + (0.0317d0*t+1.43d0)*1.d-6
          tmp = 279.0358d0 +360.00769d0*t
     1         +(1.9159d0-0.00005d0*t)*ksind(356.531d0+359.991d0*t)
     2         + 0.02d0             *ksind(353.06d0 + 719.981d0*t)
     3         - 0.0048d0           *ksind(248.64d0 - 19.341d0*t)
     4         + 0.0020d0           *ksind(285.0d0 + 329.64d0*t)
     5         + 0.0018d0           *ksind(334.2d0 -4452.67d0*t)
     6         + 0.0018d0           *ksind(293.7d0 - 0.20d0*t)
     7         + 0.0015d0           *ksind(242.4d0 + 450.37d0*t)
     8         + 0.0013d0           *ksind(211.1d0 + 225.18d0*t)
     9         + 0.0008d0           *ksind(208.0d0 + 659.29d0*t)
     a         + 0.0007d0           *ksind( 53.5d0 +  90.38d0*t)
     b         + 0.0007d0           *ksind( 12.1d0 -  30.35d0*t)
     c         + 0.0006d0           *ksind(239.1d0 + 337.18d0*t)
     d         + 0.0005d0           *ksind( 10.1d0 -   1.50d0*t)
     e         + 0.0005d0           *ksind( 99.1d0 -  22.81d0*t)
     f         + 0.0004d0           *ksind(264.8d0 + 315.56d0*t)
     g         + 0.0004d0           *ksind(233.8d0 + 299.30d0*t)
     h         + 0.0004d0           *ksind(198.1d0 + 720.02d0*t)
     i         + 0.0003d0           *ksind(349.6d0 + 1079.97d0*t)
     k         + 0.0003d0           *ksind(241.2d0 -44.43d0*t)
!
       slon=mod(tmp, 360.d0)
!
       q=(-0.007261d0+0.0000002d0*t)*kcosd(356.53d0 + 359.991d0*t)
     *     + 0.000030d0
     1    - 0.000091d0 * kcosd(353.1d0 + 719.98d0*t)
     2    + 0.000013d0 * kcosd(205.8d0 + 4452.67d0*t)
     3    + 0.000007d0 * kcosd( 62.d0  + 450.4d0*t)
     4    + 0.000007d0 * kcosd(105.d0  + 329.6d0*t)
!
       rsun=10.**q * aunit

Here is the caller graph for this function:

ksuneq()

subroutine ksuneq	(	real*8	mjd,
			ex,
			ey,
			ez
	)

Definition at line 1175 of file kceles.f.

References a, d0, h, kctoq(), ketod(), ksun(), o, and z.

          implicit real*8 (a-h, o-z)
          real*8 mjd
!             get ecliptic longitude in deg
          call ksun(mjd, slon, rsun)
!             convert to directional cos. in ecliptic
          call ketod(0.d0,slon, cx, cy, cz)
!             convert to equatorial coordinate
          call kctoq(mjd, cx, cy, cz, ex, ey, ez)

Here is the call graph for this function:

ktu()

subroutine ktu	(		iyear,
		integer*4	month,
		integer*4	day,
			ed
	)

Definition at line 282 of file kceles.f.

References a, d0, h, o, and z.

Referenced by kmjd(), and ksidet().

         implicit real*8 (a-h, o-z)
           integer*4  year, month, day
           year=mod(iyear, 1900)
           if(month .le. 2) then
               iy=year-1
               im=month+12
           else
               iy=year
               im=month
           endif
           ed= 365*iy + 30*im + day + int(3*(im+1)/5) + int(iy/4)
     1         - 33.5d0

Here is the caller graph for this function:

kvtoa()

subroutine kvtoa	(		vx,
			vy,
			vz,
			teta,
			fai
	)

Definition at line 1335 of file kceles.f.

References a, d, h, kdtoa(), o, and z.

         implicit real*8 (a-h, o-z)
!
           d=sqrt( vx**2 + vy**2 + vz**2)
           call kdtoa(vx/d, vy/d, vz/d, teta, fai)

Here is the call graph for this function:

kxtoj2()

subroutine kxtoj2	(	dimension(3,3)	pij,
			ex,
			ey,
			ez,
			ex2,
			ey2,
			ez2
	)

Definition at line 906 of file kceles.f.

References a, h, o, and z.

Referenced by kjxjy().

!
!    pij(3,3): input.   precession matrix obtained in kpmtrx
!    ex,...ez: input.   directional cosines at x
!    ex2,...ez2: output.directional cosines in j2000 ephemeris
!
       implicit real*8 (a-h,o-z)
       dimension pij(3,3)
!
       ex2= pij(1,1)*ex + pij(2,1)*ey + pij(3,1)*ez
       ey2= pij(1,2)*ex + pij(2,2)*ey + pij(3,2)*ez
       ez2= pij(1,3)*ex + pij(2,3)*ey + pij(3,3)*ez

Here is the caller graph for this function: