Télécharger chmpar.eso

Retour à la liste

Numérotation des lignes :

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

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