Télécharger la plaquette Cast3M


fr en

Télécharger cli172.eso

Retour à la liste

Numérotation des lignes : 

cli172

  1. C CLI172    SOURCE    OF166741  24/12/13    21:15:25     12097          
  2.       SUBROUTINE CLI172(MELEMF,MELEMC,MELECB,MELEFC,MELRES,INORM,ICHPVO,
  3.      &     ICHPSU,IROC,IVITC,IPC,IGAMC,ICHLIM,ILIINC,ILIINP,IJAC,IJACO)
  4. C************************************************************************
  5. C
  6. C PROJET            :  CASTEM 2000
  7. C
  8. C NOM               :  CLI172
  9. C
  10. C DESCRIPTION       :  Subroutine appellée par CLIM11
  11. C
  12. C LANGAGE           :  FORTRAN 77 + ESOPE 2000 (avec estensions CISI)
  13. C
  14. C AUTEUR            :  A. BECCANTINI, DRN/DMT/SEMT/LTMF
  15. C
  16. C************************************************************************
  17. C
  18. C APPELES (Calcul)  :
  19. C
  20. C************************************************************************
  21. C
  22. C HISTORIQUE (Anomalies et modifications éventuelles)
  23. C
  24. C HISTORIQUE :
  25. C
  26. C************************************************************************
  27. C
  28.       IMPLICIT INTEGER(I-N)
  29.  
  30. -INC PPARAM
  31. -INC CCOPTIO
  32. -INC SMLMOTS
  33. -INC SMELEME
  34.       POINTEUR MELEFC.MELEME
  35. -INC SMLENTI
  36.       POINTEUR MLEMC.MLENTI, MLEMCB.MLENTI,MLEMF.MLENTI
  37. -INC SMCHPOI
  38.       POINTEUR MPNORM.MPOVAL, MPVOL.MPOVAL, MPSURF.MPOVAL, MPRC.MPOVAL,
  39.      &     MPVC.MPOVAL, MPPC.MPOVAL, MPGAMC.MPOVAL, MPLIM.MPOVAL
  41.       POINTEUR RR.IZAFM, RUX.IZAFM, RUY.IZAFM, RRET.IZAFM,
  42.      &         UXR.IZAFM, UXUX.IZAFM, UXUY.IZAFM, UXRET.IZAFM,
  43.      &         UYR.IZAFM, UYUX.IZAFM, UYUY.IZAFM, UYRET.IZAFM,
  44.      &         RETR.IZAFM, RETUX.IZAFM, RETUY.IZAFM, RETRET.IZAFM
  45. C
  46.       INTEGER MELEMF,MELEMC,MELECB,INORM,ICHPVO,ICHPSU, IROC,IVITC,IPC
  47.      &     ,IGAMC,ICHLIM,ICEL,NFAC,IFAC,MELRES,IJACO
  48.      &     ,NGF,NGC,NLF,NLC,NLCB
  49.      &     ,ILIINC,ILIINP,IJAC
  50.      &     ,MP, NBEL, NBME, NBSOUS, NKID, NKMT, NMATRI, NP, NRIGE
  51.       REAL*8 VOLU,SURF,GAMC,CNX,CNY,GM1
  52.      &     ,RC,UXC,UYC
  53.      &     ,PC,PSRF,RHOUF,P,RHO,UN
  54.      &     ,DECIDP,DUNDPC,DUXDPC,DUYDPC
  55.      &     ,DRORO,DROUX,DROUY,DROP
  56.      &     ,DUXRO,DUXUX,DUXUY,DUXP
  57.      &     ,DUYRO,DUYUX,DUYUY,DUYP
  58.      &     ,DPRO,DPUX,DPUY,DPP
  59.      &     ,COEF1,COEF2,COEF3,COEF
  60.       CHARACTER*(8) TYPE
  61. C
  62. C
  63. C**** KRIPAD pour la correspondance global/local
  64. C
  65.       CALL KRIPAD(MELEMC,MLEMC)
  66. C     SEGINI MLEMC
  67.       CALL KRIPAD(MELECB,MLEMCB)
  68. C     SEGINI MLEMCB
  69.       CALL KRIPAD(MELEMF,MLEMF)
  70. C     SEGINI MLEMF
  71. C
  72. C**** CHPOINTs de la table DOMAINE
  73. C
  74.       CALL LICHT(INORM,MPNORM,TYPE,ICEL)
  75.       CALL LICHT(ICHPVO,MPVOL,TYPE,ICEL)
  76.       CALL LICHT(ICHPSU,MPSURF,TYPE,ICEL)
  77. C
  78. C**** LICHT active les MPOVALs en *MOD
  79. C
  80. C     SEGACT MPNORM*MOD
  81. C     SEGACT MPOVSU*MOD
  82. C     SEGACT MPOVOL*MOD
  83. C
  84. C
  85. C**** CHPOINTs des variables
  86. C
  87.       CALL LICHT(IROC,MPRC,TYPE,ICEL)
  88.       CALL LICHT(IVITC,MPVC,TYPE,ICEL)
  89.       CALL LICHT(IPC,MPPC,TYPE,ICEL)
  90.       CALL LICHT(IGAMC,MPGAMC,TYPE,ICEL)
  91.       CALL LICHT(ICHLIM,MPLIM,TYPE,ICEL)
  92. C
  93. C     SEGACT *MOD
  94. C     SEGACT *MOD
  95. C     SEGACT *MOD
  96. C     SEGACT *MOD
  97. C     SEGACT *MOD
  98. C
  99. C
  100. C**** Boucle sur le face pour le calcul des invariants de
  101. C     Riemann et du flux
  102. C
  103.       SEGACT MELEFC
  104.       NFAC=MELEFC.NUM(/2)
  105. C
  106. C**** Objet MATRIK
  107. C
  108.       NRIGE = 7
  109.       NMATRI = 1
  110.       NKID = 9
  111.       NKMT = 7
  112. C
  113.       SEGINI MATRIK
  114.       IJACO = MATRIK
  115.       MATRIK.IRIGEL(1,1) = MELRES
  116.       MATRIK.IRIGEL(2,1) = MELRES
  117. C
  118. C**** Matrice non symetrique
  119. C
  120.       MATRIK.IRIGEL(7,1) = 2
  121. C
  122.       NBME = 16
  123.       NBSOUS = 1
  124.       SEGINI IMATRI
  125.       IF(IJAC.EQ.1)THEN
  126.          MLMOTS=ILIINC
  127.       ELSEIF(IJAC.EQ.2)THEN
  128.          MLMOTS=ILIINP
  129.       ENDIF
  130.       SEGACT MLMOTS
  131.       MATRIK.IRIGEL(4,1) = IMATRI
  132. C
  133.       IMATRI.LISPRI(1) = MLMOTS.MOTS(1)
  134.       IMATRI.LISPRI(2) = MLMOTS.MOTS(2)
  135.       IMATRI.LISPRI(3) = MLMOTS.MOTS(3)
  136.       IMATRI.LISPRI(4) = MLMOTS.MOTS(4)
  137.       IMATRI.LISPRI(5) = MLMOTS.MOTS(1)
  138.       IMATRI.LISPRI(6) = MLMOTS.MOTS(2)
  139.       IMATRI.LISPRI(7) = MLMOTS.MOTS(3)
  140.       IMATRI.LISPRI(8) = MLMOTS.MOTS(4)
  141.       IMATRI.LISPRI(9) = MLMOTS.MOTS(1)
  142.       IMATRI.LISPRI(10) = MLMOTS.MOTS(2)
  143.       IMATRI.LISPRI(11) = MLMOTS.MOTS(3)
  144.       IMATRI.LISPRI(12) = MLMOTS.MOTS(4)
  145.       IMATRI.LISPRI(13) = MLMOTS.MOTS(1)
  146.       IMATRI.LISPRI(14) = MLMOTS.MOTS(2)
  147.       IMATRI.LISPRI(15) = MLMOTS.MOTS(3)
  148.       IMATRI.LISPRI(16) = MLMOTS.MOTS(4)
  149. C
  150.       SEGDES MLMOTS
  151.       MLMOTS=ILIINC
  152.       SEGACT MLMOTS
  153. C
  154.       IMATRI.LISDUA(1) = MLMOTS.MOTS(1)
  155.       IMATRI.LISDUA(2) = MLMOTS.MOTS(1)
  156.       IMATRI.LISDUA(3) = MLMOTS.MOTS(1)
  157.       IMATRI.LISDUA(4) = MLMOTS.MOTS(1)
  158.       IMATRI.LISDUA(5) = MLMOTS.MOTS(2)
  159.       IMATRI.LISDUA(6) = MLMOTS.MOTS(2)
  160.       IMATRI.LISDUA(7) = MLMOTS.MOTS(2)
  161.       IMATRI.LISDUA(8) = MLMOTS.MOTS(2)
  162.       IMATRI.LISDUA(9) = MLMOTS.MOTS(3)
  163.       IMATRI.LISDUA(10) = MLMOTS.MOTS(3)
  164.       IMATRI.LISDUA(11) = MLMOTS.MOTS(3)
  165.       IMATRI.LISDUA(12) = MLMOTS.MOTS(3)
  166.       IMATRI.LISDUA(13) = MLMOTS.MOTS(4)
  167.       IMATRI.LISDUA(14) = MLMOTS.MOTS(4)
  168.       IMATRI.LISDUA(15) = MLMOTS.MOTS(4)
  169.       IMATRI.LISDUA(16) = MLMOTS.MOTS(4)
  170. C
  171.       SEGDES MLMOTS
  172.       NBEL = NFAC
  173.       NBSOUS = 1
  174.       NP = 1
  175.       MP = 1
  176.       SEGINI   RR  , RUX , RUY , RRET ,
  177.      &         UXR , UXUX , UXUY , UXRET ,
  178.      &         UYR , UYUX , UYUY , UYRET ,
  179.      &         RETR , RETUX , RETUY , RETRET
  180. C
  181. C**** Duale = IMATRI.LISDUA(1) = 'RN'
  182. C     Primale = IMATRI.LISPRI(1) = 'RN'
  183. C     -> IMATRI.LIZAFM(1,1) = RR
  184. C
  185.       IMATRI.LIZAFM(1,1) = RR
  186.       IMATRI.LIZAFM(1,2) = RUX
  187.       IMATRI.LIZAFM(1,3) = RUY
  188.       IMATRI.LIZAFM(1,4) = RRET
  189.       IMATRI.LIZAFM(1,5) = UXR
  190.       IMATRI.LIZAFM(1,6) = UXUX
  191.       IMATRI.LIZAFM(1,7) = UXUY
  192.       IMATRI.LIZAFM(1,8) = UXRET
  193.       IMATRI.LIZAFM(1,9) = UYR
  194.       IMATRI.LIZAFM(1,10) = UYUX
  195.       IMATRI.LIZAFM(1,11) = UYUY
  196.       IMATRI.LIZAFM(1,12) = UYRET
  197.       IMATRI.LIZAFM(1,13) = RETR
  198.       IMATRI.LIZAFM(1,14) = RETUX
  199.       IMATRI.LIZAFM(1,15) = RETUY
  200.       IMATRI.LIZAFM(1,16) = RETRET
  201. C
  202.       SEGDES MATRIK
  203.       SEGDES IMATRI
  204. C
  205. C**** Fin definition MATRIK
  206. C
  207.       DO IFAC=1,NFAC,1
  208.          NGF=MELEFC.NUM(1,IFAC)
  209.          NGC=MELEFC.NUM(2,IFAC)
  210.          NLF=MLEMF.LECT(NGF)
  211.          NLC=MLEMC.LECT(NGC)
  212.          NLCB=MLEMCB.LECT(NGF)
  213.          VOLU=MPVOL.VPOCHA(NLC,1)
  214.          SURF=MPSURF.VPOCHA(NLF,1)
  215. C        In CASTEM les normales sont sortantes
  216.          CNX=-1*MPNORM.VPOCHA(NLF,1)
  217.          CNY=-1*MPNORM.VPOCHA(NLF,2)
  218. C        Variables au centre
  219.          GAMC=MPGAMC.VPOCHA(NLC,1)
  220.          GM1=GAMC-1.0D0
  221.          PC=MPPC.VPOCHA(NLC,1)
  222.          RC=MPRC.VPOCHA(NLC,1)
  223.          UXC=MPVC.VPOCHA(NLC,1)
  224.          UYC=MPVC.VPOCHA(NLC,2)
  225. C        Variables à la face
  226.          RHOUF=MPLIM.VPOCHA(NLCB,1)
  227.          PSRF=MPLIM.VPOCHA(NLCB,2)
  228. C
  229. C******* Variables à l'interface
  230. C
  231.          P=PC
  232.          RHO=P/PSRF
  233.          UN=RHOUF/RHO
  234. C
  235. C******* Derivative with respect to PC
  236. C
  237.          DUNDPC=-1*RHOUF/(RHO*RHO*PSRF)
  238.          DUXDPC=CNX*DUNDPC
  239.          DUYDPC=CNY*DUNDPC
  240.          DECIDP=UN*DUNDPC
  241. C
  242. C******* Jacobian with respect to primitive variables
  243. C
  244.          COEF=SURF/VOLU
  245.          DRORO=0.0D0
  246.          DROUX=0.0D0
  247.          DROUY=0.0D0
  248.          DROP=0.0D0
  249. C
  250.          DPRO=0.0D0
  251.          DPUX=0.0D0
  252.          DPUY=0.0D0
  253.          DPP=(RHOUF*DECIDP)*COEF
  254. C
  255.          DUXRO=0.0D0
  256.          DUXUX=0.0D0
  257.          DUXUY=0.0D0
  258.          DUXP =(RHOUF*DUXDPC+CNX)*COEF
  259. C
  260.          DUYRO=0.0D0
  261.          DUYUX=0.0D0
  262.          DUYUY=0.0D0
  263.          DUYP =(RHOUF*DUYDPC+CNY)*COEF
  264. C
  265. C******* Jacobian with respect to conservative variables
  266. C
  267.          IF(IJAC.EQ.1)THEN
  268.  
  269.             COEF1=-1.0D0*UXC/RC
  270.             COEF2=-1.0D0*UYC/RC
  271.             COEF3=0.5D0*GM1*((UXC*UXC)+(UYC*UYC))
  272. C
  273.             RR.AM(IFAC,1,1)=DRORO+(DROUX*COEF1)+(DROUY*COEF2)+(DROP
  274.      $           *COEF3)
  275.             RUX.AM(IFAC,1,1)=(DROUX/RC)-((UXC*GM1)*DROP)
  276.             RUY.AM(IFAC,1,1)=(DROUY/RC)-((UYC*GM1)*DROP)
  277.             RRET.AM(IFAC,1,1)=GM1*DROP
  278. C
  279.             UXR.AM(IFAC,1,1)=DUXRO+(DUXUX*COEF1)+(DUXUY*COEF2)+(DUXP
  280.      $           *COEF3)
  281.             UXUX.AM(IFAC,1,1)=(DUXUX/RC)-((UXC*GM1)*DUXP)
  282.             UXUY.AM(IFAC,1,1)=(DUXUY/RC)-((UYC*GM1)*DUXP)
  283.             UXRET.AM(IFAC,1,1)=GM1*DUXP
  284. C
  285.             UYR.AM(IFAC,1,1)=DUYRO+(DUYUX*COEF1)+(DUYUY*COEF2)+(DUYP
  286.      $           *COEF3)
  287.             UYUX.AM(IFAC,1,1)=(DUYUX/RC)-((UXC*GM1)*DUYP)
  288.             UYUY.AM(IFAC,1,1)=(DUYUY/RC)-((UYC*GM1)*DUYP)
  289.             UYRET.AM(IFAC,1,1)=GM1*DUYP
  290. C
  291.             RETR.AM(IFAC,1,1)=DPRO+(DPUX*COEF1)+(DPUY*COEF2)+(DPP
  292.      $           *COEF3)
  293.             RETUX.AM(IFAC,1,1)=(DPUX/RC)-((UXC*GM1)*DPP)
  294.             RETUY.AM(IFAC,1,1)=(DPUY/RC)-((UYC*GM1)*DPP)
  295.             RETRET.AM(IFAC,1,1)=GM1*DPP
  296. C
  297.          ELSEIF(IJAC.EQ.2)THEN
  298.             RR.AM(IFAC,1,1)=DRORO
  299.             RUX.AM(IFAC,1,1)=DROUX
  300.             RUY.AM(IFAC,1,1)=DROUY
  301.             RRET.AM(IFAC,1,1)=DROP
  302. C
  303.             UXR.AM(IFAC,1,1)=DUXRO
  304.             UXUX.AM(IFAC,1,1)=DUXUX
  305.             UXUY.AM(IFAC,1,1)=DUXUY
  306.             UXRET.AM(IFAC,1,1)=DUXP
  307. C
  308.             UYR.AM(IFAC,1,1)=DUYRO
  309.             UYUX.AM(IFAC,1,1)=DUYUX
  310.             UYUY.AM(IFAC,1,1)=DUYUY
  311.             UYRET.AM(IFAC,1,1)=DUYP
  312. C
  313.             RETR.AM(IFAC,1,1)=DPRO
  314.             RETUX.AM(IFAC,1,1)=DPUX
  315.             RETUY.AM(IFAC,1,1)=DPUY
  316.             RETRET.AM(IFAC,1,1)=DPP
  317.          ENDIF
  318.       ENDDO
  319. C
  320.       SEGDES MELEFC
  321. C
  322.       SEGSUP MLEMC
  323.       SEGSUP MLEMCB
  324.       SEGSUP MLEMF
  325. C
  326.       SEGDES MPNORM
  327.       SEGDES MPVOL
  328.       SEGDES MPSURF
  329.       SEGDES MPRC
  330.       SEGDES MPPC
  331.       SEGDES MPVC
  332.       SEGDES MPGAMC
  333.       SEGDES MPLIM
  334. C
  335.       SEGDES   RR  , RUX , RUY , RRET ,
  336.      &         UXR , UXUX , UXUY , UXRET ,
  337.      &         UYR , UYUX , UYUY , UYRET ,
  338.      &         RETR , RETUX , RETUY , RETRET
  339. C
  340.  9999 CONTINUE
  341.       RETURN
  342.       END
  343.  
  344.  
  345.  
  346.  
  347.  
  348.  
  349.  
  350.  
  351.  
  352.  
  353.  
  354.  
  355.  
  356.  
  357.  

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