Bienvenue aux nouveaux arrivants sur FantasPic !

- Pensez à lire les règles durant votre visite, il n'y en a pas beaucoup, mais encore faut-il les respecter .
- N’hésitez pas à faire des remarques et/ou suggestions sur le Forum, dans le but de l'améliorer et de rendre vos prochaines visites plus agréables.
- Vous pouvez regarder votre "panneau de l'utilisateur" afin de configurer vos préférences.
- Un passage par "l'utilisation du forum" est recommandé pour connaître les fonctionnalités du forum.

--- L’équipe FantasPic ---
Commentez, partagez et proposez des Tutos en langage BASIC et PASCAL !
Détection lever et coucher du soleil journalier
pspic
Passioné
Passioné
Messages : 357
Âge : 77
Enregistré en : septembre 2017
Localisation : 68

#1 Message par pspic » ven. 6 sept. 2019 19:39

Détection lever et coucher du soleil journalier.

Principe :

Un PIC calcule l’heure de lever et coucher du soleil en hh:mm pour la date du jour et la position locale (Latitude et Longitude).
Quand l’évènement lever est détecté la sortie RA0 est activée pendant 1 mn.
Quand l’évènement coucher est détecté la sortie RA1 est activée pendant 1 mn.

Matériel :

Un PIC 18F2520 programmé en MikroBasic
RTC DS3231 en liaison I2C avec le PIC.
Un module HC-06 pour la mise à jour de la RTC avec une appli Android et liaison Bluetooth.
Un écran LCD 2x16 pour la visualisation (facultatif).

Les branchements :
Cablage.JPG


Exemple pour le 06/09/2019, lever à 06:54 et coucher à 20:03
ImLcd.JPG


Le code :

Code : Tout sélectionner

program SunRiseSunSet
'Fonctionnalité :
'Activation RA0 au lever du soleil pendant 1 minute.
'Activation RA1 au coucher du soleil pendant 1 minute.
'Maj RTC DS3231 par appli Android SetRtcBt.Apk en Bluetooth avec module HC-06.
'PIC 18F2520, Osc: 8MHz

Include "SunCalc_Library"

dim Delim as string[2]
    SbRise,SbSet as string[6]
    Rec as string[16]
    TrRec as byte
    Sj,Sm,Sh,Sn,Sx,Sa,Snj,_Yh11,_Yb11, Ver as byte
    seconds, minutes, hours, _day, _month, year, Yb,Yh, _Yh, _Yb,Njs as byte

dim Soft_I2C_Scl  as sbit at RC3_bit
    Soft_I2C_Sda  as sbit at RC4_bit
    Soft_I2C_Scl_Direction as sbit at TRISC3_bit
    Soft_I2C_Sda_Direction as sbit at TRISC4_bit

'Lcd module connections
dim LCD_RS as sbit at RB4_bit
    LCD_EN as sbit at RB5_bit
    LCD_D4 as sbit at RB0_bit
    LCD_D5 as sbit at RB1_bit
    LCD_D6 as sbit at RB2_bit
    LCD_D7 as sbit at RB3_bit
    LCD_RS_Direction as sbit at TRISB4_bit
    LCD_EN_Direction as sbit at TRISB5_bit
    LCD_D4_Direction as sbit at TRISB0_bit
    LCD_D5_Direction as sbit at TRISB1_bit
    LCD_D6_Direction as sbit at TRISB2_bit
    LCD_D7_Direction as sbit at TRISB3_bit
'_______________________________________________________________________________
Sub procedure interrupt  'Interruption RCIF quand trame maj RTC reçue
 if PIR1.RCIF = 1 then
   if (UART1_Data_Ready() <> 0) then
     UART1_READ_TEXT(Rec , Delim, 255)
     TrRec = 1
   end if
   PIR1.RCIF = 0
 end if
end sub
'_______________________________________________________________________________
 sub procedure SetRtc()
  Lcd_Cmd(_LCD_CLEAR)
 'Decode trame de mise à jour reçue
'  A utiliser pour simulation
'====Simu=================================
'    Sj = Dec2Bcd(15)   'Simu jour
'    Sm = Dec2Bcd(2)    'Simu mois
'    Sh = Dec2Bcd(10)   'Simu heure
'    Sn = Dec2Bcd(10)   'Simu minute
'    Sx = Dec2Bcd(30)   'Simu seconde
'    Snj= Dec2Bcd(7)    'Simu N° jour
'    _Yb11= Dec2Bcd(20) 'Simu DU an
'====Normal================================
  Sj = Dec2Bcd(Strtoword(Rec[0]+Rec[1]))      'Jour
  Sm = Dec2Bcd(Strtoword(Rec[3]+Rec[4]))      'Mois
  Sh = Dec2Bcd(Strtoword(Rec[9]+Rec[10]))     'Heure
  Sn = Dec2Bcd(Strtoword(Rec[12]+Rec[13]))    'Minute
  Sx= Dec2Bcd(Strtoword("00"))                'Seconde
  Snj=Dec2Bcd(Strtoword(" "+Rec[16]))         'N° jour
  _Yb11= Dec2Bcd(Strtoword(Rec[6]+Rec[7]))    'An DU adr $11
'======================================
  _Yh11= Dec2Bcd(Strtoword("20"))             'An MC adr $10
  Delay_ms(100)
  I2C1_Start()              ' Start
  I2C1_wr(0xD0)             ' Addresse écriture RTC
  I2C1_wr(0)                ' Start addresse 0
  I2C1_wr(Sx)               '  Write Ss à l'adresse 2 contenant les secondes
  I2C1_wr(Sn)               '  Write Sn à l'adresse 3 contenant les minutes
  I2C1_wr(Sh)               '  Write Sh à l'adresse 4 contenant les heures
  I2C1_wr(Snj)              '  Write N° jour
  I2C1_wr(Sj)               '  Write Sj à l'adresse 5 contenant les Jour
  I2C1_wr(Sm)               '  Write Sm à l'adresse 6 contenant les mois
  I2C1_wr(_Yb11)            '  Write An (dizaine unité)
  I2C1_wr($90)              '
  I2C1_Stop()               ' stop signal
  delay_ms(500)
end sub
'_______________________________________________________________________________
sub procedure Lecture_Date_Heure()
  I2C1_Start()              ' Issue start signal
  I2C1_Wr(0xD0)             ' Addresse RTC
  I2C1_wr(0)                ' Start à l'adresse 0
  I2C1_Start()              ' start
  I2C1_wr(0xD1)             ' Addresse de lecture
  seconds = I2C1_Rd(1)      ' Read seconde byte
  minutes = I2C1_Rd(1)      ' Read minute byte
  hours = I2C1_Rd(1)        ' Read heure byte
  Njs  = I2C1_Rd(1)         ' Read N° jour byte
  _day = I2C1_Rd(1)         ' Read jour
  _month = I2C1_Rd(1)       ' Read N° jour/mois byte}
  Yb = I2C1_Rd(0)           ' Read dizaine unité an byte
  'Yh =_Yh11                ' An Millier centaine
  Yh = 32                   ' 32 = $20
  I2C1_Stop()               ' Issue stop signal}
