Sie sind hier: Home » ES-Messung » ES-Empfänger » Programm ESE

Link zu: Programm Erdsondenauswerter.bas


'*******************************************************************************
'**************               Sondenauswerter   V2.0           *****************
'*******************************************************************************

'name                     : Sondenauswerter V2.0.bas
'copyright                : (c) 20.01.2015 jep
'purpose                  : Neue Version des Auswerters für I2C und seriell
'micro                    : AtMega328P-PU
'
'offene Punkte            : Widerstands-Analogmessung

'Changelog:               : V1.1: Messintervall auf 2 Min gesetzt
'                         : V2.0: Messung mit I2C-Abfrage synchronisiert
'                           und Widerstansmessung komplett separiert

'-------------------------------------------------------------------------------

'Adresse der vorhandenen Bausteine DS18S20
'1 = 105B1790020800D8 --> Vorlauf
'2 = 10C06490020800B2 --> Rücklauf
'3 = 10398D8D020800DA --> Aussensensor Nord-West
'4 = 10297D9002080082
'5 = 103B90770208004E
'6 = 10078D770208004E
'7 = 10401190020800E7
'8 = 102C8A7702080051
'9 = 10D28F77020800E2
'10= 104A668D020800B1
'11= 101A548D02080098
'
'*******************************************************************************

$regfile = "m328Pdef.dat"                                   'ATMEL Mega328P-PU
$crystal = 16000000                                         'mit 16 MHz-Clock
$hwstack = 40                                               'default use 32 for the hardware stack
$swstack = 16                                               'default use 10 for the SW stack
$framesize = 60                                             'default use 40 for the frame space
$baud = 1200                                                'serielle Schnittstelle
$version 2 , 0 , 9

Declare Function Decigrades(BYVAL sc(9) as byte) as integer


'========================== Portkonfiguration ==================================

Config Portb.4 = Output                                     'Input MISO
PortB.4 = 1                                                 'Pullup
MISO Alias PinB.4

Config Portb.3 = Input                                      'Input MOSI
PortB.3 = 1                                                 'Pullup
MOSI Alias PinB.3

Config Portb.5 = Input                                      'Input SCK
Portb.5 = 1                                                 'Pullup
Sck Alias Pinb.5

Config Portb.1 = Output                                     'schaltet R-Messverstärker
Portb.1 = 1                                                 'Pullup
Mess_on Alias Portb.1

Config Pinc.0 = Input                                       'Eingang vom Messverstärker
Pt1000 Alias Portc.0

Config Pinc.1 = Input                                       '
Pt100o Alias Portc.1

Config PortC.3 = Output                                     'schaltet 5V für Sonde
PortC.3 = 1                                                 'ausgeschaltet
5vs Alias Portc.3

Config Pinc.2 = Input                                       'Taste 1
Pinc.2 = 1                                                  'Pullup
Ta Alias Pinc.2

'PortB.0 ist 1-wire

'==================== LCD Display mit 2 Zeilen zu 16 Zeichen ===================

'Chr(223) = °   ;   chr(244) = Omega

Config Lcdpin = Pin , E = PortD.3 , Rs = PortD.2 , Db4 = PortD.4 , Db5 = PortD.5 , Db6 = PortD.6 , Db7 = PortD.7
Config Lcd = 16 * 2

'Initialisierung des LCD's, Löschen und Cursor Home

waitms 10
cls
Initlcd                                                     'Initialisieren
Cursor Off                                                  'Cursor aus
Cls                                                         'Display löschen
Home                                                        'Cursor auf Position 1 , 1


'==========================  Zeit-Konfiguration  ===============================
$external _soft_clock                                       'Dieser Befehl bindet den Code der Original-Uhrenroutine ein

Config Clock = User                                         'Teilt dem Compiler mit, daß eine eigene Uhrenroutine verwendet wird
                                                            'Die internen Variablen _hour, _min, _sec, _day, _month, _year werden erzeugt
Const _sectic = 0                                           'Keine Sectic Sub verwenden

Config Date = dmy , Separator = .                           'Datum auf deutsches Format einstellen

Config Timer1 = Timer , Prescale = 256 , CLEAR TIMER = 1    'Clear Timer setzt Timer1 bei Erreichen des Comparewertes auf 0 zurueck
Const CTC_Value =(_XTAL / 256) - 1                          'Berechnen des Compare-Wertes, bei dem Timer1 zuruecksetzt
Compare1A = CTC_Value                                       'Comparewert setzen
Enable Compare1A                                            'Compare-ISR erlauben
On Compare1A Timer1_Clock_ISR NOSAVE                        'Definitition des Labels fuer Timer1 Compare-ISR

