Télécharger la plaquette Cast3M


fr en

Télécharger konmsp.eso

Retour à la liste

Numérotation des lignes : 

konmsp

  1. C KONMSP    SOURCE    CB215821  20/11/25    13:32:35     10792          
  2.       SUBROUTINE KONMSP(NSP,ILIINC,IRN,IUN,IPN,IYN,MLRECP,
  3.      &    MLRECV,INORM,ICHPVO,ICHPSU,MELEMC,MELEFE,MELLIM,IMAT)
  4. C
  5. C************************************************************************
  6. C
  7. C PROJET            :  CASTEM 2000
  8. C
  9. C NOM               :  KONMSP ("convection for multispecies")
  10. C
  11. C DESCRIPTION       :  Voir KON19 (appele par KON19)
  12. C                      Calcul du jacobien du résidu pour la méthode
  13. C                      AUSMplus
  14. C
  15. C                      Cas deux dimensions, gaz "calorically perfect"
  16. C                                           MULTISPECIES!!!!!!!!
  17. C
  18. C LANGAGE           :  FORTRAN 77 + ESOPE 2000 (avec estensions CISI)
  19. C
  20. C AUTEUR            :  S. KUDRIAKOV, DM2S/SFME/LTMF
  21. C
  22. C************************************************************************
  23. C
  24. C
  25. C APPELES (Outils
  26. C          CASTEM)  :  KRIPAD, LICHT, ERREUR
  27. C
  28. C APPELES (Calcul)  :  CONMSP, CWMSP
  29. C
  30. C************************************************************************
  31. C
  32. C ENTREES
  33. C
  34. C     NSP    : number of species (total) ;
  35. C
  36. C     ILINC  : liste des inconnues (pointeur d'un objet de type LISTMOTS)
  37. C
  38. C  1) Pointeurs des CHPOINT
  39. C
  40. C     IRN     : CHPOINT CENTRE  contenant la masse volumique ;
  41. C
  42. C     IUN     : CHPOINT CENTRE  contenant la vitesse ;
  43. C
  44. C     IPN     : CHPOINT CENTRE  contenant la pression ;
  45. C
  46. C     IYN     : CHPOINT CENTRE  contenant les fractions massiques ;
  47. C
  48. C     INORM   : CHPOINT FACE    contenant les normales aux faces ;
  49. C
  50. C     ICHPOVO : CHPOINT VOLUME  contenant le volume
  51. C
  52. C     ICHPOSU : CHPOINT FACE    contenant la surface des faces
  53. C
  54. C
  55. C  2) Pointeurs des LIST REELS
  56. C
  57. C     MLRECP  : LIST REELS contenant les CP's des gases differents ;
  58. C
  59. C     MLRECV  : LIST REELS contenant les CV's des gases differents ;
  60. C
  61. C  3) Pointeurs de MELEME de la table DOMAINE
  62. C
  63. C     MELEMC  : MELEME 'CENTRE' du SPG des CENTRES
  64. C
  65. C     MELEFE  : MELEME 'FACEL' du connectivité Faces -> Elts
  66. C
  67. C     MELLIM  : MELEME SPG des conditions aux bords
  68. C               N.B.: Sur le bord on ne calcule rien!
  69. C
  70. C SORTIES
  71. C
  72. C     IMAT    : pointeur de la MATRIK du jacobien du residu
  73. C
  74. C************************************************************************
  75. C
  76. C HISTORIQUE (Anomalies et modifications éventuelles)
  77. C
  78. C HISTORIQUE :
  79. C
  80. C************************************************************************
  81. C
  82. C
  83. C N.B.: On suppose qu'on a déjà controllé RO, P > 0
  84. C                                         GAMMA \in (1,3)
  85. C       Si non il faut le faire!!!
  86. C
  87. C************************************************************************
  88. C
  89.       IMPLICIT INTEGER(I-N)
  90.       IMPLICIT REAL*8(A-H,O-Z)
  91.  
  92.       INTEGER NSP,II,JJ,KV,I,J,JLL,JRR
  93.       INTEGER ILIINC, IRN,IUN,IPN,IYN,INORM,ICHPVO,ICHPSU
  94.      &        , IMAT, IGEOMC, IGEOMF
  95.      &        , NFAC, NBSOUS, NBREF, NBELEM, NBNN, NRIGE, NMATRI, NKID
  96.      &        , NKMT, NBME, NBEL,  MP, NP
  97.      &        , IFAC, NGCF, NLCF, NGCG, NGCD, NLCG, NLCD, NLFL
  98.       REAL*8 ROG, PG, UXG, UYG, VOLG
  99.      &       , ROD, PD, UXD, UYD, VOLD
  100.      &       , SURF, FUNCEL
  101.       REAL*8 WVEC_L(4), WVEC_R(4), NVECT(2), TVECT(2)
  102.       REAL*8 ZC1, ZC2, ZC3, ZC4
  103.       CHARACTER*8 TYPE
  104. C
  105. C**** LES INCLUDES
  106. C
  107.  
  108. -INC PPARAM
  109. -INC CCOPTIO
  110. -INC SMCHPOI
  112. -INC SMELEME
  113. -INC SMLMOTS
  114. -INC SMLENTI
  115.       POINTEUR MPRN.MPOVAL, MPUN.MPOVAL, MPPN.MPOVAL, MPYN.MPOVAL,
  116.      &         MPNORM.MPOVAL, MPVOLU.MPOVAL, MPOVSU.MPOVAL
  117.       POINTEUR MELEMC.MELEME, MELEMF.MELEME, MELEFE.MELEME,
  118.      &         MELEDU.MELEME, MELLIM.MELEME
  119.       POINTEUR MLENTC.MLENTI, MLENTF.MLENTI, MLELIM.MLENTI
  120.       POINTEUR CELL.IZAFM
  121.       POINTEUR MLMINC.MLMOTS
  122. C----------------------------------------------------
  123. -INC SMLREEL
  124.       POINTEUR MLRECP.MLREEL, MLRECV.MLREEL
  125. C-------------------------------------------------------
  126. C*********  Les Jacobians ******************************
  127. C-------------------------------------------------------
  128.       SEGMENT JACEL
  129.          REAL*8 JAC(3+NSP,3+NSP)
  130.       ENDSEGMENT
  131.       POINTEUR JTL.JACEL, JTR.JACEL, JTT.JACEL
  132. C--------------------------------------------------------
  133. C KRIPAD pour la correspondance global/local des centres
  134. C--------------------------------------------------------
  135.       CALL KRIPAD(MELLIM,MLELIM)
  136.       CALL KRIPAD(MELEMC,MLENTC)
  137. C------------------
  138.       SEGACT MELEMC
  139. C------------------
  140.       SEGACT MELEFE
  141. C------------------
  142.       CALL LICHT(ICHPSU,MPOVSU,TYPE,IGEOMF)
  143.       CALL LICHT(INORM,MPNORM,TYPE,IGEOMF)
  144.       CALL LICHT(ICHPVO,MPVOLU,TYPE,IGEOMC)
  145. C----------------------------------------------
  146.       MELEMF = IGEOMF
  147.       CALL KRIPAD(MELEMF,MLENTF)
  148.       SEGACT MELEMF
  149. C-----------------------------------------------
  150.       CALL LICHT(IRN,MPRN,TYPE,IGEOMC)
  151.       CALL LICHT(IPN,MPPN,TYPE,IGEOMC)
  152.       CALL LICHT(IUN,MPUN,TYPE,IGEOMC)
  153.       CALL LICHT(IYN,MPYN,TYPE,IGEOMC)
  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----------------------
  166. C**  MELEDU = 'SEG2' **
  167. C----------------------
  168.       MELEDU.ITYPEL =  2
  169. C--------------
  170.       NRIGE = 7
  171.       NMATRI = 1
  172.       NKID = 9
  173.       NKMT = 7
  174. C--------------
  175.       SEGINI MATRIK
  176.       IMAT = MATRIK
  177.       MATRIK.IRIGEL(1,1) = MELEDU
  178.       MATRIK.IRIGEL(2,1) = MELEDU
  179. C-------------------------
  180. C Matrice non symetrique
  181. C-------------------------
  182.       MATRIK.IRIGEL(7,1) = 2
  183. C-------------------------
  184.       NBME = (3+NSP)*(3+NSP)
  185.       NBSOUS = 1
  186.       SEGINI IMATRI
  187.       MLMINC = ILIINC
  188.       SEGACT MLMINC
  189.       MATRIK.IRIGEL(4,1) = IMATRI
  190. C-----------------------------------------------
  191.       DO 1 J=1,(NSP+3)
  192.         KV=(J-1)*(3+NSP)
  193.         IMATRI.LISPRI(KV+1) = MLMINC.MOTS(1)
  194.         IMATRI.LISPRI(KV+2) = MLMINC.MOTS(2)
  195.         IMATRI.LISPRI(KV+3) = MLMINC.MOTS(3)
  196.         IMATRI.LISPRI(KV+4) = MLMINC.MOTS(4)
  197.         DO 2 I=1,(NSP-1)
  198.           IMATRI.LISPRI(KV+4+I) = MLMINC.MOTS(4+I)
  199.  2      CONTINUE
  200.  1    CONTINUE
  201. C-----------------------------------------------
  202.       DO 3 J=1,(NSP+3)
  203.         KV=(J-1)*(3+NSP)
  204.         IMATRI.LISDUA(KV+1) = MLMINC.MOTS(j)
  205.         IMATRI.LISDUA(KV+2) = MLMINC.MOTS(j)
  206.         IMATRI.LISDUA(KV+3) = MLMINC.MOTS(j)
  207.         IMATRI.LISDUA(KV+4) = MLMINC.MOTS(j)
  208.         DO 4 I=1,(NSP-1)
  209.           IMATRI.LISDUA(KV+4+I) = MLMINC.MOTS(j)
  210.  4     CONTINUE
  211.  3    CONTINUE
  212. C-----------------------------------------------
  213. C-----------------------------------------------
  214.       NBEL = NBELEM
  215.       NBSOUS = 1
  216.       NP = 2
  217.       MP = 2
  218. C-----------------------------------------------------------
  219. C-----------------------------------------------------------
  220.       DO 5 I=1,NBME
  221.         SEGINI CELL
  222.         IMATRI.LIZAFM(1,I) = CELL
  223.  5    CONTINUE
  224. C---------------------------------
  225. C---------------------------------
  226.       DO IFAC = 1, NFAC, 1
  227.          NGCF = MELEFE.NUM(2,IFAC)
  228.          NLCF = MLENTF.LECT(NGCF)
  229.          IF(NLCF .NE. IFAC)THEN
  230.             WRITE(IOIMP,*) 'Il ne faut pas jouer avec la table domaine'
  231.             CALL ERREUR(5)
  232.             GOTO 9999
  233.          ENDIF
  234.          NLFL = MLELIM.LECT(NGCF)
  235.          NGCG = MELEFE.NUM(1,IFAC)
  236.          NGCD = MELEFE.NUM(3,IFAC)
  237.          IF(NLFL .NE. 0)THEN
  238. C---------------------------------------------------------
  239. C The point belongs to BC -> No contribution to jacobian!
  240. C---------------------------------------------------------
  241.             MELEDU.NUM(1,IFAC) = NGCG
  242.             MELEDU.NUM(2,IFAC) = NGCD
  243.          ELSEIF(NGCG .NE. NGCD)THEN
  244. C-----------------------------------
  245. C********** Les MELEMEs
  246. C-----------------------------------
  247.             MELEDU.NUM(1,IFAC) = NGCG
  248.             MELEDU.NUM(2,IFAC) = NGCD
  249. C-----------------------------------
  250. C********** Les etats G et D
  251. C-----------------------------------
  252.             NLCG = MLENTC.LECT(NGCG)
  253.             NLCD = MLENTC.LECT(NGCD)
  254. C-----------------
  255.             ROG = MPRN.VPOCHA(NLCG,1)
  256.             PG = MPPN.VPOCHA(NLCG,1)
  257.             UXG = MPUN.VPOCHA(NLCG,1)
  258.             UYG = MPUN.VPOCHA(NLCG,2)
  259.             VOLG = MPVOLU.VPOCHA(NLCG,1)
  260. C-------------------------------------------------
  261.             WVEC_L(1)=ROG
  262.             WVEC_L(2)=UXG
  263.             WVEC_L(3)=UYG
  264.             WVEC_L(4)=PG
  265. C-------------------------------------------------
  266.             ROD = MPRN.VPOCHA(NLCD,1)
  267.             PD = MPPN.VPOCHA(NLCD,1)
  268.             UXD = MPUN.VPOCHA(NLCD,1)
  269.             UYD = MPUN.VPOCHA(NLCD,2)
  270.             VOLD = MPVOLU.VPOCHA(NLCD,1)
  271. C------------------------------------------------
  272.             WVEC_R(1)=ROD
  273.             WVEC_R(2)=UXD
  274.             WVEC_R(3)=UYD
  275.             WVEC_R(4)=PD
  276. C------------------------------------------------
  277. C  La normale G->D
  278. C  La tangente
  279. C------------------------------------------------
  280.             SURF = MPOVSU.VPOCHA(NLCF,1)
  281.             NVECT(1) = MPNORM.VPOCHA(NLCF,1)
  282.             NVECT(2) = MPNORM.VPOCHA(NLCF,2)
  283.             TVECT(1) = -1.0D0 * NVECT(2)
  284.             TVECT(2) = NVECT(1)
  285. C-------------------------------------------------
  286.             CALL CONMSP(NSP,JLL,JRR,WVEC_L,WVEC_R,NVECT,TVECT,
  287.      &        MPYN,MLRECP,MLRECV,NLCG,NLCD)
  288. C-----------------------------------------------------
  289. C********** AB.AM(IFAC,IPRIM,IDUAL)
  290. C           A = nom de l'inconnu duale (Ro,rUX,rUY,RET)
  291. C           B = nom de l'inconnu primale (Ro,rUX,rUY,RET)
  292. C           IPRIM = 1, 2  -> G, D
  293. C           IDUAL = 1, 2  -> G, D
  294. C           i.e.
  295. C           A_IDUAL = AB.AM(IFAC,IPRIM,IDUAL) * B_IPRIM + ...
  296. C
  297. C
  298. C********** Dual RN
  299. C----------------------------------------------------
  300.             JTL=JLL
  301.             JTR=JRR
  302.             SEGACT JTL
  303.             SEGACT JTR
  304.             DO 10 II = 1,(3+NSP)
  305.               DO 15 JJ = 1,(3+NSP)
  306.                 KV = (II-1)*(3+NSP)
  307. C----------------------------------
  308.                 CELL = IMATRI.LIZAFM(1,KV+JJ)
  309.                 FUNCEL = SURF * JTL.JAC(II,JJ)
  310.                 CELL.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  311.                 CELL.AM(IFAC,1,2) = FUNCEL / VOLD
  312.  15           CONTINUE
  313.  10         CONTINUE
  314. C-----------------------------------------------------
  315.             DO 20 II = 1,(3+NSP)
  316.               DO 25 JJ = 1,(3+NSP)
  317.                 KV = (II-1)*(3+NSP)
  318.                 CELL = IMATRI.LIZAFM(1,KV+JJ)
  319.                 FUNCEL = SURF * JTR.JAC(II,JJ)
  320.                 CELL.AM(IFAC,2,2) = FUNCEL / VOLD
  321.                 CELL.AM(IFAC,2,1) = -FUNCEL / VOLG
  322.  25           CONTINUE
  323.  20         CONTINUE
  324.             SEGDES JTR
  325.             SEGDES JTL
  326. C-----------------------------------------------------
  327.          ELSE
  328. C-----------------------------------------------------
  329. C*************  Murs (NGCG = NGCD)  ******************
  330. C-----------------------------------------------------
  331.             MELEDU.NUM(1,IFAC) = NGCG
  332.             MELEDU.NUM(2,IFAC) = NGCD
  333.             NLCG = MLENTC.LECT(NGCG)
  334. C--------------------------------------
  335.             ROG = MPRN.VPOCHA(NLCG,1)
  336.             PG = MPPN.VPOCHA(NLCG,1)
  337.             UXG = MPUN.VPOCHA(NLCG,1)
  338.             UYG = MPUN.VPOCHA(NLCG,2)
  339.             VOLG = MPVOLU.VPOCHA(NLCG,1)
  340. C-------------------------------------------
  341.             WVEC_L(1)=ROG
  342.             WVEC_L(2)=UXG
  343.             WVEC_L(3)=UYG
  344.             WVEC_L(4)=PG
  345. C-------------------------------------------------
  346.             SURF = MPOVSU.VPOCHA(NLCF,1)
  347.             NVECT(1) = MPNORM.VPOCHA(NLCF,1)
  348.             NVECT(2) = MPNORM.VPOCHA(NLCF,2)
  349.             TVECT(1) =-NVECT(2)
  350.             TVECT(2) = NVECT(1)
  351. C------- COEFFICIENTS ----------------------------
  352.             ZC1=NVECT(1)*TVECT(2)+TVECT(1)*NVECT(2)
  353.             ZC2=NVECT(1)*TVECT(2)-TVECT(1)*NVECT(2)
  354.             ZC3=2.0D0*NVECT(1)*TVECT(1)
  355.             ZC4=2.0D0*NVECT(2)*TVECT(2)
  356. C-------------------------------------------------
  357.             ROD = ROG
  358.             PD = PG
  359.             UXD = -ZC1*UXG/ZC2-ZC4*UYG/ZC2
  360.             UYD = ZC3*UXG/ZC2+ZC1*UYG/ZC2
  361.             VOLD = VOLG
  362. C------------------------------------------------
  363.             WVEC_R(1)=ROD
  364.             WVEC_R(2)=UXD
  365.             WVEC_R(3)=UYD
  366.             WVEC_R(4)=PD
  367. C-------------------------------------------
  368. C********** La normale sortante
  369. C-------------------------------------------
  370.              CALL CWMSP(NSP,JLL,WVEC_L,WVEC_R,NVECT,
  371.      &        TVECT,MPYN,MLRECP,MLRECV,NLCG)
  372. C----------------------------------------------------
  373.             JTL=JLL
  374.             SEGACT JTL
  375.             DO 70 II = 1,(3+NSP)
  376.               DO 75 JJ = 1,(3+NSP)
  377.                 KV = (II-1)*(3+NSP)
  378. C---------------------------------
  379.                 CELL = IMATRI.LIZAFM(1,KV+JJ)
  380.                 FUNCEL = SURF * JTL.JAC(II,JJ)
  381.                 CELL.AM(IFAC,1,1) = -1.0D0 * FUNCEL / VOLG
  382.                 CELL.AM(IFAC,1,2) = 0.0D0
  383.  75           CONTINUE
  384.  70         CONTINUE
  385.             SEGDES JTL
  386. C--------------------------------------------
  387.             DO 40 II = 1,(3+NSP)
  388.               DO 45 JJ = 1,(3+NSP)
  389.                 KV = (II-1)*(3+NSP)
  390.                 CELL = IMATRI.LIZAFM(1,KV+JJ)
  391.                 CELL.AM(IFAC,2,2) = 0.0D0
  392.                 CELL.AM(IFAC,2,1) = 0.0D0
  393.  45           CONTINUE
  394.  40         CONTINUE
  395. C--------------------------------------------
  396.          ENDIF
  397.       ENDDO
  398. C
  399.       SEGDES MELEMC
  400.       SEGDES MELEFE
  401.       SEGDES MELEMF
  402. C
  403.       SEGDES MPOVSU
  404.       SEGDES MPVOLU
  405.       SEGDES MPNORM
  406. C
  407.       SEGDES MPRN
  408.       SEGDES MPPN
  409.       SEGDES MPUN
  410.       SEGDES MPYN
  411. C
  412.       SEGDES MELEDU
  413.       SEGDES MATRIK
  414.       DO 80 II=1,NBME
  415.        CELL = IMATRI.LIZAFM(1,II)
  416.        SEGDES CELL
  417.  80   CONTINUE
  418.       SEGDES IMATRI
  419. C
  420.       SEGSUP MLENTC
  421.       SEGSUP MLENTF
  422.       SEGSUP MLELIM
  423.       SEGDES MLMINC
  424.       IF(MELLIM .NE.0) SEGDES MELLIM
  425.  
  426.  9999 CONTINUE
  427.       RETURN
  428.       END
  429.  
  430.  
  431.  
  432.  
  433.  
  434.  
  435.  
  436.  
  437.  
  438.  
  439.  
  440.  
  441.  
  442.  
  443.  
  444.  
  445.  
  446.  
  447.  
  448.  

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