Télécharger chinp.eso

Retour à la liste

Numérotation des lignes :

  1. C CHINP SOURCE CHAT 05/01/12 21:57:46 5004
  2. SUBROUTINE CHINP(IDSCHI,LXMX,IOCHI1,IOCHI2)
  3. C
  4. C
  5. C=======================================================================
  6. C sp issu de TRIOEF
  7. C
  8. C
  9. C
  10. C LECTURE DE LA B.D.D. THERMODYNAMIQUE MINEQL
  11. C
  12. C======================================================================
  13. IMPLICIT INTEGER(I-N)
  14. IMPLICIT REAL*8(A-H,O-Z)
  15.  
  16. -INC SMLENTI
  17. POINTEUR MLXMX.MLENTI
  18. -INC CCOPTIO
  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. C
  26.  
  27. DIMENSION IAT(4),IDT(4)
  28. SEGMENT IZCOMP
  29. CHARACTER*8 NAM(NXD)
  30. INTEGER ION(NXD),IADXT(NXD)
  31. ENDSEGMENT
  32.  
  33.  
  34. NXDIM=IDX(/1)
  35. NYDIM=IDY(/1)
  36. NZDIM=IDZ(/1)
  37. NPDIM=IDP(/1)
  38. NXD=200
  39. NNN=NXDIM
  40. SEGINI IZCOMP
  41.  
  42. C INITIALIZE ADDRESS
  43. DO 20 J=1,NXD
  44. IADXT(J)=0
  45. 20 CONTINUE
  46. C
  47. CBRUNO
  48. READ(IOCHI1,520) (NAM(J),J=1,NXD)
  49. READ(IOCHI1,530) (ION(J),J=1,NXD)
  50. *
  51. C WRITE(6,*)'chinp COMPO LU '
  52. C WRITE(6,*)'chinp NNN',NNN
  53. C
  54. C INITIALIZE NN
  55. C
  56. C N3=0
  57. C
  58.  
  59. C INPUT BASIS IN A MATRIX
  60.  
  61. DO 200 I=1,NNN
  62. IDXT=IDX(I)
  63. IF(IDXT.GT.NXD)THEN
  64. INTERR(1)=IDXT
  65. C WRITE(6,*)'IDXT',IDXT
  66. C WRITE(6,*)'NDX',NDX
  67. CALL ERREUR(781)
  68. GO TO 500
  69. ENDIF
  70. CRUNO
  71. NAME(I)=' '
  72. NAME(I)(1:8)=NAM(IDXT)
  73. IONZ(I)=ION(IDXT)
  74. *
  75. C IF (IDX(I).EQ.90) JSOH=I
  76. IADXT(IDXT)=I
  77. C X(I)=10.**GX(I)
  78. IDY(I)=IDX(I)
  79. AA(I,I)=1.0D0
  80. GK(I)=0.0D0
  81. 200 CONTINUE
  82.  
  83. C WRITE(6,*)'chinp COMPOSANT SURFACE '
  84. NN(1)=NNN
  85.  
  86. C ***************** LECTURE DES DONNEES THERMODYNAMIQUES
  87.  
  88.  
  89. I=NN(1)
  90. DO 400 L=2,6
  91. * WRITE(6,*)' TYPE ',L
  92. I0=I
  93. READ(IOCHI2,510) IN
  94. C WRITE(6,*)'chinp NOMBRE ESPECE ' ,IN
  95. IF(IN.EQ.0) GO TO 400
  96. DO 300 II=1,IN
  97. READ(IOCHI2,510) IDYT,GKT,(IDT(J),IAT(J),J=1,4)
  98. DO 310 J=1,4
  99. JTEST=IDT(J)
  100. IF(JTEST.EQ.0) GO TO 310
  101. IF(IADXT(JTEST).EQ.0) GO TO 300
  102. 310 CONTINUE
  103.  
  104. I=I+1
  105. IF (I.GT.NYDIM) THEN
  106. MOTERR(1:8)=' CHXMX '
  107. MOTERR(9:16)='SUITENTI'
  108. CALL ERREUR(787)
  109. RETURN
  110. ENDIF
  111. IDY(I)=IDYT
  112. GK(I)=GKT
  113.  
  114. C WRITE(6,*)'chinp ESPÈCE',IDY(I)
  115. DO 320 J=1,4
  116. JTEST=IDT(J)
  117. C IF (IDT(J).EQ.90) N3=N3+1
  118. IF(JTEST.EQ.0) GO TO 320
  119. IADTJT=IADXT(JTEST)
  120. AA(I,IADTJT)=IAT(J)
  121. C WRITE(6,*)'chinp COMP',IDT(J),AA(I,IADTJT)
  122. 320 CONTINUE
  123. 300 CONTINUE
  124.  
  125. CMONI---------------LE 10 SEPT 91----------------------------
  126. IF (L.EQ.5) THEN
  127. NOUVI=0
  128. * WRITE(6,*)' NMXCH ',NMXCH
  129. IF (LXMX.EQ.0) GOTO 270
  130. MLXMX=LXMX
  131. SEGACT MLXMX
  132. NMXCH=MLXMX.LECT(/1)
  133.  
  134. CPATBOS------------------------------------------------------
  135. C MISE EN IDP DES SOLIDES CHOISIS PAR L UTILISATEUR
  136. NPDIM=NMXCH
  137. SEGADJ IDSCHI
  138. CALL RSETI(IDP,MLXMX.LECT,NPDIM)
  139. IN5=I
  140. C
  141. *-----------------***------MONI------***-------------------------------
  142. * CES MODIFS PERMETTENT DE FAIRE UN CHOIX DES MINERAUX A PRENDRE
  143. * EN COMPTE;( AVEC MINEQL IL EXISTE UNE FACON BIEN SIMPLE :
  144. * METTRE, DANS LE MAIN, TOUTES LES ESPECES DE TYPE 5
  145. * (MINERAL DISSOUS QUI PEUT PRECIPITER S'IL ARRIVE A SATURATION),
  146. * EN TYPE 6 :
  147. * NN(6)=NN(5)+NN(6)
  148. * NN(5)=0
  149. * PUIS, SELECTIONNER EN TYPE 5 LES MINERAUX CHOISIS :
  150. * EX:
  151. * I5=5
  152. * I6=6
  153. * CALL EXTYP(02231,I6,I5)
  154. **********************************************************************
  155.  
  156. *C RECHERCHE DES MINERAUX NON PRIS EN COMPTE
  157. III=I
  158. C ---
  159. DO 266 ICHOI=I0+1,III
  160. DO 267 NM0=1,NMXCH
  161. IF (IDY(ICHOI).EQ.(MLXMX.LECT(NM0))) GOTO 269
  162. 267 CONTINUE
  163.  
  164. IDY(ICHOI)=0
  165. GK(ICHOI)=0.D0
  166. CBRUNO
  167. DO 210 JK=1,NNN
  168. AA(ICHOI,JK)=0.D0
  169. 210 CONTINUE
  170.  
  171. I=I-1
  172. GOTO 265
  173.  
  174. 269 NOUVI=NOUVI+1
  175. IDY(I0+NOUVI)=IDY(ICHOI)
  176. GK(I0+NOUVI)=GK(ICHOI)
  177. CBRUNO
  178. DO 220 JK=1,NNN
  179. AA(I0+NOUVI,JK)=AA(ICHOI,JK)
  180. IF(ICHOI.NE.(I0+NOUVI)) AA(ICHOI,JK)=0.D0
  181. 220 CONTINUE
  182.  
  183. 265 CONTINUE
  184. 266 CONTINUE
  185. DO 275 LIK = I0+NMXCH+1,IN5
  186. IDY(LIK)=0
  187. DO 274 JIK=1,NNN
  188. AA(LIK,JIK)=0.D0
  189. 274 CONTINUE
  190. 275 CONTINUE
  191. ENDIF
  192. 270 CONTINUE
  193.  
  194.  
  195.  
  196. NN(L)=I-I0
  197. * WRITE(6,*)' NN(',L,')',NN(L)
  198. * write(6,*)'NN(4)',NN(4)
  199. 400 CONTINUE
  200.  
  201. C MISE EN IDP DES MINERAUX LORSQUE LMXMX=0
  202. IF(LXMX.NE.0) THEN
  203. SEGDES MLXMX
  204. ELSE
  205. NN123=NN(1)+NN(2)+NN(3)+1
  206. NN45=NN(1)+NN(2)+NN(3)+NN(4)+NN(5)
  207. DO 600 N=NN123,NN45
  208. NPDIM=NPDIM+1
  209. SEGADJ IDSCHI
  210. IDP(NPDIM)=IDY(N)
  211. 600 CONTINUE
  212. ENDIF
  213. C
  214. C
  215. IF (I.LT.NYDIM) THEN
  216. NYDIM=I
  217. * write(6,*)'Fin chinp'
  218. * WRITE(6,*)' NXDIM ',NXDIM,' NYDIM ',NYDIM,' NPDIM ',NPDIM,
  219. * * ' NZDIM ',NZDIM
  220. SEGADJ IDSCHI
  221. ENDIF
  222. SEGSUP IZCOMP
  223. C
  224. C
  225. 510 FORMAT (I5,F9.2,4(I4,I3),T43,A5)
  226. C 520 FORMAT((7X,A10,3(8X,A10)))
  227. 520 FORMAT((7X,A8,2X,3(8X,A8,2X)))
  228. 530 FORMAT (40I2)
  229. C*****************REMISE EN TETE DES FICHIERS IOCHI1 ET IOCHI2******
  230. 500 CONTINUE
  231. C REWIND(UNIT=IOCHI2)
  232. C CLOSE(UNIT=IOCHI2)
  233. C REWIND(UNIT=IOCHI1)
  234. C CLOSE(UNIT=IOCHI1)
  235. C*******************************************************************
  236. RETURN
  237. END
  238.  
  239.  
  240.  
  241.  
  242.  
  243.  
  244.  
  245.  

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