Time$ = "09:00:00"                                          'Stellen der Uhrzeit auf einen Initialwert
Date$ = "01.01.11"                                          'Stellen des Datums auf einen Initialwert

Dim Curr_Sec As Byte                                        ' Hier wird die aktuelle Sekunde gemerkt
Curr_Sec = 255                                              ' Initialisieren mit einem fuer _Sec nicht vorkommenden Wert

Dim Neue_sekunde As Bit                                     'Flag
Dim Alte_minute as Byte                                     '
Alte_minute = 0
Dim Wochentag As Byte                                       '0..6
Dim Jahr as Byte                                            'für Manipulationen nötig
Dim Monat as Byte                                           'für Manipulationen nötig
Dim Tag as Byte                                             'für Manipulationen nötig
Dim Stunden as Byte                                         'für Manipulationen nötig
Dim Minuten as Byte                                         'für Manipulationen nötig
Dim Sekunden as Byte                                        'für Manipulationen nötig
Dim M As Word                                               'Zählvariable für Messintervall
M = 1                                                       'damit sofort eine Messung gemacht wird
Dim Messintervall As Word                                   'Messintervall in Minuten
Messintervall = 15                                          'Messintervall 15 Min

'======================= I2C-Konfiguration, HW-I2C-Bus =========================

On TWI TWI_ISR Save                                         'Interruptroutine für die I2C-Datenübertragung
Dim Slaveadresse as Byte
Slaveadresse = &H4E                                         'Adresse Portexpander 8574 mit A0...A2 = 1
Config Twi = 400000                                         'Port´s nicht konfigurieren,
Config SCL = PortC.5                                        'nur für I2Cinit nötig
Config SDA = PortC.4                                        'nur für I2Cinit nötig
I2cinit                                                     'sie sind HW-mässig festgelegt

Dim Twi_control As Byte                                     'Controlregister lokale kopie
Dim Twi_status As Byte
Dim Twi_data As Byte
Dim Abfragevommaster As Byte
Abfragevommaster = 0

Declare Sub Twi_init_slave

Call Twi_init_slave                                         ' TWI aktivieren

'================= Serielle Konfiguration  und PT1000 ==========================

Config Serialin = Buffered , Size = 20

Config Adc = Single , Prescaler = Auto , Reference = Internal

Dim Messergebnis_pt As Word

'=========================== 1-Wire Konfiguration ==============================

Config 1wire = PortB.0                                      '1-Wire-Port

Dim Dg As Integer                                           'DECIgrades, I call it, cause I have no space for commas on the display....
Dim Degr as Single                                          'zur Darstellung umgewandelt

'hier wird direkt die Adresse des Sensors zugewiesen
Dim Dsid(8) As Byte                                         'Dallas ID 64 bits incl CRC
'
Dsid(1) = &h10                                              'Temp-Sensor: Erdsonde oben
Dsid(2) = &h41
Dsid(3) = &h76
Dsid(4) = &h8D
Dsid(5) = &h02
Dsid(6) = &h08
Dsid(7) = &h00
Dsid(8) = &h35

Dim Sc(9) as byte                                           'Scratchpad 0-8 72 bits incl CRC

'=========================================================================================

'Zum Speichern und Senden via I2C: Umwandlung 2 Byte in 1 Integer
'        +--------+--------+--------+--------+
'        | Byte 1 | Byte 2 | Byte 3 | Byte 4 |
'        |  TS(1) |  TS(2) |  TS(3) |  TS(4) |
'        +--------+--------+--------+--------+
'        | Tser = Integer1 | TE1W = Integer2 |
'        +-----------------+-----------------+
'        | Temperatur unten| Temperatur oben |
'
'
Dim TS(4) as Byte                                           'Standardspeicherformat für Temperaturen (je 2 Byte)
Dim ByteCount as Byte                                       'Index für TS
ByteCount = 1                                               'und initialisieren
Dim Tser as Integer at TS(1) overlay                        'Temperatur unten via seriell
'Tser = 147                                                  'nur zum Testen    <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
Dim TE1W As Integer at TS(3) overlay                        'Temperatur oben via 1wire
Dim Temperatursingle As Single
Dim TempKomma as string * 10
Dim Tempoben as String * 10
Tempoben = "Messen "                                        'Initaltext
Dim TEs(6) as Byte                                          'Text wie von der Sonde unten empfangen
Dim Tempunten as String * 7 at TEs(1) overlay               'gleicher Text als String darübergelegt für Anzeige
Tempunten = "Messen "                                       'Initialtext
Dim TUser(6) as Byte                                        'Text wie von der Sonde empfangen für Integerumrechnung
Dim TempuntInt as String * 4                                'dient zur Umrechnung in Integer
Dim TUstr(4) as Byte at TempuntInt overlay                  'damit wird das Komma entfernt
Dim n as Byte                                               'Zählvariable für serielle Zeichen

 