end sub
'_______________________________________________________________________________
sub procedure Formatage_Date_Heure()
  seconds  =  ((seconds and 0x70) >> 4)*10 + (seconds and 0x0F)
  minutes  =  ((minutes and 0xF0) >> 4)*10 + (minutes and 0x0F)
  hours    =  ((hours and 0x30)  >> 4)*10  + (hours and 0x0F)
   Njs = Njs  and $07  _day = ((_day and 0x30) >> 4)*10 + (_day and 0x0F)
  _month    =  ((_month and 0x10)  >> 4)*10 + (_month and 0x0F)
  _Yh = ((Yh and 0xF0)>> 4)*10 + (Yh and 0x0F )
  _Yb = ((Yb and 0xF0)>> 4)*10 + (Yb and 0x0F )
'Heure d'été
 if _Day > 24 then
  if hours = 2 then
   if _month = 3 then
    if Njs = 0 then        'A adapter suivant la source (0 pour Android)
      I2C1_Stop()
      I2C1_Start()
      I2C1_wr(0xD0)
      I2C1_wr(2)
      I2C1_wr(3)            'A 2 heure il est 3 heure     
      I2C1_Stop()
    end if
  end if
  end if
 end if
'Heure d'hiver
 if _Day > 24 then
  if hours = 3 then
   if _month = 10 then
    if Njs = 0 then          'A adapter suivant la source (0 pour Android)
    setbit(portA,3)
     I2C1_Stop()
     I2C1_Start()
     I2C1_wr(0xD0)
     I2C1_wr(2)
     I2C1_wr(2)               'A 3 heure il est 2 heure
     I2C1_Stop()
    end if
   end if
  end if
 end if
end sub
'_______________________________________________________________________________
sub procedure Affiche_Date_Heure()
  Lcd_Chr(1, 1, (_day / 10)   + 48)    'Jour dizaine
  Lcd_Chr(1, 2, (_day mod 10)   + 48)  'Jour unité
  Lcd_Out(1,3,"/")
  Lcd_Chr(1,4, (_month / 10) + 48)     'Mois dizaine
  Lcd_Chr(1,5, (_month mod 10) + 48)   'Mois unité
  Lcd_Out(1,6,"/")
  Lcd_Chr(1,7, (_Yh / 10)   + 48)      'Année millier
  Lcd_Chr(1,8, (_Yh mod 10) + 48)      'Année centaine
  Lcd_Chr(1,9, (_Yb / 10)   + 48)      'Année dizaine
  Lcd_Chr(1,10, (_Yb mod 10) + 48)     'Année unité
  Lcd_Chr(2, 1, (hours / 10)   + 48)  'Heure dizaine
  Lcd_Chr(2, 2, (hours mod 10)   + 48)'Heure unité
  Lcd_Out(2,3,":")
  Lcd_Chr(2,4, (minutes / 10) + 48)   'Minute dizaine
  Lcd_Chr(2,5, (minutes mod 10) + 48) 'Minute unité
  Lcd_Out(2,6,":")
  Lcd_Chr(2,7, (seconds / 10) + 48)   'Seconde dizaine
  Lcd_Chr(2,8, (seconds mod 10) + 48) 'Seconde unité
' Lcd_Chr(2,12, (Njs mod 10) + 48)    'N° jour
  end sub
  '_______________________________________________________________________________
  Sub Procedure ConfigureLocalData
    SC_in_LatDeg = 48       'Nord +; Sud -
    SC_in_LatMin = 4
    SC_in_LatSec = 24
    SC_in_LatSec100 = 59

    SC_in_LonDeg = 7
    SC_in_LonMin = 31
    SC_in_LonSec = 54
    SC_in_LonSec100 = 90

    SC_in_GMToffset = 0     'Ouest -; Est +
    SC_in_Latitude  = GetLocalLatitude(SC_in_LatDeg, SC_in_LatMin, SC_in_LatSec, SC_in_LatSec100)
    SC_in_Longitude = GetLocalLongitude(SC_in_LonDeg, SC_in_LonMin, SC_in_LonSec, SC_in_LonSec100)
    SC_in_dst_SMonth = 3     ' Mois départ heure été.
    SC_in_dst_EMonth = 10    ' Mois départ heure hiver.
end Sub
'_______________________________________________________________________________

main:
  ConfigureLocalData()
  Uart1_Init(9600)         'Init Usart
  Delay_ms(200)
  I2C1_Init(100000)        'Init Soft I2C
  INTCON.PEIE = 1          'Perif interupt enable = true
  PIE1.RCIE = 1
  INTCON.GIE = 1           'Global interupt enable = true
  Adcon1 = $0F             'Configure AN pins as digital I/ 'ConfigureLocalData
  TRISA = 0
  PORTA = 0
  TrRec = 0                 'Raz Trame reçu
  Delim =""+"D"+chr(13)     'Délimiteur trame recu
  Lcd_Init()                'Init Lcd
  Lcd_Cmd(_LCD_CLEAR)       'Clear Lcd display
  Lcd_Cmd(_LCD_CURSOR_OFF)  'cursor off
  LCD_OUT(1,2,"SUNRISE_SUNSET")
  delay_ms(3000)
  Lcd_Cmd(_LCD_CLEAR)
  while true
   'Lecture RTC, formatage et affichage date time______________________________
    if TrRec = 0 then          'Si pas de mise à jour RTC
     Lecture_Date_Heure()      'Lecture dans RTC
     Formatage_Date_Heure()    'Formatage date et heure
     Affiche_Date_Heure()      'Affiche date heure
     delay_ms(200)
     SC_in_ThisYear = integer(_Yb)+2000
     SC_in_ThisMonth = integer(_month)
     SC_in_ThisDay = integer(_Day)
    end if
   
   'Set Rtc si trame de mise à jour reçue_______________________________________
    if TrRec = 1 then
     SetRtc()
     TrRec = 0
    end if
'_______________________________________________________________________________
        GetMoreCalendarData(SC_in_ThisYear,          '216
                            SC_in_ThisMonth,         'N° mois
                            SC_in_ThisDay,           'N° jour
                            SC_out_IsLeapYear,       'An bisextile = 255 else 0
                            SC_out_DayOfYear,        'Jour de l'année
                            SC_out_StrDayOfWeek,     'Jour 3 car string
                            SC_out_IntDayOfWeek,     'Dimanche = 1                           
                            SC_out_DaylightSavingTime)
'_______________________________________________________________________________
        GetLocalSunRiseTime (SC_in_Latitude,
                            SC_in_Longitude,
                            SC_in_ThisYear,
                            SC_in_ThisMonth,
                            SC_in_ThisDay,
                            SC_in_GMToffset,
                            SC_out_StrBuffer,
                            SC_out_RiseTime_Hours,
                            SC_out_RiseTime_Minutes)
         
          SbRise = SC_out_StrBuffer
          LCD_OUT(1,12,SbRise)

Action sur la sortie RA0 pendant 1 minute
          if Hours = SC_out_RiseTime_Hours then
           if Minutes = SC_out_RiseTime_Minutes then
            SetBit(PORTA,0)    'Evènement lever du soleil pendant 1 minute
           end if
          end if
           if Hours <> SC_out_RiseTime_Hours then ClearBit(PORTA,0) end if
           if Minutes <> SC_out_RiseTime_Minutes then ClearBit(PORTA,0) end if
'_______________________________________________________________________________
        GetLocalSunSetTime (SC_in_Latitude,
                            SC_in_Longitude,
                            SC_in_ThisYear,
                            SC_in_ThisMonth,
                            SC_in_ThisDay,
                            SC_in_GMToffset,
                            SC_out_StrBuffer,
                            SC_out_SetTime_Hours,                           
                            SC_out_SetTime_Minutes)
                           
        SbSet = SC_out_StrBuffer
        LCD_OUT(2,12,SbSet)
       
