Télécharger chimi1.eso

Retour à la liste

Numérotation des lignes :

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

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