Download inichimi.procedur

Back to the list

   1 : * INICHIMI  PROCEDUR  JC220346  12/09/12    21:15:07     7501           
   2 : DEBPROC INICHIMI TTB1/OBJET  BBD1/MOT BBD2/MOT TTB2/OBJET TTB3/OBJET
   3 :                                                     G1/MAILLAGE ;
   4 : ********************************************************************
   5 : *    initialisation des données de CHI1 et CHI2 avec des constantes
   6 : *                      sur le maillage G1
   7 : ********************************************************************
   8 :            'SI' ('EXIS' BBD1)  ;
   9 :             BASE1= BBD1 ;
  10 :            'SINON' ;
  11 :   'MESS' 'Entrez l adresse du fichier composants de la base de données';
  12 :            OBTE BASE1*MOT ;
  13 :             FINSI ;
  14 :            'SI' ('EXIS' BBD2)  ;
  15 :             BASE2= BBD2 ;
  16 :            'SINON' ;
  17 :   'MESS' 'Entrez l adresse du fichier LOGK de la base de données';
  18 :            OBTE BASE2*MOT ;
  19 :             FINSI ;
  20 : *
  21 : *                              On trie les objets
  22 :   ILTB1= VRAI ;
  23 :   ILTB2= VRAI ;
  24 :   ILTB3= VRAI ;
  25 :     'SI' ('EXIS' TTB1  ) ;
  26 :           'SI' ('EGA' (TTB1. 'CLASSE') 'DONCHI1 ') ;
  27 :            TB2=TTB1 ;
  28 :           ILTB1=FAUX ;
  29 :           'SINON' ;
  30 :              'SI' ('EGA' (TTB1. 'CLASSE') 'DONCHI2 ') ;
  31 :               TBC2=TTB1 ;
  32 :              ILTB2=FAUX ;
  33 :              'SINON' ;
  34 :              'SI' ('EGA' (TTB1. 'CLASSE') 'PARMCHI2') ;
  35 :               TBPAR2=TTB1 ;
  36 :              ILTB3=FAUX ;
  37 :              'SINON' ;
  38 :            'MESS' 'L objet ne convient pas' ;
  39 :             'FINSI' ;
  40 :          'FINSI'    ;
  41 :     'FINSI'   ;
  42 :    'FINSI'    ;
  43 :     'SI' ('EXIS' TTB2  ) ;
  44 :           'SI' ('EGA' (TTB2. 'CLASSE') 'DONCHI1 ') ;
  45 :            TB2=TTB2 ;
  46 :           ILTB1=FAUX ;
  47 :           'SINON' ;
  48 :              'SI' ('EGA' (TTB2. 'CLASSE') 'DONCHI2 ') ;
  49 :               TBC2=TTB2 ;
  50 :              ILTB2=FAUX ;
  51 :              'SINON' ;
  52 :              'SI' ('EGA' (TTB2. 'CLASSE') 'PARMCHI2') ;
  53 :               TBPAR2=TTB2 ;
  54 :              ILTB3=FAUX ;
  55 :              'SINON' ;
  56 :            'MESS' 'L objet ne convient pas' ;
  57 :             'FINSI' ;
  58 :          'FINSI' ;
  59 :     'FINSI'  ;
  60 :    'FINSI'   ;
  61 :     'SI' ('EXIS' TTB3  ) ;
  62 :           'SI' ('EGA' (TTB3. 'CLASSE') 'DONCHI1 ') ;
  63 :            TB2=TTB3 ;
  64 :           ILTB1=FAUX ;
  65 :           'SINON' ;
  66 :              'SI' ('EGA' (TTB3. 'CLASSE') 'DONCHI2 ') ;
  67 :               TBC2=TTB3 ;
  68 :              ILTB2=FAUX ;
  69 :              'SINON' ;
  70 :              'SI' ('EGA' (TTB3. 'CLASSE') 'PARMCHI2') ;
  71 :               TBPAR2=TTB3 ;
  72 :              ILTB3=FAUX ;
  73 :              'SINON' ;
  74 :            'MESS' 'L objet ne convient pas' ;
  75 :             'FINSI'  ;
  76 :          'FINSI' ;
  77 :     'FINSI'  ;
  78 :    'FINSI'   ;
  79 : *
  80 : *
  81 :          'SI' ILTB1;
  82 :            TB2= OBJET DONCHI1 ;
  83 :           'MESS' 'Entrez la liste des composants  ' ;
  84 :           OBTE  LICOMP*LISTENTI ;
  85 :            TB2%GIDEN LICOMP ;
  86 :           FINSI ;
  87 :   INICHI1 TB2  BASE1  BASE2 ;
  88 : 'MESS''Voulez vous afficher le contenu actuel de l objet CHIMI1 ?' ;
  89 : 'OBTE' IAFFI ;
  90 : SI(EGA IAFFI 'QUIT') ;
  91 : QUITTER INICHIMI ;
  92 : FINSI ;
  93 :         TB3='CHI1' TB2 'COMP' BASE1 'LOGK' BASE2  ;
  94 :         'SI' ('EGA' IAFFI 'OUI') ;
  95 :          IMPCHI1 TB3 'TB3' ;
  96 :          'FINS' ;
  97 : *
  98 : *                                           OBJET PARMCHI2
  99 : SI ILTB3 ;
 100 : TBPAR2= OBJET PARMCHI2 ;
 101 : TBPAR2%GITMAX 95 ;
 102 : TBPAR2%GEPS 1.D-4 ;
 103 : FINSI ;
 104 : TBPAR2%GIMPRIM (LECT 1) ;
 105 : *TBPAR2%GSORTIE (MOTS 'PREC' 'TYP3' 'SOLU' 'FION') ;
 106 : TBPAR2%GSORTIE (MOTS   'SOLU' 'FION') ;
 107 : *
 108 : *
 109 : *                                       OBJET DONCHI2
 110 : LICOMP=  TB2%ACCES GIDEN ;
 111 : NBCOMP=DIME LICOMP ;
 112 : *LIST LICOMP ;
 113 :       LITOT= LICOMP ;
 114 :  IITOT= VRAI ;
 115 : SI ( ILTB2) ;
 116 :      TBC2=OBJET DONCHI2 ;
 117 :      SI (NON (EXIS G1)) ;
 118 :      OPTION DIME 2 ;
 119 :       G1 = MANU POI1 ( 0. 0. ) ;
 120 :      FINSI ;
 121 :        NUTOT= 'EXTR' LICOMP 1 ;
 122 :      MO4 MO3 NU2 = NOCOMCHI TB3 'NUMCOMP' NUTOT ;
 123 :      CTOT= MANU CHPO G1 1 MO3 0. ;
 124 :      CLGC= MANU CHPO G1 1 MO3 0. ;
 125 :      TBC2=OBJET DONCHI2 ;
 126 :      REPE BBCOMP NBCOMP ;
 127 :        NUTOT= 'EXTR' LICOMP &BBCOMP ;
 128 :      MO4 MO3 NU2 = NOCOMCHI TB3 'NUMCOMP' NUTOT ;
 129 :      CTOT1= MANU CHPO G1 1 MO3 0. ;
 130 :      CLGC1 = MANU CHPO G1 1 MO3 0. ;
 131 :      CTOT=CTOT+CTOT1 ;
 132 :      CLGC= CLGC+CLGC1 ;
 133 :      FIN BBCOMP ;
 134 : SINON ;
 135 :     SI (EGA (TYPE (TBC2%ACCES GTOT)) 'CHPOINT ') ;
 136 :     mess '(TBC2%ACCES GTOT))= CHPOINT  ' ;
 137 :     SI (EGA (TYPE (TBC2%ACCES GLOGC)) 'LOGIQUE ') ;
 138 :        CLOGC= (TBC2%ACCES GTOT) -(TBC2%ACCES GTOT) ;
 139 :        TBC2%GLOGC CLOGC ;
 140 :    FINSI ;
 141 :    G1= EXTR ( TBC2.TOT) MAIL ;
 142 :     INICHI2 TB3 TBC2 ;
 143 :    IITOT= FAUX ;
 144 :    FINSI ;
 145 : FINSI ;
 146 : *
 147 : 'SI' IITOT ;
 148 : *                               LOGC ;
 149 :      'REPE' BOULGC NBCOMP ;
 150 :      NULGC= 'EXTR' LICOMP &BOULGC ;
 151 :   MO4 MO3 NU2 = NOCOMCHI TB3 'NUMCOMP' NULGC ;
 152 :  'MESS' ' Entrez LOGC de ' NULGC   MO4 ;
 153 :   'OBTE' VLGC*FLOTTANT ;
 154 :   'SI'  ('EGA' VLGC ('MOT' 'NON'))  ;
 155 :   VLGC= 0. ;
 156 :   'FINS' ;
 157 :   CLGC1=  MANU CHPO G1 1 MO3 VLGC ;
 158 :   CLGC= CLGC+CLGC1 ;
 159 :      'FIN' BOULGC ;
 160 : * LIST CLGC   ;
 161 :  REPE BLGC1 ;
 162 :   NTAB CLGC 'TITR' ' VALEURS DE LOGC' ;
 163 :   LIMOT= EXTR CLGC 'COMP'  ;
 164 :  MOLGC= 'MENU' 'POUR MODIFIER UNE VALEUR CLIQUER SUR SON NOM ' LIMOT ;
 165 :  'SI' ('EGA' MOLGC 'Quitter' ) ;
 166 :  'QUIT' BLGC1 ;
 167 :  'FINS' ;
 168 :   MO4 MO3 NU2 = NOCOMCHI TB3 'NOMINT' MOLGC ;
 169 :  'MESS' ' Entrez LOGC de ' NU2   MO4 ;
 170 :   'OBTE' VLGC*FLOTTANT ;
 171 :   'SI' ('NON' ('EGA' VLGC ('MOT' 'NON')) ) ;
 172 :   CLGC1=  MANU CHPO G1 1 MO3 VLGC ;
 173 :   CLGC2=  EXCO MO3 CLGC MO3 ;
 174 :   CLGC= CLGC+CLGC1- CLGC2 ;
 175 :   'FINS' ;
 176 :  FIN BLGC1 ;
 177 :   TBC2%GLOGC CLGC ;
 178 : *                             DEFINITION DES CONCENTRATIONS TOTALES
 179 : *
 180 : NLICLIM= 0 ;
 181 : LICLIM='LECT' ;
 182 : LICOMP3='LECT' ;
 183 : 'SI' ('EXIS' TB2 'CLIM' ) ;
 184 : 'SI' ('EXIS'  (TB2.CLIM) 'TYP3' ) ;
 185 :       LICLIM= TB2.CLIM.TYP3*1 ;
 186 :       LICOMP3= TB2.CLIM.TYP3*1 ;
 187 :       LITOT=LICOMP 'SAUF' LICLIM ;
 188 : 'SI' ('EXIS'  (TB2.CLIM) 'COMP3' ) ;
 189 :       LITOT= LICOMP 'SAUF' TB2.CLIM.COMP3 ;
 190 : 'FINSI' ;
 191 : *     MESS ' LITOT' ; LIST LITOT ;
 192 :       NLICLIM= DIME LICLIM ;
 193 : *     'MESS' ' NOMBRE D ACTIVITE IMPOSE ' NLICLIM ;
 194 :        NUCLIM= 'EXTR' LICLIM  1 ;
 195 :       MO1 NU1 = NOESPCHI TB3 NUCLIM ;
 196 :   CCLIM= MANU CHPO G1 1 MO1  0. ;
 197 :  TB00= OBJET DONCHI1 ;
 198 :  TB00%GIDEN (TB2%ACCES GIDEN) ;
 199 :  TB0= CHI1 TB00 COMP BASE1 LOGK BASE2 ;
 200 :       SI (EXIS TB0.IDEN PRECI) ;
 201 :            NBTYP5= DIME ( TB0.IDEN.PRECI) ;
 202 :       FINSI ;
 203 :       'REPE' BOUCLIM NLICLIM ;
 204 :       LIRACTI= VRAI ;
 205 :        NUCLIM= 'EXTR' LICLIM  &BOUCLIM ;
 206 :       SI (EXIS TB0.IDEN PRECI) ;
 207 :       ICTYP5= DIME ( TB0.IDEN.PRECI SAUF (LECT NUCLIM)) ;
 208 :       SI (NON (EGA ICTYP5 NBTYP5)) ;
 209 :       LIRACTI=FAUX ;
 210 :       FINSI ;
 211 :       FINSI ;
 212 :       MO1 NU1 = NOESPCHI TB3 NUCLIM ;
 213 :       SI LIRACTI ;
 214 :  'MESS' ' Entrez l activité de ' NU1  ' son nom local est ' MO1 ;
 215 :   'OBTE' VCLIM*FLOTTANT ;
 216 :       SINON ;
 217 :         VCLIM=0. ;
 218 :       FINSI ;
 219 :   CCLI1= MANU CHPO G1 1 MO1  VCLIM ;
 220 :   CCLIM= CCLIM +CCLI1 ;
 221 :   CIMP3= NUCLIM ;
 222 :   SI (EXIS (TB2.CLIM) COMP3 ) ;
 223 :      CIMP3='EXTR' (TB2.CLIM.COMP3)  &BOUCLIM ;
 224 :      LICOMP3=  (TB2.CLIM.COMP3)*1 ;
 225 :   FINSI ;
 226 :      MO4 MO3 NU2 = NOCOMCHI TB3 'NUMCOMP' CIMP3 ;
 227 :   CTOT1=  MANU CHPO G1 1 MO3 0. ;
 228 :   CTOT= CTOT+CTOT1 ;
 229 :       'FIN' BOUCLIM ;
 230 : *  LIST CCLIM ;
 231 :   TBC2%GCLIM  CCLIM ;
 232 : 'FINSI' ;
 233 : 'FINSI' ;
 234 : *
 235 : *      cas ou l'on fixe la concentration de certains minéraux
 236 :  'MESS' 'Voulez vous fixer la concentration de certains minéraux ?' ;
 237 : OBTE IMODII ;
 238 : SI(EGA IMODII 'QUIT') ;
 239 : QUITTER INICHIMI ;
 240 : FINSI ;
 241 : SI (EGA IMODII 'OUI') ;
 242 :  MESS 'Entrez la liste de ces espèces ' ;
 243 :  OBTE LIESPCF0*LISTENTI ;
 244 :  NESPCF=DIME LIESPCF0 ;
 245 :  NBESP= DIME ( TB3.DESCHI.IDY) ;
 246 :  NBCOMP= DIME ( TB3.DESCHI.IDX) ;
 247 : * on contruit une liste de nombre de composant par espèce
 248 : * on va garder l'indice de chaque espèce dans IDY pour faciliter
 249 : * les recherches dans MATRICEA
 250 :  LLL1= LECT NESPCF*0 ;
 251 :  L1DY= LECT NESPCF*0 ;
 252 :  REPE BSPCF1 NESPCF ;
 253 :  NUNU= EXTR LIESPCF0 &BSPCF1 ;
 254 :  NBCC1=0 ;
 255 :  REPE BOUESP NBESP ;
 256 :  NUMESP= EXTR ( TB3.DESCHI.IDY) &BOUESP ;
 257 :  SI (EGA NUNU NUMESP) ;
 258 :  IIND1= &BOUESP ;
 259 :  QUITTER BOUESP ;
 260 :  FINSI ;
 261 :  FIN BOUESP ;
 262 : REMP L1DY &BSPCF1 IIND1 ;
 263 :  REPE BOUCOMP NBCOMP ;
 264 : NUAAA= NBESP*(&BOUCOMP - 1) + IIND1 ;
 265 : AAA= EXTR (TB3.DESCHI.MATRICEA) NUAAA ;
 266 : SI ( NEG AAA 0. ) ;
 267 :  NBCC1= NBCC1+1 ;
 268 : FINSI ;
 269 : FIN BOUCOMP;
 270 : REMP LLL1 &BSPCF1 NBCC1 ;
 271 : FIN BSPCF1 ;
 272 : LIESPCF= LIESPCF0 * 1 ;
 273 : LLL2= ORDO (LLL1 * 1) ;
 274 : LLDY=  LECT NESPCF*0 ;
 275 : REPE  BSPCF2 NESPCF ;
 276 : ILL2= EXTR LLL2 &BSPCF2 ;
 277 : REPE  BSPCF3 NESPCF ;
 278 : ILL3= EXTR LLL1 &BSPCF3 ;
 279 : SI ( EGA ILL2 ILL3) ;
 280 : REMP LIESPCF &BSPCF2 (EXTR LIESPCF0 &BSPCF3) ;
 281 : REMP LLDY &BSPCF2 (EXTR L1DY &BSPCF3) ;
 282 : REMP LLL1 &BSPCF3 0 ;
 283 : QUITTER BSPCF3 ;
 284 : FINSI ;
 285 : FIN BSPCF3 ;
 286 : FIN BSPCF2 ;
 287 : 'OUBL' LLL1 ;
 288 : 'OUBL' L1DY ;
 289 : 'OUBL' LIESPCF0 ;
 290 :    II2= NLICLIM*1 ;
 291 : 'REPE'  BOUCLI3 NESPCF ;
 292 :     ILL3= EXTR LIESPCF &BOUCLI3 ;
 293 :     IIND1=EXTR LLDY &BOUCLI3 ;
 294 :     REPE BOUC11 NBCOMP ;
 295 :       NUAAA= NBESP*(&BOUC11 - 1) + IIND1 ;
 296 :       AAA= EXTR (TB3.DESCHI.MATRICEA) NUAAA ;
 297 :       SI ( NEG AAA 0. ) ;
 298 :        IDX1= EXTR ( TB3.DESCHI.IDX) &BOUC11 ;
 299 :        SI ( 'EGA' (DIME LICOMP3) 0) ;
 300 :        QUITTER BOUC11 ;
 301 :        FINSI ;
 302 :        II3= DIME ( LICOMP3 'SAUF' (LECT IDX1));
 303 :        SI (EGA II2 II3) ;
 304 :        QUITTER BOUC11 ;
 305 :        SINON ;
 306 :        IDX1= 0 ;
 307 :        FINSI ;
 308 :       FINSI ;
 309 :    FIN BOUC11 ;
 310 :    SI ( EGA IDX1 0) ;
 311 :    MESS 'Tous les composants de ' ILL3 'sont déja fixés' ;
 312 :    SINON ;
 313 :    II2= II2 + 1 ;
 314 :    LICLIM= INSE LICLIM II2 ILL3 ;
 315 :    LICOMP3= INSE LICOMP3 II2 IDX1 ;
 316 :    FINSI ;
 317 : FIN BOUCLI3 ;
 318 : *MESS ' LICLIM' ; LIST LICLIM ;
 319 : *MESS ' LICOMP3 ' ; LIST LICOMP3 ;
 320 : *      on va recalculer chi1 avec les nouvelles contraintes
 321 :  TBB2= OBJET DONCHI1 ;
 322 :  TBB2%GIDEN (TB2%ACCES GIDEN);
 323 :  TBB2%GBDD (TB2%ACCES GBDD);
 324 : * l'opération qui suit ne marche pas car par les methodes on accede au
 325 : * contenu .Lorsque le contenu est NON on cherche a executer l'opérateur
 326 : * NON. Je n'ai pas trouvé le moyen de preciser qu'il s'agit d'un mot.
 327 : *TBB2%GTEMPERA (TB2%ACCES GTEMPERA);
 328 :  TBB2%GTEMPERA TB2.TEMPERATURE ;
 329 :  TBB2%GCLIM TYP3 LICLIM ;
 330 :  TBB2%GCLIM COMP3 LICOMP3 ;
 331 :  SI (EXIS TB2 CHXMX) ;
 332 :  TBB2%GCHXMX (TB2%ACCES GCHXMX);
 333 :  FINSI ;
 334 :  SI (EXIS TB2 CLIM) ;
 335 :  SI (EXIS (TB2.CLIM) 'TYP6' ) ;
 336 :  TBB2%GCLIM TYP6 (TB2%ACCES GCLIM TYP6);
 337 :  FINSI ;
 338 :  SI (EXIS (TB2.CLIM) 'TYP5' ) ;
 339 :  TBB2%GCLIM TYP5 (TB2%ACCES GCLIM TYP5);
 340 :  FINSI ;
 341 :  SI (EXIS (TB2.CLIM) 'TYP4' ) ;
 342 :  TBB2%GCLIM TYP4 (TB2%ACCES GCLIM TYP4);
 343 :  FINSI ;
 344 :  FINSI ;
 345 :  SI (EXIS TB2 NVCOMP) ;
 346 :  TBB2%GNVCOMP ( TB2%ACCES GNVCOMP) ;
 347 :  FINSI ;
 348 :  SI (EXIS TB2 NVESP) ;
 349 :  TBB2%GNVESP  ( TB2%ACCES GNVESP ) ;
 350 :  FINSI ;
 351 :  SI (EXIS TB2 NVSOSO) ;
 352 :  TBB2%GNVSOSO  ( TB2%ACCES GNVSOSO)  ;
 353 :  FINSI ;
 354 :  SI (EXIS TB2 ECHANGE) ;
 355 :  TBB2%GECHANGE (TB2%ACCES GECHANGE) ;
 356 :  FINSI ;
 357 : TB3= CHI1 TBB2 COMP BASE1 LOGK BASE2 ;
 358 :  LVESPC= PROG ;
 359 :  SI (EGA NLICLIM  0);
 360 :        NUCLIM= 'EXTR' LICLIM  1 ;
 361 :       MO1 NU1 = NOESPCHI TB3 NUCLIM ;
 362 :       CCLIM= MANU CHPO G1 1 MO1  0. ;
 363 :  FINSI ;
 364 :    II3= II2- NLICLIM ;
 365 :    REPE BOUCLI4 II3 ;
 366 :    IESPCF= EXTR LICLIM (&BOUCLI4 + NLICLIM) ;
 367 :    CIMP3= EXTR LICOMP3 (&BOUCLI4 + NLICLIM) ;
 368 :   'MESS' 'Entrez la quantité voulue de ' IESPCF ;
 369 :    OBTE VESPCF*FLOTTANT ;
 370 :   LVESPC=INSE LVESPC &BOUCLI4 VESPCF ;
 371 :      MO4 MO3 NU2 = NOCOMCHI TB3 'NUMCOMP' CIMP3 ;
 372 :      MO1 NU1 = NOESPCHI TB3  IESPCF ;
 373 :   CTOT1=  MANU CHPO G1 1 MO3 0. ;
 374 :   CTOT= CTOT+CTOT1 ;
 375 :   CCLI1= MANU CHPO G1 1 MO1 0. ;
 376 :   CCLIM= CCLIM+CCLI1 ;
 377 :    FIN BOUCLI4 ;
 378 :   LITOT= LICOMP SAUF LICOMP3 ;
 379 :       NLITOT= DIME LITOT ;
 380 :      SI (NEG NLITOT 0) ;
 381 :      'REPE' BOUTOT NLITOT ;
 382 :      NUTOT= 'EXTR' LITOT &BOUTOT ;
 383 :   MO4 MO3 NU2 = NOCOMCHI TB3 'NUMCOMP' NUTOT ;
 384 :  'MESS' ' Entrez la concentration totale de ' NUTOT   MO4 ;
 385 :   'OBTE' VTOT*FLOTTANT ;
 386 :   'SI'  ('EGA' VTOT ('MOT' 'NON'))  ;
 387 :   VTOT= 0. ;
 388 :   'FINS' ;
 389 :   CTOT1=  MANU CHPO G1 1 MO3 VTOT ;
 390 :   CTOT= CTOT+CTOT1 ;
 391 :      'FIN' BOUTOT ;
 392 :  FINSI ;
 393 : * LIST CTOT   ;
 394 : *
 395 :  REPE BCTOT ;
 396 :   NTAB CTOT TITR 'CONCENTRATION TOTALE' ;
 397 :   LIMOT= EXTR CTOT 'COMP'  ;
 398 :  MOTOT= 'MENU' 'POUR MODIFIER UNE VALEUR CLIQUER SUR SON NOM ' LIMOT ;
 399 :  'SI' ('EGA' MOTOT 'Quitter' ) ;
 400 :  'QUIT' BCTOT ;
 401 :  'FINS' ;
 402 :   MO4 MO3 NU2 = NOCOMCHI TB3 'NOMINT' MOTOT ;
 403 :  'MESS' ' Entrez la concentration totale de ' NU2   MO4 ;
 404 :   'OBTE' VTOT*FLOTTANT ;
 405 :   'SI' ('NON' ('EGA' VTOT ('MOT' 'NON')))  ;
 406 :   CTOT1=  MANU CHPO G1 1 MO3 VTOT ;
 407 :   CTOT2= EXCO MO3 CTOT MO3 ;
 408 :   CTOT= CTOT+CTOT1 -CTOT2 ;
 409 :   'FINS' ;
 410 :  FIN BCTOT ;
 411 : *
 412 :   TBC2%GTOT CTOT ;
 413 : * LIST TB3.IDEN.NOMTYP3 ;
 414 : * LIST CCLIM ;
 415 :   SI (EXIS TBC2.CLIM) ;
 416 :   CCGCLIM= COPI (TBC2%ACCES GCLIM) ;
 417 :   FINSI ;
 418 :   TBC2%GCLIM CCLIM ;
 419 : *LIST TBC2 ;
 420 : *    Prise en compte des quantités de minéraux demandées
 421 :  MESS 'Voulez vous vérifier la neutralité électrique ?' ;
 422 :  'OBTE' ISUITE ;
 423 : SI (EGA ISUITE 'OUI' ) ;
 424 :      IERR =    ELECNEUT TB3 TBC2 TBPAR2 ;
 425 :      'SI'  IERR ;
 426 :      IER1 =    ELECNEUT TB3 TBC2 TBPAR2 ;
 427 :      'FINS' ;
 428 : FINSI ;
 429 : *         TB4 = SPECHI2 TB3  TBC2 TBPAR2 ;
 430 :      'MESS''Voulez afficher les speciations ?' ;
 431 :      'OBTE' ISPECI ;
 432 :      IIMPI= VALE 'IMPI' ;
 433 :      IIMP1= VALE 'IMPI' ;
 434 :      SI (EGA ISPECI 'OUI' ) ;
 435 :      IIMP1= 1 ;
 436 :      'FINSI' ;
 437 :      OPTION IMPI IIMP1 ;
 438 :       TB4 = CHI2 TB3  TBC2 TBPAR2 ;
 439 :      OPTION IMPI IIMPI ;
 440 : *
 441 : NIDX= DIME(TB3.DESCHI.IDX) ;
 442 : NIDY= DIME(TB3.DESCHI.IDY) ;
 443 : REPE BOUCLI5 II3 ;
 444 : NUCLIM= EXTR LICLIM (&BOUCLI5 + NLICLIM) ;
 445 : NUCOMP3= EXTR LICOMP3 (&BOUCLI5 + NLICLIM) ;
 446 :       MO3 MO1 NU1= NOCOMCHI TB3 'NUMCOMP' NUCOMP3;
 447 :       TOT00= EXCO MO1 (TBC2%ACCES GTOT) MO1  ;
 448 :       TOT1= EXCO MO1(TB4.AQUE + TB4.FIXE ) MO1  ;
 449 :       TOT2=( TBC2%ACCES GTOT) -TOT00 + TOT1 ;
 450 :       TBC2%GTOT TOT2 ;
 451 : FIN BOUCLI5 ;
 452 : REPE BOUCLI6 II3 ;
 453 : NUCLIM= EXTR LICLIM (&BOUCLI6 + NLICLIM) ;
 454 : CONC0= EXTR LVESPC &BOUCLI6 ;
 455 :          CONC1= MANU CHPO G1 1 SCAL CONC0 ;
 456 :          REPE BDY2 NIDY ;
 457 :          NUNU1= EXTR (TB3.DESCHI.IDY) &BDY2 ;
 458 :          SI(EGA NUCLIM NUNU1) ;
 459 :          NUDY= &BDY2 ;
 460 :          QUITTER BDY2 ;
 461 :          FINSI ;
 462 :          FIN BDY2 ;
 463 :          REPE BDX2 NIDX ;
 464 :          IIDX= EXTR (TB3.DESCHI.IDX) &BDX2 ;
 465 :          MO3 MO1 NU1= NOCOMCHI TB3 'NUMCOMP' IIDX ;
 466 :          CONCX= NOMC MO1 CONC1 ;
 467 :          NUAA= NIDY*(&BDX2-1)+NUDY ;
 468 :          AAA= EXTR(TB3.DESCHI.MATRICEA) NUAA ;
 469 :          TOTO=(TBC2%ACCES GTOT)+ (AAA* CONCX) ;
 470 :          TBC2%GTOT TOTO ;
 471 :          FIN BDX2;
 472 : FIN BOUCLI6 ;
 473 :  TB3= CHI1 TB2 COMP BASE1 LOGK BASE2 ;
 474 : SI (EXIS TB2 CLIM ) ;
 475 :  SI (EXIS (TB2.CLIM) 'TYP3') ;
 476 :   TBC2%GCLIM CCGCLIM ;
 477 : * LIST TB3.IDEN.NOMTYP3 ;
 478 : * LIST (TBC2%ACCES GCLIM) ;
 479 : SINON ;
 480 :   TBC2%OUBLIER CLIM ;
 481 : FINSI ;
 482 : FINSI ;
 483 : * =========  fin du cas ou l'on fixe la concentration des minéraux
 484 : SINON ;
 485 :       NLITOT= DIME LITOT ;
 486 :      SI (NEG NLITOT 0) ;
 487 :      'REPE' BOUTOT NLITOT ;
 488 :      NUTOT= 'EXTR' LITOT &BOUTOT ;
 489 :   MO4 MO3 NU2 = NOCOMCHI TB3 'NUMCOMP' NUTOT ;
 490 :  'MESS' ' Entrez la concentration totale de ' NUTOT   MO4 ;
 491 :   'OBTE' VTOT*FLOTTANT ;
 492 :   'SI'  ('EGA' VTOT ('MOT' 'NON'))  ;
 493 :   VTOT= 0. ;
 494 :   'FINS' ;
 495 :   CTOT1=  MANU CHPO G1 1 MO3 VTOT ;
 496 :   CTOT= CTOT+CTOT1 ;
 497 :      'FIN' BOUTOT ;
 498 :  FINSI ;
 499 : * LIST CTOT   ;
 500 : *
 501 :  REPE BCTOT2 ;
 502 :   NTAB CTOT TITR 'CONCENTRATION TOTALE' ;
 503 :   LIMOT= EXTR CTOT 'COMP'  ;
 504 :  MOTOT= 'MENU' 'POUR MODIFIER UNE VALEUR CLIQUER SUR SON NOM ' LIMOT ;
 505 :  'SI' ('EGA' MOTOT 'Quitter' ) ;
 506 :  'QUIT' BCTOT2 ;
 507 :  'FINS' ;
 508 :   MO4 MO3 NU2 = NOCOMCHI TB3 'NOMINT' MOTOT ;
 509 :  'MESS' ' Entrez la concentration totale de ' NU2   MO4 ;
 510 :   'OBTE' VTOT*FLOTTANT ;
 511 :   'SI' ('NON' ('EGA' VTOT ('MOT' 'NON')))  ;
 512 :   CTOT1=  MANU CHPO G1 1 MO3 VTOT ;
 513 :   CTOT2= EXCO MO3 CTOT MO3 ;
 514 :   CTOT= CTOT+CTOT1 -CTOT2 ;
 515 :   'FINS' ;
 516 :  FIN BCTOT2  ;
 517 : *
 518 :   TBC2%GTOT CTOT ;
 519 : *OUBLIE TBB2 ;
 520 : * ===================  fin de la lecture des concentrations totales
 521 : FINSI ;
 522 : FINSI ;
 523 : *
 524 : *
 525 : * ================ boucle infinie
 526 :  'REPE' BOUINF  ;
 527 : *
 528 :  MESS 'Voulez vous vérifier la neutralité électrique ?' ;
 529 :  'OBTE' ISUITE ;
 530 : SI (EGA ISUITE 'QUIT' ) ;
 531 : QUITTER BOUINF ;
 532 : FINSI ;
 533 : SI (EGA ISUITE 'OUI' ) ;
 534 :      IERR =    ELECNEUT TB3 TBC2 TBPAR2 ;
 535 :      'SI'  IERR ;
 536 :      IER1 =    ELECNEUT TB3 TBC2 TBPAR2 ;
 537 :      'FINS' ;
 538 : FINSI ;
 539 : *         TB4 = SPECHI2 TB3  TBC2 TBPAR2 ;
 540 :     'MESS''Voulez afficher les speciations ?' ;
 541 :     'OBTE' ISPECI ;
 542 :     IIMPI= VALE 'IMPI' ;
 543 :     IIMP1= VALE 'IMPI' ;
 544 :     SI (EGA ISPECI 'OUI' ) ;
 545 :     IIMP1= 1 ;
 546 :     'FINSI' ;
 547 :     OPTION IMPI IIMP1 ;
 548 :      TB4 = CHI2 TB3  TBC2 TBPAR2 ;
 549 :     OPTION IMPI IIMPI ;
 550 : *
 551 : * ===========    on prend en compte le dernier LOGC calculé
 552 : TBC2%GLOGC (TB4.LOGC) ;
 553 : *  ==========
 554 : *  ==========   cas ou il y a des contraintes
 555 : SI (EXIS TB2 CLIM ) ;
 556 : SI (EXIS (TB2.CLIM )  'TYP3');
 557 : MESS 'Voulez vous que les contraintes fixées soient prises en compte'
 558 :  ' dans les valeurs des totaux ?' ;
 559 : 'OBTE' ICCT ;
 560 : SI(EGA ICCT 'QUIT') ;
 561 : QUITTER BOUINF ;
 562 : FINSI ;
 563 : 'SI' ('EGA' ICCT 'OUI') ;
 564 :  NLICLIM=DIME(TB2.CLIM.TYP3) ;
 565 :  TB00= OBJET DONCHI1 ;
 566 :  TB00%GIDEN (TB2%ACCES GIDEN) ;
 567 :  TB0= CHI1 TB00 COMP BASE1 LOGK BASE2 ;
 568 :       SI (EXIS TB0.IDEN PRECI) ;
 569 :            NBTYP5= DIME ( TB0.IDEN.PRECI) ;
 570 :       FINSI ;
 571 :     NIDX= DIME(TB3.DESCHI.IDX) ;
 572 :     NIDY= DIME(TB3.DESCHI.IDY) ;
 573 : *   mess 'VALEUR INITIALE DE TOT ' ; LIST  ( TBC2%ACCES GTOT) ;
 574 : *   MESS ' TB4 AQUE ' ; LIST TB4.AQUE ;
 575 : *   MESS ' TB4 FIXE ' ; LIST TB4.FIXE ;
 576 :     IP99=FAUX ;
 577 : REPE BBCLIM NLICLIM ;
 578 :    NUCLIM=EXTR (TB2.CLIM.TYP3) &BBCLIM ;
 579 :    SI (NUCLIM < 201) ;
 580 :       MO3 MO1 NU1= NOCOMCHI TB3 'NUMCOMP' NUCLIM ;
 581 :       TOT00= EXCO MO1 (TBC2%ACCES GTOT) MO1  ;
 582 :       TOT1= EXCO MO1(TB4.AQUE + TB4.FIXE ) MO1  ;
 583 :       TOT2=( TBC2%ACCES GTOT) -TOT00 + TOT1 ;
 584 :       TBC2%GTOT TOT2 ;
 585 :       SI (EGA NUCLIM 99) ;
 586 :           IP99=VRAI ;
 587 :       FINSI ;
 588 :    SINON ;
 589 :       NUCOMP3=EXTR (TB2.CLIM.COMP3) &BBCLIM ;
 590 :       MO3 MO1 NU1= NOCOMCHI TB3 'NUMCOMP' NUCOMP3;
 591 :       TOT00= EXCO MO1 (TBC2%ACCES GTOT) MO1  ;
 592 :       TOT1= EXCO MO1(TB4.AQUE + TB4.FIXE ) MO1  ;
 593 :       TOT2=( TBC2%ACCES GTOT) -TOT00 + TOT1 ;
 594 :       TBC2%GTOT TOT2 ;
 595 :    FINSI ;
 596 : FIN BBCLIM ;
 597 : *     MO1 NU1 = NOESPCHI TB3 NUCLIM ;
 598 : REPE B2CLIM NLICLIM ;
 599 :    NUCLIM=EXTR (TB2.CLIM.TYP3) &B2CLIM ;
 600 :       SI (EXIS TB0.IDEN PRECI) ;
 601 :       ICTYP5= DIME ( TB0.IDEN.PRECI SAUF (LECT NUCLIM)) ;
 602 :       SI (NON (EGA ICTYP5 NBTYP5)) ;
 603 :          MESS ' Entrez la quantité de minéral voulu pour ' NUCLIM ;
 604 :          OBTE CONC0*FLOTTANT ;
 605 :          CONC1= MANU CHPO G1 1 SCAL CONC0 ;
 606 :          REPE BDY NIDY ;
 607 :          NUNU1= EXTR (TB3.DESCHI.IDY) &BDY ;
 608 :          SI(EGA NUCLIM NUNU1) ;
 609 :          NUDY= &BDY ;
 610 :          QUITTER BDY ;
 611 :          FINSI ;
 612 :          FIN BDY ;
 613 :          REPE BDX NIDX ;
 614 :          IIDX= EXTR (TB3.DESCHI.IDX) &BDX ;
 615 :          MO3 MO1 NU1= NOCOMCHI TB3 'NUMCOMP' IIDX ;
 616 :          CONCX= NOMC MO1 CONC1 ;
 617 :          NUAA= NIDY*(&BDX-1)+NUDY ;
 618 :          AAA= EXTR(TB3.DESCHI.MATRICEA) NUAA ;
 619 :          TOTO=(TBC2%ACCES GTOT)+ (AAA* CONCX) ;
 620 :          TBC2%GTOT TOTO ;
 621 :          FIN BDX ;
 622 :       FINSI ;
 623 :       FINSI ;
 624 : FIN B2CLIM ;
 625 : *   mess 'VALEUR FINALE DE TOT ' ; LIST  ( TBC2%ACCES GTOT) ;
 626 : SI (EXIS (TB2.CLIM) COMP3 ) ;
 627 : TB2.CLIM%OUBLIER COMP3 ;
 628 : FINSI ;
 629 : TB2.CLIM%OUBLIER TYP3 ;
 630 : TBC2%OUBLIER CLIM ;
 631 : IDET= VRAI ;
 632 : SI IP99 ;
 633 : SI(EXIS(TB2.CLIM) TYP6) ;
 634 :    LILI= INSE (TB2.CLIM.TYP6) 1 99 ;
 635 :    TB2%GCLIM TYP6 LILI ;
 636 : SINON ;
 637 :    TB2%GCLIM TYP6 (LECT 99) ;
 638 : FINSI ;
 639 : FINSI ;
 640 : SI (EXIS (TB2.CLIM) TYP4);
 641 : IDET= FAUX ;
 642 : FINSI ;
 643 : SI (EXIS (TB2.CLIM) TYP5);
 644 : IDET= FAUX ;
 645 : FINSI ;
 646 : SI (EXIS (TB2.CLIM) TYP6);
 647 : IDET= FAUX ;
 648 : FINSI ;
 649 : SI IDET ;
 650 : TB2%OUBLIER CLIM ;
 651 : FINSI ;
 652 : ******
 653 :  MESS 'Voulez vous afficher l activité de certaines espèces ?' ;
 654 :  'OBTE' ISUITE ;
 655 : SI(EGA ISUITE 'QUIT') ;
 656 : QUITTER BOUINF ;
 657 : FINSI ;
 658 : SI (EGA ISUITE 'OUI' ) ;
 659 :  'MESS' ' entrez la liste de ces espèces' ;
 660 : OBTE  LICALA*LISTENTI ;
 661 :  CHPACT= CALACTIV TB3 TB4 LICALA;
 662 : 
 663 :   NTAB CHPACT TITR 'Activité' ;
 664 : FINSI ;
 665 : ******
 666 : 'MESS''Voulez vous afficher le contenu actuel de l objet CHIMI1 ?' ;
 667 : 'OBTE' IAFFI ;
 668 :         TB3='CHI1' TB2 'COMP' BASE1 'LOGK' BASE2  ;
 669 :         'SI' ('EGA' IAFFI 'OUI') ;
 670 :          IMPCHI1 TB3 'TB3' ;
 671 :          'FINS' ;
 672 : SI(EGA IAFFI 'QUIT') ;
 673 : QUITTER BOUINF ;
 674 : FINSI ;
 675 : *TB4 = SPECHI2 TB3  TBC2 TBPAR2 ;
 676 : **
 677 : 'MESS''Voulez afficher les speciations ?' ;
 678 : 'OBTE' ISPECI ;
 679 : IIMPI= VALE 'IMPI' ;
 680 : IIMP1= VALE 'IMPI' ;
 681 : SI (EGA ISPECI 'OUI' ) ;
 682 : IIMP1= 1 ;
 683 : 'FINSI' ;
 684 : OPTION IMPI IIMP1 ;
 685 :  TB4 = CHI2 TB3  TBC2 TBPAR2 ;
 686 : OPTION IMPI IIMPI ;
 687 : **
 688 : ******
 689 :  MESS 'Voulez vous afficher l activité de certaines espèces ?' ;
 690 :  'OBTE' ISUITE ;
 691 : SI(EGA ISUITE 'QUIT') ;
 692 : QUITTER BOUINF ;
 693 : FINSI ;
 694 : SI (EGA ISUITE 'OUI' ) ;
 695 :  'MESS' ' entrez la liste de ces espèces' ;
 696 : OBTE  LICALA*LISTENTI ;
 697 :  CHPACT= CALACTIV TB3 TB4 LICALA;
 698 :   NTAB CHPACT TITR 'Activité' ;
 699 : FINSI ;
 700 : ******
 701 :  MESS 'Voulez vous vérifier la neutralité électrique ? ' ;
 702 :  'OBTE' ISUITE ;
 703 : SI(EGA ISUITE 'QUIT') ;
 704 : QUITTER BOUINF ;
 705 : FINSI ;
 706 : SI (EGA ISUITE 'OUI' ) ;
 707 :      IERR =    ELECNEUT TB3 TBC2 TBPAR2 ;
 708 :      'SI'  IERR ;
 709 :      IER1 =    ELECNEUT TB3 TBC2 TBPAR2 ;
 710 :      FINSI
 711 : *TB4 = SPECHI2 TB3  TBC2 TBPAR2 ;
 712 : **
 713 : 'MESS''Voulez afficher les speciations ?' ;
 714 : 'OBTE' ISPECI ;
 715 : IIMPI= VALE 'IMPI' ;
 716 : IIMP1= VALE 'IMPI' ;
 717 : SI (EGA ISPECI 'OUI' ) ;
 718 : IIMP1= 1 ;
 719 : 'FINSI' ;
 720 : OPTION IMPI IIMP1 ;
 721 :  TB4 = CHI2 TB3  TBC2 TBPAR2 ;
 722 : OPTION IMPI IIMPI ;
 723 : **
 724 : ******
 725 :  MESS 'Voulez vous afficher l activité de certaines espèces ?' ;
 726 :  'OBTE' ISUITE ;
 727 : SI(EGA ISUITE 'QUIT') ;
 728 : QUITTER BOUINF ;
 729 : FINSI ;
 730 : SI (EGA ISUITE 'OUI' ) ;
 731 :  'MESS' ' entrez la liste de ces espèces' ;
 732 : OBTE  LICALA*LISTENTI ;
 733 :  CHPACT= CALACTIV TB3 TB4 LICALA;
 734 :   NTAB CHPACT TITR 'Activité' ;
 735 : FINSI ;
 736 : ******
 737 : FINSI ;
 738 : FINSI ;
 739 : FINSI ;
 740 : *LIST TBC2 ;
 741 : *INICHI2 TB3 TBC2 ;
 742 : *TB4 = SPECHI2 TB3  TBC2 TBPAR2 ;
 743 : 'MESS''Voulez afficher les speciations ?' ;
 744 : 'OBTE' ISPECI ;
 745 : IIMPI= VALE 'IMPI' ;
 746 : IIMP1= VALE 'IMPI' ;
 747 : SI (EGA ISPECI 'OUI' ) ;
 748 : IIMP1= 1 ;
 749 : 'FINSI' ;
 750 : OPTION IMPI IIMP1 ;
 751 :  TB4 = CHI2 TB3  TBC2 TBPAR2 ;
 752 : OPTION IMPI IIMPI ;
 753 : 'MESS''Voulez vous modifier DONCHI1 ? ' ;
 754 : 'OBTE' ISUITE ;
 755 : SI(EGA ISUITE 'QUIT') ;
 756 : QUITTER BOUINF ;
 757 : FINSI ;
 758 : SI (EGA ISUITE 'OUI' ) ;
 759 :   INICHI1 TB2  BASE1  BASE2 ;
 760 : *LIST LICOMP ;
 761 : 'MESS''Voulez vous afficher le contenu actuel de l objet CHIMI1 ?' ;
 762 : 'OBTE' IAFFI ;
 763 :         TB3='CHI1' TB2 'COMP' BASE1 'LOGK' BASE2  ;
 764 :         'SI' ('EGA' IAFFI 'OUI') ;
 765 :          IMPCHI1 TB3 'TB3' ;
 766 :          'FINS' ;
 767 : 'FINSI' ;
 768 : SI(EGA IAFFI 'QUIT') ;
 769 : QUITTER BOUINF ;
 770 : FINSI ;
 771 : *LIST TBC2 ;
 772 : INICHI2 TB3 TBC2 ;
 773 : *TB4 = SPECHI2 TB3  TBC2 TBPAR2 ;
 774 : 'MESS''Voulez afficher les speciations ?' ;
 775 : 'OBTE' ISPECI ;
 776 : IIMPI= VALE 'IMPI' ;
 777 : IIMP1= VALE 'IMPI' ;
 778 : SI (EGA ISPECI 'OUI' ) ;
 779 : IIMP1= 1 ;
 780 : 'FINSI' ;
 781 : OPTION IMPI IIMP1 ;
 782 :  TB4 = CHI2 TB3  TBC2 TBPAR2 ;
 783 : OPTION IMPI IIMPI ;
 784 : 'MESS''Voulez vous arreter le calcul ?' ;
 785 : 'OBTE' ISUITE ;
 786 : SI (EGA ISUITE 'OUI' ) ;
 787 : 'QUITTER' BOUINF ;
 788 : 'FINSI' ;
 789 : SI(EGA ISUITE 'QUIT') ;
 790 : QUITTER BOUINF ;
 791 : FINSI ;
 792 : FINSI ;
 793 :  'FIN' BOUINF ;
 794 :            FINP TB2 TB3 TBC2 ;
 795 : 
 796 : 
 797 :  

© Cast3M 2003 - All rights reserved.
Disclaimer