'Action sur la sortie RA1 pendant 1 minute
          if Hours = SC_out_SetTime_Hours then
           if Minutes = SC_out_SetTime_Minutes then
            SetBit(PORTA,1)       'Evènement coucher du soleil pendant 1 minute
           end if
          end if
           if Hours <> SC_out_SetTime_Hours then ClearBit(PORTA,1) end if
           if Minutes <> SC_out_SetTime_Minutes then ClearBit(PORTA,1) end if
         
'_______________________________________________________________________________

    delay_ms(500)
  wend
end.


Le module Sun Calc :

Source de ce module : Forum Mikroe.

Code : Tout sélectionner

module SunCalc_Library
 
' Source forum Mikroelektronika.
'+-------------------------------------+
'+ input parameters for local latitude +
'+ SC_in_LatDeg --> North +; South -;  +
'+-------------------------------------+
Dim SC_in_LatDeg        as Integer
Dim SC_in_LatMin        As Integer
Dim SC_in_LatSec        As Integer
Dim SC_in_LatSec100     As Integer
Dim SC_in_Latitude      as float

'+--------------------------------------+
'+ input parameters for local longitude +
'+ SC_in_LonDeg --> West +; East -;     +
'+--------------------------------------+
Dim SC_in_LonDeg        As Integer
Dim SC_in_LonMin        As Integer
Dim SC_in_LonSec        As Integer
Dim SC_in_LonSec100     As Integer
Dim SC_in_Longitude     as float

'+------------------------------------------------+
'+ input parameter for Greenwich Mean Time offset +
'+ SC_in_GMToffset --> West -; East +;            +
'+------------------------------------------------+
Dim SC_in_GMToffset     as integer

'+---------------------------------+
'+ input parameters for today date +
'+---------------------------------+
Dim SC_in_ThisDay       As Integer
Dim SC_in_ThisMonth     As Integer
Dim SC_in_ThisYear      As Integer

'+--------------------------------------------------+
'+ input parameters for Daylight Saving Time period +
'+ For Europe starting period --> march             +
'+ For Europe ending period ----> october           +
'+--------------------------------------------------+
Dim SC_in_dst_SMonth    as integer
Dim SC_in_dst_EMonth    as integer

'===============================================================================
' SC_ (SunCalc) GLOBAL OUTPUT VARIABLES
'===============================================================================

'+---------------------------------+
'+ Output values for SunRise event +
'+---------------------------------+
Dim SC_out_RiseTime_Hours       as byte
Dim SC_out_RiseTime_Minutes     as byte

'+--------------------------------+
'+ Output values for SunSet event +
'+--------------------------------+
Dim SC_out_SetTime_Hours        as byte
Dim SC_out_SetTime_Minutes      as byte

'+-----------------------------------+
'+ Output values for Noon time event +
'+-----------------------------------+
Dim SC_out_NoonTime_Hours       as byte
Dim SC_out_NoonTime_Minutes     as byte

'+---------------------------------------------+
'+ String output for SunRise, NoonTime, SunSet +
'+ showing hh:mm                               +
'+---------------------------------------------+
Dim SC_out_StrBuffer            as string[5]

'+----------------------------------------+
'+ Output value for numerical day of year +
'+ indicating 1..365                      +
'+----------------------------------------+
Dim SC_out_DayOfYear            as integer

'+-------------------------------------+
'+ String output value for day of week +
'+ 1=monday...7=sunday                 +
'+-------------------------------------+
Dim SC_out_StrDayOfWeek         as string[3]

'+------------------------------+
'+ Output value for day of week +
'+ 1=monday...7=sunday          +
'+------------------------------+
Dim SC_out_IntDayOfWeek         as integer

'+-----------------------------------+
'+ Output value for leap year result +
'+ yes=true; no=false                +
'+-----------------------------------+
Dim SC_out_IsLeapYear           as byte

'+-----------------------------------------------------+
'+ Output value for Daylight Saving Time period result +
'+ yes=true; no=false                                  +
'+-----------------------------------------------------+
Dim SC_out_DaylightSavingTime   as byte

'+----------------------------------------+
'+ Output values for Daylight Saving Time +
'+ starting date                          +
'+----------------------------------------+
Dim SC_out_DST_StartDay         as integer
Dim SC_out_DST_StartMonth       as integer
Dim SC_out_DST_StartYear        as integer

'+----------------------------------------+
'+ Output values for Daylight Saving Time +
'+ ending date                            +
'+----------------------------------------+
Dim SC_out_DST_EndDay           as integer
Dim SC_out_DST_EndMonth         as integer
Dim SC_out_DST_EndYear          as integer

'===============================================================================
'06/09/2019 Ajout pour être compatible avec la nouvelle version de Mikrobasic
Sub Function GetLocalLatitude(Dim SC_in_LatDeg As Integer,
                              Dim SC_in_LatMin As Integer,
                              Dim SC_in_LatSec As Integer,
                              Dim SC_in_LatSec100 As Integer) As float

Sub Function GetLocalLongitude(Dim SC_in_LonDeg As Integer,
                               Dim SC_in_LonMin As Integer,
                               Dim SC_in_LonSec As Integer,
                               Dim SC_in_LonSec100 As Integer) as Float

Sub Procedure GetMoreCalendarData(Dim mYear As Integer,
                                    Dim mMonth As Integer,
                                    Dim mDay As Integer,
                                    Dim Byref mIsLeapYear as byte,
                                    Dim Byref DayOfYear as integer,
                                    Dim Byref StrDayOfWeek as string[3],
                                    Dim Byref IntDayOfWeek as integer,
                                    Dim Byref SC_out_DaylightSavingTime as byte)

Sub Procedure GetLocalSunSetTime(Dim SC_in_Latitude as Float,
                                      Dim SC_in_Longitude as Float,
                                      Dim mYear As Integer,
                                      Dim mMonth As Integer,
                                      Dim mDay As Integer,
                                      Dim SC_in_GMToffset as integer,
                                      Dim ByRef StrOut as string[5],
                                      Dim ByRef ThoursOut as byte,
                                      Dim Byref TminutesOut as byte)

Sub Procedure GetLocalSunRiseTime(Dim SC_in_Latitude as Float,
                                      Dim SC_in_Longitude as Float,
                                      Dim mYear As Integer,
                                      Dim mMonth As Integer,
                                      Dim mDay As Integer,
                                      Dim SC_in_GMToffset as integer,
                                      Dim ByRef StrOut as string[5],
                                      Dim ByRef ThoursOut as byte,
                                      Dim Byref TminutesOut as byte)

Sub Procedure GetLocalNoonTime(Dim SC_in_Longitude as Float,
                                      Dim mYear As Integer,
                                      Dim mMonth As Integer,
                                      Dim mDay As Integer,
                                      Dim SC_in_GMToffset as integer,
                                      Dim ByRef StrOut as string[5],
                                      Dim ByRef ThoursOut as byte,
                                      Dim Byref TminutesOut as byte)
'Fin ajout
'===============================================================================

implements

'//****************************************************************************/
'//* Name:    GetLocalLatitude                                                */
'//* Type:    Function                                                        */
'//* Purpose:                                                                 */
'//* Arguments:                                                               */
'//*                                                                          */
'//****************************************************************************/

