Télécharger chiclm.eso

Retour à la liste

Numérotation des lignes :

  1. C CHICLM SOURCE CHAT 05/01/12 21:56:55 5004
  2. SUBROUTINE CHICLM(ICLIM,IDSCHI,IZIADR,MLENT3,LIMP3)
  3. IMPLICIT INTEGER(I-N)
  4. IMPLICIT REAL*8 (A-H,O-Z)
  5. C------------------------------------------------------------------
  6. C
  7. C PRISE EN COMPTE DES CONDITIONS AUX LIMITES
  8. C IZIADR POINTEUR DE LA LISTE DES ESPECES SIMPLES DE TYPE 3
  9. C MLENT3 POINTEUR DE LA LISTE DES ESPECES SIMPLES A RETENIR
  10. C (CONTENU DE CLIM.COMP3 )
  11. C LIMP3 POINTEUR DE LA LISTE DES ESPECES IMPOSES EN 3
  12. C (ON A BESOIN DE CETTE INFORMATION DANS CHIMI2)
  13. C
  14. C------------------------------------------------------------------
  15. -INC SMTABLE
  16. -INC SMLENTI
  17. -INC CCOPTIO
  18. POINTEUR MLIDEN.MLENTI
  19. SEGMENT IDSCHI
  20. REAL*8 GK(NYDIM),AA(NYDIM,NXDIM),FF(NZDIM,NPDIM)
  21. INTEGER IDX(NXDIM),IDY(NYDIM),IDZ(NZDIM),IDP(NPDIM),NN(6)
  22. INTEGER IDECY(NYDIM),IONZ(NXDIM)
  23. CHARACTER*32 NAME(NXDIM),NAMESP(NYDIM)
  24. ENDSEGMENT
  25. SEGMENT IZIADR
  26. INTEGER IADR(NCR)
  27. ENDSEGMENT
  28. CHARACTER*8 MTYPI,CHARI,MTYPR,CHARR
  29. LOGICAL LOGRE
  30. C
  31. NCR=0
  32. NYDIM=IDY(/1)
  33. NXDIM=IDX(/1)
  34. NZDIM=IDZ(/1)
  35. NPDIM=IDP(/1)
  36. MTAB1=ICLIM
  37. SEGACT MTAB1
  38. IF(IZIADR.EQ.0) SEGINI IZIADR
  39. NCR=IADR(/1)
  40. LIMP3=0
  41. NL=0
  42. IVALI=1
  43. XVALI=0.D0
  44. IRETI=0
  45. IVALR=0
  46. XVALR=0.D0
  47. IRETR=0
  48. MTYPI='MOT '
  49. MTYPR=' '
  50. CHARR=' '
  51. CALL ACCTAB(MTAB1,MTYPI,IVALI,XVALI,'TYP3',.TRUE.,
  52. *IRETI,MTYPR,IVALR,XVALR,CHARR,LOGRE,IRETR)
  53. IF(MTYPR.NE.' ')THEN
  54. IF(MTYPR.EQ.'LISTENTI')THEN
  55. MLENT1=IRETR
  56. SEGACT MLENT1
  57. LIMP3=MLENT1
  58. NL=MLENT1.LECT(/1)
  59. LTYPE=3
  60. DO 40 J=1,NL
  61. IDYT=MLENT1.LECT(J)
  62. II=0
  63. C ON RECHERCHE LE TYPE INITIAL POUR LE CHANGER EN TYPE 3
  64. DO 20 L=1,6
  65. LL=L
  66. IF(NN(L).NE.0)THEN
  67. I0=II+1
  68. II=II+NN(L)
  69. DO 10 I=I0,II
  70. IF(IDY(I).EQ.IDYT)GO TO 30
  71. 10 CONTINUE
  72. ENDIF
  73. 20 CONTINUE
  74. C WRITE(6,*) IDYT,' N EST PAS UNE ESPECE CONNUE '
  75. INTERR(1)=IDYT
  76. CALL ERREUR(772)
  77. RETURN
  78. 30 CONTINUE
  79. C write(6,*)' idyt ll ltype ',IDYT,LL,LTYPE
  80. CALL CHIREX(IDSCHI,IDYT,LL,LTYPE)
  81. 40 CONTINUE
  82. ELSE
  83. MOTERR(1:11)='CLIM TYP3 '
  84. MOTERR(12:20)='LISTENTI'
  85. CALL ERREUR(627)
  86. RETURN
  87. ENDIF
  88. ENDIF
  89. MLENT3=0
  90. IVALI=1
  91. XVALI=0.D0
  92. IRETI=0
  93. IVALR=0
  94. XVALR=0.D0
  95. IRETR=0
  96. MTYPI='MOT '
  97. MTYPR=' '
  98. CHARR=' '
  99. CALL ACCTAB(MTAB1,MTYPI,IVALI,XVALI,'COMP3',.TRUE.,
  100. *IRETI,MTYPR,IVALR,XVALR,CHARR,LOGRE,IRETR)
  101. IF(MTYPR.NE.' ')THEN
  102. IF(MTYPR.EQ.'LISTENTI')THEN
  103. MLENT3=IRETR
  104. SEGACT MLENT3
  105. NLC=MLENT3.LECT(/1)
  106. IF(NLC.NE.NL)THEN
  107. C WRITE(6,*)' COMP3 NE CORRESPOND PAS A TYP3 '
  108. MOTERR(1:8)='COMP3 '
  109. MOTERR(9:16)='TYP3 '
  110. CALL ERREUR(773)
  111. RETURN
  112. ENDIF
  113. DO 50 J=1,NLC
  114. IDXT= MLENT3.LECT(J)
  115. IDYT= MLENT1.LECT(J)
  116. IF(IDXT.NE.IDYT)THEN
  117. CALL CHIADY(IDX,NXDIM,IDXT,NDX)
  118. IF(NDX.EQ.0)THEN
  119. C WRITE(6,*) IDXT,' N EST PAS UN COMPOSANT DE', IDYT
  120. INTERR(1)=IDXT
  121. INTERR(2)=IDYT
  122. CALL ERREUR(774)
  123. RETURN
  124. ENDIF
  125. CALL CHIADY(IDY,NYDIM,IDYT,NDY)
  126. C write(6,*)' ndx ndy aa',ndx,ndy,aa(ndy,ndx)
  127. IF(AA(NDY,NDX).EQ.0.D0)THEN
  128. C IDXT N EST PAS UNE COMPOSANTE DE IDYT
  129. C WRITE(6,*) IDXT,' N EST PAS UN COMPOSANT DE', IDYT
  130. INTERR(1)=IDXT
  131. INTERR(2)=IDYT
  132. CALL ERREUR(774)
  133. RETURN
  134. ENDIF
  135. ELSE
  136. CALL CHIADY(IDX,NXDIM,IDYT,NDY)
  137. IF(NDY.EQ.0)THEN
  138. C IDYT N EST PAS SIMPLE IL FAUT PRECISER LE COMPOSANT IMMOBILE
  139. C WRITE(6,*) IDYT,' N EST PAS SIMPLE PRECISEZ COMP3 '
  140. INTERR(1)=IDYT
  141. CALL ERREUR(775)
  142. RETURN
  143. ENDIF
  144.  
  145. ENDIF
  146. 50 CONTINUE
  147. SEGDES MLENT1
  148. ELSE
  149. MOTERR(1:11)='CLIM COMP3 '
  150. MOTERR(12:20)='LISTENTI'
  151. CALL ERREUR(627)
  152. RETURN
  153. ENDIF
  154. ELSE
  155. IF(NL.NE.0)THEN
  156. DO 55 J=1,NL
  157. IDYT=MLENT1.LECT(J)
  158. CALL CHIADY(IDX,NXDIM,IDYT,NDY)
  159. IF(NDY.EQ.0)THEN
  160. C IDYT N EST PAS SIMPLE IL FAUT PRECISER LA COMPOSANTE IMMOBILE
  161. C WRITE(6,*) IDYT,' N EST PAS SIMPLE PRECISEZ COMP3 '
  162. INTERR(1)=IDYT
  163. CALL ERREUR(775)
  164. RETURN
  165. ENDIF
  166. 55 CONTINUE
  167. SEGDES MLENT1
  168. ENDIF
  169. ENDIF
  170. IVALI=1
  171. XVALI=0.D0
  172. IRETI=0
  173. IVALR=0
  174. XVALR=0.D0
  175. IRETR=0
  176. MTYPI='MOT '
  177. MTYPR=' '
  178. CHARR=' '
  179. CALL ACCTAB(MTAB1,MTYPI,IVALI,XVALI,'TYP6',.TRUE.,
  180. *IRETI,MTYPR,IVALR,XVALR,CHARR,LOGRE,IRETR)
  181. IF(MTYPR.NE.' ')THEN
  182. IF(MTYPR.EQ.'LISTENTI')THEN
  183. MLENT2=IRETR
  184. SEGACT MLENT2
  185. NL=MLENT2.LECT(/1)
  186. LTYPE=6
  187. DO 90 J=1,NL
  188. IDYT=MLENT2.LECT(J)
  189. II=0
  190. DO 70 L=1,6
  191. LL=L
  192. IF(NN(L).NE.0)THEN
  193. I0=II+1
  194. II=II+NN(L)
  195. DO 60 I=I0,II
  196. IF(IDY(I).EQ.IDYT)GO TO 80
  197. 60 CONTINUE
  198. ENDIF
  199. 70 CONTINUE
  200. C WRITE(6,*) IDYT,' N EST PAS UNE ESPECE CONNUE '
  201. INTERR(1)=IDYT
  202. CALL ERREUR(772)
  203. RETURN
  204. 80 CONTINUE
  205. CALL CHIREX(IDSCHI,IDYT,LL,LTYPE)
  206. C SI IADR EXISTE ON ENLEVE IDYT DE CETTE LISTE
  207. IF(IZIADR.NE.0)THEN
  208. CALL CHIADY(IADR,NCR,IDYT,JJ)
  209. IF(JJ.GT.0)THEN
  210. NCR=NCR-1
  211. DO 85 KJ=JJ,NCR
  212. IADR(KJ)=IADR(KJ+1)
  213. 85 CONTINUE
  214. SEGADJ IZIADR
  215. WRITE(6,*)'chiclm type6 iziadr=',iziadr
  216. ENDIF
  217. ENDIF
  218. 90 CONTINUE
  219. SEGDES MLENT2
  220. ELSE
  221. MOTERR(1:11)='CLIM TYP6 '
  222. MOTERR(12:20)='LISTENTI'
  223. CALL ERREUR(627)
  224. RETURN
  225. ENDIF
  226. ENDIF
  227. IVALI=1
  228. XVALI=0.D0
  229. IRETI=0
  230. IVALR=0
  231. XVALR=0.D0
  232. IRETR=0
  233. MTYPI='MOT '
  234. MTYPR=' '
  235. CHARR=' '
  236. CALL ACCTAB(MTAB1,MTYPI,IVALI,XVALI,'TYP4',.TRUE.,
  237. *IRETI,MTYPR,IVALR,XVALR,CHARR,LOGRE,IRETR)
  238. IF(MTYPR.NE.' ')THEN
  239. IF(MTYPR.EQ.'LISTENTI')THEN
  240. MLENT2=IRETR
  241. SEGACT MLENT2
  242. NL=MLENT2.LECT(/1)
  243. LTYPE=4
  244. DO 190 J=1,NL
  245. IDYT=MLENT2.LECT(J)
  246. II=0
  247. DO 170 L=1,6
  248. LL=L
  249. IF(NN(L).NE.0)THEN
  250. I0=II+1
  251. II=II+NN(L)
  252. DO 160 I=I0,II
  253. IF(IDY(I).EQ.IDYT)GO TO 180
  254. 160 CONTINUE
  255. ENDIF
  256. 170 CONTINUE
  257. C WRITE(6,*) IDYT,' N EST PAS UNE ESPECE CONNUE '
  258. INTERR(1)=IDYT
  259. CALL ERREUR(772)
  260. RETURN
  261. 180 CONTINUE
  262. CALL CHIREX(IDSCHI,IDYT,LL,LTYPE)
  263. C SI IADR EXISTE ON ENLEVE IDYT DE CETTE LISTE
  264. IF(IZIADR.NE.0)THEN
  265. CALL CHIADY(IADR,NCR,IDYT,JJ)
  266. IF(JJ.GT.0)THEN
  267. NCR=NCR-1
  268. DO 185 KJ=JJ,NCR
  269. IADR(KJ)=IADR(KJ+1)
  270. 185 CONTINUE
  271. SEGADJ IZIADR
  272. write(6,*)'chiclm type4 iziadr=',iziadr
  273. ENDIF
  274. ENDIF
  275. 190 CONTINUE
  276. SEGDES MLENT2
  277. ELSE
  278. MOTERR(1:11)='CLIM TYP4 '
  279. MOTERR(12:20)='LISTENTI'
  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(MTAB1,MTYPI,IVALI,XVALI,'TYP5',.TRUE.,
  294. *IRETI,MTYPR,IVALR,XVALR,CHARR,LOGRE,IRETR)
  295. IF(MTYPR.NE.' ')THEN
  296. IF(MTYPR.EQ.'LISTENTI')THEN
  297. MLENT2=IRETR
  298. SEGACT MLENT2
  299. NL=MLENT2.LECT(/1)
  300. LTYPE=5
  301. DO 290 J=1,NL
  302. IDYT=MLENT2.LECT(J)
  303. II=0
  304. DO 270 L=1,6
  305. LL=L
  306. IF(NN(L).NE.0)THEN
  307. I0=II+1
  308. II=II+NN(L)
  309. DO 260 I=I0,II
  310. IF(IDY(I).EQ.IDYT)GO TO 280
  311. 260 CONTINUE
  312. ENDIF
  313. 270 CONTINUE
  314. C WRITE(6,*) IDYT,' N EST PAS UNE ESPECE CONNUE '
  315. INTERR(1)=IDYT
  316. CALL ERREUR(772)
  317. RETURN
  318. 280 CONTINUE
  319. CALL CHIREX(IDSCHI,IDYT,LL,LTYPE)
  320. C SI IADR EXISTE ON ENLEVE IDYT DE CETTE LISTE
  321. IF(IZIADR.NE.0)THEN
  322. CALL CHIADY(IADR,NCR,IDYT,JJ)
  323. IF(JJ.GT.0)THEN
  324. NCR=NCR-1
  325. DO 285 KJ=JJ,NCR
  326. IADR(KJ)=IADR(KJ+1)
  327. 285 CONTINUE
  328. SEGADJ IZIADR
  329. write(6,*)'chiclm type5 iziadr=',iziadr
  330. ENDIF
  331. ENDIF
  332. 290 CONTINUE
  333. SEGDES MLENT2
  334. ELSE
  335. MOTERR(1:11)='CLIM TYP5 '
  336. MOTERR(12:20)='LISTENTI'
  337. CALL ERREUR(627)
  338. RETURN
  339. ENDIF
  340. ENDIF
  341. SEGDES MTAB1
  342. RETURN
  343. END
  344.  
  345.  
  346.  
  347.  
  348.  
  349.  
  350.  
  351.  
  352.  

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