'                                ***************
'                        *******************************
'                ***********************************************
'        ***************************************************************
'********************************  PROGRAMMSTART   *****************************
'*******************************************************************************

Enable Interrupts


Print "************************************************"
Print "************** Programmstart *******************"
Print "************************************************"

Locate 1 , 1
LCD "File-Version:"                                         'Version
Locate 2 , 1                                                'und
Lcd Version(2)                                              'Filename darstellen
Print
Print "File-Version: " ; Version(3)
Print
Wait 4                                                      '4 Sekunden warten
cls
ByteCount = 1
gosub Mintic                                                'zuerst einmal Werte holen


'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
'+++++++++++++++++++++++++++++++ Hauptschleife +++++++++++++++++++++++++++++++++


do
   Debounce Ta , 0 , Tastenauswertung , Sub                 'Springt zur Widerstandsanzeige wenn Taste TA gedrückt

   If Abfragevommaster = 1 Then
      Gosub Messung
      Abfragevommaster = 0                                  'Merker zurücksetzen
      M = Messintervall                                     'Messintervall zurücksetzen
   End If

   If Curr_Sec <> _Sec Then
      Curr_sec = _sec
      Locate 1 , 15                                         '2 Stellen genügen für die Minute
      Lcd M                                                 'Restzeit Minuten
      Locate 2 , 15
      LCD _sec                                              'laufende Sekunde
      if alte_minute <> _min then
         gosub mintic
         alte_minute = _min
      end if
   End If
loop

'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
'+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++


'################### Alles was einmal pro Minute abläuft #######################

Mintic:
   M = M - 1                                                'Messintervallzeit decrementieren
   If M = 0 Then
      M = Messintervall
      Gosub Messung                                         'Messungen durchführen
   End If
   Gosub Normalanzeige                                      'Alle Minuten neu schreiben
Return

'###############################################################################


'============================ Temperaturmessung ================================

Messung:

   5vs = 0                                                  'Speisung an die Sonden anlegen
   1wreset                                                  '1-Wire-Bus zurücksetzen
   1wwrite &HCC                                             'Adressrom´s überspringen
   1wwrite &H44                                             'Temperaturkonversion anstossen

   Locate 1 , 1
   Lcd "T oben:  Messen "                                   'Anzeige obere Zeile
   Locate 2 , 1
   Lcd "T unten: Messen "                                   'Anzeige untere Zeile
   Tempoben = " --.-"                                       'Speicher löschen
   Tempunten = " --.-"                                      'Speicher löschen
   Wait 1                                                   'Konvertierzeit ist 1 sec
   Gosub Temp_messung_1w                                    '1-Wire-Sensoren abfragen
   Wait 3                                                   'untere Messung dauert ca 4 sec
   Gosub Seriell_in                                         'seriell abfragen, Daten danach in TUstr und Tser
   Gosub Normalanzeige                                      'und anzeigen
   Wait 5                                                   'damit bei Abfrage 5 sec später die Speisung nicht
                                                            'neu eingeschaltet werden muss
   5vs = 1                                                  'Speisung an den Sonden abschalten

'Serieller Empfangspuffer leeren
   Do
      If Ischarwaiting() = 1 Then                           'Puffer nun komplett von Zeichen leeren
         n = Inkey()
      else
         goto EndeMessung                                   'wenn leer --> weiter
      End if
   Loop

Endemessung:
   Abfragevommaster = 0                                     'allfälligen Merker zurücksetzen
Return


'=========================   Normalanzeige  ====================================