Sub Function GetLocalLatitude(Dim SC_in_LatDeg As Integer,
                              Dim SC_in_LatMin As Integer,
                              Dim SC_in_LatSec As Integer,
                              Dim SC_in_LatSec100 As Integer) As float

    Dim w   As float
    Dim p   As float

    p = float(SC_in_LatSec) + float(SC_in_LatSec100) / 100.0

    If SC_in_LatDeg > 0 Then
        w = float(SC_in_LatDeg) / 1.0
        w = w + float(SC_in_LatMin) / 60.0
        w = w + p / 3600.0
    Else
        w = float(SC_in_LatDeg) / 1.0
        w = w - float(SC_in_LatMin) / 60.0
        w = w - p / 3600.0
    End If

    If w < -89.0 Then
        w = -89.0
    End If
    If w > 89.0 Then
        w = 89.0
    End If

    Result = w

End sub

'//****************************************************************************/
'//* Name:    GetSC_in_Longitude                                              */
'//* Type:    Function                                                        */
'//* Purpose:                                                                 */
'//* Arguments:                                                               */
'//*                                                                          */
'//****************************************************************************/
Sub Function GetLocalLongitude(Dim SC_in_LonDeg As Integer,
                               Dim SC_in_LonMin As Integer,
                               Dim SC_in_LonSec As Integer,
                               Dim SC_in_LonSec100 As Integer) as Float

    Dim w   as Float
    Dim p   as Float

    p = float(SC_in_LonSec) + float(SC_in_LonSec100) / 100.0

    If SC_in_LonDeg > 0 Then
        w = float(SC_in_LonDeg) / 1.0
        w = w + float(SC_in_LonMin) / 60.0
        w = w + p / 3600.0
    Else
        w = float(SC_in_LonDeg) / 1.0
        w = w - float(SC_in_LonMin) / 60.0
        w = w - p / 3600.0
    End If

    Result = w

End Sub

'//****************************************************************************/
'//* Name:    isLeapYear                                                      */
'//* Type:    Function                                                        */
'//* Purpose:                                                                 */
'//* Arguments:                                                               */
'//*                                                                          */
'//****************************************************************************/
Sub Function isLeapYear(Dim yr As Integer) As byte

        If ((yr Mod 4 = 0) And (yr Mod 100 <> 0)) Or (yr Mod 400 = 0) Then
           Result = True
        Else
           Result = False
        End If

End Sub

'=====================================================================
' Convert radian angle to degrees
'=====================================================================
Sub Function RadToDeg(Dim RadAngle as Float) as Float

    Result = (180.0 * RadAngle / 3.14159265358979)

End Sub

'=====================================================================
' Convert degree angle to radians
'=====================================================================
Sub Function DegToRad(Dim DegAngle as Float) as Float

    Result = (DegAngle * 3.14159265358979 / 180.0)

End Sub

'//****************************************************************************/
'//* Name:    calcDayOfYear                                                   */
'//* Type:    Function                                                        */
'//* Purpose: Finds numerical day-of-year from mn, day and lp year info       */
'//* Arguments:                                                               */
'//*   month: January = 1                                                     */
'//*   day  : 1 - 31                                                          */
'//*   lpyr : 1 if leap year, 0 if not                                        */
'//* Return value:                                                            */
'//*   The numerical day of year                                              */
'//****************************************************************************/
Sub Function calcDayOfYear(Dim mMonth As Integer,
                               Dim mday As Integer,
                               Dim lpyr As byte) As integer


    Dim k           As Integer

    If lpyr = True Then
        k = 1
    Else
        k = 2
    End If

    Result = integer(floor((275.0 * float(mMonth)) / 9.0) -
             float(k) * floor((float(mMonth) + 9.0) /
             12.0) + float(mday) - 30.0)

End Sub

'//***********************************************************************/
'//* Name:    calcDayOfWeek                                              */
'//* Type:    Function                                                   */
'//* Purpose: Derives weekday from Julian Day                            */
'//* Arguments:                                                          */
'//*   juld : Julian Day                                                 */
'//* Return value:                                                       */
'//*   String containing name of weekday                                 */
'//***********************************************************************/
Sub Procedure calcDayOfWeek(Dim JulD as Float,
                            Dim ByRef StrDayOfWeek as string[3],
                            Dim Byref IntDayOfWeek as integer)

    Dim a1,a2   as float
    Dim ba      as float
    Dim bc      as integer

    StrDayOfWeek = "   "
    IntDayOfWeek = 0


    a1 = JulD + 1.5
    a2 = a1 / 7.0
    ba = a1 - floor(a2) * 7.0
    bc = integer(ba)

    Select Case bc
        Case 0
            StrDayOfWeek = "Dim"
        Case 1
            StrDayOfWeek = "Lun"
        Case 2
            StrDayOfWeek = "Mar"
        Case 3
            StrDayOfWeek = "Mer"
        Case 4
            StrDayOfWeek = "Jeu"
        Case 5
            StrDayOfWeek = "Ven"
        Case 6
            StrDayOfWeek = "Sam"
    End Select

    if bc > 0 then
        IntDayOfWeek = bc
    else
        IntDayOfWeek = 7
    end if

End Sub

'//*** [1] ***************************************************************/
'//* Name:    calcJD                                                     */
'//* Type:    Function                                                   */
'//* Purpose: Julian day from calendar day                               */
'//* Arguments:                                                          */
'//*   year : 4 digit year                                               */
'//*   month: January = 1                                                */
'//*   day  : 1 - 31                                                     */
'//* Return value:                                                       */
'//*   The Julian day corresponding to the date                          */
'//* Note:                                                               */
'//*   Number is returned for start of day.  Fractional days should be   */
'//*   added later.                                                      */
'//***********************************************************************/
Sub Function CalcJD(dim aYear As Integer,
                        dim aMonth As Integer,
                        dim aDay As Integer) As float

    Dim cMonth      As integer
    Dim cYear       As integer
    Dim cDay        As integer
    Dim A           As integer
    Dim B           As integer

    If aMonth <= 2 Then
        cYear = aYear - 1
        cMonth = aMonth + 12
    Else
        cYear = aYear
        cMonth = aMonth
    End If

    cDay = aDay

    A = floor(cYear / 100.0)
    B = 2.0 - A + floor(A / 4.0)

    Result = floor(365.25 * (cYear + 4716)) +
             floor(30.6001 * (cMonth + 1)) +
             cDay + B - 1524.5

End Sub

'//*** [2] **************************************************************/
'//* Name:    calcTimeJulianCent                                        */
'//* Type:    Function                                                  */
'//* Purpose: convert Julian Day to centuries since J2000.0.            */
'//* Arguments:                                                         */
'//*   jd : the Julian Day to convert                                   */
'//* Return value:                                                      */
'//*   the value corresponding to the Julian Day                        */
'//**********************************************************************/
Sub Function CalcTimeJulianCent(Dim JD as Float) as Float

    Result = (JD - 2451545.0) / 36525.0

End Sub

'//**********************************************************************/
'//* 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                      */
'//**********************************************************************/
Sub Function CalcJDFromJulianCent(Dim t as Float) as Float

    Result = t * 36525.0 + 2451545.0

End Sub

'//**********************************************************************/
'//* Name:    calGeomMeanLongSun                                        */
'//* Type:    Function                                                  */
'//* Purpose: calculate the Geometric Mean SC_in_Longitude of the Sun   */
'//* Arguments:                                                         */
'//*   t : number of Julian centuries since J2000.0                     */
'//* Return value:                                                      */
'//*   the Geometric Mean SC_in_Longitude of the Sun in degrees         */
'//**********************************************************************/
Sub Function CalcGeomMeanLongSun(Dim t as Float) as Float

    Dim L0    as Float

    L0 = 280.46646 + t * (36000.76983 + 0.0003032 * t)

    While (L0 > 360.0)
        L0 = L0 - 360.0
    Wend

    While (L0 < 0.0)
        L0 = L0 + 360.0
    Wend

    Result = L0

