1 : C CHMPAR SOURCE CHAT 05/01/12 21:59:45 5004 2 : SUBROUTINE CHMPAR(EPS,ITMAX,ISOLM,IAFFI,PRECPE,NITEPE,NFI,IFIONI, 3 : *IZTYP4,IZTEMP,IZLOGC,IZTOT,IZCLIM,MLMSOR,DE,MAXDE,MLIMPR,ICALCLOG) 4 : C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 5 : C 6 : C OPERATEUR CHI2 7 : C ON DECODE LES TABLE CONTENANT LES DONNNES ET LES PARAMETRES DE CALCUL 8 : C 9 : C modif Phm: prise ne compte d'un idicateur pour les calculs 10 : c en log de concentration 11 : C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 12 : IMPLICIT INTEGER(I-N) 13 : IMPLICIT REAL*8(A-H,O-Z) 14 : -INC CCOPTIO 15 : -INC SMTABLE 16 : -INC SMLENTI 17 : CHARACTER*8 MTYPI,CHARI,MTYPR,CHARR 18 : LOGICAL LOGRE 19 : C 20 : C ON RECUPERE LES OBJETS OU TABLES 21 : IRETOU=0 22 : MTAB1=0 22 : CALL LIRTAB('DONNEES_CHIMIQUES',MTAB1,0,IRETOU) 23 : IRETO2=0 24 : MTAB2=0 24 : CALL LIROBJ('TABLE',MTAB2,0,IRETO2) 25 : IF(IRETO2.EQ.1)SEGACT MTAB2 26 : IF(IRETOU.EQ.0)THEN 26 : CALL LIROBJ('OBJET',MTAB3,1,IRETO1) 27 : IF(IRETO1.EQ.0)RETURN 28 : SEGACT MTAB3 29 : IVALI=1 30 : XVALI=0.D0 31 : IRETI=0 32 : IVALR=0 33 : XVALR=0.D0 34 : IRETR=0 35 : MTYPI='MOT ' 36 : MTYPR='MOT ' 37 : CHARR=' ' 37 : CALL ACCTAB(MTAB3,MTYPI,IVALI,XVALI,'CLASSE',.TRUE.,IRETI, 38 : * MTYPR,IVALR,XVALR,CHARR,LOGRE,IRETR) 39 : IF(IERR.NE.0)RETURN 40 : IF(CHARR.EQ.'PARMCHI2')THEN 41 : MTAB2=MTAB3 42 : ELSEIF(CHARR.EQ.'DONCHI2 ')THEN 43 : MTAB1=MTAB3 44 : ELSE 44 : CALL ERREUR(21) 45 : RETURN 46 : ENDIF 46 : CALL LIROBJ('OBJET',MTAB3,0,IRETO1) 47 : IF(IRETO1.EQ.1)THEN 48 : SEGACT MTAB3 49 : IVALI=1 50 : XVALI=0.D0 51 : IRETI=0 52 : IVALR=0 53 : XVALR=0.D0 54 : IRETR=0 55 : MTYPI='MOT ' 56 : MTYPR='MOT ' 57 : CHARR=' ' 57 : CALL ACCTAB(MTAB3,MTYPI,IVALI,XVALI,'CLASSE',.TRUE.,IRETI, 58 : * MTYPR,IVALR,XVALR,CHARR,LOGRE,IRETR) 59 : IF(IERR.NE.0)RETURN 60 : IF(CHARR.EQ.'PARMCHI2')THEN 61 : MTAB2=MTAB3 62 : ELSEIF(CHARR.EQ.'DONCHI2 ')THEN 63 : MTAB1=MTAB3 64 : ELSE 64 : CALL ERREUR(21) 65 : RETURN 66 : ENDIF 67 : ENDIF 68 : ENDIF 69 : C 70 : C LECTURE DES DONNEES CHIMIQUES 71 : IVALI=1 72 : XVALI=0.D0 73 : IRETI=0 74 : IVALR=0 75 : XVALR=0.D0 76 : IRETR=0 77 : MTYPI='MOT ' 78 : MTYPR=' ' 79 : CHARR=' ' 80 : IFIONI=0 80 : CALL ACCTAB(MTAB1,MTYPI,IVALI,XVALI,'FIONI',.TRUE.,IRETI, 81 : * MTYPR,IVALR,XVALR,CHARR,LOGRE,IRETR) 82 : IF(MTYPR.NE.' ')THEN 83 : IF(MTYPR.EQ.'CHPOINT ')THEN 84 : IFIONI=IRETR 85 : ELSE 86 : MOTERR(1:11)='FIONI ' 87 : MOTERR(12:20)='CHPOINT ' 87 : CALL ERREUR(627) 88 : RETURN 89 : ENDIF 90 : ENDIF 91 : IVALI=1 92 : XVALI=0.D0 93 : IRETI=0 94 : IVALR=0 95 : XVALR=0.D0 96 : IRETR=0 97 : MTYPI='MOT ' 98 : MTYPR=' ' 99 : CHARR=' ' 100 : IZTYP4=0 100 : CALL ACCTAB(MTAB1,MTYPI,IVALI,XVALI,'NTY4',.TRUE.,IRETI, 101 : * MTYPR,IVALR,XVALR,CHARR,LOGRE,IRETR) 102 : IF(MTYPR.NE.' ')THEN 103 : IF(MTYPR.EQ.'CHPOINT ')THEN 104 : IZTYP4=IRETR 105 : ELSE 106 : MOTERR(1:11)='NTYP4 ' 107 : MOTERR(12:20)='CHPOINT ' 107 : CALL ERREUR(627) 108 : RETURN 109 : ENDIF 110 : ENDIF 111 : IVALI=1 112 : XVALI=0.D0 113 : IRETI=0 114 : IVALR=0 115 : XVALR=0.D0 116 : IRETR=0 117 : MTYPI='MOT ' 118 : MTYPR=' ' 119 : CHARR=' ' 120 : IZTEMP=0 120 : CALL ACCTAB(MTAB1,MTYPI,IVALI,XVALI,'TEMPE',.TRUE.,IRETI, 121 : * MTYPR,IVALR,XVALR,CHARR,LOGRE,IRETR) 122 : IF(MTYPR.NE.' ')THEN 123 : IF(MTYPR.EQ.'CHPOINT ')THEN 124 : IZTEMP=IRETR 125 : ELSE 126 : MOTERR(1:11)='TEMPE ' 127 : MOTERR(12:20)='CHPOINT ' 127 : CALL ERREUR(627) 128 : RETURN 129 : ENDIF 130 : ENDIF 131 : IVALI=1 132 : XVALI=0.D0 133 : IRETI=0 134 : IVALR=0 135 : XVALR=0.D0 136 : IRETR=0 137 : MTYPI='MOT ' 138 : MTYPR=' ' 139 : CHARR=' ' 140 : IZCLIM=0 140 : CALL ACCTAB(MTAB1,MTYPI,IVALI,XVALI,'CLIM',.TRUE.,IRETI, 141 : * MTYPR,IVALR,XVALR,CHARR,LOGRE,IRETR) 142 : IF(MTYPR.NE.' ')THEN 143 : IF(MTYPR.EQ.'CHPOINT ')THEN 144 : IZCLIM=IRETR 145 : ELSE 146 : MOTERR(1:11)='CLIM ' 147 : MOTERR(12:20)='CHPOINT ' 147 : CALL ERREUR(627) 148 : RETURN 149 : ENDIF 150 : ENDIF 151 : IVALI=1 152 : XVALI=0.D0 153 : IRETI=0 154 : IVALR=0 155 : XVALR=0.D0 156 : IRETR=0 157 : MTYPI='MOT ' 158 : MTYPR='CHPOINT ' 159 : CHARR=' ' 159 : CALL ACCTAB(MTAB1,MTYPI,IVALI,XVALI,'LOGC',.TRUE.,IRETI, 160 : * MTYPR,IVALR,XVALR,CHARR,LOGRE,IRETR) 161 : IF(IERR.NE.0)RETURN 162 : IZLOGC=IRETR 163 : IVALI=1 164 : XVALI=0.D0 165 : IRETI=0 166 : IVALR=0 167 : XVALR=0.D0 168 : IRETR=0 169 : MTYPI='MOT ' 170 : MTYPR='CHPOINT ' 171 : CHARR=' ' 171 : CALL ACCTAB(MTAB1,MTYPI,IVALI,XVALI,'TOT',.TRUE.,IRETI, 172 : * MTYPR,IVALR,XVALR,CHARR,LOGRE,IRETR) 173 : IF(IERR.NE.0)RETURN 174 : IZTOT=IRETR 175 : SEGDES MTAB1 176 : C INITIALISATION DES PARAMETRES 177 : EPS=1.D-4 178 : ITMAX=20 179 : ISOLM=10 180 : IAFFI=2 181 : PRECPE=1.D-10 182 : DE=1.D0 183 : MAXDE=20 184 : NITEPE=50 185 : NFI=4 186 : MLIMPR=0 187 : MLMSOR=0 188 : ICALCLOG=0 189 : C LECTURES DES PARAMETRES 190 : IF(MTAB2.EQ.0)RETURN 191 : IVALI=1 192 : XVALI=0.D0 193 : IRETI=0 194 : IVALR=0 195 : XVALR=0.D0 196 : IRETR=0 197 : MTYPI='MOT ' 198 : MTYPR=' ' 199 : CHARR=' ' 199 : CALL ACCTAB(MTAB2,MTYPI,IVALI,XVALI,'EPS',.TRUE.,IRETI, 200 : * MTYPR,IVALR,XVALR,CHARR,LOGRE,IRETR) 201 : IF(MTYPR.NE.' ')THEN 202 : IF(MTYPR.EQ.'FLOTTANT')THEN 203 : EPS=XVALR 204 : ELSE 205 : MOTERR(1:11)='EPS ' 206 : MOTERR(12:20)='FLOTTANT' 206 : CALL ERREUR(627) 207 : RETURN 208 : ENDIF 209 : ENDIF 210 : IVALR=0 211 : XVALR=0.D0 212 : IRETR=0 213 : MTYPI='MOT ' 214 : MTYPR=' ' 215 : CHARR=' ' 215 : CALL ACCTAB(MTAB2,MTYPI,IVALI,XVALI,'ITMAX',.TRUE.,IRETI, 216 : * MTYPR,IVALR,XVALR,CHARR,LOGRE,IRETR) 217 : IF(MTYPR.NE.' ')THEN 218 : IF(MTYPR.EQ.'ENTIER ')THEN 219 : ITMAX=IVALR 220 : ELSE 221 : MOTERR(1:11)='ITMAX ' 222 : MOTERR(12:20)='ENTIER ' 222 : CALL ERREUR(627) 223 : RETURN 224 : ENDIF 225 : ENDIF 226 : IVALR=0 227 : XVALR=0.D0 228 : IRETR=0 229 : MTYPI='MOT ' 230 : MTYPR=' ' 231 : CHARR=' ' 231 : CALL ACCTAB(MTAB2,MTYPI,IVALI,XVALI,'ITERSOLI',.TRUE.,IRETI, 232 : * MTYPR,IVALR,XVALR,CHARR,LOGRE,IRETR) 233 : IF(MTYPR.NE.' ')THEN 234 : IF(MTYPR.EQ.'ENTIER ')THEN 235 : ISOLM=IVALR 236 : ELSE 237 : MOTERR(1:11)='ITERSOLI ' 238 : MOTERR(12:20)='ENTIER ' 238 : CALL ERREUR(627) 239 : RETURN 240 : ENDIF 241 : ENDIF 242 : IVALR=0 243 : XVALR=0.D0 244 : IRETR=0 245 : MTYPI='MOT ' 246 : MTYPR=' ' 247 : CHARR=' ' 247 : CALL ACCTAB(MTAB2,MTYPI,IVALI,XVALI,'IAFFICHE',.TRUE.,IRETI, 248 : * MTYPR,IVALR,XVALR,CHARR,LOGRE,IRETR) 249 : IF(MTYPR.NE.' ')THEN 250 : IF(MTYPR.EQ.'ENTIER ')THEN 251 : IAFFI=IVALR 252 : ELSE 253 : MOTERR(1:11)='AFFICHE ' 254 : MOTERR(12:20)='ENTIER ' 254 : CALL ERREUR(627) 255 : RETURN 256 : ENDIF 257 : ENDIF 258 : IVALI=1 259 : XVALI=0.D0 260 : IRETI=0 261 : IVALR=0 262 : XVALR=0.D0 263 : IRETR=0 264 : MTYPI='MOT ' 265 : MTYPR=' ' 266 : CHARR=' ' 266 : CALL ACCTAB(MTAB2,MTYPI,IVALI,XVALI,'PRECPE',.TRUE.,IRETI, 267 : * MTYPR,IVALR,XVALR,CHARR,LOGRE,IRETR) 268 : IF(MTYPR.NE.' ')THEN 269 : IF(MTYPR.EQ.'FLOTTANT')THEN 270 : PRECPE=XVALR 271 : ELSE 272 : MOTERR(1:11)='PRECPE ' 273 : MOTERR(12:20)='FLOTTANT' 273 : CALL ERREUR(627) 274 : RETURN 275 : ENDIF 276 : ENDIF 277 : IVALI=1 278 : XVALI=0.D0 279 : IRETI=0 280 : IVALR=0 281 : XVALR=0.D0 282 : IRETR=0 283 : MTYPI='MOT ' 284 : MTYPR=' ' 285 : CHARR=' ' 285 : CALL ACCTAB(MTAB2,MTYPI,IVALI,XVALI,'DELPE',.TRUE.,IRETI, 286 : * MTYPR,IVALR,XVALR,CHARR,LOGRE,IRETR) 287 : IF(MTYPR.NE.' ')THEN 288 : IF(MTYPR.EQ.'FLOTTANT')THEN 289 : DE=XVALR 290 : ELSE 291 : MOTERR(1:11)='DE ' 292 : MOTERR(12:20)='FLOTTANT' 292 : CALL ERREUR(627) 293 : RETURN 294 : ENDIF 295 : ENDIF 296 : IVALR=0 297 : XVALR=0.D0 298 : IRETR=0 299 : MTYPI='MOT ' 300 : MTYPR=' ' 301 : CHARR=' ' 301 : CALL ACCTAB(MTAB2,MTYPI,IVALI,XVALI,'MDELPE',.TRUE.,IRETI, 302 : * MTYPR,IVALR,XVALR,CHARR,LOGRE,IRETR) 303 : IF(MTYPR.NE.' ')THEN 304 : IF(MTYPR.EQ.'ENTIER ')THEN 305 : MAXDE=IVALR 306 : ELSE 307 : MOTERR(1:11)='MDELPE ' 308 : MOTERR(12:20)='ENTIER ' 308 : CALL ERREUR(627) 309 : RETURN 310 : ENDIF 311 : ENDIF 312 : IVALR=0 313 : XVALR=0.D0 314 : IRETR=0 315 : MTYPI='MOT ' 316 : MTYPR=' ' 317 : CHARR=' ' 317 : CALL ACCTAB(MTAB2,MTYPI,IVALI,XVALI,'NITERPE',.TRUE.,IRETI, 318 : * MTYPR,IVALR,XVALR,CHARR,LOGRE,IRETR) 319 : IF(MTYPR.NE.' ')THEN 320 : IF(MTYPR.EQ.'ENTIER ')THEN 321 : NITEPE=IVALR 322 : ELSE 323 : MOTERR(1:11)='NITERPE ' 324 : MOTERR(12:20)='ENTIER ' 324 : CALL ERREUR(627) 325 : RETURN 326 : ENDIF 327 : ENDIF 328 : IVALR=0 329 : XVALR=0.D0 330 : IRETR=0 331 : MTYPI='MOT ' 332 : MTYPR=' ' 333 : CHARR=' ' 333 : CALL ACCTAB(MTAB2,MTYPI,IVALI,XVALI,'NFI',.TRUE.,IRETI, 334 : * MTYPR,IVALR,XVALR,CHARR,LOGRE,IRETR) 335 : IF(MTYPR.NE.' ')THEN 336 : IF(MTYPR.EQ.'ENTIER ')THEN 337 : NFI=IVALR 338 : ELSE 339 : MOTERR(1:11)='NFI ' 340 : MOTERR(12:20)='ENTIER ' 340 : CALL ERREUR(627) 341 : RETURN 342 : ENDIF 343 : ENDIF 344 : IVALI=1 345 : XVALI=0.D0 346 : IRETI=0 347 : IVALR=0 348 : XVALR=0.D0 349 : IRETR=0 350 : MTYPI='MOT ' 351 : MTYPR=' ' 352 : CHARR=' ' 352 : CALL ACCTAB(MTAB2,MTYPI,IVALI,XVALI,'SORTIE',.TRUE.,IRETI, 353 : * MTYPR,IVALR,XVALR,CHARR,LOGRE,IRETR) 354 : IF(MTYPR.NE.' ')THEN 355 : IF(MTYPR.EQ.'LISTMOTS')THEN 356 : MLMSOR=IRETR 357 : ELSE 358 : MOTERR(1:11)='SORTIE ' 359 : MOTERR(12:20)='LISTMOTS' 359 : CALL ERREUR(627) 360 : RETURN 361 : ENDIF 362 : ENDIF 363 : IVALI=1 364 : XVALI=0.D0 365 : IRETI=0 366 : IVALR=0 367 : XVALR=0.D0 368 : IRETR=0 369 : MTYPI='MOT ' 370 : MTYPR=' ' 371 : CHARR=' ' 371 : CALL ACCTAB(MTAB2,MTYPI,IVALI,XVALI,'CALCLOG',.TRUE.,IRETI, 372 : * MTYPR,IVALR,XVALR,CHARR,LOGRE,IRETR) 373 : IF(MTYPR.NE.' ')THEN 374 : IF(MTYPR.EQ.'ENTIER ')THEN 375 : ICALCLOG =IVALR 376 : ELSE 377 : MOTERR(1:11)='ICALCLOG ' 378 : MOTERR(12:20)='ENTIER ' 378 : CALL ERREUR(627) 379 : RETURN 380 : ENDIF 381 : ENDIF 382 : 383 : IF(IIMPI.GT.0)THEN 384 : IVALI=1 385 : XVALI=0.D0 386 : IRETI=0 387 : IVALR=0 388 : XVALR=0.D0 389 : IRETR=0 390 : MTYPI='MOT ' 391 : MTYPR=' ' 392 : CHARR=' ' 392 : CALL ACCTAB(MTAB2,MTYPI,IVALI,XVALI,'IMPRIM',.TRUE.,IRETI, 393 : * MTYPR,IVALR,XVALR,CHARR,LOGRE,IRETR) 394 : IF(MTYPR.NE.' ')THEN 395 : IF(MTYPR.EQ.'LISTENTI')THEN 396 : MLIMPR=IRETR 397 : MLENTI=IRETR 398 : SEGACT MLENTI 399 : ELSE 400 : MOTERR(1:11)='IMPRIM ' 401 : MOTERR(12:20)='LISTENTI' 401 : CALL ERREUR(627) 402 : RETURN 403 : ENDIF 404 : ENDIF 405 : ENDIF 406 : SEGDES MTAB2 407 : RETURN 408 : END 409 : 410 : 411 : 412 : 413 : 414 : 415 : 416 : 417 :
© Cast3M 2003 - All rights reserved.
Disclaimer