Source code of the V5 released in 2013

.gitignore

+# Compiled files
+
+*.o
+*.exe
+
+# vscode IDE
+.vscode/

src/.gitignore

+# Compiled files
+*.ppu
+*.out
+*.err

src/CALCULS2.PAS

+Unit CALCULS2;
+
+
+
+interface
+
+ uses Utilit,Declara;
+
+ procedure LectureParametresStat;
+ PROCEDURE ECRITURE_STATS;
+ PROCEDURE Tri(var Ztab:YTab2; ZN:integer);
+ FUNCTION Quantile(ZTab:YTab2; ZN:integer; Zfreq:double): double;
+ PROCEDURE ISOFREQ(ZDateDebutFichier, ZDateDebut, ZDateFin:longint; var ZFic : YTypFOD; ZChaine : string) ;
+ PROCEDURE InitVolumeSimulEnSensChrono;
+IMPLEMENTATION
+
+{============================================================================}
+
+procedure LectureParametresStat;
+ begin
+   YNbTpsRet:=0;
+   YChoixFreq:=false;
+   assign(YFicResult4,YRepP+YNomFicTpsRet);
+   {$i-}
+   reset(YFicResult4);
+   if ioresult=0 then
+    begin
+     while (not(eof(YFicResult4))) and not(YChoixFreq) do
+      begin
+       readln(YFicResult4,YA,YB);
+       if ioresult=0 then
+        YChoixFreq:=true;
+      end;
+     while (not(eof(YFicResult4))) and (YNbTpsret<YNbmaxTpsRet) do
+      begin
+       readln(YFicResult4,YTps);
+       if ioresult=0 then
+        if YTps>=2 then
+         begin
+          YNbTpsRet:=YNbTpsRet+1;
+          YTpsRet[YNbTpsRet]:=YTps;
+         end;
+      end;
+     close(YFicResult4);
+    end;
+   {$i+}
+   if YChoixFreq then
+    begin
+     YA:=Amin(Amax(0,YA),0.5);
+     YB:=Amin(Amax(0,YB),1);
+    end
+   else
+    begin
+     YA:=0.5;
+     YB:=0;
+    end;
+   if YNbTpsRet=0 then
+    begin
+     YNbTpsRet:=YNbmaxTpsRet;
+     for Yi:=1 to YNbTpsRet do
+      YTpsRet[Yi]:=YTpsRetParDefo[Yi];
+    end;
+   Tri(YTpsRet,YNbTpsRet);
+   if YTpsRet[1]=2 then
+    YjTpsRet:=2
+   else
+    YjTpsRet:=1;
+ end;
+
+{===========================================================================}
+
+PROCEDURE ECRITURE_STATS;
+ begin
+     {--ECRITURE DES STATS. concernant la faisabilit‚ de l'objectif aval--}
+     writeln(YFicSortie,'  Signification du code Succes pour l''ensemble des stations :');
+     writeln(YFicSortie,'    -3 : calcul non effectue pour cause de lacune de debit naturel ',
+                                  '(a la station aval du systeme ou au droit d''une prise ou d''une restitution)');
+     writeln(YFicSortie,'    -2 : possibilite theorique d''obtenir un debit egal a l''objectif a la station aval,',
+                                  ' mais non convergence du calcul (voir fin de ce fichier)');
+     writeln(YFicSortie,'    -1 : malgre un debit stocke net minimal (QSTmin) dans chaque reservoir, le debit obtenu a ',
+                                 'la station aval est inferieur a l''objectif');
+     writeln(YFicSortie,'     0 : a la station aval, le debit obtenu est egal a l''objectif, grace aux debits ',
+                                'stockes nets dans les reservoirs ',
+                                 '(dont au moins un superieur au minimum et au moins un inferieur au maximum)');
+     writeln(YFicSortie,'     1 : malgre un debit stocke net maximal (QSTmax) dans chaque reservoir, le debit obtenu ',
+                                  'a la station aval est superieur a l''objectif');
+     writeln(YFicSortie,'     2 : meme avec un debit stocke net egal au debit naturel de prise dans chaque reservoir, ',
+                                  'le debit obtenu a la station aval serait superieur a l''objectif');
+
+     writeln(YFicSortie,'  Effectif des valeurs obtenues pour le code Succes :');
+     write(YFicSortie,'  ');
+     for Yi:=-3 to 2 do
+      write(YFicSortie,Yi,' : ',YNSucces[Yi],' ;    ');
+     writeln(YFicSortie);
+     writeln(YficSortie);
+     writeln(YFicSortie);
+
+     {--ECRITURE DES STATS. concernant les d‚bits stock‚s n‚cessaires--}
+     writeln(YFicSortie,'  Signification du code A pour chaque reservoir, decrivant la position du debit stocke net ',
+                        'par rapport aux bornes imposee par les conditions locales a la prise et a la restitution ',
+                        '(debit naturel, contraintes et consignes)');
+     writeln(YFicSortie,'    -2 : calcul non effectue pour cause de lacune de debit naturel ',
+                                  '(a la station aval du systeme ou au droit d''une prise ou d''une restitution)');
+     writeln(YFicSortie,'    -1 : debit stocke egal a la valeur minimale QSTmin (avec QSTmin < QSTmax)');
+     writeln(YFicSortie,'     0 : debit stocke situe entre valeurs minimale QSTmin et maximale QSTmax ',
+                                  '(avec QSTmin < QSTmax)');
+     writeln(YFicSortie,'     1 : debit stocke egal a la valeur maximale QSTmax (avec QSTmin = QSTmax)');
+     writeln(YFicSortie,'     2 : debit stocke egal a la valeur maximale QSTmax (avec QSTmin < QSTmax)');
+     writeln(YFicSortie,'  Effectif des valeurs obtenues pour le code A :');
+     write(YFicSortie,'    valeur  ');
+     for YRangLac:=1 to YNbLacs do
+      begin
+       for Yi:=length(YNomLac[YRanglac])+1 to 10 do
+        write(YFicSortie,' ');
+       write(YFicSortie,YNomLac[YRanglac],'  ');
+      end;
+     writeln(YFicSortie);
+     for Yi:=-2 to 2 do
+      begin
+       write(YFicSortie,'    ',YI:6,'  ');
+       for YRangLac:=1 to YNbLacs do
+        write(YFicSortie,YNCodeRepart[YRangLac,Yi]:10,'  ');
+       writeln(YFicSortie);
+      end;
+     writeln(YFicSortie);
+
+     {--ECRITURE DES STATS concernant les d‚bits pris n‚cessaires--}
+     writeln(YficSortie);
+     writeln(YFicSortie,'  Signification du code B pour chaque reservoir, decrivant la position du debit du canal de prise ',
+                        'par rapport aux bornes imposee par les conditions locales a la prise (debit naturel, ',
+                        'contraintes et consignes)');
+     writeln(YFicSortie,'    -3 : calcul non effectue pour cause de lacune de debit naturel ',
+                                  '(a la station aval du systeme ou au droit d''une prise ou d''une restitution)');
+     writeln(YFicSortie,'    -2 : debit preleve egal a la debitance minimale Qemin du canal de prise');
+     writeln(YFicSortie,'    -1 : debit preleve egal a la valeur minimale QMnat-QMref imposee par le debit de reference ',
+                                 'QMref a l''aval de la prise et le debit naturel QMnat a la prise');
+     writeln(YFicSortie,'     0 : debit preleve egal a aucune des bornes imposees');
+     writeln(YFicSortie,'     1 : debit preleve egal a la valeur maximale QMnat-QMres imposee par le debit reserve ',
+                                 'QMres a l''aval de la prise et le debit naturel QMnat a la prise');
+     writeln(YFicSortie,'     2 : debit preleve egal a la debitance maximale Qemax du canal de prise');
+     writeln(YFicSortie,'     3 : debit preleve egal au debit naturel QMnat a la prise');
+     writeln(YFicSortie,'  Effectif des valeurs obtenues pour le code B :');
+     write(YFicSortie,'    valeur  ');
+     for YRanglac:=1 to YNbLacs do
+      begin
+       for Yi:=length(YNomLac[YRanglac])+1 to 10 do
+        write(YFicSortie,' ');
+       write(YFicSortie,YNomLac[YRanglac],'  ');
+      end;
+     writeln(YFicSortie);
+     for Yi:=-3 to 3 do
+      begin
+       write(YFicSortie,'    ',YI:6,'  ');
+       for YRangLac:=1 to YNbLacs do
+        write(YFicSortie,YNCodePrise[YRangLac,Yi]:10,'  ');
+       writeln(YficSortie);
+      end;
+     writeln(YFicSortie);
+
+     {--ECRITURE DES STATS concernant les d‚bits restitu‚s n‚cessaires--}
+     writeln(YficSortie);
+     writeln(YFicSortie,'  Signification du code C pour chaque reservoir, decrivant la position du debit du canal ',
+                        'de restitution par rapport aux bornes de debitance du canal ');
+     writeln(YFicSortie,'    -2 : calcul non effectue pour cause de lacune de debit naturel ',
+                                  '(a la station aval du systeme ou au droit d''une prise ou d''une restitution)');
+     writeln(YFicSortie,'    -1 : debit restitue egal a la debitance maximale Qsmax du canal de restitution');
+     writeln(YFicSortie,'     0 : debit restitue situe entre les bornes de debitance Qsmin et Qsmax du canal de restitution');
+     writeln(YFicSortie,'     1 : debit restitue egal a la debitance minimale Qsmin du canal de restitution');
+     writeln(YFicSortie,'  Effectif des valeurs obtenues pour le code C :');
+     write(YFicSortie,'    valeur  ');
+     for YRangLac:=1 to YNbLacs do
+      begin
+       for Yi:=length(YNomLac[YRanglac])+1 to 10 do
+        write(YFicSortie,' ');
+       write(YFicSortie,YNomLac[YRanglac],'  ');
+      end;
+     writeln(YFicSortie);
+     for Yi:=-2 to 1 do
+      begin
+       write(YFicSortie,'    ',YI:6,'  ');
+       for YRangLac:=1 to YNbLacs do
+        write(YFicSortie,YNCodeRestit[YRangLac,Yi]:10,'  ');
+       writeln(YFicSortie);
+      end;
+     writeln(YFicSortie);
+
+     {--ECRITURE DES STATS concernant les d‚bits n‚cessaires … l'aval des --}
+     {--restitutions                                                      --}
+     writeln(YficSortie);
+     writeln(YFicSortie,'  Signification du code D pour chaque reservoir, decrivant la position du debit ',
+                        'a l''aval de la restitution  par rapport aux bornes imposees par les consignes ',
+                        'locales (debits reserve et de reference)');
+     writeln(YFicSortie,'    -3 : calcul non effectue pour cause de lacune de debit naturel ',
+                                  '(a la station aval du systeme ou au droit d''une prise ou d''une restitution)');
+     writeln(YFicSortie,'    -2 : debit superieur au debit de reference QVref');
+     writeln(YFicSortie,'    -1 : debit egal au debit de reference QVref');
+     writeln(YFicSortie,'     0 : debit situe entre le debit reserve QVres et le debit de reference QVref');
+     writeln(YFicSortie,'     1 : debit egal au debit reserve QVres');
+     writeln(YFicSortie,'     2 : debit inferieur au debit reserve QVres');
+     writeln(YFicSortie,'  Effectif des valeurs obtenues pour le code D :');
+     write(YFicSortie,'    valeur  ');
+     for YRangLac:=1 to YNbLacs do
+      begin
+       for Yi:=length(YNomLac[YRanglac])+1 to 10 do
+        write(YFicSortie,' ');
+       write(YFicSortie,YNomLac[YRanglac],'  ');
+      end;
+     writeln(YFicSortie);
+     for Yi:=-3 to 2 do
+      begin
+       write(YFicSortie,'    ',YI:6,'  ');
+       for YRangLac:=1 to YNbLacs do
+        write(YFicSortie,YNCodeAval[YRangLac,Yi]:10,'  ');
+       writeln(YFicSortie);
+      end;
+     writeln(YFicSortie);
+     writeln(YFicSortie,'  Nombre de fourchettes initiales sous-dimentionnees pour le calcul de QST0 : ',YNbPbBornes);
+     writeln(YFicSortie,'  Ecart absolu entre debit ideal obtenu et debit objectif atteignable a la station aval : ',
+                        'maximum obtenu = ',YEcartmax,'  (critere de convergence (code Succes=0) =',YSeuilConv,')');
+     writeln(YFicSortie);
+ end;
+
+{===========================================================================}
+
+PROCEDURE Tri(var Ztab:YTab2; ZN:integer);
+ var
+  Xi : integer;
+  Xj : integer;
+  Xk : integer;
+  XTab : YTab2;
+  XTest : boolean;
+
+ begin
+  for Xi:=1 to ZN do
+   begin
+    Xj:=0;
+    repeat
+     Xj:=Xj+1
+    until (Xj=Xi) or (Xtab[Xj]>ZTab[Xi]);
+    for Xk:=Xi downto (Xj+1) do
+     XTab[Xk]:=XTab[Xk-1];
+    XTab[Xj]:=ZTab[Xi];
+   end;
+   for Xi:=1 to ZN do
+    begin
+     ZTab[Xi]:=XTab[Xi];
+    end;
+ end;
+
+{===========================================================================}
+
+FUNCTION Quantile(ZTab:YTab2; ZN:integer; Zfreq:double): double;
+ var
+  Xi : integer;
+  Xpos: double;
+ begin
+  Xi:=Aminin(ZN-1,AMaxin(1,trunc((ZN+YB)*ZFreq+YA)));
+  XPos:=Xi-YA;
+  Xpos:=ZFreq-XPos/(ZN+YB);
+  XPos:=XPos*(ZTab[Xi+1]-ZTab[Xi]);
+  Quantile:=ZTab[Xi]+XPos*(ZN+YB)
+ end;
+
+{=============================================================================}
+
+PROCEDURE ISOFREQ (ZDateDebutFichier, ZDateDebut, ZDateFin:longint;
+                   var ZFic : YTypFOD;
+                   ZChaine : string) ;
+ var
+  XDate : string[5];
+  XChai2 : string[2];
+  XValeur : double;
+
+ begin
+
+  {--calcul des ann‚es de d‚but et de fin de s‚rie des volumes … 24h--}
+  YJJ_MM_AAAA:=ADate(ZDateDebut);
+  val(copy(YJJ_MM_AAAA,7,4),YAnDebutV,YCode);
+  YJJ_MM_AAAA:=ADate(ZDateFin);
+  val(copy(YJJ_MM_AAAA,7,4),YAnFinV,YCode);
+
+  {--ECRITURE D'EN-TÒTE DE FICHIER TEXTE DES RESULTATS--}
+  rewrite(YFicResult4);
+  writeln(YFicResult4,'Rang du calcul : ',YCompteur,' ;  ',YResume);
+  ADatation(YFicResult4);
+  writeln(YFicResult4);
+  writeln(YFicResult4,ZChaine);
+  writeln(YFicResult4);
+  writeln(YFicResult4,'De haut en bas : resultats classes par jour de l''annee (quantieme 1 a 365)');
+  write(YFicResult4,'De gauche a droite : resultats classes par ANNEE, par RANG n de ',
+                      'valeurs croissantes et par FREQUENCE de non depassement (f=(n-YA)/(Effectif+YB) avec YA=');
+  writeln(YFicResult4,YA,' et YB=',YB,')');
+  writeln(YFicResult4);
+  write(yFicResult4,'ANNEE--> ');
+  for YAn:=YAnDebutV to YAnFinV do
+   write(YFicresult4,'           ',YAn:4,' ');
+  write(YFicResult4,'      RANG-->   ');
+  for YAn:=YAnDebutV to YAnFinV do
+   write(YFicresult4,'           ',(YAn-YAnDebutV+1):4,' ');
+  write(YFicResult4,'    RETOUR-->   ','                ');
+  for Yi:=YNbTpsRet downto 1 do
+   write(YFicResult4,'         ',YTpsRet[Yi]:6:2,' ');
+  for Yi:=YjTpsRet to YNbTpsRet do
+   write(YFicResult4,'         ',YTpsRet[Yi]:6:2,' ');
+  writeln(YFicResult4);
+  write(YFicResult4,'                        ');
+  for YAn:=YAnDebutV to YAnFinV do
+   write(YFicResult4,'                                ');
+  write(YFicResult4,'  FREQUENCE-->   ','        maximum ');
+  for Yi:=YNbTpsRet downto 1 do
+   begin
+    YFreq:=1-1/YTpsRet[Yi];
+    write(YficResult4,'        ',YFreq:7:5,' ');
+   end;
+  for Yi:=YjTpsRet to YNbTpsRet do
+   begin
+    YFreq:=1/YTpsRet[Yi];
+    write(YficResult4,'        ',YFreq:7:5,' ');
+   end;
+  writeln(YFicResult4,'        minimum');
+
+  reset(ZFic);
+
+  {--BOUCLE SUR LES MOIS DE L'ANNEE--}
+  for YMois:=1 to 12 do
+   begin
+
+    {--BOUCLE SUR LES JOURS DU MOIS (en ann‚e non bissextile)--}
+    for YJour:=1 to ALongMois(2001,YMois) do
+     begin
+       {--calcul pour le jour courant, de la premiŠre et de la derniŠre--}
+      {--ann‚e pour lesquelles on a un volume calcul‚ … 24h           --}
+      if ATJour(YAnDebutV,YMois,YJour)>=ZDateDebut then
+       YAnPremier:=YAnDebutV
+      else
+       YAnPremier:=YAnDebutV+1;
+      if ATJour(YAnFinV,YMois,YJour)<=ZDateFin then
+       YAnDernier:=YAnFinV
+      else
+       YAnDernier:=YAnFinV-1;
+
+      {--cnstruction de chaine date en format jj/mm--}
+      str(YJour,XChai2);
+      if YJour<10 then
+       XChai2:='0'+XChai2;
+      str(YMois,XDate);
+      if YMois<10 then
+       XDate:='0'+XDate;
+      XDate:=XChai2+'/'+XDate;
+
+
+      {--ECRITURE DES VALEURS TRIEES PAR ANNEE--}
+      write(YFicResult4,'   ',XDate,' ');
+      for YAn:=YAnDebutV to YAnPremier-1 do
+       write(YFicResult4,'                ');
+      for YAn:=YAnPremier to YAnDernier do
+       begin
+        seek(ZFic,ATJour(YAn,YMois,YJour)-ZDateDebutFichier);
+        read(ZFic,YValBonneDate[YAn-YAnPremier+1]);
+        write(YFicResult4,YValBonneDate[YAn-YAnPremier+1]:15:2,' ');
+       end;
+      for YAn:=YAnDernier+1 to YAnFinV do
+       write(YFicResult4,'                ');
+
+      {--ECRITURE DES VALEURS TRIEES PAR VALEURS CROISSANTES--}
+      write(YFicResult4,'        ',XDate,'   ');
+      Tri(YValBonneDate,YAnDernier-YAnPremier+1);
+      for YAn:= YAnPremier to YAnDernier do
+       write(YFicResult4,YValBonneDate[YAn-YAnPremier+1]:15:2,' ');
+      for YAn:=YAnDebutV to YAnPremier-1 do
+       write(YFicResult4,'                ');
+      for YAn:=YAnDernier+1 to YAnFinV do
+       write(YFicResult4,'                ');
+
+      {--ECRITURE DES VALEURS TRIEES PAR FREQ. DECROISSANTE DE NON DEPASSMT.--}
+      write(YFicResult4,'        ',XDate,'   ');
+      write(YFicResult4,YValBonneDate[YAnDernier-YAnPremier+1]:15:2,' ');
+      for Yi:=YNbTpsRet downto YjTpsRet do
+       begin
+        YFreq:=1-1/YTpsRet[Yi];
+        Yk:=YAnDernier-YAnPremier+2;
+        repeat
+         Yk:=Yk-1;
+        until ((Yk-YA)/(YAnDernier-YanPremier+1+YB))<YFreq;
+        if Yk<(YAnDernier-YAnPremier+1) then
+         begin
+          XValeur:=YValBonneDate[Yk]+(YValbonneDate[Yk+1]-YValBonneDate[Yk])
+                *(YFreq-(Yk-YA)/(YAndernier-YAnPremier+1+YB))*(YAnDernier-YAnPremier+1+YB);
+          write(YFicResult4,XValeur:15:2,' ');
+         end
+        else
+         write(YFicResult4,'                ');
+       end;
+      for Yi:=1 to YNbTpsRet do
+       begin
+        YFreq:=1/YTpsRet[Yi];
+        Yk:=0;
+        repeat
+         Yk:=Yk+1;
+        until ((Yk-YA)/(YAnDernier-YanPremier+1+YB))>YFreq;
+        if Yk>1 then
+         begin
+          XValeur:=(YFreq-(Yk-1-YA)/(YAndernier-YAnPremier+1+YB))*(YAnDernier-YAnPremier+1+YB);
+          XValeur:=YValBonneDate[Yk-1]+(YValbonneDate[Yk]-YValBonneDate[Yk-1])*XValeur;
+          write(YFicResult4,XValeur:15:2,' ');
+         end
+        else
+         write(YFicResult4,'                ');
+       end;
+      writeln(YFicResult4,YValBonneDate[1]:15:2);
+
+     end; {fin de boucle sur les jours}
+
+   end; {fin de boucle sur les mois}
+
+  close(YFicResult4);
+  close(ZFic);
+
+ end;
+{=============================================================================}
+
+PROCEDURE InitVolumeSimulEnSensChrono;
+ begin
+     YJJ_MM_AAAA:=ADate(YDateFinLac[YRangLac]-YDateFin+YDateDebut-1);
+     val(copy(YJJ_MM_AAAA,4,2),YMoisDebutLac,YCode);
+     val(copy(YJJ_MM_AAAA,1,2),YJourDebutLac,YCode);
+     YNIter:=0;
+     YConverge:=false;
+     if YTypeObjectif=0 then
+      YVDebut:=YVtot[YRangLac]
+     else
+      YVDebut:=0;
+     repeat
+      seek(YFicQST[YRanglac],filesize(YFicQST[YRangLac])-1);
+      YNIter:=YNIter+1;
+      YNbAn:=0;
+      YVolume:=YVDebut;
+      for Yi:=YDateFinLac[YRangLac]+YdateDebut-YDateFin-1 to YdateFinLac[YrangLac]-1 do
+       begin
+        YJJ_MM_AAAA:=ADate(Yi);
+        val(copy(YJJ_MM_AAAA,4,2),YMois,YCode);
+        val(copy(YJJ_MM_AAAA,1,2),YJour,YCode);
+        if (YMois=YMoisDebutLac) and (YJour=YJourDebutLac) then
+         begin
+          YNbAn:=YNbAn+1;
+          YValBonnedate[YNbAn]:=YVolume;
+         end;
+        read(YFicQST[YRangLac],YQST[YRangLac]);
+        seek(YFicQST[YRangLac],abs(filepos(YFicQST[YRanglac])-2));
+        YVolume:=Amindouble(YVtot[YRangLac],Amax(0,YVolume+YQST[YrangLac]*86400));
+       end;
+      Tri(YValBonneDate,YNbAn);
+      YVmedian:=Quantile(YValBonneDate,YNbAn,0.5);
+      if abs(YVMedian-YVDebut)<(YVtot[YRanglac]*YSeuilRConv) then
+       YConverge:=true
+      else
+       YVDebut:=Amindouble(YVtot[YRanglac],Amaxdouble(0,(YNbAn*YVMedian-YVDebut)/(YNbAn-1)));
+     until YConverge or (YNIter=YNbmaxIter);  {fin des encadrements successifs}
+ end;
+
+{=============================================================================}
+
+BEGIN
+END.

src/CALCULS3.PAS

+Unit CALCULS3;
+
+interface
+ uses Utilit,Declara,Calculs2;
+
+ procedure CalculChroniquesVolume;
+
+IMPLEMENTATION
+
+procedure CalculChroniquesVolume;
+ begin
+
+   if not YSaisie then
+    begin
+     writeln;
+     writeln('Rang du calcul : ',YCompteur,' ;  ',YResume);
+    end;
+
+   for YRanglac:=1 to YNbLacs do
+
+    begin
+
+     {--message cran--}
+     if YSaisie then
+      write(YnomLac[YRangLac]);
+
+     {==CALCUL A REBOURS --> VOLUME EXTREME COMPATIBLE AVEC OBJECTIF FUTUR==}
+
+     {--calcul de la date entire du dbit stock initial dans le lac --}
+     {--(dcal du temps de propagation par rapport  la date initiale--}
+     {--du calcul considre  midi  la station aval du systme      --}
+     YDateFinLac[YrangLac]:=trunc(YDateFin+0.5-YD[YRangLac]);
+
+     {--initialisation du volume de rservoir (plein pour objectif Qmax et  --}
+     {--vide pour un objectif Qmin) et calcul du jour et du mois de dbut de--}
+     {--calcul  rebours                                                    --}
+     YJJ_MM_AAAA:=ADate(YDateFinLac[YRangLac]);
+     val(copy(YJJ_MM_AAAA,4,2),YMoisFinLac,YCode);
+     val(copy(YJJ_MM_AAAA,1,2),YJourFinLac,YCode);
+     YNIter:=0;
+     YConverge:=false;
+     if YTypeObjectif=0 then
+      YVFin:=0
+     else
+      YVFin:=YVtot[YRangLac];
+
+     {--ENCADREMENTS SUCCESSIFS POUR DETERMINER LE BON VOLUME INITIAL--}
+     repeat
+
+      YNIter:=YNIter+1;
+      YNbAn:=0;
+      YVolume:=YVFin;
+      reset(YFicQST[YrangLac]);
+
+      {--boucle sur le temps en chrono inverse--}
+      for Yi:=YDateFinLac[YRanglac] downto (YDateFinLac[YRangLac]-(YDateFin-YDateDebut)) do
+
+       begin
+
+        YJJ_MM_AAAA:=ADate(Yi);
+        val(copy(YJJ_MM_AAAA,4,2),YMois,YCode);
+        val(copy(YJJ_MM_AAAA,1,2),YJour,YCode);
+
+        {--si quantime = quantime initial, stockage du volume--}
+        if (YMois=YMoisFinLac) and (YJour=YJourFinLac) then
+         begin
+          YNbAn:=YNbAn+1;
+          YValBonnedate[YNbAn]:=YVolume;
+         end;
+
+        {--lecture de dbit stock idal sur fichier typ en chrono --}
+        {--inverse, et calcul de nouveau volume                     --}
+        read(YFicQST[YRangLac],YQST[YRanglac]);
+        YVolume:=Amindouble(YVtot[YRangLac],Amaxdouble(0,YVolume-YQST[YrangLac]*86400));
+
+       end; {fin de boucle sur le temps en chrono inverse}
+
+      {--tri par valeurs croissantes des volumes obtenus pour le --}
+      {--quantime initial                                       --}
+      Tri(YValBonneDate,YNbAn);
+
+      {--calcul du volume mdian obtenu pour le quantime initial--}
+      YVmedian:=Quantile(YValBonneDate,YNbAn,0.5);
+
+      {--si volume mdian est proche du volume initial, la convergence--}
+      {--est obtenue, sinon on calcule un nouveau volume initial      --}
+      if abs(YVMedian-YVFin)<(YVtot[YRanglac]*YSeuilRConv) then
+       YConverge:=true
+      else
+       YVFin:=Amindouble(YVtot[YRanglac],Amaxdouble(0,(YNbAn*YVMedian-YVFin)/(YNbAn-1)));
+
+     until YConverge or (YNIter=YNbmaxIter);  {fin des encadrements successifs}
+
+     {--message cran : nombre d'itrations --}
+     if YSaisie then
+      write('(',YNiter);
+
+     {--REMPLISSAGE FICHIERS TYPES DE VOLUME ET MANQUE CAPACITE PAR LACUNES--}
+     rewrite(YFicVobj[YRangLac]);
+     rewrite(YFicVobj0[YRangLac]);
+     rewrite(YFicVdef[YRangLac]);
+     YVolume:=Ylacune;
+     for Yi:=YDateDebut to YDateFin do
+      begin
+       write(YFicVobj[YRangLac],YVolume);
+       write(YFicVobj0[YRangLac],YVolume);
+       write(YFicVdef[YRangLac],YVolume);
+      end;
+
+     {==CALCUL DEFINITIF DE LA CHRONIQUE DE VOLUME EN CHRONO INVERSE, AVEC==}
+     {==la bonne valeur initiale, et criture sur fichiers typs de ces   ==}
+     {==volumes (dcals de + 12h par rapport aux dbits stocks nets du  ==}
+     {==lac), ainsi que des manques de capacit de rservoir, dans le sens==}
+     {==chronologique. Dans le cas d'un objectif de laminage, les volumes ==}
+     {==sont les max  ne pas dpasser pour viter les checs dus  un lac==}
+     {==plein                                                             ==}
+
+     {--initialisation du volume en fin de priode et ouverture du fichier--}
+     {--des dbits stocks en chrono inverse                              --}
+     YVobj:=YVFin;
+     YVobj0:=YVFin;
+     YVdef:=0;
+     YVdefmax[YRangLac]:=0;
+     reset(YFicQST[YrangLac]);
+
+     {--boucle sur le temps en chrono inverse--}
+     for Yi:=YDateFinLac[YRanglac] downto (YDateFinLac[YRangLac]-(YDateFin-YDateDebut)) do
+
+      begin
+
+       read(YFicQST[YRangLac],YQST[YRanglac]);
+       seek(YFicVobj[YRangLac],filepos(YFicVobj[YRangLac])-1);
+       write(YFicVobj[YRangLac],YVobj);
+       seek(YFicVobj[YRangLac],filepos(YFicVobj[YRangLac])-1);
+       seek(YFicVobj0[YRangLac],filepos(YFicVobj0[YRangLac])-1);
+       write(YFicVobj0[YRangLac],YVobj0);