End Sub

'//**********************************************************************/
'//* 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                 */
'//**********************************************************************/
Sub Function CalcGeomMeanAnomalySun(Dim t as Float) as Float

    Result = 357.52911 + t * (35999.05029 - 0.0001537 * t)

End Sub

'//**********************************************************************/
'//* 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                                        */
'//**********************************************************************/
Sub Function CalcEccentricityEarthOrbit(Dim t as Float) as Float

    Result = 0.016708634 - t * (0.000042037 + 0.0000001267 * t)

End Sub

'//**********************************************************************/
'//* 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                                        */
'//**********************************************************************/
Sub Function CalcMeanObliquityOfEcliptic(Dim t as Float) as Float

    Dim seconds     as Float

    seconds = 21.448 - t * (46.815 + t * (0.00059 - t * (0.001813)))
    Result = 23.0 + (26.0 + (seconds / 60.0)) / 60.0

End Sub

'//**********************************************************************/
'//* 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                                   */
'//**********************************************************************/
Sub Function CalcObliquityCorrection(Dim t as Float) as Float

    Dim omega       as Float

    omega = 125.04 - 1934.136 * t
    Result = CalcMeanObliquityOfEcliptic(t) + 0.00256 * Cos(DegToRad(omega))

End Sub

'//**********************************************************************/
'//* 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                              */
'//**********************************************************************/
Sub Function CalcEquationOfTime(Dim t as Float) as Float

    Dim Epsilon     as Float
    Dim L0          as Float
    Dim e           as Float
    Dim m           as Float
    Dim y           as Float
    Dim Sin2l0      as Float
    Dim Sinm        as Float
    Dim Cos2l0      as Float
    Dim Sin4l0      as Float
    Dim Etime       as Float

    Epsilon = CalcObliquityCorrection(t)
    L0 = CalcGeomMeanLongSun(t)
    e = CalcEccentricityEarthOrbit(t)
    m = CalcGeomMeanAnomalySun(t)
    y = Tan(DegToRad(Epsilon) / 2.0)
    y = y * y
    Sin2l0 = Sin(2.0 * DegToRad(L0))
    Sinm = Sin(DegToRad(m))
    Cos2l0 = Cos(2.0 * DegToRad(L0))
    Sin4l0 = Sin(4.0 * DegToRad(L0))

    Etime = y * Sin2l0 - 2.0 * e * Sinm +
                4.0 * e * y * Sinm *
                Cos2l0 - 0.5 * y * y *
                Sin4l0 - 1.25 * e * e *
                Sin(2.0 * DegToRad(m))

    Result = RadToDeg(Etime) * 4.0

End Sub

'//**********************************************************************/
'//* Name:    calcSolNoonUTC                                            */
'//* Type:    Function                                                  */
'//* Purpose: calculate the Universal Coordinated Time (UTC) of solar   */
'//*        noon for the given day at the given location on earth       */
'//* Arguments:                                                         */
'//*   t : number of Julian centuries since J2000.0                     */
'//*   SC_in_Longitude : SC_in_Longitude of observer in degrees         */
'//* Return value:                                                      */
'//*   time in minutes from zero Z                                      */
'//**********************************************************************/
Sub Function CalcSolNoonUTC(Dim t as Float,
                                Dim SC_in_Longitude as Float) as Float

    Dim tnoon       as Float
    Dim eqTime      as Float
    Dim solNoonUTC  as Float
    Dim NewT        as Float

    tnoon = CalcTimeJulianCent(CalcJDFromJulianCent(t) + SC_in_Longitude / 360.0)
    eqTime = CalcEquationOfTime(tnoon)
    solNoonUTC = 720.0 + (SC_in_Longitude * 4.0) - eqTime    '// min

    NewT = CalcTimeJulianCent(CalcJDFromJulianCent(t) -
                 0.5 + solNoonUTC / 1440.0)

    eqTime = CalcEquationOfTime(NewT)

    solNoonUTC = 720.0 + (SC_in_Longitude * 4.0) - eqTime ' // min

    Result = solNoonUTC

End Sub

'//**********************************************************************/
'//* 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                                                       */
'//**********************************************************************/
Sub Function CalcSunEqOfCenter(Dim t as Float) as Float

    Dim mRad    as Float
    Dim Sin1m   as Float
    Dim Sin2m   as Float
    Dim Sin3m   as Float
    Dim C       as Float

    mRad = DegToRad(CalcGeomMeanAnomalySun(t))
    Sin1m = Sin(mRad)
    Sin2m = Sin(mRad + mRad)
    Sin3m = Sin(mRad + mRad + mRad)

    C = Sin1m * (1.914602 - t * (0.004817 + 0.000014 * t)) +
        Sin2m * (0.019993 - 0.000101 * t) + Sin3m * 0.000289

    Result = C  ' in degrees

End Sub

'//**********************************************************************/
'//* Name:    calcSunTrueLong                                           */
'//* Type:    Function                                                  */
'//* Purpose: calculate the true SC_in_Longitude of the sun             */
'//* Arguments:                                                         */
'//*   t : number of Julian centuries since J2000.0                     */
'//* Return value:                                                      */
'//*   sun's true SC_in_Longitude in degrees                            */
'//**********************************************************************/
Sub Function CalcSunTrueLong(Dim t as Float) as Float

    Result = CalcGeomMeanLongSun(t) + CalcSunEqOfCenter(t)

End Sub

'//**********************************************************************/
'//* 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                                    */
'//**********************************************************************/
Sub Function CalcSunTrueAnomaly(Dim t as Float) as Float

    Result = CalcGeomMeanAnomalySun(t) + CalcSunEqOfCenter(t)

End Sub

'//**********************************************************************/
'//* 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                                         */
'//**********************************************************************/
Sub Function CalcSunRadVector(Dim t as Float) as Float

    Dim v       as Float
    Dim ee      as Float

    v = CalcSunTrueAnomaly(t)
    ee = CalcEccentricityEarthOrbit(t)

    Result = (1.000001018 * (1.0 - ee * ee)) / (1.0 + ee * Cos(DegToRad(v)))

End Sub

'//**********************************************************************/
'//* Name:    calcSunApparentLong                                       */
'//* Type:    Function                                                  */
'//* Purpose: calculate the apparent SC_in_Longitude of the sun         */
'//* Arguments:                                                         */
'//*   t : number of Julian centuries since J2000.0                     */
'//* Return value:                                                      */
'//*   sun's apparent SC_in_Longitude in degrees                        */
'//**********************************************************************/
Sub Function CalcSunApparentLong(Dim t as Float) as Float

    Result = CalcSunTrueLong(t) - 0.00569 -
             0.00478 * Sin(DegToRad(125.04 - 1934.136 * t))

End Sub

'//**********************************************************************/
'//* 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                                 */
'//**********************************************************************/
Sub Function CalcSunRtAscension(Dim t as Float) as Float

    Dim e           as Float
    Dim lambda      as Float
    Dim tananum     as Float
    Dim tanadenom   as Float

    e = CalcObliquityCorrection(t)
    lambda = CalcSunApparentLong(t)
    tananum = (Cos(DegToRad(e)) * Sin(DegToRad(lambda)))
    tanadenom = (Cos(DegToRad(lambda)))
    Result = RadToDeg(Atan2(tananum, tanadenom))

