En raison du déménagement des baies serveurs, les services gitlab.irstea.fr et mattermost.irstea.fr seront interrompus le samedi 2 octobre 2021 au matin. Ils devraient revenir à la normale dans la journée.

Commit 4e9527bf authored by Dorchies David's avatar Dorchies David
Browse files

feat: remove leap year hanfling

Fix #8
parent 28021b02
...@@ -378,9 +378,9 @@ procedure C1_LectureObjectif; ...@@ -378,9 +378,9 @@ procedure C1_LectureObjectif;
begin begin
val(copy(XChai,6,length(XChai)-5),XQ,XCode); val(copy(XChai,6,length(XChai)-5),XQ,XCode);
if XCode=0 then if XCode=0 then
if (XMois>0) and (XMois<13) and (XJour>0) and (XJour<=B_longMois(2001,XMois)) and (XQ>=0) then if (XMois>0) and (XMois<13) and (XJour>0) and (XJour<=B_longMois(XMois)) and (XQ>=0) then
begin begin
XNouvelleDate:= B_Quantieme(XJour,XMois,2001); XNouvelleDate:= B_Quantieme(XJour,XMois);
if XNouvelleDate>YDateObj[YNbQXobj] then if XNouvelleDate>YDateObj[YNbQXobj] then
begin begin
YNbQXobj:=YNbQXobj+1; YNbQXobj:=YNbQXobj+1;
...@@ -997,7 +997,7 @@ Procedure C1_QRefRes(ZChrono : boolean; ZType,ZRangLac:integer; ...@@ -997,7 +997,7 @@ Procedure C1_QRefRes(ZChrono : boolean; ZType,ZRangLac:integer;
val(copy(ZChaiDate,1,2),XJour,Xcode); val(copy(ZChaiDate,1,2),XJour,Xcode);
val(copy(ZChaiDate,4,2),XMois,Xcode); val(copy(ZChaiDate,4,2),XMois,Xcode);
val(copy(Zchaidate,7,4),XAn,XCode); val(copy(Zchaidate,7,4),XAn,XCode);
XQuantieme:=B_Quantieme(XJour,XMois,2001); XQuantieme:=B_Quantieme(XJour,XMois);
if (XMois=2) and (XJour=29) then if (XMois=2) and (XJour=29) then
Xquantieme:=XQuantieme-1; Xquantieme:=XQuantieme-1;
for Xi:=0 to 1 do for Xi:=0 to 1 do
......
...@@ -263,7 +263,7 @@ PROCEDURE C2_ISOFREQ (ZDateDebutFichier, ZDateDebut, ZDateFin:longint; ...@@ -263,7 +263,7 @@ PROCEDURE C2_ISOFREQ (ZDateDebutFichier, ZDateDebut, ZDateFin:longint;
begin begin
{--BOUCLE SUR LES JOURS DU MOIS (en anne non bissextile)--} {--BOUCLE SUR LES JOURS DU MOIS (en anne non bissextile)--}
for XJour:=1 to B_LongMois(2001,XMois) do for XJour:=1 to B_LongMois(XMois) do
begin begin
{--calcul pour le jour courant, de la premire et de la dernire--} {--calcul pour le jour courant, de la premire et de la dernire--}
......
...@@ -60,7 +60,7 @@ procedure Ici_Calcul_Quantile_QMN(Zfreq: double); ...@@ -60,7 +60,7 @@ procedure Ici_Calcul_Quantile_QMN(Zfreq: double);
begin begin
{--BOUCLE SUR LES JOURS DU MOIS (en anne non bissextile)--} {--BOUCLE SUR LES JOURS DU MOIS (en anne non bissextile)--}
for XJour:=1 to B_LongMois(2001,XMois) do for XJour:=1 to B_LongMois(XMois) do
begin begin
XQuant:=XQuant+1; XQuant:=XQuant+1;
......
...@@ -304,7 +304,7 @@ procedure A_Saisidate(var Zjour,Zmois,Zan:integer; var ZDada:string; ZDadamin,ZD ...@@ -304,7 +304,7 @@ procedure A_Saisidate(var Zjour,Zmois,Zan:integer; var ZDada:string; ZDadamin,ZD
val(copy(ZDada,1,2),Zjour,Bcode1); val(copy(ZDada,4,2),Zmois,Bcode2); val(copy(ZDada,1,2),Zjour,Bcode1); val(copy(ZDada,4,2),Zmois,Bcode2);
val(copy(ZDada,7,4),Zan,Bcode3); val(copy(ZDada,7,4),Zan,Bcode3);
XBon:=((Bcode1=0) and (Bcode2=0) and (Bcode3=0) and (Zmois>0) and (Zmois<13) and XBon:=((Bcode1=0) and (Bcode2=0) and (Bcode3=0) and (Zmois>0) and (Zmois<13) and
(Zjour>0) and (Zjour<=B_longmois(ZAn,ZMois)) and (Zjour>0) and (Zjour<=B_longmois(ZMois)) and
((Zjour+100*ZMois+10000.0*ZAn)<=XMatouvu) and ((Zjour+100*ZMois+10000.0*ZAn)>=XMinizup)) ((Zjour+100*ZMois+10000.0*ZAn)<=XMatouvu) and ((Zjour+100*ZMois+10000.0*ZAn)>=XMinizup))
or (ARangTouchSpecial<>0); or (ARangTouchSpecial<>0);
if not XBon then if not XBon then
......
...@@ -135,7 +135,7 @@ procedure P_DatesLuesSurFichier; ...@@ -135,7 +135,7 @@ procedure P_DatesLuesSurFichier;
if (YCode=0) and (YMois[0]>0) and (Ymois[0]<13) then if (YCode=0) and (YMois[0]>0) and (Ymois[0]<13) then
begin begin
val(copy(YDat1,1,2),YJour[0],YCode); val(copy(YDat1,1,2),YJour[0],YCode);
if (YCode=0) and (YJour[0]>0) and (YJour[0]<=B_LongMois(YAn,YMois[0])) then if (YCode=0) and (YJour[0]>0) and (YJour[0]<=B_LongMois(YMois[0])) then
begin begin
YDateDebut:=B_maxlongInt(YmeilleurDebut,B_minlongInt(B_TJour(YAn,YMois[0],YJour[0]),YMeilleurFin-3*365)); YDateDebut:=B_maxlongInt(YmeilleurDebut,B_minlongInt(B_TJour(YAn,YMois[0],YJour[0]),YMeilleurFin-3*365));
end; end;
...@@ -148,7 +148,7 @@ procedure P_DatesLuesSurFichier; ...@@ -148,7 +148,7 @@ procedure P_DatesLuesSurFichier;
if (YCode=0) and (YMois[0]>0) and (Ymois[0]<13) then if (YCode=0) and (YMois[0]>0) and (Ymois[0]<13) then
begin begin
val(copy(YDat2,1,2),YJour[0],YCode); val(copy(YDat2,1,2),YJour[0],YCode);
if (YCode=0) and (YJour[0]>0) and (YJour[0]<=B_LongMois(YAn,YMois[0])) then if (YCode=0) and (YJour[0]>0) and (YJour[0]<=B_LongMois(YMois[0])) then
YDateFin:=B_minlongInt(B_maxlongInt(YDateDebut+3*365,B_TJour(YAn,Ymois[0],YJour[0])),YmeilleurFin); YDateFin:=B_minlongInt(B_maxlongInt(YDateDebut+3*365,B_TJour(YAn,Ymois[0],YJour[0])),YmeilleurFin);
end; end;
end; end;
......
...@@ -45,9 +45,9 @@ function B_MaxLongInt (ZD1,ZD2:Longint):longint; ...@@ -45,9 +45,9 @@ function B_MaxLongInt (ZD1,ZD2:Longint):longint;
function B_MinLongInt (ZD1,ZD2:longint):longint; function B_MinLongInt (ZD1,ZD2:longint):longint;
function B_MaxDouble (ZD1,ZD2:Bprecis1) :Bprecis1; function B_MaxDouble (ZD1,ZD2:Bprecis1) :Bprecis1;
function B_MinDouble (ZD1,ZD2:Bprecis1) :Bprecis1; function B_MinDouble (ZD1,ZD2:Bprecis1) :Bprecis1;
function B_Longmois (ZAn,ZMois:integer):integer; function B_Longmois (ZMois:integer):integer;
function B_DateClaire (ZAnnee,ZQuant:integer):BChai5; {date en clair partir du quantieme} function B_DateClaire (ZAnnee,ZQuant:integer):BChai5; {date en clair partir du quantieme}
function B_Quantieme (Zjour,Zmois,ZAnnee:integer):integer; function B_Quantieme (Zjour,Zmois:integer):integer;
function B_QuantiemeNonBiss(ZDate:longint):integer; function B_QuantiemeNonBiss(ZDate:longint):integer;
function B_Tjour (ZAn,ZMois,ZJour:longint):longint; function B_Tjour (ZAn,ZMois,ZJour:longint):longint;
function B_Date (ZRang:longint):string; function B_Date (ZRang:longint):string;
...@@ -101,20 +101,14 @@ function B_MinDouble (ZD1,ZD2:Bprecis1) :Bprecis1; ...@@ -101,20 +101,14 @@ function B_MinDouble (ZD1,ZD2:Bprecis1) :Bprecis1;
{----------------------------------------------------------------------------} {----------------------------------------------------------------------------}
function B_Longmois(ZAn,ZMois:integer):integer; function B_Longmois(ZMois:integer):integer;
{donne le nombre de jours du mois Mois de l'annee An, en tenant compte pour } {donne le nombre de jours du mois Mois de l'annee An, en tenant compte pour }
{fvrier du caractre bissextile ou non de l'anne. Une anne est bissextile} {fvrier du caractre bissextile ou non de l'anne. Une anne est bissextile}
{si elle est multiple de 4 et non divisible par 100, ou bien si elle est } {si elle est multiple de 4 et non divisible par 100, ou bien si elle est }
{multiple de 400. } {multiple de 400. }
var XL : integer; var XL : integer;
begin begin
XL:=BLong[ZMois]; B_LongMois:=BLong[ZMois];
{if (ZMois=2) and ((ZAn mod 4) = 0) then XL:=XL+1;}
if (ZMois=2) and
((Zan mod 4) = 0) and
(((Zan mod 100) <> 0) or ((Zan mod 400) = 0)) then
XL:=XL+1;
B_LongMois:=XL;
end; end;
{----------------------------------------------------------------------------} {----------------------------------------------------------------------------}
...@@ -128,21 +122,21 @@ function B_DateClaire(ZAnnee,ZQuant:integer):BChai5; ...@@ -128,21 +122,21 @@ function B_DateClaire(ZAnnee,ZQuant:integer):BChai5;
begin begin
XS:=0;Xi:=0; XS:=0;Xi:=0;
repeat repeat
Xi:=Xi+1; XS:=XS+B_LongMois(Zannee,Xi); Xi:=Xi+1; XS:=XS+B_LongMois(Xi);
until XS>=ZQuant; until XS>=ZQuant;
str((ZQuant-XS+B_LongMois(ZAnnee,Xi)+Xi/100):5:2,XC); if XC[1]=' ' then XC[1]:='0'; str((ZQuant-XS+B_LongMois(Xi)+Xi/100):5:2,XC); if XC[1]=' ' then XC[1]:='0';
B_DateClaire:=XC; B_DateClaire:=XC;
end; end;
{----------------------------------------------------------------------------} {----------------------------------------------------------------------------}
function B_Quantieme(Zjour,Zmois,ZAnnee:integer): integer; function B_Quantieme(Zjour,Zmois:integer): integer;
{--calcul du quantime partir du jour, du mois et de l'anne, pour une --} {--calcul du quantime partir du jour, du mois et de l'anne, pour une --}
{--anne bissextile ou non. --} {--anne bissextile ou non. --}
var Xi,XS:integer; var Xi,XS:integer;
begin begin
Xs:=0; Xs:=0;
for Xi:=1 to ZMois-1 do Xs:=XS+B_LongMois(ZAnnee,Xi); for Xi:=1 to ZMois-1 do Xs:=XS+B_LongMois(Xi);
B_Quantieme:=XS+Zjour; B_Quantieme:=XS+Zjour;
end; end;
...@@ -161,7 +155,7 @@ function B_QuantiemeNonBiss(ZDate:longint) : integer; ...@@ -161,7 +155,7 @@ function B_QuantiemeNonBiss(ZDate:longint) : integer;
XChaineDate:=B_Date(ZDate); XChaineDate:=B_Date(ZDate);
val(copy(XChaineDate,1,2),XJour,XCode); val(copy(XChaineDate,1,2),XJour,XCode);
val(copy(XChaineDate,4,2),XMois,XCode); val(copy(XChaineDate,4,2),XMois,XCode);
B_QuantiemeNonBiss:=B_Quantieme(XJour,XMois,2001); B_QuantiemeNonBiss:=B_Quantieme(XJour,XMois);
end; end;
{----------------------------------------------------------------------------} {----------------------------------------------------------------------------}
...@@ -233,9 +227,9 @@ function B_Date(ZRang:longint):string; ...@@ -233,9 +227,9 @@ function B_Date(ZRang:longint):string;
Xj:=0; Xj:=0;
while XDuree<ZRang do while XDuree<ZRang do
begin begin
Xj:=Xj+1; XDuree:=XDuree+B_Longmois(Xi,Xj); Xj:=Xj+1; XDuree:=XDuree+B_Longmois(Xj);
end; end;
XDuree:=XDuree-B_Longmois(Xi,Xj); XDuree:=XDuree-B_Longmois(Xj);
Xk:=ZRang-XDuree; Xk:=ZRang-XDuree;
str(Xk,XS1); str(Xk,XS1);
if Xk<10 then if Xk<10 then
......
...@@ -630,7 +630,7 @@ BEGIN ...@@ -630,7 +630,7 @@ BEGIN
YJJ_MM_AAAA[0]:=B_Date(YDateEnJour[0]); YJJ_MM_AAAA[0]:=B_Date(YDateEnJour[0]);
val(copy(YJJ_MM_AAAA[0],4,2),YMois[0],YCode); val(copy(YJJ_MM_AAAA[0],4,2),YMois[0],YCode);
val(copy(YJJ_MM_AAAA[0],1,2),YJour[0],YCode); val(copy(YJJ_MM_AAAA[0],1,2),YJour[0],YCode);
YQuantieme:=B_Quantieme(YJour[0],YMois[0],2001); YQuantieme:=B_Quantieme(YJour[0],YMois[0]);
{--LECTURE DES DEBITS NATURELS pour l'indice YDelaimax--} {--LECTURE DES DEBITS NATURELS pour l'indice YDelaimax--}
C1_LectureQavalPriseRestit(Ydelaimax); C1_LectureQavalPriseRestit(Ydelaimax);
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment