Télécharger konjs1.eso

Retour à la liste

Numérotation des lignes :

  1. C KONJS1 SOURCE PV 16/11/17 22:00:11 9180
  2. SUBROUTINE KONJS1(INDMET,ILINC,ISF,IUN,INORM,ICHPVO
  3. $ ,ICHPSU,MELEMC,MELEMF,MELEFE,IMAT)
  4. C
  5. C************************************************************************
  6. C
  7. C PROJET : CASTEM 2000
  8. C
  9. C NOM : KONJS1
  10. C
  11. C DESCRIPTION : Voir KONV15
  12. C Calcul du jacobien du résidu
  13. C Cas 2D/3D
  14. C
  15. C LANGAGE : FORTRAN 77 + ESOPE 2000 (avec estensions CISI)
  16. C
  17. C AUTEUR : A. BECCANTINI, SFME/LTMF
  18. C
  19. C************************************************************************
  20. C
  21. C
  22. C APPELES (Outils
  23. C CASTEM) : KRIPAD, LICHT, ERREUR
  24. C
  25. C APPELES (Calcul) :
  26. C
  27. C************************************************************************
  28. C
  29. C ENTREES
  30. C
  31. C INDMET : type de Methode
  32. C 1 UPWIND
  33. C 2 CENTERED
  34. C
  35. C ILINC : liste des inconnues
  36. C
  37. C 1) Pointeurs des CHPOINT/CHAMELEM
  38. C
  39. C IUN : CHPOINT FACE contenant la vitesse ;
  40. C
  41. C ISF : CHAMELEM 'FACEL' contenant les scalaires à transporter
  42. C
  43. C INORM : CHPOINT FACE contenant les normales aux faces ;
  44. C
  45. C ICHPVO : CHPOINT VOLUME contenant le volume
  46. C
  47. C ICHPSU : CHPOINT FACE contenant la surface des faces
  48. C
  49. C
  50. C 2) Pointeurs de MELEME de la table DOMAINE
  51. C
  52. C MELEMC : MELEME 'CENTRE' du SPG des CENTRES
  53. C
  54. C MELEFE : MELEME 'FACEL' du connectivité Faces -> Elts
  55. C
  56. C SORTIES
  57. C
  58. C IMAT : pointeur de la MATRIK du jacobien du residu
  59. C
  60. C************************************************************************
  61. C
  62. C HISTORIQUE (Anomalies et modifications éventuelles)
  63. C
  64. C HISTORIQUE : Créée le 03.12.01
  65. C
  66. C************************************************************************
  67. C
  68. C
  69. C**** Variables de COOPTIO
  70. C
  71. C INTEGER IPLLB, IERPER, IERMAX, IERR, INTERR
  72. C & ,IOTER, IOLEC, IOIMP, IOCAR, IOACQ
  73. C & ,IOPER, IOSGB, IOGRA, IOSAU, IORES
  74. C & ,IECHO, IIMPI, IOSPI
  75. C & ,IDIM
  76. C & ,MCOORD
  77. C & ,IFOMOD, NIFOUR, IFOUR, NSDPGE, IONIVE
  78. C & ,NGMAXY, IZROSF, ISOTYP, IOSCR,LTEXLU
  79. C & ,NORINC,NORVAL,NORIND,NORVAD
  80. C & ,NUCROU, IPSAUV
  81. C
  82. IMPLICIT INTEGER(I-N)
  83. INTEGER ILINC, ISF ,IUN, INORM,ICHPVO,ICHPSU
  84. & , IMAT, IGEOMC, IGEOMF
  85. & , NFAC, NBSOUS, NBREF, NBELEM, NBNN, NRIGE, NMATRI, NKID
  86. & , NKMT, NBME, NBEL, MP, NP
  87. & , IFAC, NGCF, NLCF, NGCG, NGCD, NLCG, NLCD, NINC, IINC
  88. & ,INDMET
  89. REAL*8 UNX, UNY, UNZ, UN, VOLG, VOLD
  90. & , SURF, CNX, CNY, CNZ, FUNCEL
  91. CHARACTER*8 TYPE
  92. C
  93. C**** LES INCLUDES
  94. C
  95. -INC CCOPTIO
  96. -INC SMCHPOI
  97. -INC SMELEME
  98. -INC SMLMOTS
  99. -INC SMLENTI
  100. POINTEUR MPUN.MPOVAL,
  101. & MPNORM.MPOVAL, MPVOLU.MPOVAL, MPOVSU.MPOVAL
  102. POINTEUR MELEMC.MELEME, MELEMF.MELEME, MELEFE.MELEME,
  103. & MELEDU.MELEME
  104. POINTEUR MLENTC.MLENTI, MLENTF.MLENTI
  105. POINTEUR MATSS.IZAFM
  106. POINTEUR MLMINC.MLMOTS
  107. C
  108. C**** KRIPAD pour la correspondance global/local des centres
  109. C
  110. CALL KRIPAD(MELEMC,MLENTC)
  111. C
  112. C SEGACT MLENTC
  113. SEGACT MELEMC
  114. C
  115. SEGACT MELEFE
  116. C
  117. CALL LICHT(ICHPSU,MPOVSU,TYPE,IGEOMF)
  118. CALL LICHT(INORM,MPNORM,TYPE,IGEOMF)
  119. CALL LICHT(ICHPVO,MPVOLU,TYPE,IGEOMC)
  120. C
  121. C**** LICHT active les MPOVALs en *MOD
  122. C
  123. C i.e.
  124. C
  125. C SEGACT MPOVSU*MOD
  126. C SEGACT MPOVNO*MOD
  127. C SEGACT MPVOLU*MOD
  128. C
  129. MELEMF = IGEOMF
  130. CALL KRIPAD(MELEMF,MLENTF)
  131. C
  132. C SEGACT MLENTF
  133. SEGACT MELEMF
  134. C
  135. CALL LICHT(IUN,MPUN,TYPE,IGEOMC)
  136. C
  137. C SEGACT MPUN*MOD
  138. C
  139. NFAC = MELEFE.NUM(/2)
  140. C
  141. C**** Maillage des inconnues primales
  142. C
  143. NBSOUS = 0
  144. NBREF = 0
  145. NBELEM = NFAC
  146. NBNN = 2
  147. C
  148. SEGINI MELEDU
  149. C MELEPR = MELEDU
  150. C
  151. C**** MELEDU = 'SEG2'
  152. C
  153. MELEDU.ITYPEL = 2
  154. C
  155. NRIGE = 7
  156. NMATRI = 1
  157. NKID = 9
  158. NKMT = 7
  159. C
  160. SEGINI MATRIK
  161. IMAT = MATRIK
  162. MATRIK.IRIGEL(1,1) = MELEDU
  163. MATRIK.IRIGEL(2,1) = MELEDU
  164. C
  165. C**** Matrice non symetrique
  166. C
  167. MATRIK.IRIGEL(7,1) = 2
  168. C
  169. MLMINC = ILINC
  170. SEGACT MLMINC
  171. NINC=MLMINC.MOTS(/2)
  172. NBME = NINC
  173. NBSOUS = 1
  174. SEGINI IMATRI
  175. MATRIK.IRIGEL(4,1) = IMATRI
  176. C
  177. NBEL = NBELEM
  178. NBSOUS = 1
  179. NP = 2
  180. MP = 2
  181. DO IINC=1,NINC,1
  182. IMATRI.LISPRI(IINC) = MLMINC.MOTS(IINC)
  183. IMATRI.LISDUA(IINC) = MLMINC.MOTS(IINC)
  184. SEGINI MATSS
  185. IMATRI.LIZAFM(1,IINC) = MATSS
  186. ENDDO
  187. C
  188. DO IFAC = 1, NFAC, 1
  189. NGCF = MELEFE.NUM(2,IFAC)
  190. NLCF = MLENTF.LECT(NGCF)
  191. IF(NLCF .NE. IFAC)THEN
  192. WRITE(IOIMP,*) 'Il ne faut pas jouer avec la table domaine'
  193. CALL ERREUR(5)
  194. GOTO 9999
  195. ENDIF
  196. NGCG = MELEFE.NUM(1,IFAC)
  197. NGCD = MELEFE.NUM(3,IFAC)
  198. SURF = MPOVSU.VPOCHA(NLCF,1)
  199. CNX = MPNORM.VPOCHA(NLCF,1)
  200. CNY = MPNORM.VPOCHA(NLCF,2)
  201. UNX = MPUN.VPOCHA(NLCF,1)
  202. UNY = MPUN.VPOCHA(NLCF,2)
  203. UN= (UNX*CNX) + (UNY*CNY)
  204. IF(IDIM .EQ. 3)THEN
  205. CNZ = MPNORM.VPOCHA(NLCF,3)
  206. UNZ = MPUN.VPOCHA(NLCF,3)
  207. UN=UN+(UNZ*CNZ)
  208. ENDIF
  209. IF(NGCG .NE. NGCD)THEN
  210. C
  211. C********** Les MELEMEs
  212. C
  213. MELEDU.NUM(1,IFAC) = NGCG
  214. MELEDU.NUM(2,IFAC) = NGCD
  215. C
  216. C********** Les etats G et D
  217. C
  218. NLCG = MLENTC.LECT(NGCG)
  219. NLCD = MLENTC.LECT(NGCD)
  220. VOLG = MPVOLU.VPOCHA(NLCG,1)
  221. VOLD = MPVOLU.VPOCHA(NLCD,1)
  222. C
  223. C********** MATSS.AM(IFAC,IPRIM,IDUAL)
  224. C IPRIM = 1, 2 -> G, D
  225. C IDUAL = 1, 2 -> G, D
  226. C
  227. C********** Dual RN
  228. C
  229. IF(INDMET .EQ. 1)THEN
  230. FUNCEL = SURF * UN
  231. IF(UN .GT. 0)THEN
  232. DO IINC=1,NINC,1
  233. MATSS=IMATRI.LIZAFM(1,IINC)
  234. MATSS.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  235. MATSS.AM(IFAC,1,2) = FUNCEL / VOLD
  236. MATSS.AM(IFAC,2,1) = 0.0D0
  237. MATSS.AM(IFAC,2,2) = 0.0D0
  238. ENDDO
  239. ELSE
  240. DO IINC=1,NINC,1
  241. MATSS=IMATRI.LIZAFM(1,IINC)
  242. MATSS.AM(IFAC,2,2) = FUNCEL / VOLD
  243. MATSS.AM(IFAC,2,1) = -1.0D0 * FUNCEL / VOLG
  244. MATSS.AM(IFAC,1,1) = 0.0D0
  245. MATSS.AM(IFAC,1,2) = 0.0D0
  246. ENDDO
  247. ENDIF
  248. ELSEIF(INDMET .EQ.2)THEN
  249. FUNCEL = SURF * UN * 0.5D0
  250. DO IINC=1,NINC,1
  251. MATSS=IMATRI.LIZAFM(1,IINC)
  252. MATSS.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  253. MATSS.AM(IFAC,1,2) = FUNCEL / VOLD
  254. MATSS.AM(IFAC,2,1) = -1.0D0 * FUNCEL /VOLG
  255. MATSS.AM(IFAC,2,2) = FUNCEL / VOLD
  256. ENDDO
  257. ELSE
  258. CALL ERREUR(251)
  259. GOTO 9999
  260. ENDIF
  261. ELSE
  262. C
  263. C********** Murs (NGCG = NGCD)
  264. C
  265. C
  266. C********** Les MELEMEs
  267. C
  268. MELEDU.NUM(1,IFAC) = NGCG
  269. MELEDU.NUM(2,IFAC) = NGCD
  270. NLCG = MLENTC.LECT(NGCG)
  271. VOLG = MPVOLU.VPOCHA(NLCG,1)
  272. C
  273. IF((INDMET .EQ. 1).OR.(INDMET .EQ. 2))THEN
  274. FUNCEL = SURF * UN
  275. DO IINC=1,NINC,1
  276. MATSS=IMATRI.LIZAFM(1,IINC)
  277. MATSS.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  278. MATSS.AM(IFAC,1,2) = 0.0D0
  279. MATSS.AM(IFAC,2,1) = 0.0D0
  280. MATSS.AM(IFAC,2,2) = 0.0D0
  281. ENDDO
  282. ELSE
  283. CALL ERREUR(251)
  284. GOTO 9999
  285. ENDIF
  286. ENDIF
  287. ENDDO
  288. C
  289. SEGDES MELEMC
  290. SEGDES MELEFE
  291. SEGDES MELEMF
  292. C
  293. SEGDES MPOVSU
  294. SEGDES MPVOLU
  295. SEGDES MPNORM
  296. C
  297. SEGDES MPUN
  298. C
  299. SEGDES MELEDU
  300. SEGDES MATRIK
  301. DO IINC=1,NINC,1
  302. MATSS=IMATRI.LIZAFM(1,IINC)
  303. SEGDES MATSS
  304. ENDDO
  305. SEGDES IMATRI
  306. C
  307. SEGSUP MLENTC
  308. SEGSUP MLENTF
  309. SEGDES MLMINC
  310.  
  311. 9999 CONTINUE
  312. RETURN
  313. END
  314.  
  315.  
  316.  
  317.  
  318.  
  319.  
  320.  
  321.  
  322.  

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