Normalanzeige:

   Cls                                                      'nach Messung neu schreiben
   Locate 1 , 1
   Lcd "To: " ; Tempoben ; Chr(223) ; "C   " ; M ; "   "    'Anzeige obere Zeile
   Locate 2 , 1
   Lcd "Tu: " ; Tempunten ; Chr(223) ; "C   "               'Anzeige untere Zeile
   Locate 2 , 15                                            'um die letzten 2 Stellen zu überschreiben
   Lcd _sec
Return


'=================================== 1-wire ====================================

Temp_Messung_1W:
   1wverify DsId(1)                                         'sendet "Match ROM "
   If Err = 1 Then                                          'Error = 1 Fehler aufgetreten
      TE1W = 9999                                           'damit die Stelle nicht leer bleibt
   Elseif Err = 0 Then                                      'Sensor hat geantwortet
      1wwrite &HBE
      Sc(1) = 1wread(9)                                     '9 Bytes in Array einlesen
      if sc(9) = crc8(sc(1) , 8) then
         TE1W = DeciGrades(sc(9))                           'Umwandlung in ein Integer-Word (-32768...32767) zum abspeichern
      end if
   End If

'noch Wert des 1-Wire-Sensors für die Anzeige konvertieren
   Temperatursingle = Te1w / 10                             'und aufbereiten
   Tempkomma = Fusing(temperatursingle , "##.#")            'Komma festlegen
   Tempoben = Format(tempkomma , "+0000")                   'Zahlenausgabe formatieren
   If Temperatursingle > 100 Then Tempoben = " --.-"        'Nichtbenutzte ausblenden
   If Temperatursingle < -100 Then Tempoben = " --.-"
Return

'-----------------------

Function Decigrades(byval Sc(9) As Byte)
   Dim Tmp As Byte , Tp As Integer , Tp1 As Integer

   Tmp = Sc(1) And 1                                        '0.1C Genauigkeit, Bit 0 ausmaskieren
   If Tmp = 1 Then Decr Sc(1)                               'wenn 1 dann 1 abziehen
      Tp = Makeint(sc(1) , Sc(2))                           'Umwandeln in Integerwert, Anzahl 1/2° (Temp-Schritt ist 0.5°C)
      Tp = Tp * 50                                          'x50, da 1/100°-Schritte
      Tp = Tp - 25                                          'gemäss DS18S20 data sheet 0.25(*100) abziehen
      Tp1 = Sc(8) - Sc(7)
      Tp1 = Tp1 * 100
      Tp1 = Tp1 / Sc(8)
      Tp = Tp + Tp1
      Decigrades = Tp / 10
End Function


'================================= seriell in ==================================

Seriell_in:
n = 1
  Do
    If Ischarwaiting() = 1 Then                             'Zeichen im Puffer?
       TUser(n) = Inkey()                                   'holt Zeichen
       TEs(n) = TUser(n)                                    'und kopiert es für Integerwandlung
       incr n                                               'nächstes Zeichen
         if n = 6 then
         goto ok5:                                          '5 Zeichen empfangen
         End If                                             'also weiter
       waitms 30                                            'damit das nächste Zeichen sicher eintreffen kann wenn gerade empfangen wird
    Else                                                    'wenn kein Zeichen vorhanden (wäre Fehler)
       Tser = 9999                                          'damit wird Wert > 100 und eine Fehlermeldung erzeugt
       goto keinZeichen
    End If
  Loop                                                      'alle Zeichen abholen

ok5:                                                        'hiermit wird der Dezimalpunkt entfernt, d.h. x10
    TUstr(1) = TUser(1)
    TUstr(2) = TUser(2)
    TUstr(3) = TUser(3)
    TUstr(4) = TUser(5)

    Tser = val(TempuntInt)                                  'String wieder in Integer zurückwandeln

keinZeichen:
Return

'============================= Widerstandsmessung ==============================

Tastenauswertung:

   Waitms 500                                               '500 ms warten
   If Ta = 1 Then Goto Widerstandsmessung                   'wieder 1 --> kurz Drücken = Anzeige
   Wait 2
   If Ta = 0 Then Goto Reseten                              'immer noch 0 --> lang Drücken = Reset
'__________________

