Télécharger logk.eso

Retour à la liste

Numérotation des lignes :

  1. C LOGK SOURCE CHAT 06/03/29 21:27:14 5360
  2. SUBROUTINE LOGK
  3. C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  4. C
  5. C OPERATEUR LOGK
  6. C
  7. C CALCULE LA CONSTANTE APPARENTE DE LA LOI D'ACTION
  8. C DE MASSE ( DANS UNE SOLUTION CHIMIQUE)
  9. C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  10. IMPLICIT INTEGER(I-N)
  11. IMPLICIT REAL*8(A-H,O-Z)
  12. CHARACTER*8 MOCLE(2)
  13. CHARACTER*4 NOMTOT
  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,LISCAL.MLENTI
  23. POINTEUR MLNAME.MLMOTS,MLNESP.MLMOTS
  24. POINTEUR MLSOLU.MLENTI,MMSOLU.MLMOTS
  25. POINTEUR MCLOGK.MCHPOI,ICLOGK.MPOVAL
  26. POINTEUR MCHTMP.MCHPOI,ICHTMP.MPOVAL
  27. CHARACTER*8 TYPEMA
  28. SEGMENT IDSCHI
  29. REAL*8 GK(NYDIM),AA(NYDIM,NXDIM),FF(NZDIM,NPDIM)
  30. INTEGER IDX(NXDIM),IDY(NYDIM),IDZ(NZDIM),IDP(NPDIM),NN(6)
  31. INTEGER IDECY(NYDIM),IONZ(NXDIM)
  32. CHARACTER*32 NAME(NXDIM),NAMESP(NYDIM)
  33. ENDSEGMENT
  34. SEGMENT SP2
  35. REAL*8 GX(NXDIM),XX(NXDIM),GS(NZDIM),SS(NZDIM)
  36. REAL*8 TOT(NXDIM),TOTAQ(NXDIM),TOTFIX(NXDIM),GKS(NZDIM)
  37. REAL*8 YY(NXDIM),ZZ(NXDIM,NXDIM),CC(NYDIM),GC(NYDIM)
  38. ENDSEGMENT
  39. SEGMENT IZBID
  40. INTEGER IBID(NLISCA)
  41. ENDSEGMENT
  42. DATA MOCLE/'FORCEION','TEMPERAT'/
  43. C
  44.  
  45. ICOTY3=0
  46. C
  47. C LECTURE DE LA TABLE CHIMI1
  48. CALL CHMDEB(MLAA,MLOGK,MLFF,MLIDX,MLIDY,MLIDZ,MLIDP,MLNN,MLDECY,
  49. * MLNAME,MLIONZ,ITIDEN,ITREDO,ITEMPE,MLNESP)
  50. IF(IERR.NE.0)RETURN
  51. C
  52. C LECTURE DE LA TABLE IDEN
  53. C TOUS LES SEGMENTS REVIENNENT ACTIFS OU AVEC UN POINTEUR NUL
  54. C
  55. CALL CHMIDE(ITIDEN,MLCOMP,MLSOLU,MMSOLU,MLPREC,MMPREC,MLSURF,
  56. * MMSURF,MLTYP3,MMTYP3,MLTYP6,MMTYP6,MLPARF,MLREAC,MLIMMO,
  57. * MLPOLE,MMPOLE,MLSOSO,MMSOSO,LIMP3)
  58. IF(IERR.NE.0)RETURN
  59. C
  60. C
  61. C LECTURE DE LA TABLE TEMPE(SI ELLE EXISTE)
  62. C TOUS LES SEGMENTS REVIENNENT ACTIFS OU AVEC UN POINTEUR NUL
  63. CALL CHMTET(ITEMPE,LGKMOD,LGKTMP,IP1,IP2,IP3,IP4,IP5)
  64. IF(IERR.NE.0)RETURN
  65. LTMP=0
  66. IF(LGKMOD.NE.0)LTMP=IP3
  67. C
  68. C
  69. JCHTMP=0
  70. JCHFIO=0
  71. NPN=0
  72. LISCAL=0
  73. 10 CONTINUE
  74. IF(LISCAL.EQ.0)THEN
  75. ICO1=0
  76. CALL LIROBJ('LISTENTI',LISCAL,ICO1,IRETOU)
  77. ENDIF
  78. ICOND=0
  79. CALL LIRMOT(MOCLE,2,IRAN,ICOND)
  80. IF(IERR.NE.0)RETURN
  81. IF(IRAN.EQ.1)THEN
  82. C
  83. C
  84. C LECTURE DU CHPOIN DES FORCES IONIQUES
  85. C
  86. CALL LIROBJ('CHPOINT',JCHFIO,0,IRETOU)
  87. IF(IRETOU.EQ.0)THEN
  88. CALL ERREUR(21)
  89. RETURN
  90. ENDIF
  91. MCHPOI=JCHFIO
  92. SEGACT MCHPOI
  93. NSOUPO=IPCHP(/1)
  94. IF(NSOUPO.NE.1)THEN
  95. CALL ERREUR(21)
  96. RETURN
  97. ENDIF
  98. MSOUPO=IPCHP(1)
  99. SEGACT MSOUPO
  100. MELEME=IGEOC
  101. MPOVAL=IPOVAL
  102. SEGACT MPOVAL
  103. NPN=VPOCHA(/1)
  104. GO TO 10
  105. ENDIF
  106. IF(IRAN.EQ.2)THEN
  107. C
  108. C
  109. C LECTURE DU CHPOIN DES TEMPERATURES
  110. C
  111. CALL LIROBJ('CHPOINT',JCHTMP,0,IRETOU)
  112. IF(IRETOU.EQ.0)THEN
  113. CALL ERREUR(21)
  114. RETURN
  115. ENDIF
  116. GO TO 10
  117. ENDIF
  118. IF(JCHTMP.NE.0)THEN
  119. IF(JCHFIO.NE.0)THEN
  120. INDIQ=1
  121. NBCOMP=-1
  122. NOMTOT=' '
  123. CALL QUEPOI(JCHTMP,MELEME,INDIQ,NBCOMP,NOMTOT)
  124. IF(INDIQ.LT.0)THEN
  125. CALL ERREUR(22)
  126. ENDIF
  127. IF(IERR.NE.0)RETURN
  128. ENDIF
  129. MCHTMP=JCHTMP
  130. CALL LICHT(MCHTMP,ICHTMP,TYPEMA,IGEOM)
  131. NPN=ICHTMP.VPOCHA(/1)
  132. MELEME=IGEOM
  133. ENDIF
  134. IF(NPN.EQ.0)THEN
  135. CALL ERREUR(641)
  136. RETURN
  137. ENDIF
  138. C
  139. C ON ACTIVE LES SEGMENTS
  140. C ET ON DEFINIT LES TABLEAUX DE TRAVAIL
  141. SEGACT MLAA,MLOGK,MLFF,MLIDX,MLIDY,MLIDZ,MLNN,MLDECY,MLNAME,MLNESP
  142. SEGACT MLIONZ,MLIDP
  143. NXDIM=MLIDX.LECT(/1)
  144. NYDIM=MLIDY.LECT(/1)
  145. NZDIM=MLIDZ.LECT(/1)
  146. NPDIM=MLIDP.LECT(/1)
  147. SEGINI IDSCHI
  148. SEGINI SP2
  149. C
  150. C LE CHPOINT RESULTAT
  151. JGM=NYDIM
  152. JGN=4
  153. IF(LISCAL.NE.0)THEN
  154. SEGACT LISCAL
  155. JGM=LISCAL.LECT(/1)
  156. ENDIF
  157. NLISCA=JGM
  158. SEGINI MLMOTS,IZBID
  159. IF(LISCAL.EQ.0)THEN
  160. DO 11 I=1,NYDIM
  161. IBID(I)=I
  162. 11 CONTINUE
  163. ELSE
  164. DO 12 I=1,NLISCA
  165. DO 13 J=1,NYDIM
  166. IF(LISCAL.LECT(I).EQ.MLIDY.LECT(J))THEN
  167. IBID(I)=J
  168. GO TO 14
  169. ENDIF
  170. 13 CONTINUE
  171. CALL ERREUR(21)
  172. RETURN
  173. 14 CONTINUE
  174. 12 CONTINUE
  175. ENDIF
  176. 110 FORMAT('W',I3.3)
  177. DO 15 I=1,NLISCA
  178. WRITE(MOTS(I),110)IBID(I)
  179. 15 CONTINUE
  180. CALL CHMCRC(MLMOTS,MELEME,NPN,MCLOGK,ICLOGK)
  181. SEGSUP MLMOTS
  182. C
  183. C INITIALISATION
  184. SEGACT MELEME
  185.  
  186. C
  187. C -------------------------------------------------------------------
  188. C BOUCLE SUR LES POINTS
  189. C -------------------------------------------------------------------
  190. DO 100 II=1,NPN
  191. C CHARGEMENT DE IDSCHI
  192. CALL CHMIDS(MLAA,MLOGK,MLFF,MLIDX,MLIDY,MLIDZ,MLIDP,MLNN,MLDECY,
  193. * MLNAME,MLIONZ,IDSCHI,MLNESP)
  194. C WRITE(6,*)' GK apres CHMIDS '
  195. C WRITE(6,120)(GK(J),IDY(J),J=1,NYDIM)
  196. 120 FORMAT(6(1X,1PD12.5,I5))
  197. C CHARGEMENT EVENTUEL DE LGKMOD OU LGKTMP
  198. CALL CHMLGK(LGKMOD,LGKTMP,IP1,IP2,IP3,IP4,IP5)
  199. C
  200. XMU=0.D0
  201. XMUNEW=0.D0
  202. IF(JCHFIO.NE.0)THEN
  203. XMUNEW=VPOCHA(II,1)
  204. ENDIF
  205. TMP=25.D0
  206. TMPNEW=25.D0
  207. IF(JCHTMP.NE.0)TMPNEW=ICHTMP.VPOCHA(II,1)
  208. CALL CHMKMD(IDSCHI,LGKMOD,LGKTMP,ICOTY3,LTMP,TMP,TMPNEW,
  209. * XMU,XMUNEW,GNEW)
  210. DO 95 J=1,NLISCA
  211. ICLOGK.VPOCHA(II,J)=GK(IBID(J))
  212. 95 CONTINUE
  213. 100 CONTINUE
  214. C --------------------------------------------------------------
  215. C LE MENAGE
  216. C
  217. SEGSUP IDSCHI
  218. SEGSUP SP2,IZBID
  219. C
  220. C ON DESACTIVE LES DONNEES
  221. SEGDES MLAA,MLOGK,MLFF,MLIDX,MLIDY,MLIDZ,MLNN,MLDECY,MLNAME,MLNESP
  222. SEGDES MLIONZ,MLIDP
  223. SEGDES MELEME
  224. MLENTI=MLCOMP
  225. SEGDES MLENTI
  226. IF(MLSOSO.NE.0)THEN
  227. MLENTI=MLSOSO
  228. MLMOTS=MMSOSO
  229. SEGDES MLENTI,MLMOTS
  230. ENDIF
  231. IF(MLPOLE.NE.0)THEN
  232. MLENTI=MLPOLE
  233. MLMOTS=MMPOLE
  234. SEGDES MLENTI,MLMOTS
  235. ENDIF
  236. IF(MLSOLU.NE.0)THEN
  237. MLENTI=MLSOLU
  238. MLMOTS=MMSOLU
  239. SEGDES MLENTI,MLMOTS
  240. ENDIF
  241. IF(MLPREC.NE.0)THEN
  242. MLENTI=MLPREC
  243. MLMOTS=MMPREC
  244. SEGDES MLENTI,MLMOTS
  245. ENDIF
  246. IF(MLSURF.NE.0)THEN
  247. MLENTI=MLSURF
  248. MLMOTS=MMSURF
  249. SEGDES MLENTI,MLMOTS
  250. ENDIF
  251. IF(MLTYP3.NE.0)THEN
  252. MLENTI=MLTYP3
  253. MLMOTS=MMTYP3
  254. SEGDES MLENTI,MLMOTS
  255. ENDIF
  256. IF(MLTYP6.NE.0)THEN
  257. MLENTI=MLTYP6
  258. MLMOTS=MMTYP6
  259. SEGDES MLENTI,MLMOTS
  260. ENDIF
  261. IF(MLPARF.NE.0)THEN
  262. MLENTI=MLPARF
  263. SEGDES MLENTI
  264. ENDIF
  265. IF(MLREAC.NE.0)THEN
  266. MLENTI=MLREAC
  267. SEGDES MLENTI
  268. ENDIF
  269. IF(MLIMMO.NE.0)THEN
  270. MLENTI=MLIMMO
  271. SEGDES MLENTI
  272. ENDIF
  273. IF(JCHTMP.NE.0)THEN
  274. SEGDES ICHTMP
  275. ENDIF
  276. IF(JCHFIO.NE.0)THEN
  277. SEGDES MSOUPO,MPOVAL,MCHPOI
  278. ENDIF
  279. IF(LISCAL.NE.0)THEN
  280. SEGDES LISCAL
  281. ENDIF
  282. CALL CHMDGK(LGKMOD,LGKTMP,IP1,IP2,IP3,IP4,IP5)
  283. C
  284. C ON SAUVE LE RESULTAT
  285. CALL ECROBJ('CHPOINT',MCLOGK)
  286. MSOUPO=MCLOGK.IPCHP(1)
  287. SEGDES ICLOGK,MCLOGK,MSOUPO
  288. RETURN
  289. END
  290.  
  291.  
  292.  
  293.  
  294.  
  295.  
  296.  
  297.  
  298.  
  299.  

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