Télécharger fioni.eso

Retour à la liste

Numérotation des lignes :

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

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