Widerstandsmessung:

   Print "Widerstansmessung"
   Mess_on = 0                                              'Messverstärker einschalten
   Cls
   Locate 1 , 1
   Lcd "Messung  PT1000-"                                   'Anzeige obere Zeile
   Locate 2 , 1
   Lcd "Widerstand      "                                   'Anzeige untere Zeile
   Tempunten = " --.-"                                      'Speicher löschen um Fehler zu erkennen
   Wait 5

   Start Adc                                                'zuerst Widerstandsmessung
   Waitms 500                                               'Konvertierzeit
   Messergebnis_pt = Getadc(0)                              'Spannung über dem PT1000 messen
   Stop Adc
   Waitms 200
   Mess_on = 1                                              'Messverstärker ausschalten

'seriell in abfragen
   5vs = 0                                                  'Speisung an die Sonden anlegen
   Wait 4                                                   'Messzeit
   Gosub Seriell_in                                         'digitaler Temperaturwert abfragen
   Wait 1
   5vs = 1                                                  'Speisung an den Sonden abschalten

'serieller Empfangspuffer leeren
   Do
      If Ischarwaiting() = 1 Then                           'Puffer nun komplett von Zeichen leeren
         n = Inkey()
      else
         Goto Widerstandsanzeige                            'wenn leer --> weiter
      End If
   Loop

Widerstandsanzeige:
   Cls
   Locate 1 , 1                                             'und anzeigen
   Lcd "PT1000:   " ; Messergebnis_pt                       'PT1000 (momentan nur den Messwert um eine Tabelle zu erstellen)
   Locate 2 , 1                                             'und
   Lcd "T unten: " ; Tempunten ; Chr(223) ; "C"             'Temperatur unten
   Print "T unten: " ; Tempunten ; "    PT1000: " ; Messergebnis_pt
   Print
   Wait 6                                                   'werden 4 sec angezeigt
   Gosub Normalanzeige                                      'und wieder die normale Darstellung

Return
'__________________

Reseten:

Print "Reset"
Print

Goto 0

'================================================================================

'######################## TWI-slave Interruptroutine ###########################

TWI_ISR:
      TWI_status = TWSR and &hF8
      If Twi_status = &HA8 Or Twi_status = &HB8 Then        'Anfrage vom Master für ein Byte
         Twdr = Ts(bytecount)                               'neue Daten ausgeben
         If Bytecount = 4 Then
            TWCR = &B10000101                               'TWINT löschen, TWEA auf 0, erwartet NACK, TWIE Interrupt ein
            Bytecount = 1                                   'Zählert wieder zurückstellen
            Abfragevommaster = 1                            'Merker setzen da von Master abgefragt wurde
         Else
            TWCR = &B11000101                               'TWINT löschen, TWEA auf 1, erwartet ACK, TWIE Interrupt ein
            Incr ByteCount
         End if
      Else
         If Twi_status = &HC0 Or Twi_status = &HC8 Then Twcr = &B11000101       'TWINT löschen, TWEA auf 0, erwartet ACK, TWIE Interrupt ein
      End If
Return
'_________________________________________________________

' TWI als Slave aktivieren
Sub Twi_init_slave
    Twsr = 0                                                ' status und Prescaler auf 0
    Twdr = &HFF                                             ' default FF
    Twar = Slaveadresse                                     ' Slaveadresse setzen
    Twcr = &B01000101                                       ' TWI aktivieren, ACK einschalten
'    Print "TWI initialisiert "
End Sub


'################################ Timer Interruptroutine #######################

Timer1_Clock_ISR:                                           'Falls eigener Code eingefuegt werden soll, der vor der Uhrenroutine sekuendlich
'PUSHALL                                                     'ausgefuehrt wird, so muss mit PUSHALL/POPALL die Sicherung der Register erfolgen

' #### Hier kann aehnlich wie bei "CONFIG CLOCK = soft, GOSUB = SECTIC" eigener Code eingefuegt werden ####

'POPALL                                                      'Ohne eigenen Code kann PUSHALL/POPALL auskommentiert werden, das spart Stack
                                                            'und Ausfuehrungszeit
 !jmp _soft_clock                                           'Ruft Bascom's Uhrenroutine auf
Return                                                      'Nur vorhanden, damit es huebscher aussieht, dieses Return wird aber nie verwendet

Getdatetime:                                                'Um Bascom's Routinen zum Stellen der Uhr, wie Time$ = ... verwenden zu koennen,
Return                                                      'muessen folgende Label als leere Subs vorhanden sein

Settime:
Return

Setdate:
Return

'###############################################################################


END

'*******************************************************************************
'        ***************************************************************
'                ***********************************************
'                        *******************************
'                                ***************


 
besucherzaehler-kostenlos.de