End Sub

'//**********************************************************************/
'//* 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                                     */
'//**********************************************************************/
Sub Function CalcSunDeclination(Dim t as Float) as Float

    Dim e           as Float
    Dim lambda      as Float
    Dim sint        as Float

    e = CalcObliquityCorrection(t)
    lambda = CalcSunApparentLong(t)
    sint = Sin(DegToRad(e)) * Sin(DegToRad(lambda))
    Result = RadToDeg(Asin(sint))

End Sub

'//**********************************************************************/
'//* Name:    calcHourAngleSunrise                                      */
'//* Type:    Function                                                  */
'//* Purpose: calculate the hour angle of the sun at sunrise for the    */
'//*            SC_in_Latitude                                          */
'//* Arguments:                                                         */
'//*   lat : SC_in_Latitude of observer in degrees                      */
'//*    solarDec : declination angle of sun in degrees                  */
'//* Return value:                                                      */
'//*   hour angle of sunrise in radians                                 */
'//**********************************************************************/
Sub Function CalcHourAngleSunrise(Dim lat as Float,
                                      Dim SolarDec as Float) as Float

    Dim latrad      as Float
    Dim sdrad       as Float
    Dim HAarg       as Float

    latrad = DegToRad(lat)
    sdrad = DegToRad(SolarDec)
    HAarg = (Cos(DegToRad(90.833)) / (Cos(latrad) * Cos(sdrad)) -
             Tan(latrad) * Tan(sdrad))
    Result = (Acos(Cos(DegToRad(90.833)) / (Cos(latrad) * Cos(sdrad)) -
             Tan(latrad) * Tan(sdrad)))


End Sub

'//**********************************************************************/
'//* Name:    calcHourAngleSunset                                       */
'//* Type:    Function                                                  */
'//* Purpose: calculate the hour angle of the sun at sunset for the     */
'//*            SC_in_Latitude                                          */
'//* Arguments:                                                         */
'//*   lat : SC_in_Latitude of observer in degrees                      */
'//*    solarDec : declination angle of sun in degrees                  */
'//* Return value:                                                      */
'//*   hour angle of sunset in radians                                  */
'//**********************************************************************/
Sub Function CalcHourAngleSunset(Dim lat as Float,
                                     Dim SolarDec as Float) as Float

    Dim latrad      as Float
    Dim sdrad       as Float
    Dim HAarg       as Float
    Dim HA          as Float

    latrad = DegToRad(lat)
    sdrad = DegToRad(SolarDec)

    HAarg = (Cos(DegToRad(90.833)) / (Cos(latrad) * Cos(sdrad)) -
            Tan(latrad) * Tan(sdrad))

    HA = (Acos(Cos(DegToRad(90.833)) / (Cos(latrad) * Cos(sdrad)) -
            Tan(latrad) * Tan(sdrad)))

    Result = -HA

End Sub

'//*** [3] ********************************************************************/
'//* Name:    calcSunriseUTC                                                  */
'//* Type:    Function                                                        */
'//* Purpose: calculate the Universal Coordinated Time (UTC) of sunrise       */
'//*            for the given day at the given location on earth              */
'//* Arguments:                                                               */
'//*   JD  : julian day                                                       */
'//*   SC_in_Latitude : SC_in_Latitude of observer in degrees                 */
'//*   SC_in_Longitude : SC_in_Longitude of observer in degrees               */
'//* Return value:                                                            */
'//*   time in minutes from zero Z                                            */
'//****************************************************************************/
Sub Function CalcSunRiseUTC(Dim JD as Float,
                                Dim SC_in_Latitude as Float,
                                Dim SC_in_Longitude as Float) as float


    Dim t           as Float
    Dim noonmin     as Float
    Dim tnoon       as Float
    Dim eqTime      as Float
    Dim SolarDec    as Float
    Dim HourAngle   as Float
    Dim Delta       as Float
    Dim TimeDiff    as Float
    Dim TimeUTC     as Float
    Dim NewT        as Float


    t = CalcTimeJulianCent(JD)
    noonmin = CalcSolNoonUTC(t, SC_in_Longitude)
    tnoon = CalcTimeJulianCent(JD + noonmin / 1440.0)

    eqTime = CalcEquationOfTime(tnoon)
    SolarDec = CalcSunDeclination(tnoon)
    HourAngle = CalcHourAngleSunrise(SC_in_Latitude, SolarDec)

    Delta = SC_in_Longitude - RadToDeg(HourAngle)
    TimeDiff = 4.0 * Delta   '// in minutes of time
    TimeUTC = 720.0 + TimeDiff - eqTime  '// in minutes

    NewT = CalcTimeJulianCent(CalcJDFromJulianCent(t) + TimeUTC / 1440.0)
    eqTime = CalcEquationOfTime(NewT)
    SolarDec = CalcSunDeclination(NewT)
    HourAngle = CalcHourAngleSunrise(SC_in_Latitude, SolarDec)
    Delta = SC_in_Longitude - RadToDeg(HourAngle)
    TimeDiff = 4.0 * Delta
    TimeUTC = 720.0 + TimeDiff - eqTime  '// in minutes

    Result = TimeUTC

End Sub

'//**********************************************************************/
'//* Name:    calcSunsetUTC                                             */
'//* Type:    Function                                                  */
'//* Purpose: calculate the Universal Coordinated Time (UTC) of sunset  */
'//*            for the given day at the given location on earth        */
'//* Arguments:                                                         */
'//*   JD  : julian day                                                 */
'//*   SC_in_Latitude : SC_in_Latitude of observer in degrees           */
'//*   SC_in_Longitude : SC_in_Longitude of observer in degrees         */
'//* Return value:                                                      */
'//*   time in minutes from zero Z                                      */
'//**********************************************************************/
Sub Function CalcSunSetUTC(Dim JD as Float,
                               Dim SC_in_Latitude as Float,
                               Dim SC_in_Longitude as Float) as Float


    Dim t               as Float
    Dim noonmin         as Float
    Dim tnoon           as Float
    Dim eqTime          as Float
    Dim SolarDec        as Float
    Dim HourAngle       as Float
    Dim Delta           as Float
    Dim TimeDiff        as Float
    Dim TimeUTC         as Float
    Dim NewT            as Float

    t = CalcTimeJulianCent(JD)
    noonmin = CalcSolNoonUTC(t, SC_in_Longitude)
    tnoon = CalcTimeJulianCent(JD + noonmin / 1440.0)

    eqTime = CalcEquationOfTime(tnoon)
    SolarDec = CalcSunDeclination(tnoon)
    HourAngle = CalcHourAngleSunset(SC_in_Latitude, SolarDec)

    Delta = SC_in_Longitude - RadToDeg(HourAngle)
    TimeDiff = 4.0 * Delta
    TimeUTC = 720.0 + TimeDiff - eqTime

    NewT = CalcTimeJulianCent(CalcJDFromJulianCent(t) + TimeUTC / 1440.0)
    eqTime = CalcEquationOfTime(NewT)
    SolarDec = CalcSunDeclination(NewT)
    HourAngle = CalcHourAngleSunset(SC_in_Latitude, SolarDec)

    Delta = SC_in_Longitude - RadToDeg(HourAngle)
    TimeDiff = 4.0 * Delta
    TimeUTC = 720.0 + TimeDiff - eqTime  '// in minutes

    Result = TimeUTC

