Télécharger la plaquette Cast3M


fr en

Télécharger cli173.eso

Retour à la liste

Numérotation des lignes : 

cli173

  1. C CLI173    SOURCE    OF166741  24/12/13    21:15:26     12097          
  2.       SUBROUTINE CLI173(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               :  CLI173
  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.      &         RUZ.IZAFM, UXUZ.IZAFM, UYUZ.IZAFM, RETUZ.IZAFM,
  46.      &         UZR.IZAFM, UZUX.IZAFM, UZUY.IZAFM, UZRET.IZAFM,
  47.      &         UZUZ.IZAFM
  48. C
  49.       INTEGER MELEMF,MELEMC,MELECB,INORM,ICHPVO,ICHPSU, IROC,IVITC,IPC
  50.      &     ,IGAMC,ICHLIM,ICEL,NFAC,IFAC,MELRES,IJACO
  51.      &     ,NGF,NGC,NLF,NLC,NLCB
  52.      &     ,ILIINC,ILIINP,IJAC
  53.      &     ,MP, NBEL, NBME, NBSOUS, NKID, NKMT, NMATRI, NP, NRIGE
  54.       REAL*8 VOLU,SURF,GAMC,CNX,CNY,CNZ,GM1
  55.      &     ,RC,UXC,UYC,UZC
  56.      &     ,PC,PSRF,RHOUF,P,RHO,UN
  57.      &     ,DECIDP,DUNDPC,DUXDPC,DUYDPC,DUZDPC
  58.      &     ,DRORO,DROUX,DROUY,DROP
  59.      &     ,DUXRO,DUXUX,DUXUY,DUXP
  60.      &     ,DUYRO,DUYUX,DUYUY,DUYP
  61.      &     ,DPRO,DPUX,DPUY,DPP
  62.      &     ,COEF1,COEF2,COEF3,COEF,COEF4
  63.      &     ,DROUZ,DUXUZ,DUYUZ,DPUZ
  64.      &     ,DUZRO,DUZUX,DUZUY,DUZUZ,DUZP
  65.       CHARACTER*(8) TYPE
  66. C
  67. C
  68. C**** KRIPAD pour la correspondance global/local
  69. C
  70.       CALL KRIPAD(MELEMC,MLEMC)
  71. C     SEGINI MLEMC
  72.       CALL KRIPAD(MELECB,MLEMCB)
  73. C     SEGINI MLEMCB
  74.       CALL KRIPAD(MELEMF,MLEMF)
  75. C     SEGINI MLEMF
  76. C
  77. C**** CHPOINTs de la table DOMAINE
  78. C
  79.       CALL LICHT(INORM,MPNORM,TYPE,ICEL)
  80.       CALL LICHT(ICHPVO,MPVOL,TYPE,ICEL)
  81.       CALL LICHT(ICHPSU,MPSURF,TYPE,ICEL)
  82. C
  83. C**** LICHT active les MPOVALs en *MOD
  84. C
  85. C     SEGACT MPNORM*MOD
  86. C     SEGACT MPOVSU*MOD
  87. C     SEGACT MPOVOL*MOD
  88. C
  89. C
  90. C**** CHPOINTs des variables
  91. C
  92.       CALL LICHT(IROC,MPRC,TYPE,ICEL)
  93.       CALL LICHT(IVITC,MPVC,TYPE,ICEL)
  94.       CALL LICHT(IPC,MPPC,TYPE,ICEL)
  95.       CALL LICHT(IGAMC,MPGAMC,TYPE,ICEL)
  96.       CALL LICHT(ICHLIM,MPLIM,TYPE,ICEL)
  97. C
  98. C     SEGACT *MOD
  99. C     SEGACT *MOD
  100. C     SEGACT *MOD
  101. C     SEGACT *MOD
  102. C     SEGACT *MOD
  103. C
  104. C
  105. C**** Boucle sur le face pour le calcul des invariants de
  106. C     Riemann et du flux
  107. C
  108.       SEGACT MELEFC
  109.       NFAC=MELEFC.NUM(/2)
  110. C
  111. C**** Objet MATRIK
  112. C
  113.       NRIGE = 7
  114.       NMATRI = 1
  115.       NKID = 9
  116.       NKMT = 7
  117. C
  118.       SEGINI MATRIK
  119.       IJACO = MATRIK
  120.       MATRIK.IRIGEL(1,1) = MELRES
  121.       MATRIK.IRIGEL(2,1) = MELRES
  122. C
  123. C**** Matrice non symetrique
  124. C
  125.       MATRIK.IRIGEL(7,1) = 2
  126. C
  127.       NBME = 25
  128.       NBSOUS = 1
  129.       SEGINI IMATRI
  130.       IF(IJAC.EQ.1)THEN
  131.          MLMOTS=ILIINC
  132.       ELSEIF(IJAC.EQ.2)THEN
  133.          MLMOTS=ILIINP
  134.       ENDIF
  135.       SEGACT MLMOTS
  136.       MATRIK.IRIGEL(4,1) = IMATRI
  137. C
  138.       IMATRI.LISPRI(1) = MLMOTS.MOTS(1)
  139.       IMATRI.LISPRI(2) = MLMOTS.MOTS(2)
  140.       IMATRI.LISPRI(3) = MLMOTS.MOTS(3)
  141.       IMATRI.LISPRI(4) = MLMOTS.MOTS(4)
  142.       IMATRI.LISPRI(5) = MLMOTS.MOTS(5)
  143. C
  144.       IMATRI.LISPRI(6) = MLMOTS.MOTS(1)
  145.       IMATRI.LISPRI(7) = MLMOTS.MOTS(2)
  146.       IMATRI.LISPRI(8) = MLMOTS.MOTS(3)
  147.       IMATRI.LISPRI(9) = MLMOTS.MOTS(4)
  148.       IMATRI.LISPRI(10) = MLMOTS.MOTS(5)
  149. C
  150.       IMATRI.LISPRI(11) = MLMOTS.MOTS(1)
  151.       IMATRI.LISPRI(12) = MLMOTS.MOTS(2)
  152.       IMATRI.LISPRI(13) = MLMOTS.MOTS(3)
  153.       IMATRI.LISPRI(14) = MLMOTS.MOTS(4)
  154.       IMATRI.LISPRI(15) = MLMOTS.MOTS(5)
  155. C
  156.       IMATRI.LISPRI(16) = MLMOTS.MOTS(1)
  157.       IMATRI.LISPRI(17) = MLMOTS.MOTS(2)
  158.       IMATRI.LISPRI(18) = MLMOTS.MOTS(3)
  159.       IMATRI.LISPRI(19) = MLMOTS.MOTS(4)
  160.       IMATRI.LISPRI(20) = MLMOTS.MOTS(5)
  161. C
  162.       IMATRI.LISPRI(21) = MLMOTS.MOTS(1)
  163.       IMATRI.LISPRI(22) = MLMOTS.MOTS(2)
  164.       IMATRI.LISPRI(23) = MLMOTS.MOTS(3)
  165.       IMATRI.LISPRI(24) = MLMOTS.MOTS(4)
  166.       IMATRI.LISPRI(25) = MLMOTS.MOTS(5)
  167. C
  168.       SEGDES MLMOTS
  169.       MLMOTS=ILIINC
  170.       SEGACT MLMOTS
  171. C
  172. C
  173.       IMATRI.LISDUA(1) = MLMOTS.MOTS(1)
  174.       IMATRI.LISDUA(2) = MLMOTS.MOTS(1)
  175.       IMATRI.LISDUA(3) = MLMOTS.MOTS(1)
  176.       IMATRI.LISDUA(4) = MLMOTS.MOTS(1)
  177.       IMATRI.LISDUA(5) = MLMOTS.MOTS(1)
  178. C
  179.       IMATRI.LISDUA(6) = MLMOTS.MOTS(2)
  180.       IMATRI.LISDUA(7) = MLMOTS.MOTS(2)
  181.       IMATRI.LISDUA(8) = MLMOTS.MOTS(2)
  182.       IMATRI.LISDUA(9) = MLMOTS.MOTS(2)
  183.       IMATRI.LISDUA(10) = MLMOTS.MOTS(2)
  184. C
  185.       IMATRI.LISDUA(11) = MLMOTS.MOTS(3)
  186.       IMATRI.LISDUA(12) = MLMOTS.MOTS(3)
  187.       IMATRI.LISDUA(13) = MLMOTS.MOTS(3)
  188.       IMATRI.LISDUA(14) = MLMOTS.MOTS(3)
  189.       IMATRI.LISDUA(15) = MLMOTS.MOTS(3)
  190. C
  191.       IMATRI.LISDUA(16) = MLMOTS.MOTS(4)
  192.       IMATRI.LISDUA(17) = MLMOTS.MOTS(4)
  193.       IMATRI.LISDUA(18) = MLMOTS.MOTS(4)
  194.       IMATRI.LISDUA(19) = MLMOTS.MOTS(4)
  195.       IMATRI.LISDUA(20) = MLMOTS.MOTS(4)
  196. C
  197.       IMATRI.LISDUA(21) = MLMOTS.MOTS(5)
  198.       IMATRI.LISDUA(22) = MLMOTS.MOTS(5)
  199.       IMATRI.LISDUA(23) = MLMOTS.MOTS(5)
  200.       IMATRI.LISDUA(24) = MLMOTS.MOTS(5)
  201.       IMATRI.LISDUA(25) = MLMOTS.MOTS(5)
  202. C
  203.       SEGDES MLMOTS
  204.       NBEL = NFAC
  205.       NBSOUS = 1
  206.       NP = 1
  207.       MP = 1
  208.       SEGINI   RR  , RUX , RUY , RUZ ,RRET ,
  209.      &         UXR , UXUX , UXUY , UXUZ ,UXRET ,
  210.      &         UYR , UYUX , UYUY , UYUZ , UYRET ,
  211.      &         UZR , UZUX , UZUY , UZUZ , UZRET ,
  212.      &         RETR , RETUX , RETUY, RETUZ , RETRET
  213. C
  214. C**** Duale = IMATRI.LISDUA(1) = 'RN'
  215. C     Primale = IMATRI.LISPRI(1) = 'RN'
  216. C     -> IMATRI.LIZAFM(1,1) = RR
  217. C
  218.       IMATRI.LIZAFM(1,1) = RR
  219.       IMATRI.LIZAFM(1,2) = RUX
  220.       IMATRI.LIZAFM(1,3) = RUY
  221.       IMATRI.LIZAFM(1,4) = RUZ
  222.       IMATRI.LIZAFM(1,5) = RRET
  223. C
  224.       IMATRI.LIZAFM(1,6) = UXR
  225.       IMATRI.LIZAFM(1,7) = UXUX
  226.       IMATRI.LIZAFM(1,8) = UXUY
  227.       IMATRI.LIZAFM(1,9) = UXUZ
  228.       IMATRI.LIZAFM(1,10) = UXRET
  229. C
  230.       IMATRI.LIZAFM(1,11) = UYR
  231.       IMATRI.LIZAFM(1,12) = UYUX
  232.       IMATRI.LIZAFM(1,13) = UYUY
  233.       IMATRI.LIZAFM(1,14) = UYUZ
  234.       IMATRI.LIZAFM(1,15) = UYRET
  235. C
  236.       IMATRI.LIZAFM(1,16) = UZR
  237.       IMATRI.LIZAFM(1,17) = UZUX
  238.       IMATRI.LIZAFM(1,18) = UZUY
  239.       IMATRI.LIZAFM(1,19) = UZUZ
  240.       IMATRI.LIZAFM(1,20) = UZRET
  241. C
  242.       IMATRI.LIZAFM(1,21) = RETR
  243.       IMATRI.LIZAFM(1,22) = RETUX
  244.       IMATRI.LIZAFM(1,23) = RETUY
  245.       IMATRI.LIZAFM(1,24) = RETUZ
  246.       IMATRI.LIZAFM(1,25) = RETRET
  247. C
  248.       SEGDES MATRIK
  249.       SEGDES IMATRI
  250. C
  251. C**** Fin definition MATRIK
  252. C
  253.       DO IFAC=1,NFAC,1
  254.          NGF=MELEFC.NUM(1,IFAC)
  255.          NGC=MELEFC.NUM(2,IFAC)
  256.          NLF=MLEMF.LECT(NGF)
  257.          NLC=MLEMC.LECT(NGC)
  258.          NLCB=MLEMCB.LECT(NGF)
  259.          VOLU=MPVOL.VPOCHA(NLC,1)
  260.          SURF=MPSURF.VPOCHA(NLF,1)
  261. C        In CASTEM les normales sont sortantes
  262.          CNX=-1*MPNORM.VPOCHA(NLF,1)
  263.          CNY=-1*MPNORM.VPOCHA(NLF,2)
  264.          CNZ=-1*MPNORM.VPOCHA(NLF,3)
  265. C        Variables au centre
  266.          RC=MPRC.VPOCHA(NLC,1)
  267.          PC=MPPC.VPOCHA(NLC,1)
  268.          UXC=MPVC.VPOCHA(NLC,1)
  269.          UYC=MPVC.VPOCHA(NLC,2)
  270.          UZC=MPVC.VPOCHA(NLC,3)
  271.          GAMC=MPGAMC.VPOCHA(NLC,1)
  272.          GM1=GAMC-1.0D0
  273.          RHOUF=MPLIM.VPOCHA(NLCB,1)
  274.          PSRF=MPLIM.VPOCHA(NLCB,2)
  275. C
  276. C******* Variables à l'interface
  277. C
  278.          P=PC
  279.          RHO=P/PSRF
  280.          UN=RHOUF/RHO
  281. C
  282. C******* Derivative with respect to PC
  283. C
  284.          DUNDPC=-1*RHOUF/(RHO*RHO*PSRF)
  285.          DUXDPC=CNX*DUNDPC
  286.          DUYDPC=CNY*DUNDPC
  287.          DUZDPC=CNZ*DUNDPC
  288.          DECIDP=UN*DUNDPC
  289. C
  290. C******* Jacobian with respect to primitive variables
  291. C
  292.          COEF=SURF/VOLU
  293.          DRORO=0.0D0
  294.          DROUX=0.0D0
  295.          DROUY=0.0D0
  296.          DROUZ=0.0D0
  297.          DROP=0.0D0
  298. C
  299.          DPRO=0.0D0
  300.          DPUX=0.0D0
  301.          DPUY=0.0D0
  302.          DPUZ=0.0D0
  303.          DPP=(RHOUF*DECIDP)*COEF
  304. C
  305.          DUXRO=0.0D0
  306.          DUXUX=0.0D0
  307.          DUXUY=0.0D0
  308.          DUXUZ=0.0D0
  309.          DUXP =(RHOUF*DUXDPC+CNX)*COEF
  310. C
  311.          DUYRO=0.0D0
  312.          DUYUX=0.0D0
  313.          DUYUY=0.0D0
  314.          DUYUZ=0.0D0
  315.          DUYP =(RHOUF*DUYDPC+CNY)*COEF
  316. C
  317.          DUZRO=0.0D0
  318.          DUZUX=0.0D0
  319.          DUZUY=0.0D0
  320.          DUZUZ=0.0D0
  321.          DUZP =(RHOUF*DUZDPC+CNZ)*COEF
  322. C
  323. C******* Jacobian with respect to conservative variables
  324. C
  325.          IF(IJAC.EQ.1)THEN
  326.             GM1=GAMC-1.0D0
  327. C
  328.             COEF1=-1.0D0*UXC/RC
  329.             COEF2=-1.0D0*UYC/RC
  330.             COEF3=-1.0D0*UZC/RC
  331.             COEF4=0.5D0*GM1*((UXC*UXC)+(UYC*UYC)+(UZC*UZC))
  332. C
  333.             RR.AM(IFAC,1,1)=DRORO+(DROUX*COEF1)+(DROUY*COEF2)+(DROUZ
  334.      $           *COEF3)+(DROP*COEF4)
  335.             RUX.AM(IFAC,1,1)=(DROUX/RC)-((UXC*GM1)*DROP)
  336.             RUY.AM(IFAC,1,1)=(DROUY/RC)-((UYC*GM1)*DROP)
  337.             RUZ.AM(IFAC,1,1)=(DROUZ/RC)-((UZC*GM1)*DROP)
  338.             RRET.AM(IFAC,1,1)=GM1*DROP
  339. C
  340.             UXR.AM(IFAC,1,1)=DUXRO+(DUXUX*COEF1)+(DUXUY*COEF2)+(DUXUZ
  341.      $           *COEF3)+(DUXP*COEF4)
  342.             UXUX.AM(IFAC,1,1)=(DUXUX/RC)-((UXC*GM1)*DUXP)
  343.             UXUY.AM(IFAC,1,1)=(DUXUY/RC)-((UYC*GM1)*DUXP)
  344.             UXUZ.AM(IFAC,1,1)=(DUXUZ/RC)-((UZC*GM1)*DUXP)
  345.             UXRET.AM(IFAC,1,1)=GM1*DUXP
  346. C
  347.             UYR.AM(IFAC,1,1)=DUYRO+(DUYUX*COEF1)+(DUYUY*COEF2)+(DUYUZ
  348.      $           *COEF3)+(DUYP*COEF4)
  349.             UYUX.AM(IFAC,1,1)=(DUYUX/RC)-((UXC*GM1)*DUYP)
  350.             UYUY.AM(IFAC,1,1)=(DUYUY/RC)-((UYC*GM1)*DUYP)
  351.             UYUZ.AM(IFAC,1,1)=(DUYUZ/RC)-((UZC*GM1)*DUYP)
  352.             UYRET.AM(IFAC,1,1)=GM1*DUYP
  353. C
  354.             UZR.AM(IFAC,1,1)=DUZRO+(DUZUX*COEF1)+(DUZUY*COEF2)+(DUZUZ
  355.      $           *COEF3)+(DUZP*COEF4)
  356.             UZUX.AM(IFAC,1,1)=(DUZUX/RC)-((UXC*GM1)*DUZP)
  357.             UZUY.AM(IFAC,1,1)=(DUZUY/RC)-((UYC*GM1)*DUZP)
  358.             UZUZ.AM(IFAC,1,1)=(DUZUZ/RC)-((UZC*GM1)*DUZP)
  359.             UZRET.AM(IFAC,1,1)=GM1*DUZP
  360. C
  361.             RETR.AM(IFAC,1,1)=DPRO+(DPUX*COEF1)+(DPUY*COEF2)+(DPUZ
  362.      $           *COEF3)+(DPP*COEF4)
  363.             RETUX.AM(IFAC,1,1)=(DPUX/RC)-((UXC*GM1)*DPP)
  364.             RETUY.AM(IFAC,1,1)=(DPUY/RC)-((UYC*GM1)*DPP)
  365.             RETUZ.AM(IFAC,1,1)=(DPUZ/RC)-((UZC*GM1)*DPP)
  366.             RETRET.AM(IFAC,1,1)=GM1*DPP
  367. C
  368.          ELSEIF(IJAC.EQ.2)THEN
  369.             RR.AM(IFAC,1,1)=DRORO
  370.             RUX.AM(IFAC,1,1)=DROUX
  371.             RUY.AM(IFAC,1,1)=DROUY
  372.             RUZ.AM(IFAC,1,1)=DROUZ
  373.             RRET.AM(IFAC,1,1)=DROP
  374. C
  375.             UXR.AM(IFAC,1,1)=DUXRO
  376.             UXUX.AM(IFAC,1,1)=DUXUX
  377.             UXUY.AM(IFAC,1,1)=DUXUY
  378.             UXUZ.AM(IFAC,1,1)=DUXUZ
  379.             UXRET.AM(IFAC,1,1)=DUXP
  380. C
  381.             UYR.AM(IFAC,1,1)=DUYRO
  382.             UYUX.AM(IFAC,1,1)=DUYUX
  383.             UYUY.AM(IFAC,1,1)=DUYUY
  384.             UYUZ.AM(IFAC,1,1)=DUYUZ
  385.             UYRET.AM(IFAC,1,1)=DUYP
  386. C
  387.             UZR.AM(IFAC,1,1)=DUZRO
  388.             UZUX.AM(IFAC,1,1)=DUZUX
  389.             UZUY.AM(IFAC,1,1)=DUZUY
  390.             UZUZ.AM(IFAC,1,1)=DUZUZ
  391.             UZRET.AM(IFAC,1,1)=DUZP
  392. C
  393.             RETR.AM(IFAC,1,1)=DPRO
  394.             RETUX.AM(IFAC,1,1)=DPUX
  395.             RETUY.AM(IFAC,1,1)=DPUY
  396.             RETUZ.AM(IFAC,1,1)=DPUZ
  397.             RETRET.AM(IFAC,1,1)=DPP
  398.          ENDIF
  399.       ENDDO
  400. C
  401.       SEGDES MELEFC
  402. C
  403.       SEGSUP MLEMC
  404.       SEGSUP MLEMCB
  405.       SEGSUP MLEMF
  406. C
  407.       SEGDES MPNORM
  408.       SEGDES MPVOL
  409.       SEGDES MPSURF
  410.       SEGDES MPRC
  411.       SEGDES MPPC
  412.       SEGDES MPVC
  413.       SEGDES MPGAMC
  414.       SEGDES MPLIM
  415. C
  416.       SEGDES   RR  , RUX , RUY , RUZ ,RRET ,
  417.      &         UXR , UXUX , UXUY , UXUZ ,UXRET ,
  418.      &         UYR , UYUX , UYUY , UYUZ , UYRET ,
  419.      &         UZR , UZUX , UZUY , UZUZ , UZRET ,
  420.      &         RETR , RETUX , RETUY, RETUZ , RETRET
  421. C
  422.  9999 CONTINUE
  423.       RETURN
  424.       END
  425.  
  426.  
  427.  
  428.  
  429.  
  430.  
  431.  
  432.  
  433.  
  434.  
  435.  
  436.  
  437.  
  438.  
  439.  

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