Télécharger la plaquette Cast3M


fr en

Télécharger konjc1.eso

Retour à la liste

Numérotation des lignes : 

konjc1

  1. C KONJC1    SOURCE    OF166741  24/12/13    21:16:36     12097          
  2.       SUBROUTINE KONJC1(ILINC,IRN,IUN,IPN,IGAMN,INORM,ICHPVO
  3.      $     ,ICHPSU,MELEMC,MELEFE,MELLIM,IMAT)
  4. C
  5. C************************************************************************
  6. C
  7. C PROJET            :  CASTEM 2000
  8. C
  9. C NOM               :  KONJC1
  10. C
  11. C DESCRIPTION       :  Voir KON12
  12. C                      Calcul du jacobien du résidu pour la méthode
  13. C                      centrée
  14. C
  15. C                      Cas deux dimensions, gaz "calorically perfect"
  16. C
  17. C LANGAGE           :  FORTRAN 77 + ESOPE 2000 (avec estensions CISI)
  18. C
  19. C AUTEUR            :  A. BECCANTINI, DRN/DMT/SEMT/LTMF
  20. C
  21. C************************************************************************
  22. C
  23. C
  24. C APPELES (Outils
  25. C          CASTEM)  :  KRIPAD, LICHT, ERREUR
  26. C
  27. C APPELES (Calcul)  :  CENTJ0, CENTJ2
  28. C
  29. C************************************************************************
  30. C
  31. C ENTREES
  32. C
  33. C     ILINC  : liste des inconnues (pointeur d'un objet de type LISTMOTS)
  34. C
  35. C  1) Pointeurs des CHPOINT
  36. C
  37. C     IRN     : CHPOINT CENTRE  contenant la masse volumique ;
  38. C
  39. C     IUN     : CHPOINT CENTRE  contenant la vitesse ;
  40. C
  41. C     IPN     : CHPOINT CENTRE  contenant la pression ;
  42. C
  43. C     IGAMN   : CHPOINT CENTRE  contenant le gamma ;
  44. C
  45. C     INORM   : CHPOINT FACE    contenant les normales aux faces ;
  46. C
  47. C     ICHPVO  : CHPOINT VOLUME  contenant le volume
  48. C
  49. C     ICHPSU  : CHPOINT FACE    contenant la surface des faces
  50. C
  51. C
  52. C  2) Pointeurs de MELEME de la table DOMAINE
  53. C
  54. C     MELEMC  : MELEME 'CENTRE' du SPG des CENTRES
  55. C
  56. C     MELEFE  : MELEME 'FACEL' du connectivité Faces -> Elts
  57. C
  58. C     MELLIM  : MELEME sur lequel on ne veut pas calculer
  59. C               la contribution à la matrice jacobienne
  60. C
  61. C SORTIES
  62. C
  63. C     IMAT    : pointeur de la MATRIK du jacobien du residu
  64. C
  65. C************************************************************************
  66. C
  67. C HISTORIQUE (Anomalies et modifications éventuelles)
  68. C
  69. C HISTORIQUE :
  70. C
  71. C************************************************************************
  72. C
  73. C
  74. C N.B.: On suppose qu'on a déjà controllé RO, P > 0
  75. C                                         GAMMA \in (1,3)
  76. C       Si non il faut le faire!!!
  77. C
  78. C************************************************************************
  79. C
  80.       IMPLICIT INTEGER(I-N)
  81.       INTEGER ILINC, IRN,IUN,IPN,IGAMN,INORM,ICHPVO,ICHPSU
  82.      &        , IMAT, IGEOMC, IGEOMF
  83.      &        , NFAC, NBSOUS, NBREF, NBELEM, NBNN, NRIGE, NMATRI, NKID
  84.      &        , NKMT, NBME, NBEL,  MP, NP
  85.      &        , IFAC, NGCF, NLCF, NGCG, NGCD, NLCG, NLCD, NLFL
  86.       REAL*8 ROG, PG, UXG, UYG, GAMG, VOLG
  87.      &       , ROD, PD, UXD, UYD, GAMD, VOLD
  88.      &       , SURF, CNX, CNY, CTX, CTY, FUNCEL
  89.      &       , DFRO(4), DFRET(4), DFRUN(4), DFRUT(4)
  90.       CHARACTER*8 TYPE
  91. C
  92. C**** LES INCLUDES
  93. C
  94.  
  95. -INC PPARAM
  96. -INC CCOPTIO
  97. -INC SMCHPOI
  99. -INC SMELEME
  100. -INC SMLMOTS
  101. -INC SMLENTI
  102.       POINTEUR MPRN.MPOVAL, MPUN.MPOVAL, MPPN.MPOVAL, MPGAMN.MPOVAL,
  103.      &         MPNORM.MPOVAL, MPVOLU.MPOVAL, MPOVSU.MPOVAL
  104.       POINTEUR MELEMC.MELEME, MELEMF.MELEME, MELEFE.MELEME,
  105.      &         MELEDU.MELEME, MELLIM.MELEME
  106.       POINTEUR MLENTC.MLENTI, MLENTF.MLENTI, MLELIM.MLENTI
  107.       POINTEUR RR.IZAFM, RUX.IZAFM, RUY.IZAFM, RRET.IZAFM,
  108.      &         UXR.IZAFM, UXUX.IZAFM, UXUY.IZAFM, UXRET.IZAFM,
  109.      &         UYR.IZAFM, UYUX.IZAFM, UYUY.IZAFM, UYRET.IZAFM,
  110.      &         RETR.IZAFM, RETUX.IZAFM, RETUY.IZAFM, RETRET.IZAFM
  111.       POINTEUR MLMINC.MLMOTS
  112. C
  113. C**** KRIPAD pour la correspondance global/local des conditions limits
  114. C
  115.       CALL KRIPAD(MELLIM,MLELIM)
  116. c     SEGACT MELLIM
  117. C
  118. C**** KRIPAD pour la correspondance global/local des centres
  119. C
  120.       CALL KRIPAD(MELEMC,MLENTC)
  121. C
  122. C     SEGACT MLENTC
  123.       SEGACT MELEMC
  124. C
  125.       SEGACT MELEFE
  126. C
  127.       CALL LICHT(ICHPSU,MPOVSU,TYPE,IGEOMF)
  128.       CALL LICHT(INORM,MPNORM,TYPE,IGEOMF)
  129.       CALL LICHT(ICHPVO,MPVOLU,TYPE,IGEOMC)
  130. C
  131. C**** LICHT active les MPOVALs en *MOD
  132. C
  133. C     i.e.
  134. C
  135. C     SEGACT MPOVSU*MOD
  136. C     SEGACT MPOVNO*MOD
  137. C     SEGACT MPVOLU*MOD
  138. C
  139.       MELEMF = IGEOMF
  140.       CALL KRIPAD(MELEMF,MLENTF)
  141. C
  142. C     SEGACT MLENTF
  143.       SEGACT MELEMF
  144. C
  145.       CALL LICHT(IRN,MPRN,TYPE,IGEOMC)
  146.       CALL LICHT(IPN,MPPN,TYPE,IGEOMC)
  147.       CALL LICHT(IUN,MPUN,TYPE,IGEOMC)
  148.       CALL LICHT(IGAMN,MPGAMN,TYPE,IGEOMC)
  149. C
  150. C     SEGACT MPRN*MOD
  151. C     SEGACT MPPN*MOD
  152. C     SEGACT MPUN*MOD
  153. C     SEGACT MPGAMN*MOD
  154. C
  155.       NFAC = MELEFE.NUM(/2)
  156. C
  157. C**** Maillage des inconnues primales
  158. C
  159.       NBSOUS = 0
  160.       NBREF = 0
  161.       NBELEM =  NFAC
  162.       NBNN = 2
  163. C
  164.       SEGINI MELEDU
  165. C     MELEPR = MELEDU
  166. C
  167. C**** MELEDU = 'SEG2'
  168. C
  169.       MELEDU.ITYPEL =  2
  170. C
  171.       NRIGE = 7
  172.       NMATRI = 1
  173.       NKID = 9
  174.       NKMT = 7
  175. C
  176.       SEGINI MATRIK
  177.       IMAT = MATRIK
  178.       MATRIK.IRIGEL(1,1) = MELEDU
  179.       MATRIK.IRIGEL(2,1) = MELEDU
  180. C
  181. C**** Matrice non symetrique
  182. C
  183.       MATRIK.IRIGEL(7,1) = 2
  184. C
  185.       NBME = 16
  186.       NBSOUS = 1
  187.       SEGINI IMATRI
  188.       MLMINC = ILINC
  189.       SEGACT MLMINC
  190.       MATRIK.IRIGEL(4,1) = IMATRI
  191. C
  192.       IMATRI.LISPRI(1) = MLMINC.MOTS(1)
  193.       IMATRI.LISPRI(2) = MLMINC.MOTS(2)
  194.       IMATRI.LISPRI(3) = MLMINC.MOTS(3)
  195.       IMATRI.LISPRI(4) = MLMINC.MOTS(4)
  196.       IMATRI.LISPRI(5) = MLMINC.MOTS(1)
  197.       IMATRI.LISPRI(6) = MLMINC.MOTS(2)
  198.       IMATRI.LISPRI(7) = MLMINC.MOTS(3)
  199.       IMATRI.LISPRI(8) = MLMINC.MOTS(4)
  200.       IMATRI.LISPRI(9) = MLMINC.MOTS(1)
  201.       IMATRI.LISPRI(10) = MLMINC.MOTS(2)
  202.       IMATRI.LISPRI(11) = MLMINC.MOTS(3)
  203.       IMATRI.LISPRI(12) = MLMINC.MOTS(4)
  204.       IMATRI.LISPRI(13) = MLMINC.MOTS(1)
  205.       IMATRI.LISPRI(14) = MLMINC.MOTS(2)
  206.       IMATRI.LISPRI(15) = MLMINC.MOTS(3)
  207.       IMATRI.LISPRI(16) = MLMINC.MOTS(4)
  208. C
  209.       IMATRI.LISDUA(1) = MLMINC.MOTS(1)
  210.       IMATRI.LISDUA(2) = MLMINC.MOTS(1)
  211.       IMATRI.LISDUA(3) = MLMINC.MOTS(1)
  212.       IMATRI.LISDUA(4) = MLMINC.MOTS(1)
  213.       IMATRI.LISDUA(5) = MLMINC.MOTS(2)
  214.       IMATRI.LISDUA(6) = MLMINC.MOTS(2)
  215.       IMATRI.LISDUA(7) = MLMINC.MOTS(2)
  216.       IMATRI.LISDUA(8) = MLMINC.MOTS(2)
  217.       IMATRI.LISDUA(9) = MLMINC.MOTS(3)
  218.       IMATRI.LISDUA(10) = MLMINC.MOTS(3)
  219.       IMATRI.LISDUA(11) = MLMINC.MOTS(3)
  220.       IMATRI.LISDUA(12) = MLMINC.MOTS(3)
  221.       IMATRI.LISDUA(13) = MLMINC.MOTS(4)
  222.       IMATRI.LISDUA(14) = MLMINC.MOTS(4)
  223.       IMATRI.LISDUA(15) = MLMINC.MOTS(4)
  224.       IMATRI.LISDUA(16) = MLMINC.MOTS(4)
  225. C
  226.       NBEL = NBELEM
  227.       NBSOUS = 1
  228.       NP = 2
  229.       MP = 2
  230.       SEGINI   RR  , RUX , RUY , RRET ,
  231.      &         UXR , UXUX , UXUY , UXRET ,
  232.      &         UYR , UYUX , UYUY , UYRET ,
  233.      &         RETR , RETUX , RETUY , RETRET
  234. C
  235. C**** Duale = IMATRI.LISDUA(1) = 'RN'
  236. C     Primale = IMATRI.LISPRI(1) = 'RN'
  237. C     -> IMATRI.LIZAFM(1,1) = RR
  238. C
  239. C     Duale = IMATRI.LISDUA(2) = 'RN'
  240. C     Primale = IMATRI.LISPRI(1) = 'RUXN'
  241. C     -> IMATRI.LIZAFM(1,2) = RUX
  242. C     ...
  243. C
  244.       IMATRI.LIZAFM(1,1) = RR
  245.       IMATRI.LIZAFM(1,2) = RUX
  246.       IMATRI.LIZAFM(1,3) = RUY
  247.       IMATRI.LIZAFM(1,4) = RRET
  248.       IMATRI.LIZAFM(1,5) = UXR
  249.       IMATRI.LIZAFM(1,6) = UXUX
  250.       IMATRI.LIZAFM(1,7) = UXUY
  251.       IMATRI.LIZAFM(1,8) = UXRET
  252.       IMATRI.LIZAFM(1,9) = UYR
  253.       IMATRI.LIZAFM(1,10) = UYUX
  254.       IMATRI.LIZAFM(1,11) = UYUY
  255.       IMATRI.LIZAFM(1,12) = UYRET
  256.       IMATRI.LIZAFM(1,13) = RETR
  257.       IMATRI.LIZAFM(1,14) = RETUX
  258.       IMATRI.LIZAFM(1,15) = RETUY
  259.       IMATRI.LIZAFM(1,16) = RETRET
  260. C
  261.       DO IFAC = 1, NFAC, 1
  262.          NGCF = MELEFE.NUM(2,IFAC)
  263.          NLCF = MLENTF.LECT(NGCF)
  264.          IF(NLCF .NE. IFAC)THEN
  265.             WRITE(IOIMP,*) 'Il ne faut pas jouer avec la table domaine'
  266.             CALL ERREUR(5)
  267.             GOTO 9999
  268.          ENDIF
  269.          NGCG = MELEFE.NUM(1,IFAC)
  270.          NGCD = MELEFE.NUM(3,IFAC)
  271.          NLFL = MLELIM.LECT(NGCF)
  272.          IF(NLFL .NE. 0)THEN
  273. C
  274. C********** The point belongs on BC -> No contribution to jacobian!
  275. C
  276.             MELEDU.NUM(1,IFAC) = NGCG
  277.             MELEDU.NUM(2,IFAC) = NGCD
  278.  
  279.          ELSEIF(NGCG .NE. NGCD)THEN
  280. C
  281. C********** Les MELEMEs
  282. C
  283.             MELEDU.NUM(1,IFAC) = NGCG
  284.             MELEDU.NUM(2,IFAC) = NGCD
  285. C
  286. C********** Les etats G et D
  287. C
  288.             NLCG = MLENTC.LECT(NGCG)
  289.             NLCD = MLENTC.LECT(NGCD)
  290. C
  291.             ROG = MPRN.VPOCHA(NLCG,1)
  292.             PG = MPPN.VPOCHA(NLCG,1)
  293.             UXG = MPUN.VPOCHA(NLCG,1)
  294.             UYG = MPUN.VPOCHA(NLCG,2)
  295.             GAMG = MPGAMN.VPOCHA(NLCG,1)
  296.             VOLG = MPVOLU.VPOCHA(NLCG,1)
  297. C
  298.             ROD = MPRN.VPOCHA(NLCD,1)
  299.             PD = MPPN.VPOCHA(NLCD,1)
  300.             UXD = MPUN.VPOCHA(NLCD,1)
  301.             UYD = MPUN.VPOCHA(NLCD,2)
  302.             GAMD = MPGAMN.VPOCHA(NLCD,1)
  303.             VOLD = MPVOLU.VPOCHA(NLCD,1)
  304. C
  305. C********** La normale G->D
  306. C           La tangente
  307. C
  308.             SURF = MPOVSU.VPOCHA(NLCF,1)
  309.             CNX = MPNORM.VPOCHA(NLCF,1)
  310.             CNY = MPNORM.VPOCHA(NLCF,2)
  311.             CTX = -1.0D0 * CNY
  312.             CTY = CNX
  313. C
  314. C********** La contribution de Gauche
  315. C
  316.             CALL CENTJ0(ROG,UXG,UYG,PG,GAMG,CNX,CNY,CTX,CTY,
  317.      &           DFRO,DFRUN,DFRUT,DFRET)
  318. C
  319. C
  320. C********** AB.AM(IFAC,IPRIM,IDUAL)
  321. C           A = nom de l'inconnu duale (Ro,rUX,rUY,RET)
  322. C           B = nom de l'inconnu primale (Ro,rUX,rUY,RET)
  323. C           IPRIM = 1, 2  -> G, D
  324. C           IDUAL = 1, 2  -> G, D
  325. C           i.e.
  326. C           A_IDUAL = AB.AM(IFAC,IPRIM,IDUAL) * B_IPRIM + ...
  327. C
  328. C
  329. C********** Dual RN
  330. C
  331.             FUNCEL = SURF * DFRO(1)
  332.             RR.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  333.             RR.AM(IFAC,1,2) = FUNCEL / VOLD
  334. C
  335.             FUNCEL = SURF * DFRO(2)
  336.             RUX.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  337.             RUX.AM(IFAC,1,2) = FUNCEL / VOLD
  338. C
  339.             FUNCEL = SURF * DFRO(3)
  340.             RUY.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  341.             RUY.AM(IFAC,1,2) = FUNCEL / VOLD
  342. C
  343.             FUNCEL = SURF * DFRO(4)
  344.             RRET.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  345.             RRET.AM(IFAC,1,2) = FUNCEL / VOLD
  346. C
  347. C********** Dual RUXN
  348. C
  349.             FUNCEL = SURF * (DFRUN(1) * CNX + DFRUT(1) * CTX)
  350.             UXR.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  351.             UXR.AM(IFAC,1,2) = FUNCEL / VOLD
  352. C
  353.             FUNCEL = SURF * (DFRUN(2) * CNX + DFRUT(2) * CTX)
  354.             UXUX.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  355.             UXUX.AM(IFAC,1,2) = FUNCEL / VOLD
  356. C
  357.             FUNCEL = SURF * (DFRUN(3) * CNX + DFRUT(3) * CTX)
  358.             UXUY.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  359.             UXUY.AM(IFAC,1,2) = FUNCEL / VOLD
  360. C
  361.             FUNCEL = SURF * (DFRUN(4) * CNX + DFRUT(4) * CTX)
  362.             UXRET.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  363.             UXRET.AM(IFAC,1,2) = FUNCEL / VOLD
  364. C
  365. C********** Dual RUYN
  366. C
  367.             FUNCEL = SURF * (DFRUN(1) * CNY + DFRUT(1) * CTY)
  368.             UYR.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  369.             UYR.AM(IFAC,1,2) = FUNCEL / VOLD
  370. C
  371.             FUNCEL = SURF * (DFRUN(2) * CNY + DFRUT(2) * CTY)
  372.             UYUX.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  373.             UYUX.AM(IFAC,1,2) = FUNCEL / VOLD
  374. C
  375.             FUNCEL = SURF * (DFRUN(3) * CNY + DFRUT(3) * CTY)
  376.             UYUY.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  377.             UYUY.AM(IFAC,1,2) = FUNCEL / VOLD
  378. C
  379.             FUNCEL = SURF * (DFRUN(4) * CNY + DFRUT(4) * CTY)
  380.             UYRET.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  381.             UYRET.AM(IFAC,1,2) = FUNCEL / VOLD
  382. C
  383. C********** Dual RETN
  384. C
  385.             FUNCEL = SURF * DFRET(1)
  386.             RETR.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  387.             RETR.AM(IFAC,1,2) = FUNCEL / VOLD
  388. C
  389.             FUNCEL = SURF * DFRET(2)
  390.             RETUX.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  391.             RETUX.AM(IFAC,1,2) = FUNCEL / VOLD
  392. C
  393.             FUNCEL = SURF * DFRET(3)
  394.             RETUY.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  395.             RETUY.AM(IFAC,1,2) = FUNCEL / VOLD
  396. C
  397.             FUNCEL = SURF * DFRET(4)
  398.             RETRET.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  399.             RETRET.AM(IFAC,1,2) = FUNCEL / VOLD
  400. C
  401. C
  402. C********** La contribution de D
  403. C
  404.             CNX = -1.0D0 * CNX
  405.             CNY = -1.0D0 * CNY
  406.             CTX = -1.0D0 * CTX
  407.             CTY = -1.0D0 * CTY
  408. C
  409.             CALL CENTJ0(ROD,UXD,UYD,PD,GAMD,CNX,CNY,CTX,CTY,
  410.      &           DFRO,DFRUN,DFRUT,DFRET)
  411. C
  412. C
  413. C********** Dual RN
  414. C
  415.             FUNCEL = SURF * DFRO(1)
  416.             RR.AM(IFAC,2,2) = -1.0D0 * FUNCEL / VOLD
  417.             RR.AM(IFAC,2,1) = FUNCEL / VOLG
  418. C
  419.             FUNCEL = SURF * DFRO(2)
  420.             RUX.AM(IFAC,2,2) = -1.0D0 * FUNCEL / VOLD
  421.             RUX.AM(IFAC,2,1) = FUNCEL / VOLG
  422. C
  423.             FUNCEL = SURF * DFRO(3)
  424.             RUY.AM(IFAC,2,2) = -1.0D0 * FUNCEL / VOLD
  425.             RUY.AM(IFAC,2,1) = FUNCEL / VOLG
  426. C
  427.             FUNCEL = SURF * DFRO(4)
  428.             RRET.AM(IFAC,2,2) = -1.0D0 * FUNCEL / VOLD
  429.             RRET.AM(IFAC,2,1) = FUNCEL / VOLG
  430. C
  431. C********** Dual RUXN
  432. C
  433.             FUNCEL = SURF * (DFRUN(1) * CNX + DFRUT(1) * CTX)
  434.             UXR.AM(IFAC,2,2) = -1.0D0 * FUNCEL / VOLD
  435.             UXR.AM(IFAC,2,1) = FUNCEL / VOLG
  436. C
  437.             FUNCEL = SURF * (DFRUN(2) * CNX + DFRUT(2) * CTX)
  438.             UXUX.AM(IFAC,2,2) = -1.0D0 * FUNCEL / VOLD
  439.             UXUX.AM(IFAC,2,1) = FUNCEL / VOLG
  440. C
  441.             FUNCEL = SURF * (DFRUN(3) * CNX + DFRUT(3) * CTX)
  442.             UXUY.AM(IFAC,2,2) = -1.0D0 * FUNCEL / VOLD
  443.             UXUY.AM(IFAC,2,1) = FUNCEL / VOLG
  444. C
  445.             FUNCEL = SURF * (DFRUN(4) * CNX + DFRUT(4) * CTX)
  446.             UXRET.AM(IFAC,2,2) = -1.0D0 * FUNCEL / VOLD
  447.             UXRET.AM(IFAC,2,1) = FUNCEL / VOLG
  448. C
  449. C********** Dual RUYN
  450. C
  451.             FUNCEL = SURF * (DFRUN(1) * CNY + DFRUT(1) * CTY)
  452.             UYR.AM(IFAC,2,2) = -1.0D0 * FUNCEL / VOLD
  453.             UYR.AM(IFAC,2,1) = FUNCEL / VOLG
  454. C
  455.             FUNCEL = SURF * (DFRUN(2) * CNY + DFRUT(2) * CTY)
  456.             UYUX.AM(IFAC,2,2) = -1.0D0 * FUNCEL / VOLD
  457.             UYUX.AM(IFAC,2,1) = FUNCEL / VOLG
  458. C
  459.             FUNCEL = SURF * (DFRUN(3) * CNY + DFRUT(3) * CTY)
  460.             UYUY.AM(IFAC,2,2) = -1.0D0 * FUNCEL / VOLD
  461.             UYUY.AM(IFAC,2,1) = FUNCEL / VOLG
  462. C
  463.             FUNCEL = SURF * (DFRUN(4) * CNY + DFRUT(4) * CTY)
  464.             UYRET.AM(IFAC,2,2) = -1.0D0 * FUNCEL / VOLD
  465.             UYRET.AM(IFAC,2,1) = FUNCEL / VOLG
  466. C
  467. C********** Dual RETN
  468. C
  469.             FUNCEL = SURF * DFRET(1)
  470.             RETR.AM(IFAC,2,2) = -1.0D0 * FUNCEL / VOLD
  471.             RETR.AM(IFAC,2,1) = FUNCEL / VOLG
  472. C
  473.             FUNCEL = SURF * DFRET(2)
  474.             RETUX.AM(IFAC,2,2) = -1.0D0 * FUNCEL / VOLD
  475.             RETUX.AM(IFAC,2,1) = FUNCEL / VOLG
  476. C
  477.             FUNCEL = SURF * DFRET(3)
  478.             RETUY.AM(IFAC,2,2) = -1.0D0 * FUNCEL / VOLD
  479.             RETUY.AM(IFAC,2,1) = FUNCEL / VOLG
  480. C
  481.             FUNCEL = SURF * DFRET(4)
  482.             RETRET.AM(IFAC,2,2) = -1.0D0 * FUNCEL / VOLD
  483.             RETRET.AM(IFAC,2,1) = FUNCEL / VOLG
  484. C
  485.          ELSE
  486. C
  487. C********** Murs (NGCG = NGCD)
  488. C
  489. C
  490. C********** Les MELEMEs
  491. C
  492.             MELEDU.NUM(1,IFAC) = NGCG
  493.             MELEDU.NUM(2,IFAC) = NGCD
  494.             NLCG = MLENTC.LECT(NGCG)
  495. C
  496.             ROG = MPRN.VPOCHA(NLCG,1)
  497.             PG = MPPN.VPOCHA(NLCG,1)
  498.             UXG = MPUN.VPOCHA(NLCG,1)
  499.             UYG = MPUN.VPOCHA(NLCG,2)
  500.             GAMG = MPGAMN.VPOCHA(NLCG,1)
  501.             VOLG = MPVOLU.VPOCHA(NLCG,1)
  502. C
  503. C********** La normale sortante
  504. C
  505.             SURF = MPOVSU.VPOCHA(NLCF,1)
  506.             CNX = MPNORM.VPOCHA(NLCF,1)
  507.             CNY = MPNORM.VPOCHA(NLCF,2)
  508. C
  509.             CALL CENTJ2(ROG,UXG,UYG,GAMG,CNX,CNY,
  510.      &           DFRUN)
  511. C
  512. C********** Dual RN
  513. C
  514.             RR.AM(IFAC,1,1) = 0.0D0
  515.             RR.AM(IFAC,1,2) = 0.0D0
  516. C
  517.             RUX.AM(IFAC,1,1) = 0.0D0
  518.             RUX.AM(IFAC,1,2) = 0.0D0
  519. C
  520.             RUY.AM(IFAC,1,1) = 0.0D0
  521.             RUY.AM(IFAC,1,2) = 0.0D0
  522. C
  523.             RRET.AM(IFAC,1,1) = 0.0D0
  524.             RRET.AM(IFAC,1,2) = 0.0D0
  525. C
  526. C********** Dual RUXN
  527. C
  528.             FUNCEL = SURF * DFRUN(1) * CNX
  529.             UXR.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  530.             UXR.AM(IFAC,1,2) = 0.0D0
  531. C
  532.             FUNCEL = SURF * DFRUN(2) * CNX
  533.             UXUX.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  534.             UXUX.AM(IFAC,1,2) = 0.0D0
  535. C
  536.             FUNCEL = SURF * DFRUN(3) * CNX
  537.             UXUY.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  538.             UXUY.AM(IFAC,1,2) = 0.0D0
  539. C
  540.             FUNCEL = SURF * DFRUN(4) * CNX
  541.             UXRET.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  542.             UXRET.AM(IFAC,1,2) = 0.0D0
  543. C
  544. C********** Dual RUYN
  545. C
  546.             FUNCEL = SURF * DFRUN(1) * CNY
  547.             UYR.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  548.             UYR.AM(IFAC,1,2) = 0.0D0
  549. C
  550.             FUNCEL = SURF * DFRUN(2) * CNY
  551.             UYUX.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  552.             UYUX.AM(IFAC,1,2) = 0.0D0
  553. C
  554.             FUNCEL = SURF * DFRUN(3) * CNY
  555.             UYUY.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  556.             UYUY.AM(IFAC,1,2) = 0.0D0
  557. C
  558.             FUNCEL = SURF * DFRUN(4) * CNY
  559.             UYRET.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  560.             UYRET.AM(IFAC,1,2) = 0.0D0
  561. C
  562. C********** Dual RETN
  563. C
  564.             RETR.AM(IFAC,1,1) = 0.0D0
  565.             RETR.AM(IFAC,1,2) = 0.0D0
  566. C
  567.             RETUX.AM(IFAC,1,1) = 0.0D0
  568.             RETUX.AM(IFAC,1,2) = 0.0D0
  569. C
  570.             RETUY.AM(IFAC,1,1) = 0.0D0
  571.             RETUY.AM(IFAC,1,2) = 0.0D0
  572. C
  573.             RETRET.AM(IFAC,1,1) = 0.0D0
  574.             RETRET.AM(IFAC,1,2) = 0.0D0
  575. C
  576. C********** Dual RN
  577. C
  578.             RR.AM(IFAC,2,2) = 0.0D0
  579.             RR.AM(IFAC,2,1) = 0.0D0
  580. C
  581.             RUX.AM(IFAC,2,2) = 0.0D0
  582.             RUX.AM(IFAC,2,1) = 0.0D0
  583. C
  584.             RUY.AM(IFAC,2,2) = 0.0D0
  585.             RUY.AM(IFAC,2,1) = 0.0D0
  586. C
  587.             RRET.AM(IFAC,2,2) = 0.0D0
  588.             RRET.AM(IFAC,2,1) = 0.0D0
  589. C
  590. C********** Dual RUXN
  591. C
  592.             UXR.AM(IFAC,2,2) = 0.0D0
  593.             UXR.AM(IFAC,2,1) = 0.0D0
  594. C
  595.             UXUX.AM(IFAC,2,2) = 0.0D0
  596.             UXUX.AM(IFAC,2,1) = 0.0D0
  597. C
  598.             UXUY.AM(IFAC,2,2) = 0.0D0
  599.             UXUY.AM(IFAC,2,1) = 0.0D0
  600. C
  601.             UXRET.AM(IFAC,2,2) = 0.0D0
  602.             UXRET.AM(IFAC,2,1) = 0.0D0
  603. C
  604. C********** Dual RUYN
  605. C
  606.             UYR.AM(IFAC,2,2) = 0.0D0
  607.             UYR.AM(IFAC,2,1) = 0.0D0
  608. C
  609.             UYUX.AM(IFAC,2,2) = 0.0D0
  610.             UYUX.AM(IFAC,2,1) = 0.0D0
  611. C
  612.             UYUY.AM(IFAC,2,2) = 0.0D0
  613.             UYUY.AM(IFAC,2,1) = 0.0D0
  614. C
  615.             UYRET.AM(IFAC,2,2) = 0.0D0
  616.             UYRET.AM(IFAC,2,1) = 0.0D0
  617. C
  618. C********** Dual RETN
  619. C
  620.             RETR.AM(IFAC,2,2) = 0.0D0
  621.             RETR.AM(IFAC,2,1) = 0.0D0
  622. C
  623.             RETUX.AM(IFAC,2,2) = 0.0D0
  624.             RETUX.AM(IFAC,2,1) = 0.0D0
  625. C
  626.             RETUY.AM(IFAC,2,2) = 0.0D0
  627.             RETUY.AM(IFAC,2,1) = 0.0D0
  628. C
  629.             RETRET.AM(IFAC,2,2) = 0.0D0
  630.             RETRET.AM(IFAC,2,1) = 0.0D0
  631. C
  632.          ENDIF
  633.       ENDDO
  634. C
  635.       SEGDES MELEMC
  636.       SEGDES MELEFE
  637.       SEGDES MELEMF
  638. C
  639.       SEGDES MPOVSU
  640.       SEGDES MPVOLU
  641.       SEGDES MPNORM
  642. C
  643.       SEGDES MPRN
  644.       SEGDES MPPN
  645.       SEGDES MPUN
  646.       SEGDES MPGAMN
  647. C
  648.       SEGDES MELEDU
  649.       SEGDES MATRIK
  650.       SEGDES IMATRI
  651. C
  652.       SEGDES   RR  , RUX , RUY , RRET ,
  653.      &         UXR , UXUX , UXUY , UXRET ,
  654.      &         UYR , UYUX , UYUY , UYRET ,
  655.      &         RETR , RETUX , RETUY , RETRET
  656.  
  657.       SEGSUP MLENTC
  658.       SEGSUP MLENTF
  659.       SEGDES MLMINC
  660.       SEGSUP MLELIM
  661.       IF(MELLIM .NE.0) SEGDES MELLIM
  662. C
  663.  9999 CONTINUE
  664.       RETURN
  665.       END
  666.  
  667.  
  668.  
  669.  
  670.  
  671.  
  672.  
  673.  
  674.  
  675.  
  676.  

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