End Sub

Sub Procedure TimeToString(Dim fTime as Float,
                              Dim GMT As Integer,
                              Dim Byref Buffer as string[5],
                              Dim ByRef ThoursOut as byte,
                              Dim Byref TminutesOut as byte)


    Dim fHour       As float
    Dim fMin        As float
    Dim fSec        As float
    dim sHour       as string[17]
    dim sMin        as string[17]
    dim n           as byte
    dim k           as byte

    Buffer = "     "

    fSec = floor((fTime - floor(fTime)) * 60.0)
    fSec = fSec + floor(fTime) * 60.0
    fHour = floor(fSec / 3600.0)
    fMin = floor((fSec / 3600.0 - fHour) * 60.0)
    fSec = fSec - fHour * 3600.0 - fMin * 60.0

    If fSec >= 30.0 Then
        fMin = fMin + 1.0
    End If

    if SC_out_DaylightSavingTime then
        fHour = fHour + float(GMT) + 1.0
    else
        fHour = fHour + float(GMT)
    end if

    floatToStr(fHour,sHour)
    floatToStr(fMin,sMin)

    k = 0
    for n = 0 to 17
        if sHour[n] = "." then
           k = n
        end if
    next n
    if k = 1 then
       Buffer[0] = "0"
       Buffer[1] = sHour[0]
    end if
    if k = 2 then
       Buffer[0] = sHour[0]
       Buffer[1] = sHour[1]
    end if

    Buffer[2] = ":"

    k = 0
    for n = 0 to 17
        if sMin[n] = "." then
           k = n
        end if
    next n
    if k = 1 then
       Buffer[3] = "0"
       Buffer[4] = sMin[0]
    end if
    if k = 2 then
       Buffer[3] = sMin[0]
       Buffer[4] = sMin[1]
    end if

    ThoursOut = fHour
    TminutesOut = fMin

End Sub

'//**********************************************************************/
'//* Name:    GetLocalSunRiseTime                                       */
'//* Type:    Procedure                                                 */
'//* Purpose: calculate the local Sun Rise time                         */
'//*                                                                    */
'//* Arguments:                                                         */
'//*   JD  : julian day                                                 */
'//*   SC_in_Latitude : SC_in_Latitude of observer in degrees           */
'//*   SC_in_Longitude : SC_in_Longitude of observer in degrees         */
'//* Return value:                                                      */
'//*   time in minutes from zero Z                                      */
'//**********************************************************************/
Sub Procedure GetLocalSunRiseTime(Dim SC_in_Latitude as Float,
                                      Dim SC_in_Longitude as Float,
                                      Dim mYear As Integer,
                                      Dim mMonth As Integer,
                                      Dim mDay As Integer,
                                      Dim SC_in_GMToffset as integer,
                                      Dim ByRef StrOut as string[5],
                                      Dim ByRef ThoursOut as byte,
                                      Dim Byref TminutesOut as byte)



    Dim JD              as Float
    Dim t               as Float
    Dim RiseTimeGMT     as Float

    JD = CalcJD(mYear, mMonth, mDay)
    t = CalcTimeJulianCent(JD)

    ' Apparent SunRise GMT time
    RiseTimeGMT = CalcSunRiseUTC(JD, SC_in_Latitude, SC_in_Longitude)
    TimeToString (RiseTimeGMT, SC_in_GMToffset , StrOut, ThoursOut, TminutesOut)

End Sub

Sub Procedure GetLocalSunSetTime(Dim SC_in_Latitude as Float,
                                      Dim SC_in_Longitude as Float,
                                      Dim mYear As Integer,
                                      Dim mMonth As Integer,
                                      Dim mDay As Integer,
                                      Dim SC_in_GMToffset as integer,
                                      Dim ByRef StrOut as string[5],
                                      Dim ByRef ThoursOut as byte,
                                      Dim Byref TminutesOut as byte)


    Dim JD              as Float
    Dim t               as Float
    Dim SetTimeGMT      as Float

    JD = CalcJD(mYear, mMonth, mDay)
    t = CalcTimeJulianCent(JD)

    ' Apparent SunSet GMT time
    SetTimeGMT = CalcSunSetUTC(JD, SC_in_Latitude, SC_in_Longitude)
    TimeToString (SetTimeGMT, SC_in_GMToffset , StrOut, ThoursOut, TminutesOut)
End Sub

Sub Procedure GetLocalNoonTime(Dim SC_in_Longitude as Float,
                                      Dim mYear As Integer,
                                      Dim mMonth As Integer,
                                      Dim mDay As Integer,
                                      Dim SC_in_GMToffset as integer,
                                      Dim ByRef StrOut as string[5],
                                      Dim ByRef ThoursOut as byte,
                                      Dim Byref TminutesOut as byte)




    Dim JD              as Float
    Dim t               as Float
    Dim SolNoonGMT      as Float

    JD = CalcJD(mYear, mMonth, mDay)
    t = CalcTimeJulianCent(JD)

    ' Calculate solar noon for this date
    SolNoonGMT = CalcSolNoonUTC(t, SC_in_Longitude)
    TimeToString (SolNoonGMT, SC_in_GMToffset , StrOut, ThoursOut, TminutesOut)
End Sub

Sub Procedure GetMoreCalendarData(Dim mYear As Integer,
                                    Dim mMonth As Integer,
                                    Dim mDay As Integer,
                                    Dim Byref mIsLeapYear as byte,
                                    Dim Byref DayOfYear as integer,
                                    Dim Byref StrDayOfWeek as string[3],
                                    Dim Byref IntDayOfWeek as integer,
                                    Dim Byref SC_out_DaylightSavingTime as byte)

    Dim Jd          as float
    Dim i           as integer
    Dim LastSunday  as integer
    Dim sTemp       as string[3]
    Dim iTemp       as integer


    '+----------------------------------------------+
    '+ Leap year calculation                        +
    '+----------------------------------------------+
    mIsLeapYear = isLeapYear(mYear)

    '+----------------------------------------------+
    '+ Numerical day of year calculation            +
    '+----------------------------------------------+
    DayOfYear = calcDayOfYear(mMonth,mDay,mIsLeapYear)

    '+----------------------------------------------+
    '+ Numerical and string day of week calculation +
    '+----------------------------------------------+
    jd = CalcJD(mYear,mMonth,mDay)
    calcDayOfWeek(jd,StrDayOfWeek,IntDayOfWeek)

    '+----------------------------------------------+
    '+ Daylight Saving Time (DST) calculation       +
    '+----------------------------------------------+

    ' remember to put the right ending day
    ' for the for-next loop.
    '------------------------------------------
    for i = 1 to 31 ' march ending day
        iTemp = 0
        jd = 0
        jd = CalcJD(mYear,SC_in_dst_SMonth,i)
        calcDayOfWeek(jd,sTemp,iTemp)
        if iTemp = 7 then   ' Looking for Sunday day
            LastSunday = i
        end if
    next i
    SC_out_DST_StartDay = LastSunday
    SC_out_DST_StartMonth = SC_in_dst_SMonth
    SC_out_DST_StartYear = mYear

    ' remember to put the right ending day
    ' for the for-next loop.
    '------------------------------------------
    for i = 1 to 31 ' october ending day
        iTemp = 0
        jd = 0
        jd = CalcJD(mYear,SC_in_dst_EMonth,i)
        calcDayOfWeek(jd,sTemp,iTemp)
        if iTemp = 7 then   ' Looking for Sunday day
            LastSunday = i
        end if
    next i
    SC_out_DST_EndDay = LastSunday
    SC_out_DST_EndMonth = SC_in_dst_EMonth
    SC_out_DST_EndYear = mYear

    SC_out_DaylightSavingTime = false
    if (CalcJD(mYear,mMonth,mDay) >=
        CalcJD(SC_out_DST_StartYear,
                SC_out_DST_StartMonth,
                SC_out_DST_StartDay)) then
                    if (CalcJD(mYear,mMonth,mDay) <=
                        CalcJD(SC_out_DST_EndYear,
                                SC_out_DST_EndMonth,
                                SC_out_DST_EndDay)) then
                                    '-----------------
                                    SC_out_DaylightSavingTime = true
                    end if
    end if

