Télécharger chired.eso

Retour à la liste

Numérotation des lignes :

  1. C CHIRED SOURCE CHAT 05/01/12 21:57:59 5004
  2. SUBROUTINE CHIRED(IDSCHI,MTAB1,MTAB2,IZIADR,IADH,MLENT3,LIMP3)
  3. IMPLICIT INTEGER(I-N)
  4. IMPLICIT REAL*8 (A-H,O-Z)
  5. C------------------------------------------------------------------
  6. C
  7. C CHARGEMENT DES TABLES IDEN ET REDOX
  8. C MTAB1 = POINTEUR TABLE IDEN
  9. C MTAB2 = POINTEUR TABLE REDOX
  10. C = 0 EN ENTREE
  11. C MLENT3= POINTEUR DES COMPOSANTS IMMOBILES POUR
  12. C LES CONDITIONS AUX LIMITES DES TYPE 3
  13. C ( LU ET VERIFIE DANS CHICLM ,PEUT ETRE NUL)
  14. C LIMP3 = POINTEUR DE LA LISTE DES ESPECES MISES EN
  15. C TYP3 PAR CLIM ( TAB1.CLIM.TYP3)
  16. C
  17. C------------------------------------------------------------------
  18. -INC SMTABLE
  19. -INC SMLENTI
  20. -INC SMLREEL
  21. -INC SMLMOTS
  22. -INC CCOPTIO
  23. SEGMENT IDSCHI
  24. REAL*8 GK(NYDIM),AA(NYDIM,NXDIM),FF(NZDIM,NPDIM)
  25. INTEGER IDX(NXDIM),IDY(NYDIM),IDZ(NZDIM),IDP(NPDIM),NN(6)
  26. INTEGER IDECY(NYDIM),IONZ(NXDIM)
  27. CHARACTER*32 NAME(NXDIM),NAMESP(NYDIM)
  28. ENDSEGMENT
  29. SEGMENT IZIADR
  30. INTEGER IADR(NCR)
  31. ENDSEGMENT
  32. SEGMENT IZRED
  33. INTEGER ITAB(NCR,2)
  34. REAL*8 ATAB(NCR,2)
  35. ENDSEGMENT
  36. SEGMENT IZREDI
  37. INTEGER IRCR(MCR),ICR(LCR)
  38. ENDSEGMENT
  39. SEGMENT IZIMM
  40. INTEGER IADE(NCE),IADC(NCC),IMM(NIMM)
  41. ENDSEGMENT
  42. SEGMENT IZRIAD
  43. INTEGER IRAD(NIRA),ICONS(NXDIM)
  44. ENDSEGMENT
  45. SEGMENT IZSS
  46. INTEGER ISOLU(NYDIM),ISURF(NYDIM)
  47. ENDSEGMENT
  48. CHARACTER*8 MTYPI,CHARI,MTYPR,CHARR
  49. C
  50. C CHITRI1 CREE ET CHARGE IZIADR et IADH
  51. IZRED=0
  52. IZREDI=0
  53. IF(IZIADR.NE.0)THEN
  54. C CHITRI CREE ET CHARGE IZRED
  55. CALL CHITRI(IDSCHI,IZIADR,IZRED,IZREDI)
  56. ENDIF
  57. NXDIM=IDX(/1)
  58. NYDIM=IDY(/1)
  59. NZDIM=IDZ(/1)
  60. NPDIM=IDP(/1)
  61. JSOH=0
  62. NCE=NN(3)
  63. NCC=NN(3)
  64. NIRA=NXDIM
  65. NIMM=NXDIM
  66. SEGINI IZIMM ,IZRIAD
  67. C ON VA METTRE DANS IRAD UN INDICE POUR CHAQUE
  68. C COMPOSANT 3=IMMOBILE 2=REACTIFS 1=CONSERVATIF
  69. CALL INITI(IRAD,NIRA,2)
  70. C TRI RELATION TYP3
  71. NCE=0
  72. NCC=0
  73. JI=NN(1)+NN(2)+1
  74. JM= NN(1)+NN(2)+NN(3)
  75. DO 20 JJ=JI,JM
  76. DO 10 J=1,NXDIM
  77. IF (IDX(J).EQ.IDY(JJ)) THEN
  78. NCE =NCE+1
  79. IADE(NCE)=IDX(J)
  80. IRAD(J)=3
  81. GO TO 16
  82. ENDIF
  83. 10 CONTINUE
  84. NCC =NCC+1
  85. IADC(NCC)=IDY(JJ)
  86. 16 CONTINUE
  87. 20 CONTINUE
  88. C-------------------------------------------------------------
  89. C RECHERCHE DES COMPOSANTS NON TRANSPORTES
  90. NIMM=0
  91. IF(IADH.NE.0)THEN
  92. NIMM=NIMM+1
  93. IMM(NIMM)=60
  94. CALL CHIADY(IDX,NXDIM,60,III)
  95. IRAD(III)=3
  96. ENDIF
  97. IF(IZRED.NE.0)THEN
  98. MCR=IRCR(/1)
  99. CALL RSETI(IMM(NIMM+1),IRCR,MCR)
  100. NIMM=NIMM+MCR
  101. DO 25 J=1,MCR
  102. JJ=IRCR(J)
  103. CALL CHIADY(IDX,NXDIM,JJ,III)
  104. IRAD(III)=3
  105. 25 CONTINUE
  106. ENDIF
  107. IF(NCE.NE.0)THEN
  108. CALL RSETI(IMM(NIMM+1),IADE,NCE)
  109. NIMM=NIMM+NCE
  110. ENDIF
  111. JN=NN(1)+NN(2)+NN(3)+NN(4)+NN(5)+1
  112. JK=NN(1)+NN(2)+NN(3)+NN(4)+NN(5)+NN(6)
  113. NADSORB=0
  114. DO 40 J=1,NXDIM
  115. IF(IDX(J).EQ.80) NADSORB=NADSORB+1
  116. C /TEST SUR LES SITES DE SURFACES/
  117. IF (IDX(J).GE.90.AND.IDX(J).LE.96) THEN
  118. C
  119. NADSORB=NADSORB+1
  120. NIMM=NIMM+1
  121. IMM(NIMM)=IDX(J)
  122. IRAD(J)=3
  123. ENDIF
  124.  
  125. C /TEST SUR LES COMPOSANTS DE TYPE 6/
  126.  
  127. DO 30 JJ=JN,JK
  128. IF (IDX(J).EQ.IDY(JJ)) THEN
  129. IF ( IDX(J).NE.99) THEN
  130. NIMM=NIMM+1
  131. IMM(NIMM)=IDX(J)
  132. IRAD(J)=3
  133. ENDIF
  134. ENDIF
  135. 30 CONTINUE
  136. 40 CONTINUE
  137. C PRISE EN COMPTE DES COMPOSANTS IMMOBILES DE CLIM TYP3
  138. C ON A DEJA VERIFIE LEUR EXISTANCE
  139. IF(MLENT3.GT.0)THEN
  140. NL=MLENT3.LECT(/1)
  141. MLENT1=LIMP3
  142. SEGACT MLENT1
  143. DO 35 J=1,NL
  144. IDXT=MLENT3.LECT(J)
  145. IDYT= MLENT1.LECT(J)
  146. IF(IDXT.NE.IDYT)THEN
  147. C ON VERIFIE QUE IDXT N'EST PAS DEJA IMMOBILE
  148. CALL CHIADY(IMM,NIMM,IDXT,III)
  149. IF(III.EQ.0)THEN
  150. NIMM=NIMM+1
  151. IMM(NIMM)=IDXT
  152. CALL CHIADY(IDX,NXDIM,IDXT,JJ)
  153. IRAD(JJ)=3
  154. ELSE
  155. C WRITE(6,*) ' LE COMPOSANT ',IDXT,' EST DEJA IMMOBILE'
  156. INTERR(1)=IDXT
  157. CALL ERREUR(778)
  158. RETURN
  159. ENDIF
  160. ENDIF
  161. 35 CONTINUE
  162. SEGDES MLENT1
  163. ENDIF
  164. C ----------------------------------------------------
  165. C
  166. C RECHERCHE DU NOMBRE DE COMPOSANTS CONSERVATIFS: NCONS
  167.  
  168. NCONS=0
  169.  
  170. C TEST DE LA PRESENCE D'UN COMPOSANT DANS UNE ESPECE ADSORBEE
  171.  
  172. IJ=NN(1)+1
  173. IK=NN(1)+NN(2)+NN(3)+NN(4)
  174. CALL CHIADY(IDX,NXDIM,90,JSOH)
  175. DO 65 J=1,NXDIM
  176. IF(JSOH.GT.0) THEN
  177. DO 45 I=IJ,IK
  178. IF (AA(I,JSOH).GT.0.D0.AND.ABS(AA(I,J)).GT.0.D0) GOTO 60
  179. 45 CONTINUE
  180. ENDIF
  181.  
  182. C/ TEST DE LA PRESENCE D'UN COMPOSANT DANS UNE ESPECE SOLIDE
  183. C DE TYPE 3, 4 OU 5.
  184.  
  185. JI=NN(1)+NN(2)+1
  186. IM=NN(1)+NN(2)+NN(3)+NN(4)+NN(5)
  187.  
  188. DO 50 I=JI,IM
  189. IF (ABS(AA(I,J)).GT.0.D0) THEN
  190. * WRITE(6,*) ' SOLIDE ',IDX(J)
  191. GO TO 60
  192. ENDIF
  193.  
  194. 50 CONTINUE
  195.  
  196. ** ESPECE ECHANGEE
  197. DO 55 I = IJ,IK
  198. IF (ABS(AA(I,J)).GT.0.D0) THEN
  199. IF(IDECY(I).NE.0) THEN
  200. C WRITE(6,*) ' ECHANGE',IDX(J)
  201. GO TO 60
  202. ENDIF
  203. ENDIF
  204. 55 CONTINUE
  205.  
  206. IF(IRAD(J).NE.3)THEN
  207. NCONS=NCONS+1
  208. ICONS(NCONS)=IDX(J)
  209. IRAD(J)=1
  210. C WRITE(6,*) 'ICONS(',N,'): ',IDX(J)
  211. ENDIF
  212. 60 CONTINUE
  213. 65 CONTINUE
  214. C --------------------------------------------------------
  215. SEGACT MTAB1
  216. IVALI=0
  217. XVALI=0.D0
  218. IRETI=0
  219. IVALR=0
  220. XVALR=0.D0
  221. MTYPI='MOT '
  222. IF(NIMM.NE.0)THEN
  223. JG=NIMM
  224. SEGINI MLENTI
  225. CALL RSETI(LECT,IMM,JG)
  226. IRETR=MLENTI
  227. MTYPR='LISTENTI'
  228. CHARR=' '
  229. CALL ECCTAB(MTAB1,MTYPI,IVALI,XVALI,'IMMO',.TRUE.,
  230. * IRETI,MTYPR,IVALR,XVALR,CHARR,.TRUE.,IRETR)
  231. SEGDES MLENTI
  232. ENDIF
  233. IF(NCONS.NE.0)THEN
  234. JG=NCONS
  235. SEGINI MLENTI
  236. CALL RSETI(LECT,ICONS,JG)
  237. IRETR=MLENTI
  238. MTYPR='LISTENTI'
  239. CHARR=' '
  240. CALL ECCTAB(MTAB1,MTYPI,IVALI,XVALI,'PARF',.TRUE.,
  241. * IRETI,MTYPR,IVALR,XVALR,CHARR,.TRUE.,IRETR)
  242. SEGDES MLENTI
  243. ENDIF
  244. C COMPOSANTS REACTIFS
  245. JJG=NXDIM-NCONS-NIMM
  246. IF(JJG.NE.0)THEN
  247. JG=JJG
  248. SEGINI MLENTI
  249. I=0
  250. DO 70 J=1,NXDIM
  251. IF(IRAD(J).EQ.2)THEN
  252. I=I+1
  253. LECT(I)=IDX(J)
  254. ENDIF
  255. 70 CONTINUE
  256. IRETR=MLENTI
  257. MTYPR='LISTENTI'
  258. CHARR=' '
  259. CALL ECCTAB(MTAB1,MTYPI,IVALI,XVALI,'REAC',.TRUE.,
  260. * IRETI,MTYPR,IVALR,XVALR,CHARR,.TRUE.,IRETR)
  261. SEGDES MLENTI
  262. ENDIF
  263. IF(NN(6).NE.0)THEN
  264. C TYP6
  265. JG=NN(6)
  266. SEGINI MLENTI
  267. JN=NN(1)+NN(2)+NN(3)+NN(4)+NN(5)+1
  268. CALL RSETI(LECT,IDY(JN),JG)
  269. IRETR=MLENTI
  270. MTYPR='LISTENTI'
  271. CHARR=' '
  272. CALL ECCTAB(MTAB1,MTYPI,IVALI,XVALI,'TYP6',.TRUE.,
  273. * IRETI,MTYPR,IVALR,XVALR,CHARR,.TRUE.,IRETR)
  274. SEGDES MLENTI
  275. JGN=4
  276. JGM=JG
  277. SEGINI MLMOTS
  278. DO 71 I=1,JG
  279. NLL=JN-1+I
  280. WRITE(MOTS(I),110)NLL
  281. 71 CONTINUE
  282. IRETR=MLMOTS
  283. MTYPR='LISTMOTS'
  284. CHARR=' '
  285. CALL ECCTAB(MTAB1,MTYPI,IVALI,XVALI,'NOMTYP6',.TRUE.,
  286. * IRETI,MTYPR,IVALR,XVALR,CHARR,.TRUE.,IRETR)
  287. SEGDES MLMOTS
  288. ENDIF
  289. C TYP3
  290. IF(NN(3).NE.0)THEN
  291. JG=NN(3)
  292. SEGINI MLENTI
  293. JN=NN(1)+NN(2)+1
  294. CALL RSETI(LECT,IDY(JN),JG)
  295. IRETR=MLENTI
  296. MTYPR='LISTENTI'
  297. CHARR=' '
  298. CALL ECCTAB(MTAB1,MTYPI,IVALI,XVALI,'TYP3',.TRUE.,
  299. * IRETI,MTYPR,IVALR,XVALR,CHARR,.TRUE.,IRETR)
  300. SEGDES MLENTI
  301. JGN=4
  302. JGM=JG
  303. SEGINI MLMOTS
  304. DO 72 I=1,JG
  305. NLL=JN-1+I
  306. WRITE(MOTS(I),110)NLL
  307. 72 CONTINUE
  308. IRETR=MLMOTS
  309. MTYPR='LISTMOTS'
  310. CHARR=' '
  311. CALL ECCTAB(MTAB1,MTYPI,IVALI,XVALI,'NOMTYP3',.TRUE.,
  312. * IRETI,MTYPR,IVALR,XVALR,CHARR,.TRUE.,IRETR)
  313. SEGDES MLMOTS
  314. IF(LIMP3.NE.0) THEN
  315. IRETR=LIMP3
  316. MTYPR='LISTENTI'
  317. CHARR=' '
  318. CALL ECCTAB(MTAB1,MTYPI,IVALI,XVALI,'IMP3',.TRUE.,
  319. * IRETI,MTYPR,IVALR,XVALR,CHARR,.TRUE.,IRETR)
  320. ENDIF
  321. ENDIF
  322. C PRECIPITES POTENTIELS
  323. JJG=NN(4)+NN(5)
  324. IF(JJG.NE.0)THEN
  325. JG=JJG
  326. SEGINI MLENTI
  327. JN=NN(1)+NN(2)+NN(3)+1
  328. CALL RSETI(LECT,IDY(JN),JG)
  329. IRETR=MLENTI
  330. MTYPR='LISTENTI'
  331. CHARR=' '
  332. CALL ECCTAB(MTAB1,MTYPI,IVALI,XVALI,'PRECI',.TRUE.,
  333. * IRETI,MTYPR,IVALR,XVALR,CHARR,.TRUE.,IRETR)
  334. SEGDES MLENTI
  335. JGN=4
  336. JGM=JG
  337. SEGINI MLMOTS
  338. DO 75 I=1,JG
  339. NLL=JN-1+I
  340. WRITE(MOTS(I),110)NLL
  341. 75 CONTINUE
  342. IRETR=MLMOTS
  343. MTYPR='LISTMOTS'
  344. CHARR=' '
  345. CALL ECCTAB(MTAB1,MTYPI,IVALI,XVALI,'NOMPRECI',.TRUE.,
  346. * IRETI,MTYPR,IVALR,XVALR,CHARR,.TRUE.,IRETR)
  347. SEGDES MLMOTS
  348. ENDIF
  349. C SOLUTIONS SOLIDES
  350. IF(NZDIM.NE.0)THEN
  351. JG=NN(4)+NN(5)+NN(6)
  352. SEGINI MLENTI
  353. KS=0
  354. JN=NN(1)+NN(2)+NN(3)+1
  355. DO L=1,JG
  356. NII=JN-1+L
  357. IDYNI=IDY(NII)
  358. CALL CHIADY(IDZ,NZDIM,IDYNI,IDNI)
  359. IF(IDNI.NE.0)THEN
  360. KS=KS+1
  361. LECT(KS)=IDYNI
  362. ENDIF
  363. END DO
  364. JG=KS
  365. SEGADJ MLENTI
  366. IRETR=MLENTI
  367. MTYPR='LISTENTI'
  368. CHARR=' '
  369. CALL ECCTAB(MTAB1,MTYPI,IVALI,XVALI,'SOSO',.TRUE.,
  370. * IRETI,MTYPR,IVALR,XVALR,CHARR,.TRUE.,IRETR)
  371. SEGDES MLENTI
  372. JGN=4
  373. JGM=NN(4)+NN(5)+NN(6)
  374. SEGINI MLMOTS
  375. KM=0
  376. DO I=1,JGM
  377. NLL=JN-1+I
  378. IDYNL=IDY(NLL)
  379. CALL CHIADY(IDZ,NZDIM,IDYNL,IDNL)
  380. IF(IDNL.NE.0)THEN
  381. KM=KM+1
  382. WRITE(MOTS(KM),110)NLL
  383. ENDIF
  384. END DO
  385. JGM=KM
  386. SEGADJ MLMOTS
  387. IRETR=MLMOTS
  388. MTYPR='LISTMOTS'
  389. CHARR=' '
  390. CALL ECCTAB(MTAB1,MTYPI,IVALI,XVALI,'NOMSOSO',.TRUE.,
  391. * IRETI,MTYPR,IVALR,XVALR,CHARR,.TRUE.,IRETR)
  392. SEGDES MLMOTS
  393. ENDIF
  394. C POLES DE SOLUTIONS SOLIDES
  395. IF(NZDIM.NE.0)THEN
  396. IF(NPDIM.NE.0)THEN
  397. JG=NN(6)
  398. SEGINI MLENTI
  399. KL=0
  400. JN=NN(1)+NN(2)+NN(3)+NN(4)+NN(5)+1
  401. DO L=1,NN(6)
  402. NII=JN-1+L
  403. IDYNI=IDY(NII)
  404. CALL CHIADY(IDP,NPDIM,IDYNI,IDNI)
  405. IF(IDNI.NE.0)THEN
  406. DO K=1,NZDIM
  407. IF(FF(K,IDNI).NE.0.D0)THEN
  408. KL=KL+1
  409. LECT(KL)=IDYNI
  410. ENDIF
  411. END DO
  412. ENDIF
  413. END DO
  414. JG=KL
  415. SEGADJ MLENTI
  416. IRETR=MLENTI
  417. MTYPR='LISTENTI'
  418. CHARR=' '
  419. CALL ECCTAB(MTAB1,MTYPI,IVALI,XVALI,'POLE',.TRUE.,
  420. * IRETI,MTYPR,IVALR,XVALR,CHARR,.TRUE.,IRETR)
  421. SEGDES MLENTI
  422. JGN=4
  423. JGM=NN(6)
  424. SEGINI MLMOTS
  425. KM=0
  426. DO I=1,NN(6)
  427. NLL=JN-1+I
  428. IDYNL=IDY(NLL)
  429. CALL CHIADY(IDP,NPDIM,IDYNL,IDNL)
  430. IF(IDNL.NE.0)THEN
  431. DO K=1,NZDIM
  432. IF(FF(K,IDNL).NE.0.D0)THEN
  433. KM=KM+1
  434. WRITE(MOTS(KM),110)NLL
  435. ENDIF
  436. END DO
  437. ENDIF
  438. END DO
  439. JGM=KM
  440. SEGADJ MLMOTS
  441. IRETR=MLMOTS
  442. MTYPR='LISTMOTS'
  443. CHARR=' '
  444. CALL ECCTAB(MTAB1,MTYPI,IVALI,XVALI,'NOMPOLE',.TRUE.,
  445. * IRETI,MTYPR,IVALR,XVALR,CHARR,.TRUE.,IRETR)
  446. SEGDES MLMOTS
  447. ENDIF
  448. ENDIF
  449. C TABLEAU IRAD
  450. JG=NXDIM
  451. SEGINI MLENTI
  452. CALL RSETI(LECT,IRAD,JG)
  453. IRETR=MLENTI
  454. MTYPR='LISTENTI'
  455. CHARR=' '
  456. CALL ECCTAB(MTAB1,MTYPI,IVALI,XVALI,'COMP',.TRUE.,
  457. *IRETI,MTYPR,IVALR,XVALR,CHARR,.TRUE.,IRETR)
  458. SEGDES MLENTI
  459. SEGSUP IZIMM ,IZRIAD
  460. C ESPECES SOLUBLES
  461. C ET ESPECES DE SURFACE
  462. C A COMPLETER POUR LES ESPECES DE SURFACE
  463. SEGINI IZSS
  464. N1=0
  465. N3=0
  466. JK=NN(1)+NN(2)
  467. DO 85 I=1,JK
  468. IF(IDECY(I).NE.0)THEN
  469. N3=N3+1
  470. ISURF(N3)=IDY(I)
  471. GO TO 82
  472. ENDIF
  473. N1=N1+1
  474. ISOLU(N1)=IDY(I)
  475. 82 CONTINUE
  476. 85 CONTINUE
  477. IF ( N1.LT.1)THEN
  478. C WRITE(6,*)' IL N Y A PAS D ESPECE EN SOLUTION '
  479. CALL ERREUR(779)
  480. RETURN
  481. ENDIF
  482. DO 88 I=1,NXDIM
  483. IF(IDX(I).EQ.99)THEN
  484. CALL CHIADY(IDY,NYDIM,99,J)
  485. IF( J.GT.NN(1)+NN(2)+NN(3))THEN
  486. N1=N1+1
  487. ISOLU(N1)=99
  488. ENDIF
  489. GO TO 90
  490. ENDIF
  491. 88 CONTINUE
  492. 90 CONTINUE
  493. C ESPECES EN SOLUTION
  494. JG=N1
  495. SEGINI MLENTI
  496. CALL RSETI(LECT,ISOLU,JG)
  497. IRETR=MLENTI
  498. MTYPR='LISTENTI'
  499. CHARR=' '
  500. CALL ECCTAB(MTAB1,MTYPI,IVALI,XVALI,'SOLU',.TRUE.,
  501. *IRETI,MTYPR,IVALR,XVALR,CHARR,.TRUE.,IRETR)
  502. SEGDES MLENTI
  503. JGN=4
  504. JGM=JG
  505. SEGINI MLMOTS
  506. DO 92 I=1,JG
  507. CALL CHIADY(IDY,NYDIM,ISOLU(I),NLL)
  508. WRITE(MOTS(I),110)NLL
  509. 92 CONTINUE
  510. IRETR=MLMOTS
  511. MTYPR='LISTMOTS'
  512. CHARR=' '
  513. CALL ECCTAB(MTAB1,MTYPI,IVALI,XVALI,'NOMSOLU',.TRUE.,
  514. *IRETI,MTYPR,IVALR,XVALR,CHARR,.TRUE.,IRETR)
  515. SEGDES MLMOTS
  516. C ESPECES DE SURFACE
  517. IF(N3.NE.0)THEN
  518. JG=N3
  519. SEGINI MLENTI
  520. CALL RSETI(LECT,ISURF,JG)
  521. IRETR=MLENTI
  522. MTYPR='LISTENTI'
  523. CHARR=' '
  524. CALL ECCTAB(MTAB1,MTYPI,IVALI,XVALI,'SURF',.TRUE.,
  525. * IRETI,MTYPR,IVALR,XVALR,CHARR,.TRUE.,IRETR)
  526. SEGDES MLENTI
  527. JGN=4
  528. JGM=JG
  529. SEGINI MLMOTS
  530. DO 93 I=1,JG
  531. CALL CHIADY(IDY,NYDIM,ISURF(I),NLL)
  532. WRITE(MOTS(I),110)NLL
  533. 93 CONTINUE
  534. IRETR=MLMOTS
  535. MTYPR='LISTMOTS'
  536. CHARR=' '
  537. CALL ECCTAB(MTAB1,MTYPI,IVALI,XVALI,'NOMSURF',.TRUE.,
  538. * IRETI,MTYPR,IVALR,XVALR,CHARR,.TRUE.,IRETR)
  539. SEGDES MLMOTS
  540. ENDIF
  541. SEGSUP IZSS
  542. C DESCRIPTION DES REDOX
  543. IF(IZRED.NE.0)THEN
  544. CALL CRTABL(MTAB2)
  545. NCR=ITAB(/1)
  546. JG=NCR
  547. SEGINI MLENTI
  548. if (jg.ne.0) CALL RSETI(LECT,ITAB(1,1),JG)
  549. IRETR=MLENTI
  550. MTYPR='LISTENTI'
  551. CHARR=' '
  552. CALL ECCTAB(MTAB2,MTYPI,IVALI,XVALI,'I1',.TRUE.,
  553. * IRETI,MTYPR,IVALR,XVALR,CHARR,.TRUE.,IRETR)
  554. SEGDES MLENTI
  555. SEGINI MLENTI
  556. if (jg.ne.0) CALL RSETI(LECT,ITAB(1,2),JG)
  557. IRETR=MLENTI
  558. MTYPR='LISTENTI'
  559. CHARR=' '
  560. CALL ECCTAB(MTAB2,MTYPI,IVALI,XVALI,'I2',.TRUE.,
  561. * IRETI,MTYPR,IVALR,XVALR,CHARR,.TRUE.,IRETR)
  562. SEGDES MLENTI
  563. SEGINI MLREEL
  564. if (jg.ne.0) CALL RSETD(PROG,ATAB(1,1),JG)
  565. IRETR=MLREEL
  566. MTYPR='LISTREEL'
  567. CHARR=' '
  568. CALL ECCTAB(MTAB2,MTYPI,IVALI,XVALI,'A1',.TRUE.,
  569. * IRETI,MTYPR,IVALR,XVALR,CHARR,.TRUE.,IRETR)
  570. SEGDES MLREEL
  571. SEGINI MLREEL
  572. if (jg.ne.0) CALL RSETD(PROG,ATAB(1,2),JG)
  573. IRETR=MLREEL
  574. MTYPR='LISTREEL'
  575. CHARR=' '
  576. CALL ECCTAB(MTAB2,MTYPI,IVALI,XVALI,'A2',.TRUE.,
  577. * IRETI,MTYPR,IVALR,XVALR,CHARR,.TRUE.,IRETR)
  578. SEGDES MLREEL
  579. SEGSUP IZIADR, IZRED,IZREDI
  580. ENDIF
  581. 110 FORMAT('W',I3.3)
  582. RETURN
  583. END
  584.  
  585.  
  586.  
  587.  
  588.  
  589.  
  590.  
  591.  

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