Télécharger chmpar.eso

Retour à la liste

Numérotation des lignes :

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

© Cast3M 2003 - Tous droits réservés.
Mentions légales