End Sub

'****************************** End Module *************************************
end.


L'appli smart phone:

Utilisation :
SetRtcAndroidPic.doc

Le code App Inventor et le fichier Apk pour le smart phone.
SetRtcBt.zip
Vous n’avez pas les permissions nécessaires pour voir les fichiers joints à ce message.
Modifié en dernier par pspic le dim. 27 oct. 2019 08:46, modifié 4 fois.

Détection lever et coucher du soleil journalier
Gérard
Avatar de l’utilisateur
Expert
Expert
Messages : 1640
Âge : 65
Enregistré en : septembre 2015
Localisation : Alsace - Haut-Rhin

#2 Message par Gérard » dim. 8 sept. 2019 16:49

Bonjour à tous,

Je voulais compiler mais il n'a pas voulu, il me dit :
Syntax error : Expected "end" but "" found.
Le 18/04/19 je suis devenu papy de jumeaux, le 01/09/23 une petite cousine des jumeaux est née.

Détection lever et coucher du soleil journalier
pspic
Passioné
Passioné
Messages : 357
Âge : 77
Enregistré en : septembre 2017
Localisation : 68

#3 Message par pspic » dim. 8 sept. 2019 19:23

Regarde à la ligne 277 du programme principal et à la ligne 1153 du module, il doit manquer le point après le "end" final (soit end.)

Détection lever et coucher du soleil journalier
Gérard
Avatar de l’utilisateur
Expert
Expert
Messages : 1640
Âge : 65
Enregistré en : septembre 2015
Localisation : Alsace - Haut-Rhin

#4 Message par Gérard » lun. 9 sept. 2019 11:49

Led 2 end. sont présents.
Il donne l'erreur à la ligne 2 de SunCalc_Library.
Le 18/04/19 je suis devenu papy de jumeaux, le 01/09/23 une petite cousine des jumeaux est née.

Détection lever et coucher du soleil journalier
pspic
Passioné
Passioné
Messages : 357
Âge : 77
Enregistré en : septembre 2017
Localisation : 68

#5 Message par pspic » lun. 9 sept. 2019 13:23

Efface tout et essaye le code ci-joint.
SunCalc.zip

Tu utilises quoi comme module RTC et avec quel type de pile ?
Vous n’avez pas les permissions nécessaires pour voir les fichiers joints à ce message.

Détection lever et coucher du soleil journalier
Gérard
Avatar de l’utilisateur
Expert
Expert
Messages : 1640
Âge : 65
Enregistré en : septembre 2015
Localisation : Alsace - Haut-Rhin

#6 Message par Gérard » lun. 9 sept. 2019 14:29

La compilation fonctionne. Peux-tu me dire ce qui n'allait pas?
J'utilise une DS3231, elle a une compensation interne de température et est plus précise que la DS1307.
Le 18/04/19 je suis devenu papy de jumeaux, le 01/09/23 une petite cousine des jumeaux est née.

Détection lever et coucher du soleil journalier
pspic
Passioné
Passioné
Messages : 357
Âge : 77
Enregistré en : septembre 2017
Localisation : 68

#7 Message par pspic » lun. 9 sept. 2019 17:01

La compilation fonctionne. Peux-tu me dire ce qui n'allait pas?
J'utilise une DS3231, elle a une compensation interne de température et est plus précise que la DS1307.

Je n'ai pas cherché à comprendre ne sachant pas comment tu as crée le projet.
OK pour la RTC qui semble être compatible avec mon code.
Je pense qu'il est souhaitable de créer une nouvelle discussion pour ne pas polluer ce tuto, ceci n'empêche pas de l'améliorer quand c'est nécessaire.
Ce tuto est une base, mais pour une gestion de volets il faudra encore broder autour.

Détection lever et coucher du soleil journalier
pspic
Passioné
Passioné
Messages : 357
Âge : 77
Enregistré en : septembre 2017
Localisation : 68

#8 Message par pspic » lun. 9 sept. 2019 19:36

Pour Gérard :
Dans la procédure ConfigureLocalData il faut mettre la latitude / longitude pour tes coordonnés locales.

Code : Tout sélectionner

Sub Procedure ConfigureLocalData
    SC_in_LatDeg = 48        'degrés
    SC_in_LatMin = 4           'minutes
    SC_in_LatSec = 24         'secondes
    SC_in_LatSec100 = 59   '1/100 de secondes

    SC_in_LonDeg = 7
    SC_in_LonMin = 31
    SC_in_LonSec = 54
    SC_in_LonSec100 = 90
   


Bonne soirée.

Détection lever et coucher du soleil journalier
pspic
Passioné
Passioné
Messages : 357
Âge : 77
Enregistré en : septembre 2017
Localisation : 68

#9 Message par pspic » mar. 10 sept. 2019 09:28

Bonjour Gérard,
Ce matin pour un lever à 06:59, la sortie RA0 n'est pas passée à zéro à 07:00 comme prévu.
J'ai donc corrigé ce bug, il faudra donc modifier ton programme, désolé !

Code : Tout sélectionner

'Action sur la sortie RA0 pendant 1 minute
          if Hours = SC_out_RiseTime_Hours then
           if Minutes = SC_out_RiseTime_Minutes then
            SetBit(PORTA,0)    'Evènement lever du soleil pendant 1 minute
           end if
          end if
          if Hours <> SC_out_RiseTime_Hours then ClearBit(PORTA,0) end if
           if Minutes <> SC_out_RiseTime_Minutes then ClearBit(PORTA,0) end if

'Action sur la sortie RA1 pendant 1 minute
          if Hours = SC_out_SetTime_Hours then
           if Minutes = SC_out_SetTime_Minutes then
            SetBit(PORTA,1)       'Evènement coucher du soleil pendant 1 minute
           end if
          end if
           if Hours <> SC_out_SetTime_Hours then ClearBit(PORTA,1) end if
           if Minutes <> SC_out_SetTime_Minutes then ClearBit(PORTA,1) end if
 

Détection lever et coucher du soleil journalier
pspic
Passioné
Passioné
Messages : 357
Âge : 77
Enregistré en : septembre 2017
Localisation : 68

#10 Message par pspic » dim. 27 oct. 2019 09:01

Bonjour à tous,
J'ai été obligé de corriger un petit bug concernant le N° du jour de la semaine.
Le N° du jour sur smartphone Android est = 0 pour dimanche et 7 pour Delphi.
En PJ, la source corrigée.
SunRiseSunSet.zip
Vous n’avez pas les permissions nécessaires pour voir les fichiers joints à ce message.


Retourner vers « Langage BASIC & PASCAL »

Qui est en ligne

Utilisateurs parcourant ce forum : Aucun utilisateur enregistré et 1 invité