Télécharger chimi1.eso

Retour à la liste

Numérotation des lignes :

  1. C CHIMI1 SOURCE CHAT 05/01/12 21:57:28 5004
  2. SUBROUTINE CHIMI1
  3. C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  4. C
  5. C OPERATEUR CHI1
  6. C
  7. C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  8. IMPLICIT INTEGER(I-N)
  9. IMPLICIT REAL*8(A-H,O-Z)
  10. -INC CCOPTIO
  11. -INC SMTABLE
  12. -INC SMLENTI
  13. -INC SMTEXTE
  14. SEGMENT IDSCHI
  15. REAL*8 GK(NYDIM),AA(NYDIM,NXDIM),FF(NZDIM,NPDIM)
  16. INTEGER IDX(NXDIM),IDY(NYDIM),IDZ(NZDIM),IDP(NPDIM),NN(6)
  17. INTEGER IDECY(NYDIM),IONZ(NXDIM)
  18. CHARACTER*32 NAME(NXDIM),NAMESP(NYDIM)
  19. ENDSEGMENT
  20. SEGMENT IZIADR
  21. INTEGER IADR(NCR)
  22. ENDSEGMENT
  23. POINTEUR MLIDEN.MLENTI
  24. CHARACTER*8 MTYPI,CHARI,MTYPR,CHARR
  25. CHARACTER*72 CHARB,CHARL,CHART
  26. LOGICAL LTEMPE,LOGIR,LOGRE
  27. C
  28. MLENT3=0
  29. LIMP3=0
  30. IRETOU=0
  31. MTAB1=0
  32. CALL LIROBJ('TABLE',MTAB1,0,IRETOU)
  33. IF(IRETOU.EQ.0)THEN
  34. CALL LIROBJ('OBJET',MTAB1,1,IRETOU)
  35. * write(6,*)' mtab1 ',mtab1
  36. IF(IRETOU.EQ.0)RETURN
  37. ENDIF
  38. C ON LIT LES ADRESSES DE LA BASE DE DONNEE
  39. IOCHI1=0
  40. IOCHI2=0
  41. IOCHI3=0
  42. LBB=0
  43. LBL=0
  44. LBT=0
  45. DO 10 I=1,3
  46. CALL LIRCHA(CHARR,0,IRETOU)
  47. IF(IRETOU.EQ.0)GO TO 11
  48. IF(CHARR(1:6).EQ.'COMP')THEN
  49. CALL LIRENT(IVAL,0,IRETOU)
  50. IF(IRETOU.EQ.1)IOCHI1=IVAL
  51. CALL LIRCHA(CHARB,0,LBB)
  52. ELSEIF(CHARR(1:4).EQ.'LOGK')THEN
  53. CALL LIRENT(IVAL,0,IRETOU)
  54. IF(IRETOU.EQ.1)IOCHI2=IVAL
  55. CALL LIRCHA(CHARL,0,LBL)
  56. ELSEIF(CHARR(1:4).EQ.'ENTH')THEN
  57. CALL LIRENT(IVAL,0,IRETOU)
  58. IF(IRETOU.EQ.1)IOCHI3=IVAL
  59. CALL LIRCHA(CHART,0,LBT)
  60. ELSE
  61. MOTERR(1:6)='COMP'
  62. CALL ERREUR(396)
  63. RETURN
  64. ENDIF
  65. 10 CONTINUE
  66. 11 CONTINUE
  67. IF(IOCHI1.EQ.0)THEN
  68. IF(LBB.EQ.0)THEN
  69. MOTERR(1:4)='COMP'
  70. CALL ERREUR(396)
  71. RETURN
  72. ELSE
  73. IOCHI1=80
  74. ENDIF
  75. ENDIF
  76. IF(LBB.NE.0)THEN
  77. CALL CHIDBD(IOCHI1,CHARB)
  78. ENDIF
  79. IF(LBL.NE.0)THEN
  80. IF(CHARB(1:LBB).EQ.CHARL(1:LBL))THEN
  81. IOCHI2=IOCHI1
  82. ELSE
  83. IF(IOCHI2.EQ.0)IOCHI2=IOCHI1+1
  84. CALL CHIDBD(IOCHI2,CHARL)
  85. ENDIF
  86. ELSE
  87. IF(IOCHI2.EQ.0)IOCHI2=IOCHI1
  88. ENDIF
  89. IF(LBT.NE.0)THEN
  90. IF(CHART(1:LBT).EQ.CHARL(1:LBL))THEN
  91. IOCHI3=IOCHI2
  92. ELSE
  93. IF(IOCHI3.EQ.0)IOCHI3=IOCHI2+1
  94. CALL CHIDBD(IOCHI3,CHART)
  95. ENDIF
  96. ELSE
  97. ENDIF
  98. C
  99. SEGACT MTAB1
  100. IVALI=1
  101. XVALI=0.D0
  102. IRETI=0
  103. IVALR=0
  104. XVALR=0.D0
  105. IRETR=0
  106. MTYPI='MOT '
  107. MTYPR='LISTENTI'
  108. CHARR=' '
  109. CALL ACCTAB(MTAB1,MTYPI,IVALI,XVALI,'IDEN',.TRUE.,IRETI,
  110. * MTYPR,IVALR,XVALR,CHARR,LOGRE,IRETR)
  111. IF(IERR.NE.0)RETURN
  112. MLIDEN=IRETR
  113. SEGACT MLIDEN
  114. NLIDEN=MLIDEN.LECT(/1)
  115. SEGDES MLIDEN
  116. LXMX=0
  117. IVALI=1
  118. XVALI=0.D0
  119. IRETI=0
  120. IVALR=0
  121. XVALR=0.D0
  122. IRETR=0
  123. MTYPI='MOT '
  124. MTYPR=' '
  125. CHARR=' '
  126. CALL ACCTAB(MTAB1,MTYPI,IVALI,XVALI,'CHXMX',.TRUE.,IRETI,
  127. * MTYPR,IVALR,XVALR,CHARR,LOGRE,IRETR)
  128. IF(MTYPR.NE.' ')THEN
  129. IF(MTYPR.NE.'LISTENTI')THEN
  130. MOTERR(1:11)='CHXMX '
  131. MOTERR(12:20)='LISTENTI'
  132. CALL ERREUR(627)
  133. RETURN
  134. ENDIF
  135. LXMX=IRETR
  136. ENDIF
  137. LBDD=0
  138. IVALI=1
  139. XVALI=0.D0
  140. IRETI=0
  141. IVALR=0
  142. XVALR=0.D0
  143. IRETR=0
  144. MTYPI='MOT '
  145. MTYPR=' '
  146. CHARR=' '
  147. CALL ACCTAB(MTAB1,MTYPI,IVALI,XVALI,'BDD',.TRUE.,IRETI,
  148. * MTYPR,IVALR,XVALR,CHARR,LOGRE,IRETR)
  149. IF(MTYPR.NE.' ')THEN
  150. IF(CHARR.EQ.'MINEQL ')THEN
  151. LBDD=0
  152. ELSEIF(CHARR.EQ.'STRASBG ')THEN
  153. LBDD=1
  154. ELSE
  155. MOTERR(1:11)='BDD '
  156. MOTERR(12:20)='CONNU '
  157. CALL ERREUR(627)
  158. RETURN
  159. ENDIF
  160. ENDIF
  161. CALL CHILEC(LBDD,MLIDEN,LXMX,IDSCHI,IOCHI1,IOCHI2)
  162. IF(IERR.NE.0)RETURN
  163. C ON GARDE LA LISTE DES ESPECES SIMPLES DE TYPE 3
  164. CALL CHITR1(IDSCHI,IZIADR,IADH,LBDD)
  165. * WRITE(6,*)'CHILEC et CHITRI faits'
  166. C
  167. IVALI=0
  168. XVALI=0.D0
  169. IRETI=0
  170. IVALR=0
  171. XVALR=0.D0
  172. IRETR=0
  173. MTYPI='MOT '
  174. MTYPR=' '
  175. CHARR=' '
  176. NVCOMP=0
  177. CALL ACCTAB(MTAB1,MTYPI,IVALI,XVALI,'NVCOMP',.TRUE.,IRETI,
  178. * MTYPR,IVALR,XVALR,CHARR,LOGRE,IRETR)
  179. IF(MTYPR.NE.' ')THEN
  180. IF((MTYPR.NE.'TABLE ').AND.(MTYPR.NE.'OBJET '))THEN
  181. MOTERR(1:11)='NVCOMP '
  182. MOTERR(12:20)='TABLE '
  183. CALL ERREUR(627)
  184. RETURN
  185. ENDIF
  186. NVCOMP=IRETR
  187. CALL CHICMP(NVCOMP,IDSCHI)
  188. IF(IERR.NE.0)RETURN
  189. ENDIF
  190. IVALI=0
  191. XVALI=0.D0
  192. IRETI=0
  193. IVALR=0
  194. XVALR=0.D0
  195. IRETR=0
  196. MTYPI='MOT '
  197. MTYPR=' '
  198. CHARR=' '
  199. NVESP=0
  200. CALL ACCTAB(MTAB1,MTYPI,IVALI,XVALI,'NVESP',.TRUE.,IRETI,
  201. * MTYPR,IVALR,XVALR,CHARR,LOGRE,IRETR)
  202. IF(MTYPR.NE.' ')THEN
  203. IF((MTYPR.NE.'TABLE ').AND.(MTYPR.NE.'OBJET '))THEN
  204. MOTERR(1:11)='NVESP '
  205. MOTERR(12:20)='TABLE '
  206. CALL ERREUR(627)
  207. RETURN
  208. ENDIF
  209. NVESP=IRETR
  210. CALL CHIESP(NVESP,IDSCHI)
  211. ENDIF
  212. IVALI=0
  213. XVALI=0.D0
  214. IRETI=0
  215. IVALR=0
  216. XVALR=0.D0
  217. IRETR=0
  218. MTYPI='MOT '
  219. MTYPR=' '
  220. CHARR=' '
  221. NVSOSO=0
  222. * write(6,*)' mtab1 ',mtab1
  223. CALL ACCTAB(MTAB1,MTYPI,IVALI,XVALI,'NVSOSO',.TRUE.,IRETI,
  224. * MTYPR,IVALR,XVALR,CHARR,LOGRE,IRETR)
  225. IF(MTYPR.NE.' ')THEN
  226. IF((MTYPR.NE.'TABLE ').AND.(MTYPR.NE.'OBJET '))THEN
  227. MOTERR(1:11)='NVSOSO '
  228. MOTERR(12:20)='TABLE '
  229. CALL ERREUR(627)
  230. RETURN
  231. ENDIF
  232. NVSOSO=IRETR
  233. * WRITE(6,*)'CHIMI1, NVSOSO=',NVSOSO
  234. CALL CHISOL(NVSOSO,IDSCHI)
  235. ENDIF
  236. IVALI=0
  237. XVALI=0.D0
  238. IRETI=0
  239. IVALR=0
  240. XVALR=0.D0
  241. IRETR=0
  242. MTYPI='MOT '
  243. MTYPR=' '
  244. CHARR='LISTENTI'
  245. IZECH=0
  246. CALL ACCTAB(MTAB1,MTYPI,IVALI,XVALI,'ECHANGE',.TRUE.,IRETI,
  247. * MTYPR,IVALR,XVALR,CHARR,LOGRE,IRETR)
  248. IF(MTYPR.NE.' ')THEN
  249. IZECH=IRETR
  250. CALL CHIECH(IZECH,IDSCHI)
  251. ENDIF
  252. IVALI=0
  253. XVALI=0.D0
  254. IRETI=0
  255. IVALR=0
  256. XVALR=0.D0
  257. IRETR=0
  258. MTYPI='MOT '
  259. MTYPR=' '
  260. CHARR='TABLE'
  261. ICLIM=0
  262. MLENT=0
  263. CALL ACCTAB(MTAB1,MTYPI,IVALI,XVALI,'CLIM',.TRUE.,IRETI,
  264. * MTYPR,IVALR,XVALR,CHARR,LOGRE,IRETR)
  265. IF(MTYPR.NE.' ')THEN
  266. ICLIM=IRETR
  267. CALL CHICLM(ICLIM,IDSCHI,IZIADR,MLENT3,LIMP3)
  268. IF(IERR.NE.0)RETURN
  269. ENDIF
  270. LTEMPE=.FALSE.
  271. LTMP=1
  272. LOGIR=.TRUE.
  273. IVALI=1
  274. XVALI=0.D0
  275. IRETI=0
  276. IVALR=0
  277. XVALR=0.D0
  278. IRETR=0
  279. MTYPI='MOT '
  280. MTYPR=' '
  281. CHARR=' '
  282. CALL ACCTAB(MTAB1,MTYPI,IVALI,XVALI,'TEMPERATURE',.TRUE.,IRETI,
  283. * MTYPR,IVALR,XVALR,CHARR,LOGIR,IRETR)
  284. IF(MTYPR.NE.' ')THEN
  285. IF(CHARR.EQ.'OUI')THEN
  286. LTEMPE=.TRUE.
  287. ELSEIF(CHARR.EQ.'NON')THEN
  288. LTEMPE=.FALSE.
  289. ELSEIF(MTYPR.EQ.'ENTIER ')THEN
  290. LTEMPE=.TRUE.
  291. LTMP=IVALR
  292. IF((LTMP.NE.1).AND.(LTMP.NE.2))THEN
  293. MOTERR(1:40)='**********************TEMPERATURE '
  294. CALL ERREUR(-301)
  295. CALL ERREUR(21)
  296. RETURN
  297. ENDIF
  298. ELSE
  299. MOTERR(1:40)='**********************TEMPERATURE '
  300. CALL ERREUR(-301)
  301. CALL ERREUR(21)
  302. RETURN
  303. ENDIF
  304. ENDIF
  305. IF(LTEMPE)THEN
  306. IF(IOCHI3.EQ.0)IOCHI3=IOCHI2
  307. ENDIF
  308. SEGDES MTAB1
  309. C ON CREE LA TABLE RESULTAT
  310. CALL CRTABL(MTAB3)
  311. CALL ECCTAB(MTAB3,'MOT',0,0.D0,'SOUSTYPE',.TRUE.,0,'MOT',
  312. * 0,0.D0,'CHIMI1',.TRUE.,0)
  313. C TABLE DESCHI (DESCRIPTION)
  314. CALL CRTABL(MTAB2)
  315. CALL CHIDES(MTAB2,IDSCHI)
  316. CHARR=' '
  317. CALL ECCTAB(MTAB3,'MOT',0,0.D0,'DESCHI',.TRUE.,0,'TABLE',
  318. * 0,0.D0,CHARR,.TRUE.,MTAB2)
  319. SEGDES MTAB2
  320. MTAB2=0
  321. CALL CRTABL(MTAB1)
  322. CALL CHIRED(IDSCHI,MTAB1,MTAB2,IZIADR,IADH,MLENT3,LIMP3)
  323. IF(MLENT3.NE.0)THEN
  324. SEGDES MLENT3
  325. ENDIF
  326. IF(IERR.NE.0)RETURN
  327. CHARR=' '
  328. CALL ECCTAB(MTAB3,'MOT',0,0.D0,'IDEN',.TRUE.,0,'TABLE',
  329. * 0,0.D0,CHARR,.TRUE.,MTAB1)
  330. SEGDES MTAB1
  331. IF(MTAB2.NE.0)THEN
  332. CHARR=' '
  333. CALL ECCTAB(MTAB3,'MOT',0,0.D0,'REDOX',.TRUE.,0,'TABLE',
  334. * 0,0.D0,CHARR,.TRUE.,MTAB2)
  335. SEGDES MTAB2
  336. ENDIF
  337. IF(LTEMPE)THEN
  338. CALL CRTABL(MTAB1)
  339. CALL CHITET(MTAB1,IDSCHI,LBDD,IOCHI3,LTMP)
  340. CHARR=' '
  341. CALL ECCTAB(MTAB3,'MOT',0,0.D0,'TEMPE',.TRUE.,0,'TABLE',
  342. * 0,0.D0,CHARR,.TRUE.,MTAB1)
  343. SEGDES MTAB1
  344. ENDIF
  345. REWIND(UNIT=IOCHI1)
  346. CLOSE(UNIT=IOCHI1)
  347. IF(IOCHI1.NE.IOCHI2)THEN
  348. REWIND(UNIT=IOCHI2)
  349. CLOSE(UNIT=IOCHI2)
  350. ENDIF
  351. IF((IOCHI3.NE.IOCHI2).AND.LTEMPE)THEN
  352. REWIND(UNIT=IOCHI3)
  353. CLOSE(UNIT=IOCHI3)
  354. ENDIF
  355. CALL ECROBJ('TABLE',MTAB3)
  356. SEGDES MTAB3
  357. SEGSUP IDSCHI
  358. RETURN
  359. END
  360.  
  361.  
  362.  
  363.  
  364.  
  365.  
  366.  
  367.  
  368.  
  369.  
  370.  

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