UrarenKalitatea: Pascal Source Code for Water Quality

UrarenKalitatea Pascal Source Code

The following is a complete Pascal program designed to manage and calculate water quality measurements and indices.

PROGRAM UrarenKalitatea ;

USES
  Crt, SysUtils ;

CONST
  MAX_NEURKETAK = 1000 ;

TYPE
  tsKateLabur = STRING [10] ;
  tsKateLuze = STRING [150] ;
  tarOinarrizkoParametroak = ARRAY [1..9] OF Real ;
  trdNeurketa = RECORD
    sBehatokia,
    sData: tsKateLabur ;
    rKIO: Real ;
    iKI: Integer ;
    arParametroak : tarOinarrizkoParametroak ;
  END ;
  tardNeurketenZerrenda = ARRAY [1..MAX_NEURKETAK] OF trdNeurketa ;
  tfrdNeurketenFitxategia = FILE OF trdNeurketa ;

FUNCTION fncAukeraIrakurri : Char ;
VAR
  cAukera : Char ;
BEGIN
  Writeln('1. Neurketen fitxategiaren edukia erakutsi') ;
  Writeln('2. Kalitate indizeak kalkulatu (KIO eta KI)') ;
  Writeln('3. Behatoki baten KI okerreko egun jarraituak erakutsi');
  Writeln('0. Amaitu') ;
  Write('Zure aukera ----> ') ;
  REPEAT
    cAukera := ReadKey ;
  UNTIL (cAukera >= '0') AND (cAukera <= '3') ;
  Writeln(cAukera) ;
  ClrScr ;
  fncAukeraIrakurri := cAukera ;
END ;

PROCEDURE GoiburuaErakutsi ;
BEGIN
  Writeln('===============================================================================') ;
  Writeln('CF':37, 'pH':5, 'DB05':5, 'NO3':5, 'PO4':5, 'cT':5, 'T':5, 'Sd':5, 'Od':5) ;
  Writeln('Behatokia':10, 'Data':12, 'KIO':6, 'KI':3, 'P-1':6, 'P-2':5, 'P-3':5, 'P-4':5, 'P-5':5, 'P-6':5, 'P-7':5, 'P-8':5, 'P-9':5) ;
  Writeln('===============================================================================') ;
END ;

PROCEDURE NeurketaErakutsi (CONST rdNeurketaBat : trdNeurketa) ;
VAR
  i : Integer ;
BEGIN
  WITH rdNeurketaBat DO
  BEGIN
    Write(sBehatokia:10, sData:12, rKIO:6:1, iKI:3, ' ') ;
    FOR i := 1 TO 9 DO
      Write(arParametroak[i]:5:1) ;
  END ;
  Writeln ;
END ;

PROCEDURE NeurketaGuztiakErakutsi (sFitxIzen : tsKateLuze) ;
VAR
  f: tfrdNeurketenFitxategia;
  rdNeurketaBat: trdNeurketa ;
BEGIN
  Assign(f, sFitxIzen) ;
  Reset(f) ;
  GoiburuaErakutsi ;
  WHILE NOT EOF(f) DO
  BEGIN
    Read(f, rdNeurketaBat) ;
    NeurketaErakutsi(rdNeurketaBat) ;
  END ;
  Close(f) ;
END ;

PROCEDURE PisuakIrakurri (VAR arPisuak : tarOinarrizkoParametroak) ;
VAR
  i : Integer ;
BEGIN
  { Goiburua idaztea eskatzen da, ez prozedura osoaren garapena }
  Writeln ;
  Writeln('KIO indizea kalkulatzeko oinarrizko parametroen pisuak eman') ;
  FOR i := 1 TO 9 DO
  BEGIN
    REPEAT
      Write(i, '. parametroaren pisua (1.0 eta 4.0 artekoa): ') ;
      Readln(arPisuak[i]) ;
    UNTIL (arPisuak[i] >= 1.0) AND (arPisuak[i] <= 4.0) ;
  END ;
  WriteLn ;
  Writeln('KIO indizea kalkulatzeko parametroak:') ;
  FOR i := 1 TO 9 DO
  BEGIN
    Write(arPisuak[i]:8:1) ;
  END ;
  WriteLn ;
END ;

FUNCTION fnrKalkulatuKIO (CONST arParametroak, arPisuak : tarOinarrizkoParametroak) : Real ;
VAR
  i: Integer ;
  rKIO : Real ;
BEGIN
  rKIO := 0 ;
  FOR i := 1 TO 9 DO
    rKIO := rKIO + arParametroak[i] * arPisuak[i] ;
  fnrKalkulatuKIO := rKIO ;
END ;

FUNCTION fniKalkulatuKi(rKIO : Real) : Integer ;
VAR
  iKI : Integer ;
BEGIN
  IF rKIO < 50.0 THEN
    iKI := 0
  ELSE IF rKIO < 65.0 THEN
    iKI := 1
  ELSE IF rKIO < 75.0 THEN
    iKI := 2
  ELSE IF rKIO < 85.0 THEN
    iKI := 3
  ELSE IF rKIO < 100.0 THEN
    iKI := 4
  ELSE
    iKI := 5 ;
  fniKalkulatuKI := iKI ;
END ;

PROCEDURE KalitateIndizeakKalkulatu (sFitxIzen : tsKateLuze) ;
VAR
  f : tfrdNeurketenFitxategia;
  rdNeurketaBat : trdNeurketa ;
  arPisuak: tarOinarrizkoParametroak ;
BEGIN
  PisuakIrakurri(arPisuak) ;
  Assign(f, sFitxIzen) ;
  Reset(f) ;
  WHILE NOT EOF(f) DO
  BEGIN
    Read(f, rdNeurketaBat) ;
    WITH rdNeurketaBat DO
    BEGIN
      rKIO := fnrKalkulatuKIO(arParametroak, arPisuak) ;
      iKI := fniKalkulatuKI(rKIO) ;
    END ;
    Seek(f, FilePos(f) - 1) ;
    Write(f, rdNeurketaBat) ;
  END ;
  Close(f) ;
END ;