Télécharger chisol.eso

Retour à la liste

Numérotation des lignes :

  1. C CHISOL SOURCE PV 07/11/23 21:15:39 5978
  2. C CHISOL SOURCE BOS 97/03/03
  3. SUBROUTINE CHISOL(NVSOSO,IDSCHI)
  4. IMPLICIT INTEGER(I-N)
  5. IMPLICIT REAL*8 (A-H,O-Z)
  6. C-----------------------------------------------------------------
  7. C
  8. C PRISE EN COMPTE DE NOUVELLES SOLUTIONS SOLIDES
  9. C
  10. C-----------------------------------------------------------------
  11. -INC SMTABLE
  12. -INC SMLENTI
  13. -INC SMLREEL
  14. -INC CCOPTIO
  15. POINTEUR MLIDEN.MLENTI
  16. SEGMENT IDSCHI
  17. REAL*8 GK(NYDIM),AA(NYDIM,NXDIM),FF(NZDIM,NPDIM)
  18. INTEGER IDX(NXDIM),IDY(NYDIM),IDZ(NZDIM),IDP(NPDIM),NN(6)
  19. INTEGER IDECY(NYDIM),IONZ(NXDIM)
  20. CHARACTER*32 NAME(NXDIM),NAMESP(NYDIM)
  21. ENDSEGMENT
  22. real*8 lf
  23. CHARACTER*8 MTYPI,CHARI,MTYPR,CHARR
  24. LOGICAL LOGRE
  25. INTEGER LINIT
  26. C
  27. NZDIM=IDZ(/1)
  28. NYDIM=IDY(/1)
  29. NXDIM=IDX(/1)
  30. NPDIM=IDP(/1)
  31. MTAB1=NVSOSO
  32. SEGACT MTAB1
  33. NNSOSO=MTAB1.MLOTAB
  34. NISOSO=NNSOSO
  35. C si MTAB1 est une table tous ses indices sont des entiers, mais
  36. C si MTAB1 est un objet il y a des indices METHODE HERI ... en plus
  37. IVALI=0
  38. XVALI=0.D0
  39. IRETI=0
  40. IVALR=0
  41. XVALR=0.D0
  42. IRETR=0
  43. MTYPI='MOT '
  44. MTYPR=' '
  45. CHARR=' '
  46. CALL ACCTAB(MTAB1,MTYPI,IVALI,XVALI,'CLASSE',.TRUE.,IRETI,
  47. * MTYPR,IVALR,XVALR,CHARR,LOGRE,IRETR)
  48. IF(IERR.NE.0)RETURN
  49. IF(MTYPR.EQ.'MOT ')THEN
  50. C
  51. C on a trouvé CLASSE c'est un OBJET on va compter les indices entier
  52. C
  53. NISOSO= 0
  54. DO 5 IESP=1,NNSOSO
  55. IF((MTAB1.MTABTI(IESP)).EQ.'ENTIER') NISOSO= NISOSO+1
  56. 5 CONTINUE
  57. ENDIF
  58. * WRITE(6,*)'CHISOL',NNSOSO
  59. DO 80 ISOSO=1,NISOSO
  60. IVALI=ISOSO
  61. XVALI=0.D0
  62. IRETI=0
  63. IVALR=0
  64. XVALR=0.D0
  65. IRETR=0
  66. MTYPI='ENTIER '
  67. MTYPR=' '
  68. CHARR=' '
  69. CHARI=' '
  70. CALL ACCTAB(MTAB1,MTYPI,IVALI,XVALI,CHARI,.TRUE.,IRETI,
  71. * MTYPR,IVALR,XVALR,CHARR,.TRUE.,IRETR)
  72. IF(IERR.NE.0)RETURN
  73. IF((MTYPR.EQ.'TABLE ').OR.(MTYPR.EQ.'OBJET '))THEN
  74. MTAB2=IRETR
  75. * WRITE(6,*)'chisol mtab2=',MTAB2
  76. SEGACT MTAB2
  77. IVALI=1
  78. XVALI=0.D0
  79. IRETI=0
  80. IVALR=0
  81. XVALR=0.D0
  82. IRETR=0
  83. MTYPI='MOT '
  84. MTYPR='ENTIER '
  85. CHARR=' '
  86. CALL ACCTAB(MTAB2,MTYPI,IVALI,XVALI,'IDEN',.TRUE.,IRETI,
  87. * MTYPR,IVALR,XVALR,CHARR,.TRUE.,IRETR)
  88. IF(IERR.NE.0)RETURN
  89. IDSOSO=IVALR
  90. * WRITE(6,*)'chisol idsoso=',IDSOSO
  91. IVALI=1
  92. XVALI=0.D0
  93. IRETI=0
  94. IVALR=0
  95. XVALR=0.D0
  96. IRETR=0
  97. MTYPI='MOT '
  98. MTYPR='LISTENTI'
  99. CHARR=' '
  100. CALL ACCTAB(MTAB2,MTYPI,IVALI,XVALI,'SOLID',.TRUE.,IRETI,
  101. * MTYPR,IVALR,XVALR,CHARR,.TRUE.,IRETR)
  102. IF(IERR.NE.0)RETURN
  103. MLENTI=IRETR
  104. * write(6,*)'chisol mlenti= ',MLENTI
  105. SEGACT MLENTI
  106. LB=LECT(/1)
  107. IVALI=1
  108. XVALI=0.D0
  109. IRETI=0
  110. IVALR=0
  111. XVALR=0.D0
  112. IRETR=0
  113. MTYPI='MOT '
  114. MTYPR='ENTIER '
  115. CHARR=' '
  116. CALL ACCTAB(MTAB2,MTYPI,IVALI,XVALI,'ITYP',.TRUE.,IRETI,
  117. * MTYPR,IVALR,XVALR,CHARR,.TRUE.,IRETR)
  118. IF(IERR.NE.0)RETURN
  119. ITJP=IVALR
  120. * WRITE(6,*)'CHISOL idsoso,itjp,mlenti',IDSOSO,ITJP,MLENTI
  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(MTAB2,MTYPI,IVALI,XVALI,'FRACTIO',.TRUE.,IRETI,
  131. * MTYPR,IVALR,XVALR,CHARR,LOGRE,IRETR)
  132. * write(6,*)'chisol mtypr=',MTYPR,' iretr=',IRETR
  133. IF(MTYPR.EQ.'LISTREEL')THEN
  134.  
  135. C SI L UTILISATEUR DONNE LES FRACTIONS MOLAIRES
  136. MLREEL=IRETR
  137. SEGACT MLREEL
  138. LC=PROG(/1)
  139. IF(LB.NE.LC)THEN
  140. MOTERR(1:40)='**********NVSOSO.FRACTIO '
  141. CALL ERREUR(-301)
  142. CALL ERREUR(21)
  143. RETURN
  144. ENDIF
  145. DO 20 L=1,LB
  146. IF(LECT(L).NE.0)THEN
  147. IDCK=LECT(L)
  148. CALL CHIADY(IDP,NPDIM,IDCK,K)
  149. IF(K.EQ.0)THEN
  150. * WRITE(6,*)' LE POLE ',IDCK,' N A PAS ETE RETENU'
  151. * WRITE(6,*)' LA SOLSOL ',IDSOSO,' NE PEUT ETRE FORMEE'
  152. MOTERR(1:40)='**********NVSOSO.SOLID '
  153. CALL ERREUR(-301)
  154. INTERR(1)=IDCK
  155. CALL ERREUR(776)
  156. RETURN
  157. ENDIF
  158. ELSE
  159. GOTO 30
  160. ENDIF
  161. 20 CONTINUE
  162. 30 CONTINUE
  163. NN(6)=NN(6)+1
  164. NYDIM=NYDIM+1
  165. NZDIM=NZDIM+1
  166. SEGADJ IDSCHI
  167. IDY(NYDIM)=IDSOSO
  168. DO 10 I=1,NPDIM
  169. FF(NZDIM,I)=0.D0
  170. 10 CONTINUE
  171.  
  172. C PRISE EN COMPTE DES FRACTIONS MOLAIRES DONNEES
  173. DO 40 IX=1,LB
  174. IF(LECT(IX).EQ.0) GO TO 50
  175. IDCK=LECT(IX)
  176. CALL CHIADY(IDP,NPDIM,IDCK,IK)
  177. FF(NZDIM,IK)=PROG(IX)
  178. 40 CONTINUE
  179.  
  180. C CALCUL DES COEFFICIENTS STOECHIOMETRIQUES
  181. DO JC=1,NXDIM
  182. VF=0
  183. DO IB=1,NPDIM
  184. IF(FF(NZDIM,IB).NE.0.D0)THEN
  185. IDPB=IDP(IB)
  186. CALL CHIADY(IDY,NYDIM,IDPB,IDPC)
  187. VF=VF+AA(IDPC,JC)*FF(NZDIM,IB)
  188. AA(NYDIM,JC)=VF
  189. ENDIF
  190. END DO
  191. END DO
  192.  
  193. C CALCUL DE LA CONSTANTE D EQUILIBRE
  194. GK(NYDIM)=0
  195. DO JD=1,NPDIM
  196. IDPJD=IDP(JD)
  197. CALL CHIADY(IDY,NYDIM,IDPJD,IDJD)
  198. IF(FF(NZDIM,JD).NE.0.D0)THEN
  199. LF=LOG10(ABS(FF(NZDIM,JD)))
  200. GK(NYDIM)=GK(NYDIM)+FF(NZDIM,JD)*(GK(IDJD)-LF)
  201. ENDIF
  202. END DO
  203. SEGDES MLREEL
  204. ELSE
  205.  
  206. C SI L UTILISATEUR NE DONNE PAS DE FRACTIONS MOLAIRES
  207. NN(6)=NN(6)+1
  208. NYDIM=NYDIM+1
  209. NZDIM=NZDIM+1
  210. SEGADJ IDSCHI
  211. IDY(NYDIM)=IDSOSO
  212. DO 15 I=1,NPDIM
  213. FF(NZDIM,I)=0.D0
  214. 15 CONTINUE
  215.  
  216. C INITIALISATION DES FRACTIONS MOLAIRES
  217. DO 60 IIX=1,LB
  218. IF(LECT(IIX).EQ.0) GOTO 50
  219. IDCK=LECT(IIX)
  220. CALL CHIADY(IDP,NPDIM,IDCK,IIK)
  221. FF(NZDIM,IIK)=1.D0
  222. 60 CONTINUE
  223. ENDIF
  224.  
  225. 50 CONTINUE
  226.  
  227. C MISE EN TYPE 6 DES POLES DE SOLUTIONS SOLIDES
  228. NN1=NN(1)+NN(2)+NN(3)
  229. NN2=NN(1)+NN(2)+NN(3)+NN(4)
  230. NN3=NN(1)+NN(2)+NN(3)+NN(4)+NN(5)
  231. NN4=NN(1)+NN(2)+NN(3)+NN(4)+NN(5)+1
  232. DO INN=NN1+1,NN3
  233. NN4=NN4-1
  234. IDYN=IDY(NN4)
  235. * write(6,*)'chisol idyn',idyn,'idy(nn4)',idy(nn4)
  236. CALL CHIADY(IDP,NPDIM,IDYN,IDN)
  237. * write(6,*)'chisol idn',idn
  238. IF(IDN.NE.0)THEN
  239. IF(FF(NZDIM,IDN).NE.0.D0)THEN
  240. * write(6,*)'chisol ff(nzdim,idn)',ff(nzdim,idn)
  241. IF(NN4.GT.NN1.AND.NN4.LE.NN2)THEN
  242. LINIT=4
  243. CALL CHIREX(IDSCHI,IDYN,LINIT,6)
  244. * write(6,*)'chisol 4 ok pour',idyn,'inn',nn4,'idy',idy(nn4)
  245. ENDIF
  246. IF(NN4.GT.NN2.AND.NN4.LE.NN3)THEN
  247. LINIT=5
  248. CALL CHIREX(IDSCHI,IDYN,LINIT,6)
  249. * write(6,*)'chisol 5 ok pour',idyn,'nn4',nn4,'idy',idy(nn4)
  250. ENDIF
  251. ENDIF
  252. ENDIF
  253. END DO
  254.  
  255. LINIT=6
  256. CALL CHIREX(IDSCHI,IDSOSO,LINIT,ITJP)
  257. IDZ(NZDIM)=IDSOSO
  258. SEGDES MLENTI
  259. SEGDES MTAB2
  260. ELSE
  261. MOTERR(1:40)='******** NVSOSO ??????????? '
  262. CALL ERREUR(-301)
  263. CALL ERREUR(21)
  264. RETURN
  265. ENDIF
  266. 80 CONTINUE
  267. SEGDES MTAB1
  268.  
  269. * write(6,*)'fin chisol'
  270. * write(6,*)'NXDIM,NYDIM,NPDIM,NZDIM',NXDIM,NYDIM,NPDIM,NZDIM
  271. * write(6,*)(name(i),i=1,NXDIM)
  272. * write(6,*)'IDX',(IDX(I),I=1,NXDIM)
  273. * write(6,*)'IDY',(IDY(I),I=1,NYDIM)
  274. * WRITE(6,*)'IDZ',(IDZ(I),I=1,NZDIM)
  275. * write(6,*)'IDP',(IDP(I),i=1,npdim)
  276. * do 100 i=1,nydim
  277. * write(6,*)'IDY',idy(i),'AA',(aa(i,j),j=1,nxdim)
  278. * 100 continue
  279. * do 300 k=1,nzdim
  280. * write(6,*)'IDZ',idz(k),'FF',(ff(k,i),i=1,npdim)
  281. * 300 continue
  282. * write(6,*)'GK',(GK(I),I=1,NYDIM)
  283. * write(6,110)((aa(i,j),i=1,NYDIM),j=1,NXDIM)
  284. * write(6,110)((ff(k,i),k=1,NZDIM),i=1,NYDIM)
  285. 110 format(2x,(10(1PE10.3)))
  286.  
  287. RETURN
  288. END
  289.  
  290.  
  291.  
  292.  
  293.  
  294.  
  295.  
  296.  

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