Télécharger fioni.eso

Retour à la liste

Numérotation des lignes :

  1. C FIONI SOURCE CHAT 06/03/29 21:21:07 5360
  2. SUBROUTINE FIONI
  3. C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  4. C
  5. C OPERATEUR FION
  6. C
  7. C CALCULE LA FORCE IONIQUE D'UNE SOLUTION CHIMIQUE
  8. C UTILISE LES RESULTATS DE CHI1
  9. C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  10. IMPLICIT INTEGER(I-N)
  11. IMPLICIT REAL*8(A-H,O-Z)
  12. -INC CCOPTIO
  13. -INC SMLENTI
  14. -INC SMLMOTS
  15. -INC SMCHPOI
  16. -INC SMELEME
  17. POINTEUR MLAA.MLREEL,MLOGK.MLREEL,MLFF.MLREEL
  18. POINTEUR MLIDX.MLENTI,MLIDY.MLENTI,MLIDZ.MLENTI,MLIDP.MLENTI
  19. POINTEUR MLNN.MLENTI,MLDECY.MLENTI
  20. POINTEUR MLIONZ.MLENTI,MLPREC.MLENTI
  21. POINTEUR MLNAME.MLMOTS,MLNESP.MLMOTS
  22. POINTEUR MLSOLU.MLENTI,MMSOLU.MLMOTS
  23. POINTEUR MCHFIO.MCHPOI,ICHFIO.MPOVAL
  24. CHARACTER*8 TYPEMA
  25. SEGMENT IDSCHI
  26. REAL*8 GK(NYDIM),AA(NYDIM,NXDIM),FF(NZDIM,NPDIM)
  27. INTEGER IDX(NXDIM),IDY(NYDIM),IDZ(NZDIM),IDP(NPDIM),NN(6)
  28. INTEGER IDECY(NYDIM),IONZ(NXDIM)
  29. CHARACTER*32 NAME(NXDIM),NAMESP(NYDIM)
  30. ENDSEGMENT
  31. SEGMENT SP2
  32. REAL*8 GX(NXDIM),XX(NXDIM),GS(NZDIM),SS(NZDIM)
  33. REAL*8 TOT(NXDIM),TOTAQ(NXDIM),TOTFIX(NXDIM),GKS(NZDIM)
  34. REAL*8 YY(NXDIM),ZZ(NXDIM,NXDIM),CC(NYDIM),GC(NYDIM)
  35. ENDSEGMENT
  36. SEGMENT IZBID
  37. INTEGER IBID(NSOL)
  38. ENDSEGMENT
  39. C
  40.  
  41. C
  42. C LECTURE DE LA TABLE CHIMI1
  43. CALL CHMDEB(MLAA,MLOGK,MLFF,MLIDX,MLIDY,MLIDZ,MLIDP,MLNN,MLDECY,
  44. * MLNAME,MLIONZ,ITIDEN,ITREDO,ITEMPE,MLNESP)
  45. IF(IERR.NE.0)RETURN
  46. C
  47. C LECTURE DE LA TABLE IDEN
  48. C TOUS LES SEGMENTS REVIENNENT ACTIFS OU AVEC UN POINTEUR NUL
  49. C
  50. CALL CHMIDE(ITIDEN,MLCOMP,MLSOLU,MMSOLU,MLPREC,MMPREC,MLSURF,
  51. * MMSURF,MLTYP3,MMTYP3,MLTYP6,MMTYP6,MLPARF,MLREAC,MLIMMO,
  52. * MLPOLE,MMPOLE,MLSOSO,MMSOSO,LIMP3)
  53. IF(IERR.NE.0)RETURN
  54. C
  55. C LECTURE DU CHPOIN DES CONCENTRATIONS
  56. C
  57. CALL LIROBJ('CHPOINT',MCHPOI,0,IRETOU)
  58. IF(IRETOU.EQ.0)THEN
  59. CALL ERREUR(21)
  60. RETURN
  61. ENDIF
  62. SEGACT MCHPOI
  63. NSOUPO=IPCHP(/1)
  64. IF(NSOUPO.NE.1)THEN
  65. CALL ERREUR(21)
  66. RETURN
  67. ENDIF
  68. MSOUPO=IPCHP(1)
  69. SEGACT MSOUPO
  70. MELEME=IGEOC
  71. MPOVAL=IPOVAL
  72. NC=NOCOMP(/2)
  73. NSOL=MLSOLU.LECT(/1)
  74. SEGINI IZBID
  75. DO 20 I=1,NSOL
  76. DO 25 J=1,NC
  77. IF(MMSOLU.MOTS(I).EQ.NOCOMP(J))THEN
  78. IBID(I)=J
  79. GO TO 22
  80. ENDIF
  81. 25 CONTINUE
  82. CALL ERREUR(21)
  83. RETURN
  84. 22 CONTINUE
  85. 20 CONTINUE
  86. SEGACT MPOVAL
  87. NPN=VPOCHA(/1)
  88.  
  89. C
  90. C ON ACTIVE LES SEGMENTS
  91. C ET ON DEFINIT LES TABLEAUX DE TRAVAIL
  92. SEGACT MLAA,MLOGK,MLFF,MLIDX,MLIDY,MLIDZ,MLNN,MLDECY,MLNAME,MLNESP
  93. SEGACT MLIONZ,MLIDP
  94. NXDIM=MLIDX.LECT(/1)
  95. NYDIM=MLIDY.LECT(/1)
  96. NZDIM=MLIDZ.LECT(/1)
  97. NPDIM=MLIDP.LECT(/1)
  98. SEGINI IDSCHI
  99. SEGINI SP2
  100. C
  101. JGM=1
  102. JGN=4
  103. SEGINI MLMOTS
  104. MOTS(1)='SCAL'
  105. CALL CHMCRC(MLMOTS,MELEME,NPN,MCHFIO,ICHFIO)
  106. SEGSUP MLMOTS
  107. C
  108. C INITIALISATION
  109. SEGACT MELEME
  110. C
  111. C -------------------------------------------------------------------
  112. C BOUCLE SUR LES POINTS
  113. C -------------------------------------------------------------------
  114. DO 100 II=1,NPN
  115. C CHARGEMENT DE IDSCHI
  116. CALL CHMIDS(MLAA,MLOGK,MLFF,MLIDX,MLIDY,MLIDZ,MLIDP,MLNN,MLDECY,
  117. * MLNAME,MLIONZ,IDSCHI,MLNESP)
  118. C WRITE(6,*)' GK apres CHMIDS '
  119. C WRITE(6,120)(GK(J),IDY(J),J=1,NYDIM)
  120. 120 FORMAT(6(1X,1PD12.5,I5))
  121. C CHARGEMENT DE SP2
  122. DO 6 J=1,NXDIM
  123. TOT(J)= 0.D0
  124. GX(J)= 0.D0
  125. XX(J)=0.D0
  126. TOTAQ(J)=0.D0
  127. TOTFIX(J)=0.D0
  128. YY(J)=0.D0
  129. 6 CONTINUE
  130. CALL INITD(GC,NYDIM,0.D0)
  131. CALL INITD(CC,NYDIM,0.D0)
  132. DO 30 I=1,NSOL
  133. CC(I)=VPOCHA(II,IBID(I))
  134. 30 CONTINUE
  135. C
  136. C= REMISE A ZERO DES FORCES IONIQUES
  137. C
  138. XMUNEW = 0.D0
  139. CALL CHMION(IDSCHI,SP2,XMUNEW)
  140. ICHFIO.VPOCHA(II,1)= XMUNEW
  141. 100 CONTINUE
  142. C --------------------------------------------------------------
  143. C LE MENAGE
  144. C
  145. SEGSUP IDSCHI
  146. SEGSUP SP2,IZBID
  147. C
  148. C ON DESACTIVE LES DONNEES
  149. SEGDES MLAA,MLOGK,MLFF,MLIDX,MLIDY,MLIDZ,MLNN,MLDECY,MLNAME,MLNESP
  150. SEGDES MLIONZ,MLIDP
  151. SEGDES MELEME
  152. MLENTI=MLCOMP
  153. SEGDES MLENTI
  154. IF(MLSOSO.NE.0)THEN
  155. MLENTI=MLSOSO
  156. MLMOTS=MMSOSO
  157. SEGDES MLENTI,MLMOTS
  158. ENDIF
  159. IF(MLPOLE.NE.0)THEN
  160. MLENTI=MLPOLE
  161. MLMOTS=MMPOLE
  162. SEGDES MLENTI,MLMOTS
  163. ENDIF
  164. IF(MLSOLU.NE.0)THEN
  165. MLENTI=MLSOLU
  166. MLMOTS=MMSOLU
  167. SEGDES MLENTI,MLMOTS
  168. ENDIF
  169. IF(MLPREC.NE.0)THEN
  170. MLENTI=MLPREC
  171. MLMOTS=MMPREC
  172. SEGDES MLENTI,MLMOTS
  173. ENDIF
  174. IF(MLSURF.NE.0)THEN
  175. MLENTI=MLSURF
  176. MLMOTS=MMSURF
  177. SEGDES MLENTI,MLMOTS
  178. ENDIF
  179. IF(MLTYP3.NE.0)THEN
  180. MLENTI=MLTYP3
  181. MLMOTS=MMTYP3
  182. SEGDES MLENTI,MLMOTS
  183. ENDIF
  184. IF(MLTYP6.NE.0)THEN
  185. MLENTI=MLTYP6
  186. MLMOTS=MMTYP6
  187. SEGDES MLENTI,MLMOTS
  188. ENDIF
  189. IF(MLPARF.NE.0)THEN
  190. MLENTI=MLPARF
  191. SEGDES MLENTI
  192. ENDIF
  193. IF(MLREAC.NE.0)THEN
  194. MLENTI=MLREAC
  195. SEGDES MLENTI
  196. ENDIF
  197. IF(MLIMMO.NE.0)THEN
  198. MLENTI=MLIMMO
  199. SEGDES MLENTI
  200. ENDIF
  201. SEGDES MSOUPO,MPOVAL,MCHPOI
  202. C
  203. C ON SAUVE LE RESULTAT
  204. CALL ECROBJ('CHPOINT',MCHFIO)
  205. MSOUPO=MCHFIO.IPCHP(1)
  206. SEGDES ICHFIO,MCHFIO,MSOUPO
  207. RETURN
  208. END
  209.  
  210.  
  211.  
  212.  
  213.  
  214.  
  215.  
  216.  

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