Télécharger fimvf3.eso

Retour à la liste

Numérotation des lignes :

  1. C FIMVF3 SOURCE PV 16/11/17 21:59:25 9180
  2. SUBROUTINE FIMVF3(ILIINC,ICEN,IGRAV,IJAC)
  3. C************************************************************************
  4. C
  5. C PROJET : CASTEM 2000
  6. C
  7. C NOM : FIMVF3
  8. C
  9. C DESCRIPTION : VOIR FIMVF1
  10. C
  11. C Gaz ideal mono-espece:
  12. C jacobienne lié à la gravité.
  13. C
  14. C LANGAGE : FORTRAN 77 + ESOPE 2000 (avec extensions CISI)
  15. C
  16. C AUTEUR : A. BECCANTINI, DEN/DM2S/SFME/LTMF
  17. C
  18. C************************************************************************
  19. C
  20. C ENTREES :
  21. C
  22. C ILIINC : LISTMOTS, noms des inconnues
  23. C
  24. C ICEN : SPG geometrique
  25. C
  26. C IGRAV : CHPOINT gravité
  27. C
  28. C
  29. C SORTIES : IJAC : MATRIK jacobienne
  30. C
  31. C
  32. C************************************************************************
  33. C
  34. C HISTORIQUE (Anomalies et modifications éventuelles)
  35. C
  36. C HISTORIQUE : Créée le 24.1.03
  37. C
  38. C************************************************************************
  39. C
  40. C
  41. C**** Variables de COOPTIO
  42. C
  43. C INTEGER IPLLB, IERPER, IERMAX, IERR, INTERR
  44. C & ,IOTER, IOLEC, IOIMP, IOCAR, IOACQ
  45. C & ,IOPER, IOSGB, IOGRA, IOSAU, IORES
  46. C & ,IECHO, IIMPI, IOSPI
  47. C & ,IDIM
  48. C & ,MCOORD
  49. C & ,IFOMOD, NIFOUR, IFOUR, NSDPGE, IONIVE
  50. C & ,NGMAXY, IZROSF, ISOTYP, IOSCR, LTEXLU
  51. C & ,NORINC, NORVAL, NORIND, NORVAD
  52. C & ,NUCROU, IPSAUV, IFICLE, IPREFI
  53. C
  54. C**** Les variables
  55. C
  56. IMPLICIT INTEGER(I-N)
  57. INTEGER ILIINC,ICEN,IGRAV,IJAC,N1,NLCE
  58. & ,IGEOM
  59. & ,MP, NBEL, NBME, NBSOUS, NKID, NKMT, NMATRI, NP, NRIGE
  60. CHARACTER*8 TYPE
  61. REAL*8 GX, GY, GZ
  62. C
  63. C**** Les includes
  64. C
  65. -INC CCOPTIO
  66. -INC SMLMOTS
  67. -INC SMELEME
  68. -INC SMCHPOI
  69. C
  70. C**** Dual = ux (composante de la qdm)
  71. C Primal = rho
  72. C Matrice elementaire = UXR
  73. C
  74. POINTEUR UXR.IZAFM, UYR.IZAFM, UZR.IZAFM,
  75. & RETUX.IZAFM, RETUY.IZAFM, RETUZ.IZAFM
  76. C
  77. C**** Let's start programming!!!
  78. C
  79. IPT1 = ICEN
  80. SEGACT IPT1
  81. N1 = IPT1.NUM(/2)
  82. SEGDES IPT1
  83. C
  84. C**** Lecture de MPOVALs
  85. C
  86. CALL LICHT(IGRAV,MPOVA3,TYPE,IGEOM)
  87. C
  88. C**** LICHT active les MPOVALs en *MOD
  89. C
  90. C i.e.
  91. C
  92. C SEGACT MPOVA3*MOD
  93. C
  94. C
  95. C**** Objet MATRIK
  96. C
  97. NRIGE = 7
  98. NMATRI = 1
  99. NKID = 9
  100. NKMT = 7
  101. C
  102. SEGINI MATRIK
  103. IJAC = MATRIK
  104. MATRIK.IRIGEL(1,1) = ICEN
  105. MATRIK.IRIGEL(2,1) = ICEN
  106. C
  107. C**** Matrice non symetrique
  108. C
  109. MATRIK.IRIGEL(7,1) = 2
  110. C
  111. MLMOTS=ILIINC
  112. SEGACT MLMOTS
  113. NBSOUS = 1
  114. IF(IDIM.EQ.2)THEN
  115. NBME = 4
  116. SEGINI IMATRI
  117. MATRIK.IRIGEL(4,1) = IMATRI
  118. C
  119. IMATRI.LISPRI(1) = MLMOTS.MOTS(1)
  120. IMATRI.LISPRI(2) = MLMOTS.MOTS(1)
  121. IMATRI.LISPRI(3) = MLMOTS.MOTS(2)
  122. IMATRI.LISPRI(4) = MLMOTS.MOTS(3)
  123. C
  124. IMATRI.LISDUA(1) = MLMOTS.MOTS(2)
  125. IMATRI.LISDUA(2) = MLMOTS.MOTS(3)
  126. IMATRI.LISDUA(3) = MLMOTS.MOTS(4)
  127. IMATRI.LISDUA(4) = MLMOTS.MOTS(4)
  128. ELSEIF(IDIM.EQ.3)THEN
  129. C
  130. NBME = 6
  131. SEGINI IMATRI
  132. MATRIK.IRIGEL(4,1) = IMATRI
  133. C
  134. IMATRI.LISPRI(1) = MLMOTS.MOTS(1)
  135. IMATRI.LISPRI(2) = MLMOTS.MOTS(1)
  136. IMATRI.LISPRI(3) = MLMOTS.MOTS(1)
  137. IMATRI.LISPRI(4) = MLMOTS.MOTS(2)
  138. IMATRI.LISPRI(5) = MLMOTS.MOTS(3)
  139. IMATRI.LISPRI(6) = MLMOTS.MOTS(4)
  140. C
  141. IMATRI.LISDUA(1) = MLMOTS.MOTS(2)
  142. IMATRI.LISDUA(2) = MLMOTS.MOTS(3)
  143. IMATRI.LISDUA(3) = MLMOTS.MOTS(4)
  144. IMATRI.LISDUA(4) = MLMOTS.MOTS(5)
  145. IMATRI.LISDUA(5) = MLMOTS.MOTS(5)
  146. IMATRI.LISDUA(6) = MLMOTS.MOTS(5)
  147. ENDIF
  148. C
  149. SEGDES MLMOTS
  150. NBEL = N1
  151. NBSOUS = 1
  152. NP = 1
  153. MP = 1
  154. C
  155. IF(IDIM .EQ. 2)THEN
  156. SEGINI UXR, UYR, RETUX, RETUY
  157. IMATRI.LIZAFM(1,1) = UXR
  158. IMATRI.LIZAFM(1,2) = UYR
  159. IMATRI.LIZAFM(1,3) = RETUX
  160. IMATRI.LIZAFM(1,4) = RETUY
  161. ELSEIF(IDIM.EQ.3)THEN
  162. SEGINI UXR, UYR, UZR, RETUX, RETUY, RETUZ
  163. IMATRI.LIZAFM(1,1) = UXR
  164. IMATRI.LIZAFM(1,2) = UYR
  165. IMATRI.LIZAFM(1,3) = UZR
  166. IMATRI.LIZAFM(1,4) = RETUX
  167. IMATRI.LIZAFM(1,5) = RETUY
  168. IMATRI.LIZAFM(1,6) = RETUZ
  169. ENDIF
  170. C
  171. SEGDES MATRIK
  172. SEGDES IMATRI
  173. C SEGDES IMATRI
  174. C
  175. C**** Fin definition MATRIK
  176. C
  177. GZ = 0.0D0
  178. DO NLCE = 1, N1, 1
  179. C
  180. C******* Les differents variables a chaque centre
  181. C
  182. GX = MPOVA3.VPOCHA(NLCE,1)
  183. GY = MPOVA3.VPOCHA(NLCE,2)
  184. IF(IDIM .EQ. 3)THEN
  185. GZ = MPOVA3.VPOCHA(NLCE,3)
  186. ENDIF
  187. C
  188. UXR.AM(NLCE,1,1)=GX
  189. UYR.AM(NLCE,1,1)=GY
  190. RETUX.AM(NLCE,1,1)=GX
  191. RETUY.AM(NLCE,1,1)=GY
  192. IF(IDIM.EQ.3)THEN
  193. UZR.AM(NLCE,1,1)=GZ
  194. RETUZ.AM(NLCE,1,1)=GZ
  195. ENDIF
  196. ENDDO
  197. C
  198. SEGDES MPOVA3
  199. IF(IDIM .EQ. 2)THEN
  200. SEGDES UXR, UYR, RETUX, RETUY
  201. ELSEIF(IDIM.EQ.3)THEN
  202. SEGDES UXR, UYR, UZR, RETUX, RETUY, RETUZ
  203. ENDIF
  204. RETURN
  205. END
  206.  
  207.  
  208.  
  209.  
  210.  
  211.  
  212.  
  213.  
  214.  
  215.  
  216.  
  217.  
  218.  

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