UNIT PARAM; {JC Bader, nov 2016} INTERFACE uses Crt,Utilit,Interfas,DECLARA; function P_InterpolBareme(ZZV : double; ZZBareme : YBareme): double; procedure P_EcritureSeparation; procedure P_ChoixEntreeOptions; procedure P_DatesLuesSurFichier; procedure P_StationAval; procedure P_ContraintesEtConsignesLacs; procedure P_ParametresReseau; IMPLEMENTATION {========================================================================} function P_InterpolBareme(ZZV : double; ZZBareme : YBareme): double; var Wi : integer; begin with ZZBareme do begin if YEffectif= 1 then P_InterpolBareme:=YDebit[1] else begin Wi:=1; repeat Wi:=Wi+1 until (Wi=YEffectif) or (YVolume[Wi]>=ZZV); P_InterpolBareme:=B_maxdouble(0,YDebit[Wi-1]+(YDebit[Wi]-YDebit[Wi-1])*(ZZV-YVolume[Wi-1])/(YVolume[Wi]-YVolume[Wi-1])); end; end; end; {fin de fonction P_InterpoleBareme} {========================================================================} procedure P_EcritureSeparation; begin writeln(YFicSortie); writeln(YFicSortie,'=============================================================================='); writeln(YFicSortie); end; {fin de procedure P_EcritureSeparation} {========================================================================} {--d‚termination du mode d'entr‚e des paramŠtres de calcul --} {========================================================================} procedure P_ChoixEntreeOptions; var XTpot : integer; begin assign(YFitext,YNomFicFin); {$i-} erase(YFitext); if ioresult=0 then begin end; YSaisie:=true; assign(YFitext,YRepP+YNomFicMode); reset(YFitext); if ioresult=0 then begin read(YFitext,YChoix); if (ioresult=0) and (YChoix<>0) then YSaisie:=false; close(YFitext); end; if not YSaisie then begin assign(YFitext,YRepP+YNomFicChoix); reset(YFitext); writeln; writeln('Le contenu du fichier ',YNomFicMode,' entraŒne la lecture des options de calcul'); writeln('dans le fichier ',YNomFicChoix,'.'); if ioresult=0 then begin readln(YFitext,YNomFicLacs); readln(YFitext,YRangPBarrage); readln(YFitext,YRangPReseau); readln(YFitext,YNomFicDebit); readln(YFitext,YNomFicObjectif); readln(YFitext,YTypeObjectif); if YTypeObjectif<>0 then YTypeObjectif:=1; readln(YFiText,YDat1); readln(YFitext,YDat2); readln(YFitext,YAbsRel); if YAbsRel<>1 then YAbsRel:=2; readln(YFitext,YOptionrepart); if YOptionRepart>3 then begin readln(YFitext,XTpot); if XTpot=1 then YCodeTpot:=true else YCodeTpot:=false; end; readln(YFitext,YChoixSubProg); close(YFitext); end else YSaisie:=true; end; if YSaisie then begin A_Window1; clrscr; end; {$i+} end; {fin de P_ChoixEntreeOptions} {========================================================================} {--Prise en compte des dates de d‚but et fin de calcul YDat1 et Ydat2 --} {--(pr‚c‚demment lues directement sur fichier des options de calcul) --} {--pour d‚finir la p‚riode de calcul [YDateDebut YdateFin] au sein de --} {--la p‚riode [YMeilleurDebut YMeilleurFin]. --} {========================================================================} procedure P_DatesLuesSurFichier; begin YDateDebut:=YMeilleurDebut; YDateFin:=YMeilleurFin; val(copy(YDat1,7,4),YAn,YCode); if YCode=0 then begin val(copy(YDat1,4,2),YMois[0],YCode); if (YCode=0) and (YMois[0]>0) and (Ymois[0]<13) then begin val(copy(YDat1,1,2),YJour[0],YCode); if (YCode=0) and (YJour[0]>0) and (YJour[0]<=B_LongMois(YAn,YMois[0])) then begin YDateDebut:=B_maxlongInt(YmeilleurDebut,B_minlongInt(B_TJour(YAn,YMois[0],YJour[0]),YMeilleurFin-3*365)); end; end; end; val(copy(YDat2,7,4),YAn,YCode); if YCode=0 then begin val(copy(YDat2,4,2),YMois[0],YCode); if (YCode=0) and (YMois[0]>0) and (Ymois[0]<13) then begin val(copy(YDat2,1,2),YJour[0],YCode); if (YCode=0) and (YJour[0]>0) and (YJour[0]<=B_LongMois(YAn,YMois[0])) then YDateFin:=B_minlongInt(B_maxlongInt(YDateDebut+3*365,B_TJour(YAn,Ymois[0],YJour[0])),YmeilleurFin); end; end; end; {fin de procedure P_DatesLuesSurFichier} {============================================================================} procedure Ici_Controle (ZRang : integer; var Z : double; Z1,Z2:double); begin if (ZZ2) then begin Z:=B_mindouble(B_maxdouble(Z,Z1),Z2); YNbModif[ZRang]:=YNbModif[ZRang]+1; end; end; {fin de procedure Ici_Controle} {============================================================================} procedure Ici_ControleEntier (ZRang : integer; var Z : integer; Z1,Z2:integer); begin if (ZZ2) then begin Z:=B_minIn(B_maxIn(Z,Z1),Z2); YNbModif[ZRang]:=YNbModif[ZRang]+1; end; end; {fin de procedure Ici_ControleEntier} {============================================================================} procedure Ici_TestLecture (ZRangLac,ZTypeDebit,ZRangDonnee,ZRang : integer); begin if ioresult<>0 then begin writeln(YFicSortie); YNmallu:=YNmallu+1; if ZRangLac<>0 then write(YFicSortie,' Lac ',ZRanglac,', '); if ZTypeDebit<>0 then write(YFicSortie,YNomDebit[ZtypeDebit],', '); write(YFicSortie,YNomParamLac[ZRangDonnee]); if ZRang<>0 then write(YFicSortie,'(',ZRang,')'); end; end; {fin de procedure Ici_TestLecture} {===========================================================================} {--Lecture des paramŠtres de station aval, lacs et Temps de propag. --} {--Ecriture sur fichier de sortie des ‚ventuels PB de lecture rencontr‚s. --} {===========================================================================} procedure Ici_EntreesLac; var XIoResult : integer; XSeraRien : integer; Xi : integer; XNbVersion : integer; XChai8 : YChai8; XFic : text; XEnTete : string; XRangVersion : array[1..YNbmaxVersion] of integer; BEGIN {d‚but de procedure EntreeLacs} {--Message ‚cran d'entr‚e de programme, saisie du nom de fichier des lacs--} if YSaisie then begin a_Titre; writeln(' CALCUL DES VOLUMES MINIMAUX OU MAXIMAUX QU''IL FAUT RESPECTER DANS DES'); writeln(' RESERVOIRS POUR POUVOIR SATISFAIRE AU MIEUX UN OBJECTIF DE GESTION COMMUN'); writeln(' (HYDROGRAMME ANNUEL MINIMAL OU MAXIMAL DEFINI A UNE STATION SITUEE A L''AVAL)'); writeln; writeln('Le calcul n‚cessite certains paramŠtres et donn‚es pr‚alablement saisis selon'); writeln('un format impos‚ dans des fichiers texte situ‚s dans les r‚pertoires suivants :'); writeln; writeln(YRepP,' : '); writeln(' -un fichier (facultatif) nomm‚ ',YNomFicTpsRet,', listant les temps de retour'); writeln(' … utiliser pour l''analyse statistique des r‚sultats'); writeln; writeln(YRepP,YRepStations,' : '); writeln(' -un fichier localisant l''objectif de gestion et listant les r‚servoirs situ‚s'); writeln(' … l''amont avec les temps de propagation entre ceux-ci et l''objectif'); writeln; writeln('Sous-r‚pertoire de ',YRepP,YRepB,' (nom : entier entre 1 et ',YNbmaxVersion,') :'); writeln(' -un fichier par r‚servoir pr‚cisant ses contraintes et consignes de gestion'); writeln; writeln('Sous-r‚pertoire de ',YRepP,YRepS,' (nom : entier entre 1 et ',YNbmaxVersion,' ) :'); writeln(' -un fichier par r‚servoir pr‚cisant les stations … utiliser, les temps de '); writeln(' propagation et les superficies de bassin versant n‚cessaires, pour le'); writeln(' calcul des d‚bits naturels aux points de prise et de restitution'); writeln; writeln(YRepD,' : '); writeln(' -un fichier des d‚bits journaliers naturels aux stations n‚cessaires'); writeln; writeln(YRepO,' : '); writeln(' -un fichier d‚finissant l''hydrogramme objectif annuel … la station aval'); writeln; write('Les r‚sultats sont ‚dit‚s en fichiers texte dans le r‚pertoire ',YRepR); A_Tapez; a_texte; clrscr; A_quest; write('nom du fichier localisant l''objectif de gestion (station aval) ? '); A_lecture_xy; A_Reponse(YNomFicLacs,14); end; writeln(YFicSortie,'Nom du fichier localisant l''objectif aval, listant les reservoirs ', 'situes a l''amont et donnant les temps de propagation : ',YRepP,YRepStations,YNomFicLacs); writeln(YFicSortie); YResume:='systeme = '+YNomFicLacs+'['; {--ouverture du fichier des paramŠtres de station aval--} {$i-} assign(YFitext,YRepP+YRepStations+YNomFicLacs); YOuvertEtLu:=false; reset(YFitext); {--cas d'ouverture correcte du fichier des paramŠtres de station aval--} if ioresult=0 then begin {--cas o— le fichier n'est pas vide--} if not eof(YFiText) then begin YVtotCumul:=0; YNMalLu:=0; readln(YFitext); if (ioresult=0) then YOuvertEtLu:=true; write (YFicSortie,'Problemes detectes dans le fichier ',YNomFicLacs,' : '); {--lecture du nom de station aval et du nombre de lacs--} YNbModif[0]:=0; readln(YFitext,YNomStatAval); Ici_TestLecture(0,0,1,0); readln(YFiText,YNbLacs); Ici_TestLecture(0,0,2,0); Ici_ControleEntier(0,YNbLacs,1,YNmaxLacs); {--lecture des noms de r‚servoirs--} for YRangLac:=1 to YNbLacs do begin readln(YFitext,XChai8); XSeraRien:=ioresult; YNomLac[YRangLac]:=''; for Xi:=1 to length(XChai8) do if not(ord(XChai8[Xi]) in YSeparateur) then YNomLac[YRangLac]:=concat(YNomLac[YrangLac],XChai8[Xi]); end; {--lecture des temps de propagation--} for YRanglac:=1 to YNbLacs do begin readln(YFiText,YD[YRangLac]); Ici_TestLecture(YRangLac,0,8,0); Ici_Controle(0,YD[YRangLac],0,1e20); end; close(YFitext); {--cas o— aucune erreur d‚tect‚e --} if YNMalLu=0 then begin {--‚criture en sortie--} writeln(YFicSortie,'AUCUN'); writeln(YFicSortie); {--lecture ‚ventuelle des r‚glages--} assign(YFitext,YRepP+YNomFicReglage); reset(YFitext); if (ioresult=0) then begin YNbPbReglage:=0; for YRangLac:=1 to YNbLacs do begin if eof(YFitext) then YNbPbReglage:=YNbPbReglage+1; readln(YFitext,YReglage[YRangLac]); if ioresult<>0 then YNbPbReglage:=YNbPbReglage+1; end; close(YFitext); end else YNbPbReglage:=1; if YNblacs=1 then YNbPbReglage:=1; if YNbPbReglage<>0 then for YRanglac:=1 to YNbLacs do YReglage[Yranglac]:=0; {--Choix de la version des paramŠtres de contraintes et consignes.--} {--Ce bloc permet de d‚finir le nom YNomRepBarrage du r‚pertoire --} {--contenant les fichiers caract‚risant les contraintes et --} {--de chaque r‚servoir. --} if YSaisie then begin A_Titre; writeln; writeln('versions disponibles pour les contraintes et consignes de r‚servoirs :'); XNbVersion:=0; for Xi:=1 to YNbMaxVersion do begin str(Xi,YNomRepBarrage); YNomRepBarrage:=YRepP+YRepB+YNomRepBarrage+'\'; assign(XFic,YNomRepBarrage+'version.txt'); reset(XFic); if IOResult=0 then begin readln(XFic,XEnTete); if IOResult=0 then begin XNbVersion:=XNbVersion+1; A_Propo; write(XNbVersion:2); A_Titre; writeln(' : [',Xi:2,'] ',XEntete); XRangVersion[XNbVersion]:=Xi; end; close(XFic); end; end; if XNbVersion=0 then begin YRangPBarrage:=0; writeln('Liste vide. Calcul impossible'); A_Tapez; end else begin if XNbVersion=1 then begin Xi:=1; writeln('Cette version des paramŠtres sera utilis‚e pour les calculs.'); end else begin A_Quest; write('version de paramŠtres … utiliser (entre 1 et ',XNbVersion,') ? '); A_SaisiInt(Xi,1,XNbVersion,2); end; YRangPBarrage:=XRangVersion[Xi]; end; writeln; end; if YRangPBarrage>0 then begin str(YRangPBarrage,YNomRepBarrage); YNomRepBarrage:=YRepP+YRepB+YNomRepBarrage+'\'; assign(XFic,YNomRepBarrage+'version.txt'); reset(XFic); readln(XFic,XEnTete); close(XFic); writeln(YFicSortie,'Version utilisee pour les parametres de consignes et contraintes locales : rang ',YRangPBarrage); writeln(YFicSortie,' (',XEntete,')'); writeln(YFicSortie); end else writeln(yFicSortie,'Aucune version disponible pour les parametres de consignes et contraintes locales des reservoirs. Calcul impossible.'); flush(YFicSortie); {--Cas o— une version de paramŠtres de rŠgles et consignes locales a--} {--pu ˆtre s‚lectionn‚ : alors choix de la version des paramŠtres de--} {--r‚seaux. Ce bloc permet de d‚finir le nom YNomRepReseau du --} {--r‚pertoire contenant les fichiers caract‚risant le r‚seau de --} {--stations associ‚ … chaque r‚servoir. --} if YRangPBarrage>0 then begin if YSaisie then begin A_Titre; writeln('versions disponibles pour les r‚seaux de stations associ‚s aux r‚servoirs :'); XNbVersion:=0; for Xi:=1 to YNbMaxVersion do begin str(Xi,YNomRepReseau); YNomRepReseau:=YRepP+YRepS+YNomRepReseau+'\'; assign(XFic,YNomRepReseau+'version.txt'); reset(XFic); if IOResult=0 then begin readln(XFic,XEnTete); if IOResult=0 then begin XNbVersion:=XNbVersion+1; A_Propo; write(XNbVersion:2); A_Titre; writeln(' : [',Xi:2,'] ',XEntete); XRangVersion[XNbVersion]:=Xi; end; close(XFic); end; end; if XNbVersion=0 then begin YRangPReseau:=0; writeln('Liste vide. Calcul impossible'); A_tapez; end else begin if XNbVersion=1 then begin Xi:=1; writeln('Cette version des paramŠtres sera utilis‚e pour les calculs.'); end else begin A_Quest; write('version de paramŠtres … utiliser (entre 1 et ',XNbVersion,') ? '); A_SaisiInt(Xi,1,XNbVersion,2); end; YRangPReseau:=XRangVersion[Xi]; end; writeln; end; {fin du cas o— saisie clavier} if YRangPReseau>0 then begin str(YRangPReseau,YNomRepReseau); YNomRepReseau:=YRepP+YRepS+YNomRepReseau+'\'; assign(XFic,YNomRepReseau+'version.txt'); reset(XFic); readln(XFic,XEnTete); close(XFic); writeln(YFicSortie,'Version utilisee pour les parametres de reseaux de stations associes aux reservoirs : rang ',YRangPReseau); writeln(YFicSortie,' (',XEntete,')'); writeln(YFicSortie); end else writeln(yFicSortie,'Aucune version disponible pour les parametres de reseaux de stations associes aux reservoirs. Calcul impossible.'); flush(YFicSortie); end; {fin du cas ou version de paramŠtres rŠgles et consignes a ‚t‚ s‚lectionn‚} end; {fin du cas o— aucune erreur n'est d‚tect‚e} writeln(YFicSortie); end {fin du cas o— le fichier des paramŠtres de station aval n'est pas vide} {--cas o— le fichier des paramŠtres de station aval est vide--} else begin writeln(YFicSortie,'Probleme detecte : lecture impossible dans le fichier ',YNomFicLacs); close(YFitext); end; end {fin du cas d'ouverture correcte du fichier des paramŠtres de station aval} {--cas d'ouverture incorrecte du fichier--} else writeln(YFicSortie,'Probleme detecte : impossibilite d''ouvrir le fichier ',YNomFicLacs); {--r‚activation du contr“le des entr‚e-sorties et ‚criture en sortie--} {$i+} writeln(YFicSortie); writeln(YFicSortie); {--‚criture sur fichier de sortie, si la lecture s'est bien pass‚e--} if (YNMalLu=0) and YOuvertetLu then begin writeln(YFicSortie,'Identifiant de la station situee a l''aval du systeme : ',YNomStatAval); writeln(YFicSortie); writeln(YFicSortie,'Nombre K de reservoirs : ',YNbLacs); writeln(YFicSortie); writeln(YFicSortie,'Noms des reservoirs et temps de propagation D entre point de restitution et station aval (heures) :'); for YRangLac:=1 to YNbLacs do writeln(YFicSortie,' ',YNomLac[YRangLac],' : ',YD[YRangLac]); writeln(YFicSortie); if YNbModif[0]>1 then writeln(YFicSortie,'ATTENTION : ', YNbModif[0],' valeurs modifiees par rapport aux originales (non conformes)') else if YNbmodif[0]>0 then writeln(YFicSortie,'ATTENTION : ', YNbModif[0],' valeur modifiee par rapport a l''originale (non conforme)'); writeln(YFicSortie); end; END; {fin de procedure Ici_EntreesLac} {===========================================================================} {--Appelle la procedure de Lecture des paramŠtres de station aval, lacs et==} {==Temps de propag. ==} {===========================================================================} procedure P_StationAval; begin YNbLacs:=0; Ici_EntreesLac; P_EcritureSeparation; YCalculPossibl:= (YNMalLu=0) and YOuvertEtLu; if YSaisie then begin write('fichier ',YNomFicLacs,' : '); if YCalculPossibl then writeln('correct.') else begin writeln('non correct. ABANDON du calcul.'); writeln; writeln('Consulter le fichier ',YNomFicSortie,'.'); end; end; if not YCalculPossibl then begin writeln(YFicSortie); writeln(YFicSortie,'ABANDON DU CALCUL (probleme dans le fichier ',YNomFicLacs,')'); close(YFicSortie); end; flush(YFicSortie); end; {fin de procedure P_StationAval} {===========================================================================} {==Lecture des contraintes et consignes dans le fichier de paramŠtres ==} {==associ‚ au r‚servoir de rang YRanglac ==} {===========================================================================} procedure Ici_LectureRegles; var XRangFormule : integer; XRangPivot : integer; XRangSeuil : integer; XPivotAnt : integer; XSeraRien : integer; Xi : integer; Xj : integer; XSeuilAnt : double; XChai8 : YChai8; XChaine : string; Xbareme : YBareme; BEGIN {$i-} {--ouverture du fichier des contraintes et consignes--} assign(YFitext,YNomRepBarrage+YNomLac[YRangLac]+YSuffixe[1]); reset(YFitext); YOuvertEtLu:=false; {--cas d'ouverture correcte du fichier des contraintes et consignes--} if ioresult=0 then begin {--cas o— le fichier n'est pas vide--} if not eof(YFiText) then begin YNMalLu:=0; readln(YFitext,XChaine); XSerarien:=ioresult; writeln(YFicSortie,'En-tete du fichier : ',XChaine); writeln(YFicSortie); readln(YFitext,XChai8); YNomReservoir[YRangLac]:=''; for Xi:=1 to length(XChai8) do if not(ord(XChai8[Xi]) in YSeparateur) then YNomReservoir[YRangLac]:=concat(YNomReservoir[YrangLac],XChai8[Xi]); if (ioresult=0) then YOuvertEtLu:=true; write (YFicSortie,'Problemes detectes dans la lecture du fichier ',YNomLac[YRanglac],YSuffixe[1],' : '); {--lecture des contraintes de gestion des canaux (prise et restitution)} YNbModif[YRangLac]:=0; for Xi:=1 to 4 do begin with XBareme do begin read(YFiText,YEffectif); Ici_TestLecture(YRangLac,0,Xi+2,0); Ici_ControleEntier(YRangLac,YEffectif,1,YNmaxBareme); for Xj:=1 to YEffectif do begin read(YFitext,YVolume[Xj]); Ici_TestLecture(YRangLac,0,Xi+2,Xj); if Xj=1 then Ici_Controle(YRangLac,YVolume[Xj],0,1e20) else Ici_Controle(YRangLac,YVolume[Xj],YVolume[Xj-1]+1/BTresPositif,1e20); end; for Xj:=1 to YEffectif do begin YVolume[Xj]:=YVolume[Xj]*1e6; if Xj0 then begin {read(YFitext,YBorneGradient[YRangLac,YTypeDebit],YBorneDebit[YRangLac,YTypeDebit]);} read(YFitext,YBorneGradient[YRangLac,YTypeDebit]); Ici_TestLecture(YRangLac,YTypeDebit,10,0); Ici_Controle(YrangLac,YBorneGradient[YRangLac,YTypeDebit],0,1e20); end; readln(YFiText); XPivotAnt:=0; for XRangPivot:=1 to YNbPivot[YRangLac,YTypeDebit] do begin read(YFitext,YQuantPivot[YRangLac,YTypeDebit,XRangPivot]); Ici_TestLecture(YRangLac,YTypeDebit,11,XRangPivot); Ici_ControleEntier(YrangLac,YQuantPivot[YrangLac,YTypeDebit,XRangPivot], XPivotAnt+1,365-YNbPivot[YRangLac,YTypeDebit]+XRangPivot); XPivotAnt:=YQuantPivot[YRangLac,YTypeDebit,XRangPivot]; end; readln(YFitext); YNbFormule[YRangLac,YTypeDebit]:=0; for XRangPivot:=1 to YNbPivot[YRangLac,YTypeDebit] do begin read(YFitext,YRangFormule[YRangLac,YTypeDebit,XRangPivot]); Ici_TestLecture(YRangLac,YTypeDebit,12,XRangPivot); Ici_ControleEntier(YrangLac,YrangFormule[YRangLac,YTypeDebit,XRangPivot],1,YNbPivot[YRangLac,YTypeDebit]); YNbFormule[YRangLac,YTypeDebit]:=B_maxin(YNbFormule[YRangLac,YTypeDebit], YRangFormule[YRangLac,YTypeDebit,XRangPivot]); end; YRangFormule[YRangLac,YTypeDebit,0]:=YRangFormule[YRanglac,YTypeDebit,YNbPivot[YRangLac,YTypeDebit]]; readln(YFitext); {--boucle sur le nombre de formules--} for XRangFormule:=1 to YNbFormule[YRangLac,YTypeDebit] do begin read(YFiText,YNbSeuil[YRangLac,YTypeDebit,XRangFormule]); Ici_TestLecture(YRangLac,YTypeDebit,13,XRangFormule); Ici_ControleEntier(YrangLac,YNbSeuil[YRangLac,YTypeDebit,XRangFormule],1,YNbmaxSeuil); XseuilAnt:=1e20; for XRangSeuil:=1 to YNbSeuil[YrangLac,YTypeDebit,XRangFormule] do begin read(YFitext,YSeuil[YRangLac,YTypeDebit,XRangFormule,XRangSeuil], YDebit[YRangLac,YTypeDebit,XRangFormule,XRangSeuil]); Ici_TestLecture(YRangLac,YTypeDebit,13,XRangFormule); Ici_Controle(YrangLac,YSeuil[YRangLac,YtypeDebit,XrangFormule,Xrangseuil], -1e20,XSeuilAnt); XseuilAnt:=YSeuil[YRangLac,YtypeDebit,XrangFormule,Xrangseuil]; Ici_Controle(YrangLac,YDebit[YRangLac,YtypeDebit,XrangFormule,Xrangseuil],0,1e20); end; readln(YFitext); end; {fin de boucle sur le nombre de formules} end; {fin de boucle sur les 4 types de d‚bit de r‚f‚rence et r‚serv‚s} if YNMalLu=0 then write(YFicSortie,'AUCUN'); writeln(YFicSortie); end {fin du cas o— le fichier n'est pas vide} {--cas o— le fichier est vide--} else writeln(YFicSortie,'Probleme detecte : lecture impossible dans le fichier ',YNomLac[YRangLac],YSuffixe[1]); close(YFitext); end {fin du cas d'ouverture correcte du fichier} {--cas d'ouverture incorrecte du fichier--} else writeln(YFicSortie,'Probleme detecte : impossibilite d''ouvrir le fichier ',YNomLac[YRangLac],YSuffixe[1]); writeln(YFicSortie); writeln(YFicSortie); {$i+} END; {fin de proc‚dure Ici_LectureRegles} {===========================================================================} {--Pour le r‚servoir de rang YRangLac, ‚criture sur fichier de sortie --} {--(d‚j… ouvert) des paramŠtres et rŠgles de gestion (volume, contraintes,--} {--consignes). --} {===========================================================================} procedure Ici_EcritureParametresLacs(var ZFic:text); var XRangSeuil : integer; XrangFormule : integer; XNpivot : integer; Xi : integer; Xplur : string[1]; XCroiss : array[1..4] of boolean; {--------------------------------------------------------------------------} procedure XEcritureBareme(ZBareme : YBareme; var ZCroiss:boolean); var Wi : integer; begin ZCroiss:=true; with ZBareme do begin for Wi:=1 to YEffectif-1 do write(ZFic,(YVolume[Wi]*1e-6):10,' ; '); write(ZFic,(YVolume[YEffectif]*1e-6):10,' -- '); for Wi:=1 to YEffectif-1 do write(ZFic,YDebit[Wi]:10,' ; '); writeln(ZFic,YDebit[YEffectif]:10); for Wi:=2 to YEffectif do if YDebit[Wi]= ',B_dateclaire(2001,YQuantPivot[YRangLac,YTypeDebit,XNPivot])); write(ZFic,' : Q',YRangFormule[YRangLac,YTypeDebit,XNPivot]); if XNPivot ',YSeuil[YRangLac,YTypeDebit,XRangFormule,XRangSeuil]:6); write(ZFic,' alors ',Ydebit[Yranglac,YTypeDebit,XRangFormule,XrangSeuil]:6,', sinon, '); end; writeln(ZFic,'QMnat'); end; end; if YTypeFormule[YRangLac, YTypeDebit]<>0 then begin write(ZFic,' par ailleurs : '); if YTypeFormule[YRangLac,YTypeDebit]=1 then writeln(ZFic,YNomDebit[YTypeDebit],YRangLac,' = max [ ',YNomDebit[YTypeDebit],YRangLac, ' , QV(T-1)-',YBorneGradient[YRangLac,YTypeDebit],' ]') else writeln(ZFic,YNomDebit[YTypeDebit],YRangLac,' = min [ ',YNomDebit[YTypeDebit],YRangLac, ' , QV(T-1)+',YBorneGradient[YRangLac,YTypeDebit],' ]'); end; end; if YNbModif[YrangLac]>0 then begin XPlur:=''; if YNbModif[YRangLac]>1 then XPlur:='s'; writeln(ZFic); writeln(ZFic,' ATTENTION ATTENTION : ',YNbModif[YrangLac],' valeur',Xplur,' originale',Xplur,' non conforme',Xplur, ' automatiquement corrigee',XPlur,' pour ce reservoir'); end; for Xi:=1 to 4 do if not XCroiss[Xi] then writeln(ZFic,' ATTENTION ATTENTION : bareme non croissant pour ',YNomParamLac[Xi+2]); if YNomLac[YRangLac]<>YNomReservoir[YRanglac] then begin writeln(ZFic); writeln(Zfic,' ATTENTION : le nom du lac differe avec celui qui est ', 'contenu dans le fichier ',YNomFicLacs); end; END; {fin de Ici_EcritureParametresLacs} {===========================================================================} {--LECTURE DES PARAMETRES, CONTRAINTES ET CONSIGNES de gestion pour tous --} {--les lacs, et ‚criture en clair sur fichier de sortie. Ecriture sur ce --} {--fichier de la rŠgle adopt‚e pour la r‚partition des tƒches entre --} {--r‚servoirs --} {===========================================================================} procedure P_ContraintesEtConsignesLacs; var XAdd : double; XChai : string; BEGIN {--LECTURE ET ECRITURE DES PARAMETRES, CONTRAINTES ET CONSIGNES LACS--} if YCalculPossibl then begin for YRangLac:=1 to YNbLacs do begin writeln(YFicSortie,'Nom du fichier des contraintes et consignes du reservoir ',YRangLac, ' : ',YNomRepBarrage,YNomLac[YRangLac],YSuffixe[1]); writeln(YFicSortie); Ici_LectureRegles; if YOuvertetLu then Ici_EcritureParametresLacs(YFicSortie) else YCalculPossibl:=false; YCalculPossibl:=YCalculPossibl and (YNMalLu=0); P_EcritureSeparation; end; if Ysaisie then begin write('fichiers des contraintes et consignes : '); if YCalculPossibl then writeln('corrects.') else begin writeln('non corrects. ABANDON du calcul.'); writeln; writeln('Consulter le fichier ',YNomFicSortie,'.'); end; end; if not YCalculPossibl then begin writeln(YFicSortie); writeln(YFicSortie,'ABANDON DU CALCUL (probleme dans un (au moins) des fichiers de contraintes et consignes)'); close(YFicSortie); end; end; {--Ecriture sur fichier texte de sortie du mode adopt‚ pour la --} {--r‚partition des taches entre r‚servoirs --} if YCalculPossibl then begin if YNbLacs>1 then begin XAdd:=0; for YRangLac:=1 to YNbLacs do Xadd:=B_max(Xadd,-YVtot[YrangLac]*(1+YReglage[YRanglac])); YVRtotCumul:=0; for YRangLac:=1 to YNbLacs do begin YVRtot[YRanglac]:=YVtot[YRanglac]*(1+YReglage[YRanglac])+Xadd; YVRtotCumul:=YVRtotCumul+YVRtot[YRangLac]; end; if YVRTotCumul>0 then for YRanglac:=1 to YNbLacs do YVRtot[YRangLac]:=YVRtot[YRanglac]*YVtotCumul/YVRtotCumul else for YRanglac:=1 to YNbLacs do YVRtot[YRangLac]:=YVtot[YRanglac]; end else YVRtot[1]:=YVtot[1]; for YRanglac:=1 to YNbLacs do begin YPartTheorique[YrangLac]:=YVtot[YRanglac]/YVtotCumul; YPart[YrangLac]:=YVRtot[YRanglac]/YVtotCumul; end; writeln(YFicSortie); write(YFicSortie,'Option choisie : '); case YOptionRepart of 1:begin writeln(YFicSortie,'REPARTITION FIXE des taches entre reservoirs (mode 1), ', 'en proportion de leur volume fictif VRtot assigne :'); writeln(YFicSortie); write (YFicSortie,'volume reel Vtot : '); for YRanglac:=1 to YNbLacs do write(YFicSortie,YVtot[YRangLac],' '); writeln(YFicsortie); write (YFicSortie,'reglage souhaite Ec : '); for YRanglac:=1 to YNbLacs do write(YFicSortie,YReglage[YRangLac],' '); writeln(YFicsortie); write (YFicSortie,'volume assigne VRtot : '); for YRanglac:=1 to YNbLacs do write(YFicSortie,YVRtot[YRangLac],' '); writeln(YFicSortie); write (YFicSortie,'part standard : '); for YRanglac:=1 to YNbLacs do write(YFicSortie,YPartTheorique[YRangLac],' '); writeln(YFicSortie); write (YFicSortie,'part assignee : '); for YRanglac:=1 to YNbLacs do write(YFicSortie,YPart[YRangLac],' '); end; 2:writeln(YFicSortie,'REPARTITION VARIABLE des taches entre reservoirs (mode 2), ', 'tenant compte des volumes d''eau presents et des ', 'durees potentielles minimales Tpot de reconstitution du volume utilisable maximal'); 3:writeln(YFicSortie,'REPARTITION VARIABLE des taches entre reservoirs (mode 3), ', 'visant a equilibrer leurs taux de remplissage'); 4..5 : begin write(YFicSortie,'REPARTITION VARIABLE des taches entre reservoirs ', '(mode ',YOptionRepart,'), visant a equilibrer les durees potentielles minimales '); if YCodeTpot then write(YFicSortie,'Tpot1 de reconstitution du volume utilisable maximal') else write(YFicSortie,'Tpot2 d''epuisement du volume utilisable'); if YOptionRepart=4 then writeln(yFicSortie,', calculees avec des debits constants des cours d''eau aux prises (egaux aux modules)') else writeln(YFicSortie,', calculees avec des debits variables des cours d''eau aux prises (f=',YFreqNondep:6:4,')'); end; end; writeln(YFicSortie); P_EcritureSeparation; end; YStandard:=true; for YRangLac:=1 to YNbLacs do if YPartTheorique[YRangLac]<>YPart[YRangLac] then YStandard:=false; YResume:=YResume+' repartition '; case YOptionRepart of 1: begin YResume:=YResume+'figee '; if YStandard then YResume:=YResume+'(1 - proportionnelle a Vtot) : ' else YResume:=YResume+'(1 - imposee) : '; for YRanglac:=1 to YNblacs do begin str(YPart[YRangLac]:6:4,YChaine); YResume:=YResume+YChaine+' ' end; end; 2: YResume:=YResume+'variable (2 - fonction de V et Tpot(moyen))'; 3: YResume:=YResume+'variable (3 - visant equilibre V/Vtot)'; 4: begin YResume:=YResume+'variable (4 - visant equilibre Tpot'; if YCodeTpot then YResume:=YResume+'1' else YResume:=YResume+'2'; YResume:=YResume+'(moyen))'; end; 5: begin str(YFreqNonDep:6:4,XChai); YResume:=YResume+'variable (5 - visant equilibre Tpot'; if YCodeTpot then YResume:=YResume+'1' else YResume:=YResume+'2'; YResume:=YResume+'(f='+XChai+'))'; end; end; YResume:=YResume+' ; '; flush(YFicSortie); END; {fin de P_ContraintesEtConsignesLacs} {===========================================================================} {--lecture des paramŠtres de reseau pour chaque r‚servoir --} {===========================================================================} procedure Ici_EntreeReseaux; var Xi : integer; XRang : integer; XChai8 : YChai8; XChaine : string; XSerarien : integer; {---------------------------------------------------------------------------} procedure XTestLecture (ZRangDonnee,ZRang : integer); begin if ioresult<>0 then begin writeln(YFicSortie); YNmallu:=YNmallu+1; write(YFicSortie,' ',YNomParamReso[ZRangDonnee]); if ZRang<>0 then write(YFicSortie,'(',ZRang,')'); end; end; {---------------------------------------------------------------------------} BEGIN {d‚but de procedure Ici_EntreeReseaux} {$i-} {--ouverture du fichier des paramŠtres de r‚seau--} str(YRangLac,YNum); assign(YFitext,YNomRepReseau+YNomLac[YRangLac]+YSuffixe[2]); reset(YFitext); YOuvertEtLu:=false; {--cas d'ouverture correcte du fichier des paramŠtres de r‚seau--} if ioresult=0 then begin {--cas o— le fichier n'est pas vide--} if not eof(YFiText) then begin readln(YFitext,XChaine); XSerarien:=ioresult; writeln(YFicSortie,'En-tete du fichier : ',XChaine); writeln(YFicSortie); YNMalLu:=0; readln(YFitext,XChai8); YNomReseau[YRangLac]:=''; for Xi:=1 to length(XChai8) do if not(ord(XChai8[Xi]) in YSeparateur) then YNomReseau[YRangLac]:=concat(YNomReseau[YrangLac],XChai8[Xi]); if (ioresult=0) then YOuvertEtLu:=true; write (YFicSortie,'Problemes detectes dans la lecture du fichier ',YNomLac[YRanglac],' : '); {--lecture des nombres de stations amont et interm‚diaires--} YNbModif[YRangLac]:=0; readln(YFitext,YNam[YRangLac],YNint[YRangLac]); XTestLecture(1,0); Ici_ControleEntier(YRanglac,YNam[YRangLac],0,2); Ici_ControleEntier(YRanglac,YNint[YRanglac],0,1); {--lecture des identifiants de stations--} readln(Yfitext,YNomStatAv[YRangLac]); XTestLecture(2,0); for Xrang:=1 to YNam[YRangLac] do begin readln(YFitext,YNomStatAm[YRangLac,Xrang]); XTestLecture(3,Xrang); end; if YNint[YRangLac]>0 then readln(YFitext,YNomStatInt[YrangLac]); XTestLecture(4,0); {--cas o— le nombre de stations amont est non nul--} if YNam[YRangLac]>0 then begin for Xrang:=1 to YNam[YRangLac] do begin readln(YFitext,YDv[YRangLac,Xrang]); XTestLecture(8,0); Ici_Controle(YRangLac,YDv[YRangLac,Xrang],0,1e20); end; for Xrang:=1 to YNam[YRangLac] do begin readln(YFitext,YDm[YRangLac,Xrang]); XTestLecture(9,Xrang); Ici_Controle(YRangLac,YDm[YRangLac,Xrang],YDv[YRangLac,XRang],1e20); end; for Xrang:=1 to YNam[YRangLac] do begin readln(YFitext,YDam[YRangLac,Xrang]); XTestLecture(10,Xrang); Ici_Controle(YRangLac,YDam[YRangLac,Xrang],YDv[YRangLac,XRang],1e20); end; if YNint[YRangLac]>0 then begin readln(YFitext,YDint[YRangLac]); XTestLecture(11,0); Ici_Controle(YRangLac,YDint[YRangLac],0,1e20); end; readln(YFitext,YSav[YRangLac]); XTestLecture(12,0); Ici_Controle(YRangLac,YSav[YRangLac],0,1e20); for Xrang:=1 to YNam[YrangLac] do begin readln(YFitext,YSv[YrangLac,XRang]); XTestLecture(13,0); Ici_Controle(YRangLac,YSv[YRangLac,XRang],0,YSav[YRangLac]); end; for Xrang:=1 to YNam[YRangLac] do begin readln(YFitext,YSm[YRangLac,Xrang]); XTestLecture(14,Xrang); Ici_Controle(YRangLac,YSm[YRangLac,Xrang],0,YSav[YRangLac]); end; for Xrang:=1 to YNam[YRangLac] do begin readln(YFitext,YSam[YRangLac,Xrang]); XTestLecture(15,Xrang); Ici_Controle(YRangLac,YSam[YRangLac,Xrang],0,YSav[YRangLac]); end; if YNint[YRangLac]>0 then begin readln(YFitext,YSint[YRangLac]); XTestLecture(16,0); Ici_Controle(YRangLac,YSint[YRangLac],0,1e20); end; end; {fin du cas o— le nombre de stations amont est non nul} if YNMalLu=0 then write(YFicSortie,'AUCUN'); writeln(YFicSortie); end {fin du cas o— le fichier n'est pas vide} {--cas o— le fichier est vide--} else writeln(YFicSortie,'Probleme detecte : lecture impossible dans le fichier ',YNomLac[YRangLac],YSuffixe[2]); close(YFitext); end {fin du cas d'ouverture correcte du fichier} {--cas d'ouverture incorrecte du fichier--} else writeln(YFicSortie,'Probleme detecte : impossibilite d''ouvrir le fichier ',YNomLac[YRangLac],YSuffixe[2]); writeln(YFicSortie); writeln(YFicSortie); {$i+} END; {fin de procedure Ici_EntreeReseaux} {=============================================================================} {--‚criture des paramŠtres des r‚seaux sur fichier de sortie --} {=============================================================================} procedure Ici_EcritureParametresReseaux(var ZFic:text); var XRang : integer; XPlur : string[1]; BEGIN writeln(ZFic,'nom du reservoir : ',YNomReseau[YRangLac]); writeln(Zfic,'nombre de stations amont et intermediaires : ', YNAm[YrangLac],' et ',YNInt[YRangLac]); writeln(ZFic,'identifiant de station aval : ',YNomStatAv[YRangLac]); if YNAm[YRangLac]>0 then begin if YNam[YRangLac]>1 then write(ZFic,'identifiants des stations amont : ') else write(ZFic,'identifiant de la station amont : '); for Xrang:=1 to YNam[YRangLac] do write(ZFic,YNomStatAm[YrangLac,Xrang],' '); writeln(ZFic); if YNint[YRangLac]>0 then writeln(ZFic,'identifiant de station intermediaire : ',YNomStatInt[YRangLac]); write(ZFic,'Dv = '); for Xrang:=1 to YNam[YRangLac] do begin write(ZFic,YDv[YRangLac,Xrang],' '); YDv[YRangLac,Xrang]:=YDv[YRangLac,XRang]/24; end; writeln(ZFic,'heures (temps de propagation entre les points de restitution et la station situee a l''aval du reservoir)'); write(ZFic,'Dm = '); for Xrang:=1 to YNam[YrangLac] do begin write(ZFic,YDm[YRangLac,Xrang],' '); YDm[YRangLac,XRang]:=YDm[YRangLac,XRang]/24; end; writeln(ZFic,' heures (temps de propagation entre les points de prise et la station situee a l''aval du reservoir)'); write(ZFic,'Dam = '); for Xrang:=1 to YNam[YrangLac] do begin write(ZFic,YDam[YRangLac,Xrang],' '); YDam[YrangLac,XRang]:=YDam[YRangLac,XRang]/24; end; writeln(ZFic,' heures (temps de propagation entre les stations situees a l''amont et ', 'la station situee a l''aval du reservoir)'); if YNint[YRangLac]>0 then begin writeln(ZFic,'Dint = ',YDint[YRangLac],' heures (temps de propagation entre la station intermediaire et ', 'la station situee a l''aval du reservoir)'); YDint[YRanglac]:=YDint[YRangLac]/24; end; writeln(ZFic,'Sav = ',YSav[YRangLac],' km2 (superficie du bassin versant a la', ' station situee a l''aval du reservoir)'); write(ZFic,'Sv = '); for Xrang:=1 to YNam[YrangLac] do write(ZFic,YSv[YRangLac,Xrang],' '); writeln(ZFic,' km2 (superficie de bassin versant aux points de restitution)'); write(ZFic,'Sm = '); for Xrang:=1 to YNam[YrangLac] do write(ZFic,YSm[YRangLac,Xrang],' '); writeln(ZFic,' km2 (superficie de bassin versant aux points de prise)'); write(ZFic,'Sam = '); for Xrang:=1 to YNam[YrangLac] do write(ZFic,YSam[YRangLac,Xrang],' '); writeln(ZFic,' km2 (superficie de bassin versant aux stations situees a l''amont des restitutions du reservoir)'); if YNint[YRangLac]>0 then writeln(ZFic,'Sint = ',YSint[YRangLac],' km2 (superficie de bassin versant a la station intermediaire)'); end; if YNbModif[YrangLac]>0 then begin Xplur:=''; if YNbModif[YRangLac]>1 then XPlur:='s'; writeln(ZFic); writeln(ZFic,' ATTENTION ATTENTION : ',YNbModif[YrangLac],' valeur',Xplur,' originale',Xplur,' non conforme',Xplur, ' automatiquement corrigee',XPlur,' pour ce reseau'); end; if YNomLac[YRangLac]<>YNomReseau[YRanglac] then begin writeln(ZFic); writeln(Zfic,' ATTENTION : le nom du lac differe avec celui qui est contenu ', 'dans le fichier ',YNomFicLacs); end; END; {fin de procedure Ici_EcritureParametresReseaux} {===========================================================================} {==Lecture des paramŠtres r‚seaux et ‚criture en clair de ces paramŠtres ==} {==sur fichier de sortie ==} {===========================================================================} procedure P_ParametresReseau; begin if YCalculPossibl then begin for YRangLac:=1 to YNbLacs do begin writeln(YFicSortie,'Nom du fichier des parametres reseau du reservoir ',YRangLac,' : ',YNomRepReseau,YNomLac[YRangLac],YSuffixe[2]); writeln(YFicSortie); Ici_EntreeReseaux; if YOuvertEtLu then Ici_EcritureParametresReseaux(YFicSortie) else YCalculPossibl:=false; YCalculPossibl:=YCalculPossibl and (YNMalLu=0); P_EcritureSeparation; end; if YSaisie then begin write('fichiers des paramŠtres r‚seaux/r‚servoirs : '); if YCalculPossibl then writeln('corrects.') else begin writeln('non corrects. ABANDON du calcul.'); writeln; writeln('Consulter le fichier ',YNomFicSortie,'.'); end; end; if not YCalculPossibl then begin writeln(YFicSortie); writeln(YFicSortie,'ABANDON DU CALCUL (probleme dans un (au moins) des fichiers de reseau/reservoir)'); close(YFicSortie); end; end; flush(YFicSortie); end; {fin de proc‚dure P_ParametresReseau} {============================================================================} BEGIN END.