Télécharger la plaquette Cast3M


fr en

Télécharger cli142.eso

Retour à la liste

Numérotation des lignes : 

cli142

  1. C CLI142    SOURCE    OF166741  24/12/13    21:15:17     12097          
  2.       SUBROUTINE CLI142(MELEMF,MELEMC,MELECB,MELEFC,MELRES,INORM,ICHPVO,
  3.      &     ICHPSU,IROC,IVITC,IPC,IGAMC,ILIINC,ILIINP,IJAC,IJACO)
  4. C************************************************************************
  5. C
  6. C PROJET            :  CASTEM 2000
  7. C
  8. C NOM               :  CLI122
  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
  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.  
  45.       INTEGER MELEMF,MELEMC,MELECB,INORM,ICHPVO,ICHPSU, IROC,IVITC,IPC
  46.      &     ,IGAMC,ICEL,NFAC,IFAC,MELRES,IJACO
  47.      &     ,NGF,NGC,NLF,NLC
  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
  51.      &     ,UNC
  52.      &     ,GM1,USGM1,COEF,ECIN,HIN
  53.      &     ,DRORO,DROUX,DROUY,DROP
  54.      &     ,DUXRO,DUXUX,DUXUY,DUXP
  55.      &     ,DUYRO,DUYUX,DUYUY,DUYP
  56.      &     ,DPRO,DPUX,DPUY,DPP
  57.      &     ,COEF1,COEF2,COEF3
  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. C
  90. C     SEGACT *MOD
  91. C     SEGACT *MOD
  92. C     SEGACT *MOD
  93. C     SEGACT *MOD
  94. C     SEGACT *MOD
  95. C
  96. C
  97. C**** Boucle sur le face pour le calcul des invariants de
  98. C     Riemann et du flux
  99. C
  100.       SEGACT MELEFC
  101.       NFAC=MELEFC.NUM(/2)
  102. C
  103. C**** Objet MATRIK
  104. C
  105.       NRIGE = 7
  106.       NMATRI = 1
  107.       NKID = 9
  108.       NKMT = 7
  109. C
  110.       SEGINI MATRIK
  111.       IJACO = MATRIK
  112.       MATRIK.IRIGEL(1,1) = MELRES
  113.       MATRIK.IRIGEL(2,1) = MELRES
  114. C
  115. C**** Matrice non symetrique
  116. C
  117.       MATRIK.IRIGEL(7,1) = 2
  118. C
  119.       NBME = 16
  120.       NBSOUS = 1
  121.       SEGINI IMATRI
  122.       IF(IJAC.EQ.1)THEN
  123.          MLMOTS=ILIINC
  124.       ELSEIF(IJAC.EQ.2)THEN
  125.          MLMOTS=ILIINP
  126.       ENDIF
  127.       SEGACT MLMOTS
  128.       MATRIK.IRIGEL(4,1) = IMATRI
  129. C
  130.       IMATRI.LISPRI(1) = MLMOTS.MOTS(1)
  131.       IMATRI.LISPRI(2) = MLMOTS.MOTS(2)
  132.       IMATRI.LISPRI(3) = MLMOTS.MOTS(3)
  133.       IMATRI.LISPRI(4) = MLMOTS.MOTS(4)
  134.       IMATRI.LISPRI(5) = MLMOTS.MOTS(1)
  135.       IMATRI.LISPRI(6) = MLMOTS.MOTS(2)
  136.       IMATRI.LISPRI(7) = MLMOTS.MOTS(3)
  137.       IMATRI.LISPRI(8) = MLMOTS.MOTS(4)
  138.       IMATRI.LISPRI(9) = MLMOTS.MOTS(1)
  139.       IMATRI.LISPRI(10) = MLMOTS.MOTS(2)
  140.       IMATRI.LISPRI(11) = MLMOTS.MOTS(3)
  141.       IMATRI.LISPRI(12) = MLMOTS.MOTS(4)
  142.       IMATRI.LISPRI(13) = MLMOTS.MOTS(1)
  143.       IMATRI.LISPRI(14) = MLMOTS.MOTS(2)
  144.       IMATRI.LISPRI(15) = MLMOTS.MOTS(3)
  145.       IMATRI.LISPRI(16) = MLMOTS.MOTS(4)
  146. C
  147.       SEGDES MLMOTS
  148.       MLMOTS=ILIINC
  149.       SEGACT MLMOTS
  150. C
  151.       IMATRI.LISDUA(1) = MLMOTS.MOTS(1)
  152.       IMATRI.LISDUA(2) = MLMOTS.MOTS(1)
  153.       IMATRI.LISDUA(3) = MLMOTS.MOTS(1)
  154.       IMATRI.LISDUA(4) = MLMOTS.MOTS(1)
  155.       IMATRI.LISDUA(5) = MLMOTS.MOTS(2)
  156.       IMATRI.LISDUA(6) = MLMOTS.MOTS(2)
  157.       IMATRI.LISDUA(7) = MLMOTS.MOTS(2)
  158.       IMATRI.LISDUA(8) = MLMOTS.MOTS(2)
  159.       IMATRI.LISDUA(9) = MLMOTS.MOTS(3)
  160.       IMATRI.LISDUA(10) = MLMOTS.MOTS(3)
  161.       IMATRI.LISDUA(11) = MLMOTS.MOTS(3)
  162.       IMATRI.LISDUA(12) = MLMOTS.MOTS(3)
  163.       IMATRI.LISDUA(13) = MLMOTS.MOTS(4)
  164.       IMATRI.LISDUA(14) = MLMOTS.MOTS(4)
  165.       IMATRI.LISDUA(15) = MLMOTS.MOTS(4)
  166.       IMATRI.LISDUA(16) = MLMOTS.MOTS(4)
  167. C
  168.       SEGDES MLMOTS
  169.       NBEL = NFAC
  170.       NBSOUS = 1
  171.       NP = 1
  172.       MP = 1
  173.       SEGINI   RR  , RUX , RUY , RRET ,
  174.      &         UXR , UXUX , UXUY , UXRET ,
  175.      &         UYR , UYUX , UYUY , UYRET ,
  176.      &         RETR , RETUX , RETUY , RETRET
  177. C
  178. C**** Duale = IMATRI.LISDUA(1) = 'RN'
  179. C     Primale = IMATRI.LISPRI(1) = 'RN'
  180. C     -> IMATRI.LIZAFM(1,1) = RR
  181. C
  182.       IMATRI.LIZAFM(1,1) = RR
  183.       IMATRI.LIZAFM(1,2) = RUX
  184.       IMATRI.LIZAFM(1,3) = RUY
  185.       IMATRI.LIZAFM(1,4) = RRET
  186.       IMATRI.LIZAFM(1,5) = UXR
  187.       IMATRI.LIZAFM(1,6) = UXUX
  188.       IMATRI.LIZAFM(1,7) = UXUY
  189.       IMATRI.LIZAFM(1,8) = UXRET
  190.       IMATRI.LIZAFM(1,9) = UYR
  191.       IMATRI.LIZAFM(1,10) = UYUX
  192.       IMATRI.LIZAFM(1,11) = UYUY
  193.       IMATRI.LIZAFM(1,12) = UYRET
  194.       IMATRI.LIZAFM(1,13) = RETR
  195.       IMATRI.LIZAFM(1,14) = RETUX
  196.       IMATRI.LIZAFM(1,15) = RETUY
  197.       IMATRI.LIZAFM(1,16) = RETRET
  198. C
  199.       SEGDES MATRIK
  200.       SEGDES IMATRI
  201. C
  202. C**** Fin definition MATRIK
  203. C
  204.       DO IFAC=1,NFAC,1
  205.          NGF=MELEFC.NUM(1,IFAC)
  206.          NGC=MELEFC.NUM(2,IFAC)
  207.          NLF=MLEMF.LECT(NGF)
  208.          NLC=MLEMC.LECT(NGC)
  209.          VOLU=MPVOL.VPOCHA(NLC,1)
  210.          SURF=MPSURF.VPOCHA(NLF,1)
  211. C        In CASTEM les normales sont sortantes
  212.          CNX=MPNORM.VPOCHA(NLF,1)
  213.          CNY=MPNORM.VPOCHA(NLF,2)
  214. C        Variables au centre
  215.          RC=MPRC.VPOCHA(NLC,1)
  216.          PC=MPPC.VPOCHA(NLC,1)
  217.          UXC=MPVC.VPOCHA(NLC,1)
  218.          UYC=MPVC.VPOCHA(NLC,2)
  219.          GAMC=MPGAMC.VPOCHA(NLC,1)
  220.          GM1=GAMC-1.0D0
  221.          USGM1=1.0D0/GM1
  222. C
  223. C******* On calcule UN, UT
  224. C
  225.          UNC=(UXC*CNX)+(UYC*CNY)
  226. C
  227. C******* Densite, vitesse, pression sur le bord
  228. C
  229.          COEF=-1*SURF/VOLU
  230. C
  231.          DRORO=UNC*COEF
  232.          DROUX=(RC*CNX)*COEF
  233.          DROUY=(RC*CNY)*COEF
  234.          DROP=0.0D0
  235. C
  236.          DUXRO=(UNC*UXC)*COEF
  237.          DUXUX=((RC*CNX*UXC)+(RC*UNC))*COEF
  238.          DUXUY=((RC*CNY*UXC))*COEF
  239.          DUXP=CNX*COEF
  240. C
  241.          DUYRO=(UNC*UYC)*COEF
  242.          DUYUX=((RC*CNX*UYC))*COEF
  243.          DUYUY=((RC*CNY*UYC)+(RC*UNC))*COEF
  244.          DUYP=CNY*COEF
  245. C
  246.          ECIN=0.5D0*((UXC*UXC)+(UYC*UYC))
  247.          HIN=GAMC*USGM1*PC
  248.          DPRO=(UNC*ECIN)*COEF
  249.          DPUX=((CNX*HIN)+(RC*CNX*ECIN)+(RC*UNC*UXC))*COEF
  250.          DPUY=((CNY*HIN)+(RC*CNY*ECIN)+(RC*UNC*UYC))*COEF
  251.          DPP=(UNC*GAMC*USGM1)*COEF
  252. CC
  253. CC******* Jacobian with respect to conservative variables
  254. CC
  255.          IF(IJAC.EQ.1)THEN
  256.  
  257.             COEF1=-1.0D0*UXC/RC
  258.             COEF2=-1.0D0*UYC/RC
  259.             COEF3=0.5D0*GM1*((UXC*UXC)+(UYC*UYC))
  260. C
  261.             RR.AM(IFAC,1,1)=DRORO+(DROUX*COEF1)+(DROUY*COEF2)+(DROP
  262.      $           *COEF3)
  263.             RUX.AM(IFAC,1,1)=(DROUX/RC)-((UXC*GM1)*DROP)
  264.             RUY.AM(IFAC,1,1)=(DROUY/RC)-((UYC*GM1)*DROP)
  265.             RRET.AM(IFAC,1,1)=GM1*DROP
  266. C
  267.             UXR.AM(IFAC,1,1)=DUXRO+(DUXUX*COEF1)+(DUXUY*COEF2)+(DUXP
  268.      $           *COEF3)
  269.             UXUX.AM(IFAC,1,1)=(DUXUX/RC)-((UXC*GM1)*DUXP)
  270.             UXUY.AM(IFAC,1,1)=(DUXUY/RC)-((UYC*GM1)*DUXP)
  271.             UXRET.AM(IFAC,1,1)=GM1*DUXP
  272. C
  273.             UYR.AM(IFAC,1,1)=DUYRO+(DUYUX*COEF1)+(DUYUY*COEF2)+(DUYP
  274.      $           *COEF3)
  275.             UYUX.AM(IFAC,1,1)=(DUYUX/RC)-((UXC*GM1)*DUYP)
  276.             UYUY.AM(IFAC,1,1)=(DUYUY/RC)-((UYC*GM1)*DUYP)
  277.             UYRET.AM(IFAC,1,1)=GM1*DUYP
  278. C
  279.             RETR.AM(IFAC,1,1)=DPRO+(DPUX*COEF1)+(DPUY*COEF2)+(DPP
  280.      $           *COEF3)
  281.             RETUX.AM(IFAC,1,1)=(DPUX/RC)-((UXC*GM1)*DPP)
  282.             RETUY.AM(IFAC,1,1)=(DPUY/RC)-((UYC*GM1)*DPP)
  283.             RETRET.AM(IFAC,1,1)=GM1*DPP
  284. C
  285.          ELSEIF(IJAC.EQ.2)THEN
  286.             RR.AM(IFAC,1,1)=DRORO
  287.             RUX.AM(IFAC,1,1)=DROUX
  288.             RUY.AM(IFAC,1,1)=DROUY
  289.             RRET.AM(IFAC,1,1)=DROP
  290. C
  291.             UXR.AM(IFAC,1,1)=DUXRO
  292.             UXUX.AM(IFAC,1,1)=DUXUX
  293.             UXUY.AM(IFAC,1,1)=DUXUY
  294.             UXRET.AM(IFAC,1,1)=DUXP
  295. C
  296.             UYR.AM(IFAC,1,1)=DUYRO
  297.             UYUX.AM(IFAC,1,1)=DUYUX
  298.             UYUY.AM(IFAC,1,1)=DUYUY
  299.             UYRET.AM(IFAC,1,1)=DUYP
  300. C
  301.             RETR.AM(IFAC,1,1)=DPRO
  302.             RETUX.AM(IFAC,1,1)=DPUX
  303.             RETUY.AM(IFAC,1,1)=DPUY
  304.             RETRET.AM(IFAC,1,1)=DPP
  305.          ENDIF
  306.       ENDDO
  307. C
  308.       SEGDES MELEFC
  309. C
  310.       SEGSUP MLEMC
  311.       SEGSUP MLEMCB
  312.       SEGSUP MLEMF
  313. C
  314.       SEGDES MPNORM
  315.       SEGDES MPVOL
  316.       SEGDES MPSURF
  317.       SEGDES MPRC
  318.       SEGDES MPPC
  319.       SEGDES MPVC
  320.       SEGDES MPGAMC
  321. C
  322.       SEGDES   RR  , RUX , RUY , RRET ,
  323.      &         UXR , UXUX , UXUY , UXRET ,
  324.      &         UYR , UYUX , UYUY , UYRET ,
  325.      &         RETR , RETUX , RETUY , RETRET
  326. C
  327.  9999 CONTINUE
  328.       RETURN
  329.       END
  330.  
  331.  
  332.  
  333.  
  334.  
  335.  
  336.  
  337.  
  338.  
  339.  
  340.  
  341.  
  342.  
  343.  
  344.  

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