sun.vb

计算日出日落的vb2005类

        Dim C As Double = Math.Floor((B - 122.1) / 365.25)
        Dim D As Double = Math.Floor(365.25 * C)
        Dim E As Double = Math.Floor((B - D) / 30.6001)

        Dim day As Double = B - D - Math.Floor(30.6001 * E) + f
        Dim month As Double
        If E < 14 Then
            month = E - 1
        Else
            month = E - 13
        End If
        Dim year As Double
        If month > 2 Then
            year = C - 4716
        Else
            year = C - 4715
        End If

        ' alert ("date: " + day + "-" + monthList[month-1].name + "-" + year);

        '  Return (((day & "-") + monthList(month - 1).name & "-") + year)

        Return (((day & "-") + monthList(month - 1).name & "-") + year)
    End Function


    '***********************************************************************/
    '* Name: calcDayFromJD */
    '* Type: Function */
    '* Purpose: Calendar day (minus year) from Julian Day */
    '* Arguments: */
    '* jd : Julian Day */
    '* Return value: */
    '* String date in the form DD-MONTH */
    '***********************************************************************/
    ' 根据儒略日计算月份日子。
    Public Function calcDayFromJD(ByVal jd As Double) As String
        Dim z As Double = Math.Floor(jd + 0.5)
        Dim f As Double = (jd + 0.5) - z
        Dim a As Double
        If z < 2299161 Then
            a = z
        Else
            Dim alpha As Double = Math.Floor((z - 1867216.25) / 36524.25)
            a = z + 1 + alpha - Math.Floor(alpha / 4)
        End If

        Dim B As Double = a + 1524
        Dim C As Double = Math.Floor((B - 122.1) / 365.25)
        Dim D As Double = Math.Floor(365.25 * C)
        Dim E As Double = Math.Floor((B - D) / 30.6001)

        Dim day As Double = B - D - Math.Floor(30.6001 * E) + f
        Dim month As Double
        If E < 14 Then
            month = E - 1
        Else
            month = E - 13
        End If
        Dim year As Double
        If month > 2 Then
            year = C - 4716
        Else
            year = C - 4715
        End If



        If day < 10 Then
            'calcDayFromJD = "0"
            calcDayFromJD = ""
        Else
            calcDayFromJD = ""
        End If
        '    calcDayFromJD &= day.ToString & monthList(month - 1).abbr
        calcDayFromJD &= monthList(month - 1).abbr & day.ToString & "日"
        Return calcDayFromJD
    End Function


    '***********************************************************************/
    '* Name: calcTimeJulianCent */
    '* Type: Function */
    '* Purpose: convert Julian Day to centuries since J2000.0. */
    '* Arguments: */
    '* jd : the Julian Day to convert */
    '* Return value: */
    '* the T value corresponding to the Julian Day */
    '***********************************************************************/

    ' 转换儒略日为世纪。
    Public Function calcTimeJulianCent(ByVal jd As Double) As Double
        Dim T As Double = (jd - 2451545.0R) / 36525.0R
        Return T
    End Function



    '***********************************************************************/
    '* Name: calcJDFromJulianCent */
    '* Type: Function */
    '* Purpose: convert centuries since J2000.0 to Julian Day. */
    '* Arguments: */
    '* t : number of Julian centuries since J2000.0 */
    '* Return value: */
    '* the Julian Day corresponding to the t value */
    '***********************************************************************/

    ' 转换世纪为儒略日。
    Public Function calcJDFromJulianCent(ByVal t As Double) As Double
        Dim JD As Double = t * 36525.0R + 2451545.0R
        Return JD
    End Function


    '***********************************************************************/
    '* Name: calGeomMeanLongSun */
    '* Type: Function */
    '* Purpose: calculate the Geometric Mean Longitude of the Sun */
    '* Arguments: */
    '* t : number of Julian centuries since J2000.0 */
    '* Return value: */
    '* the Geometric Mean Longitude of the Sun in degrees */
    '***********************************************************************/
    ' 计算太阳的平黄经。
    Public Function calcGeomMeanLongSun(ByVal t As Double) As Double
        Dim L0 As Double = 280.46646 + t * (36000.76983 + 0.0003032 * t)
        While L0 > 360.0R
            L0 -= 360.0R
        End While
        While L0 < 0.0R
            L0 += 360.0R
        End While
        Return L0
        ' in degrees
    End Function


    '***********************************************************************/
    '* Name: calGeomAnomalySun */
    '* Type: Function */
    '* Purpose: calculate the Geometric Mean Anomaly of the Sun */
    '* Arguments: */
    '* t : number of Julian centuries since J2000.0 */
    '* Return value: */
    '* the Geometric Mean Anomaly of the Sun in degrees */
    '***********************************************************************/

    ' 计算太阳的平近点角。
    Public Function calcGeomMeanAnomalySun(ByVal t As Double) As Double
        Dim M As Double = 357.52911 + t * (35999.05029 - 0.0001537 * t)
        Return M
        ' in degrees
    End Function

    '***********************************************************************/
    '* Name: calcEccentricityEarthOrbit */
    '* Type: Function */
    '* Purpose: calculate the eccentricity of earth's orbit */
    '* Arguments: */
    '* t : number of Julian centuries since J2000.0 */
    '* Return value: */
    '* the unitless eccentricity */
    '***********************************************************************/


    ' 计算环地轨道的离心率。
    Public Function calcEccentricityEarthOrbit(ByVal t As Double) As Double
        Dim e As Double = 0.016708634 - t * (0.000042037R + 0.0000001267R * t)
        Return e
        ' unitless
    End Function

    '***********************************************************************/
    '* Name: calcSunEqOfCenter */
    '* Type: Function */
    '* Purpose: calculate the equation of center for the sun */
    '* Arguments: */
    '* t : number of Julian centuries since J2000.0 */
    '* Return value: */
    '* in degrees */
    '***********************************************************************/

    ' 计算太阳的中心差。
    Public Function calcSunEqOfCenter(ByVal t As Double) As Double
        Dim m As Double = calcGeomMeanAnomalySun(t)

        Dim mrad As Double = degToRad(m)
        Dim sinm As Double = Math.Sin(mrad)
        Dim sin2m As Double = Math.Sin(mrad + mrad)
        Dim sin3m As Double = Math.Sin(mrad + mrad + mrad)

        Dim C As Double = sinm * (1.914602 - t * (0.004817 + 0.000014R * t)) + sin2m * (0.019993 - 0.000101 * t) + sin3m * 0.000289
        Return C
        ' in degrees
    End Function

    '***********************************************************************/
    '* Name: calcSunTrueLong */
    '* Type: Function */
    '* Purpose: calculate the true longitude of the sun */
    '* Arguments: */
    '* t : number of Julian centuries since J2000.0 */
    '* Return value: */
    '* sun's true longitude in degrees */
    '***********************************************************************/

    ' 计算太阳的真经度。
    Public Function calcSunTrueLong(ByVal t As Double) As Double
        Dim l0 As Double = calcGeomMeanLongSun(t)
        Dim c As Double = calcSunEqOfCenter(t)

        Dim l1 As Double = l0 + c
        Return l1
        ' in degrees
    End Function

    '***********************************************************************/
    '* Name: calcSunTrueAnomaly */
    '* Type: Function */
    '* Purpose: calculate the true anamoly of the sun */
    '* Arguments: */
    '* t : number of Julian centuries since J2000.0 */
    '* Return value: */
    '* sun's true anamoly in degrees */
    '***********************************************************************/
    ' 计算太阳的真近点角。
    Public Function calcSunTrueAnomaly(ByVal t As Double) As Double
        Dim m As Double = calcGeomMeanAnomalySun(t)
        Dim c As Double = calcSunEqOfCenter(t)

        Dim v As Double = m + c
        Return v
        ' in degrees
    End Function

    '***********************************************************************/
    '* Name: calcSunRadVector */
    '* Type: Function */
    '* Purpose: calculate the distance to the sun in AU */
    '* Arguments: */
    '* t : number of Julian centuries since J2000.0 */
    '* Return value: */
    '* sun radius vector in AUs */
    '***********************************************************************/
    ' 计算太阳矢径。
    Public Function calcSunRadVector(ByVal t As Double) As Double
        Dim v As Double = calcSunTrueAnomaly(t)
        Dim e As Double = calcEccentricityEarthOrbit(t)

        Dim R As Double = (1.000001018 * (1 - e * e)) / (1 + e * Math.Cos(degToRad(v)))
        Return R
        ' in AUs
    End Function

    '***********************************************************************/
    '* Name: calcSunApparentLong */
    '* Type: Function */
    '* Purpose: calculate the apparent longitude of the sun */
    '* Arguments: */
    '* t : number of Julian centuries since J2000.0 */
    '* Return value: */
    '* sun's apparent longitude in degrees */
    '***********************************************************************/
    ' 计算太阳的视经度。
    Public Function calcSunApparentLong(ByVal t As Double) As Double
        Dim o As Double = calcSunTrueLong(t)

        Dim omega As Double = 125.04 - 1934.136 * t
        Dim lambda As Double = o - 0.00569 - 0.00478 * Math.Sin(degToRad(omega))
        Return lambda
        ' in degrees
    End Function

    '***********************************************************************/
    '* Name: calcMeanObliquityOfEcliptic */
    '* Type: Function */
    '* Purpose: calculate the mean obliquity of the ecliptic */
    '* Arguments: */
    '* t : number of Julian centuries since J2000.0 */
    '* Return value: */
    '* mean obliquity in degrees */
    '***********************************************************************/

    ' 计算黄道的平均倾斜度。
    Public Function calcMeanObliquityOfEcliptic(ByVal t As Double) As Double
        Dim seconds As Double = 21.448 - t * (46.815R + t * (0.00059 - t * (0.001813)))
        Dim e0 As Double = 23.0R + (26.0R + (seconds / 60.0R)) / 60.0R
        Return e0
        ' in degrees
    End Function

    '***********************************************************************/
    '* Name: calcObliquityCorrection */
    '* Type: Function */
    '* Purpose: calculate the corrected obliquity of the ecliptic */
    '* Arguments: */
    '* t : number of Julian centuries since J2000.0 */
    '* Return value: */
    '* corrected obliquity in degrees */
    '***********************************************************************/
    ' 计算黄道的修正倾斜度。
    Public Function calcObliquityCorrection(ByVal t As Double) As Double
        Dim e0 As Double = calcMeanObliquityOfEcliptic(t)

        Dim omega As Double = 125.04 - 1934.136 * t
        Dim e As Double = e0 + 0.00256 * Math.Cos(degToRad(omega))
        Return e
        ' in degrees
    End Function

    '***********************************************************************/
    '* Name: calcSunRtAscension */
    '* Type: Function */
    '* Purpose: calculate the right ascension of the sun */
    '* Arguments: */
    '* t : number of Julian centuries since J2000.0 */
    '* Return value: */
    '* sun's right ascension in degrees */
    '***********************************************************************/

    ' 计算太阳的赤经。
    Public Function calcSunRtAscension(ByVal t As Double) As Double
        Dim e As Double = calcObliquityCorrection(t)
        Dim lambda As Double = calcSunApparentLong(t)

        Dim tananum As Double = (Math.Cos(degToRad(e)) * Math.Sin(degToRad(lambda)))
        Dim tanadenom As Double = (Math.Cos(degToRad(lambda)))
        Dim alpha As Double = radToDeg(Math.Atan2(tananum, tanadenom))
        Return alpha
        ' in degrees
    End Function

    '***********************************************************************/
    '* Name: calcSunDeclination */
    '* Type: Function */
    '* Purpose: calculate the declination of the sun */
    '* Arguments: */
    '* t : number of Julian centuries since J2000.0 */
    '* Return value: */
    '* sun's declination in degrees */
    '***********************************************************************/
    ' 计算太阳偏角。
    Public Function calcSunDeclination(ByVal t As Double) As Double
        Dim e As Double = calcObliquityCorrection(t)
        Dim lambda As Double = calcSunApparentLong(t)

        Dim sint As Double = Math.Sin(degToRad(e)) * Math.Sin(degToRad(lambda))
        Dim theta As Double = radToDeg(Math.Asin(sint))
        Return theta
        ' in degrees
    End Function

    '***********************************************************************/
    '* Name: calcEquationOfTime */
    '* Type: Function */
    '* Purpose: calculate the difference between true solar time and mean */
    '* solar time */
    '* Arguments: */
    '* t : number of Julian centuries since J2000.0 */
    '* Return value: */
    '* equation of time in minutes of time */
    '***********************************************************************/

    ' 计算真太阳时和平太阳时之间的差。
    Public Function calcEquationOfTime(ByVal t As Double) As Double
        Dim epsilon As Double = calcObliquityCorrection(t)
        Dim l0 As Double = calcGeomMeanLongSun(t)
        Dim e As Double = calcEccentricityEarthOrbit(t)
        Dim m As Double = calcGeomMeanAnomalySun(t)

        Dim y As Double = Math.Tan(degToRad(epsilon) / 2.0R)
        y *= y

        Dim sin2l0 As Double = Math.Sin(2.0R * degToRad(l0))
        Dim sinm As Double = Math.Sin(degToRad(m))
        Dim cos2l0 As Double = Math.Cos(2.0R * degToRad(l0))
        Dim sin4l0 As Double = Math.Sin(4.0R * degToRad(l0))
        Dim sin2m As Double = Math.Sin(2.0R * degToRad(m))

        Dim Etime As Double = y * sin2l0 - 2.0R * e * sinm + 4.0R * e * y * sinm * cos2l0 - 0.5 * y * y * sin4l0 - 1.25 * e * e * sin2m

        Return radToDeg(Etime) * 4.0R
        ' in minutes of time
    End Function

    '***********************************************************************/
    '* Name: calcHourAngleSunrise */
    '* Type: Function */
    '* Purpose: calculate the hour angle of the sun at sunrise for the */
    '* latitude */
    '* Arguments: */
    '* lat : latitude of observer in degrees */
    '* solarDec : declination angle of sun in degrees */
    '* Return value: */
    '* hour angle of sunrise in radians */
    '***********************************************************************/

    ' 计算日出时太阳时角。
    Public Function calcHourAngleSunrise(ByVal lat As Double, ByVal solarDec As Double) As Double
        Dim latRad As Double = degToRad(lat)
        Dim sdRad As Double = degToRad(solarDec)

        Dim HAarg As Double = (Math.Cos(degToRad(90.833)) / (Math.Cos(latRad) * Math.Cos(sdRad)) - Math.Tan(latRad) * Math.Tan(sdRad))