Télécharger fimvf3.eso

Retour à la liste

Numérotation des lignes :

fimvf3
  1. C FIMVF3 SOURCE CB215821 20/11/25 13:28:56 10792
  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.  
  66. -INC PPARAM
  67. -INC CCOPTIO
  68. -INC SMLMOTS
  69. -INC SMELEME
  70. -INC SMCHPOI
  71. C
  72. C**** Dual = ux (composante de la qdm)
  73. C Primal = rho
  74. C Matrice elementaire = UXR
  75. C
  76. POINTEUR UXR.IZAFM, UYR.IZAFM, UZR.IZAFM,
  77. & RETUX.IZAFM, RETUY.IZAFM, RETUZ.IZAFM
  78. C
  79. C**** Let's start programming!!!
  80. C
  81. IPT1 = ICEN
  82. SEGACT IPT1
  83. N1 = IPT1.NUM(/2)
  84. SEGDES IPT1
  85. C
  86. C**** Lecture de MPOVALs
  87. C
  88. CALL LICHT(IGRAV,MPOVA3,TYPE,IGEOM)
  89. C
  90. C**** LICHT active les MPOVALs en *MOD
  91. C
  92. C i.e.
  93. C
  94. C SEGACT MPOVA3*MOD
  95. C
  96. C
  97. C**** Objet MATRIK
  98. C
  99. NRIGE = 7
  100. NMATRI = 1
  101. NKID = 9
  102. NKMT = 7
  103. C
  104. SEGINI MATRIK
  105. IJAC = MATRIK
  106. MATRIK.IRIGEL(1,1) = ICEN
  107. MATRIK.IRIGEL(2,1) = ICEN
  108. C
  109. C**** Matrice non symetrique
  110. C
  111. MATRIK.IRIGEL(7,1) = 2
  112. C
  113. MLMOTS=ILIINC
  114. SEGACT MLMOTS
  115. NBSOUS = 1
  116. IF(IDIM.EQ.2)THEN
  117. NBME = 4
  118. SEGINI IMATRI
  119. MATRIK.IRIGEL(4,1) = IMATRI
  120. C
  121. IMATRI.LISPRI(1) = MLMOTS.MOTS(1)
  122. IMATRI.LISPRI(2) = MLMOTS.MOTS(1)
  123. IMATRI.LISPRI(3) = MLMOTS.MOTS(2)
  124. IMATRI.LISPRI(4) = MLMOTS.MOTS(3)
  125. C
  126. IMATRI.LISDUA(1) = MLMOTS.MOTS(2)
  127. IMATRI.LISDUA(2) = MLMOTS.MOTS(3)
  128. IMATRI.LISDUA(3) = MLMOTS.MOTS(4)
  129. IMATRI.LISDUA(4) = MLMOTS.MOTS(4)
  130. ELSEIF(IDIM.EQ.3)THEN
  131. C
  132. NBME = 6
  133. SEGINI IMATRI
  134. MATRIK.IRIGEL(4,1) = IMATRI
  135. C
  136. IMATRI.LISPRI(1) = MLMOTS.MOTS(1)
  137. IMATRI.LISPRI(2) = MLMOTS.MOTS(1)
  138. IMATRI.LISPRI(3) = MLMOTS.MOTS(1)
  139. IMATRI.LISPRI(4) = MLMOTS.MOTS(2)
  140. IMATRI.LISPRI(5) = MLMOTS.MOTS(3)
  141. IMATRI.LISPRI(6) = MLMOTS.MOTS(4)
  142. C
  143. IMATRI.LISDUA(1) = MLMOTS.MOTS(2)
  144. IMATRI.LISDUA(2) = MLMOTS.MOTS(3)
  145. IMATRI.LISDUA(3) = MLMOTS.MOTS(4)
  146. IMATRI.LISDUA(4) = MLMOTS.MOTS(5)
  147. IMATRI.LISDUA(5) = MLMOTS.MOTS(5)
  148. IMATRI.LISDUA(6) = MLMOTS.MOTS(5)
  149. ENDIF
  150. C
  151. SEGDES MLMOTS
  152. NBEL = N1
  153. NBSOUS = 1
  154. NP = 1
  155. MP = 1
  156. C
  157. IF(IDIM .EQ. 2)THEN
  158. SEGINI UXR, UYR, RETUX, RETUY
  159. IMATRI.LIZAFM(1,1) = UXR
  160. IMATRI.LIZAFM(1,2) = UYR
  161. IMATRI.LIZAFM(1,3) = RETUX
  162. IMATRI.LIZAFM(1,4) = RETUY
  163. ELSEIF(IDIM.EQ.3)THEN
  164. SEGINI UXR, UYR, UZR, RETUX, RETUY, RETUZ
  165. IMATRI.LIZAFM(1,1) = UXR
  166. IMATRI.LIZAFM(1,2) = UYR
  167. IMATRI.LIZAFM(1,3) = UZR
  168. IMATRI.LIZAFM(1,4) = RETUX
  169. IMATRI.LIZAFM(1,5) = RETUY
  170. IMATRI.LIZAFM(1,6) = RETUZ
  171. ENDIF
  172. C
  173. SEGDES MATRIK
  174. SEGDES IMATRI
  175. C SEGDES IMATRI
  176. C
  177. C**** Fin definition MATRIK
  178. C
  179. GZ = 0.0D0
  180. DO NLCE = 1, N1, 1
  181. C
  182. C******* Les differents variables a chaque centre
  183. C
  184. GX = MPOVA3.VPOCHA(NLCE,1)
  185. GY = MPOVA3.VPOCHA(NLCE,2)
  186. IF(IDIM .EQ. 3)THEN
  187. GZ = MPOVA3.VPOCHA(NLCE,3)
  188. ENDIF
  189. C
  190. UXR.AM(NLCE,1,1)=GX
  191. UYR.AM(NLCE,1,1)=GY
  192. RETUX.AM(NLCE,1,1)=GX
  193. RETUY.AM(NLCE,1,1)=GY
  194. IF(IDIM.EQ.3)THEN
  195. UZR.AM(NLCE,1,1)=GZ
  196. RETUZ.AM(NLCE,1,1)=GZ
  197. ENDIF
  198. ENDDO
  199. C
  200. SEGDES MPOVA3
  201. IF(IDIM .EQ. 2)THEN
  202. SEGDES UXR, UYR, RETUX, RETUY
  203. ELSEIF(IDIM.EQ.3)THEN
  204. SEGDES UXR, UYR, UZR, RETUX, RETUY, RETUZ
  205. ENDIF
  206. RETURN
  207. END
  208.  
  209.  
  210.  
  211.  
  212.  
  213.  
  214.  
  215.  
  216.  
  217.  
  218.  
  219.  
  220.  
  221.  
  222.  

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