Télécharger la plaquette Cast3M


fr en

Télécharger cli152.eso

Retour à la liste

Numérotation des lignes : 

cli152

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

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