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    CB215821  20/11/25    13:20:06     10792          
  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. C
  45. C**** Variables de COOPTIO
  46. C
  47. C      INTEGER IPLLB, IERPER, IERMAX, IERR, INTERR
  48. C     &        ,IOTER,   IOLEC,  IOIMP,     IOCAR,  IOACQ
  49. C     &        ,IOPER,   IOSGB,  IOGRA,     IOSAU,  IORES
  50. C     &        ,IECHO,   IIMPI,  IOSPI
  51. C     &        ,IDIM,    IFICLE, IPREFI
  52. C     &        ,MCOORD
  53. C     &        ,IFOMOD, NIFOUR, IFOUR, NSDPGE, IONIVE
  54. C     &        ,NGMAXY, IZROSF, ISOTYP, IOSCR,LTEXLU
  55. C     &        ,NORINC,NORVAL,NORIND,NORVAD
  56. C     &        ,NUCROU, IPSAUV
  57. C
  58.       INTEGER MELEMF,MELEMC,MELECB,INORM,ICHPVO,ICHPSU, IROC,IVITC,IPC
  59.      &     ,IGAMC,ICEL,NFAC,IFAC,MELRES,IJACO
  60.      &     ,NGF,NGC,NLF,NLC
  61.      &     ,ILIINC,ILIINP,IJAC
  62.      &     ,MP, NBEL, NBME, NBSOUS, NKID, NKMT, NMATRI, NP, NRIGE
  63.       REAL*8 VOLU,SURF,RC,PC,UXC,UYC,GAMC,CNX,CNY
  64.      &     ,UNC
  65.      &     ,GM1,USGM1,COEF,ECIN,HIN
  66.      &     ,DRORO,DROUX,DROUY,DROP
  67.      &     ,DUXRO,DUXUX,DUXUY,DUXP
  68.      &     ,DUYRO,DUYUX,DUYUY,DUYP
  69.      &     ,DPRO,DPUX,DPUY,DPP
  70.      &     ,COEF1,COEF2,COEF3
  71.       CHARACTER*(8) TYPE
  72. C
  73. C
  74. C**** KRIPAD pour la correspondance global/local
  75. C
  76.       CALL KRIPAD(MELEMC,MLEMC)
  77. C     SEGINI MLEMC
  78.       CALL KRIPAD(MELECB,MLEMCB)
  79. C     SEGINI MLEMCB
  80.       CALL KRIPAD(MELEMF,MLEMF)
  81. C     SEGINI MLEMF
  82. C
  83. C**** CHPOINTs de la table DOMAINE
  84. C
  85.       CALL LICHT(INORM,MPNORM,TYPE,ICEL)
  86.       CALL LICHT(ICHPVO,MPVOL,TYPE,ICEL)
  87.       CALL LICHT(ICHPSU,MPSURF,TYPE,ICEL)
  88. C
  89. C**** LICHT active les MPOVALs en *MOD
  90. C
  91. C     SEGACT MPNORM*MOD
  92. C     SEGACT MPOVSU*MOD
  93. C     SEGACT MPOVOL*MOD
  94. C
  95. C
  96. C**** CHPOINTs des variables
  97. C
  98.       CALL LICHT(IROC,MPRC,TYPE,ICEL)
  99.       CALL LICHT(IVITC,MPVC,TYPE,ICEL)
  100.       CALL LICHT(IPC,MPPC,TYPE,ICEL)
  101.       CALL LICHT(IGAMC,MPGAMC,TYPE,ICEL)
  102. C
  103. C     SEGACT *MOD
  104. C     SEGACT *MOD
  105. C     SEGACT *MOD
  106. C     SEGACT *MOD
  107. C     SEGACT *MOD
  108. C
  109. C
  110. C**** Boucle sur le face pour le calcul des invariants de
  111. C     Riemann et du flux
  112. C
  113.       SEGACT MELEFC
  114.       NFAC=MELEFC.NUM(/2)
  115. C
  116. C**** Objet MATRIK
  117. C
  118.       NRIGE = 7
  119.       NMATRI = 1
  120.       NKID = 9
  121.       NKMT = 7
  122. C
  123.       SEGINI MATRIK
  124.       IJACO = MATRIK
  125.       MATRIK.IRIGEL(1,1) = MELRES
  126.       MATRIK.IRIGEL(2,1) = MELRES
  127. C
  128. C**** Matrice non symetrique
  129. C
  130.       MATRIK.IRIGEL(7,1) = 2
  131. C
  132.       NBME = 16
  133.       NBSOUS = 1
  134.       SEGINI IMATRI
  135.       IF(IJAC.EQ.1)THEN
  136.          MLMOTS=ILIINC
  137.       ELSEIF(IJAC.EQ.2)THEN
  138.          MLMOTS=ILIINP
  139.       ENDIF
  140.       SEGACT MLMOTS
  141.       MATRIK.IRIGEL(4,1) = IMATRI
  142. C
  143.       IMATRI.LISPRI(1) = MLMOTS.MOTS(1)
  144.       IMATRI.LISPRI(2) = MLMOTS.MOTS(2)
  145.       IMATRI.LISPRI(3) = MLMOTS.MOTS(3)
  146.       IMATRI.LISPRI(4) = MLMOTS.MOTS(4)
  147.       IMATRI.LISPRI(5) = MLMOTS.MOTS(1)
  148.       IMATRI.LISPRI(6) = MLMOTS.MOTS(2)
  149.       IMATRI.LISPRI(7) = MLMOTS.MOTS(3)
  150.       IMATRI.LISPRI(8) = MLMOTS.MOTS(4)
  151.       IMATRI.LISPRI(9) = MLMOTS.MOTS(1)
  152.       IMATRI.LISPRI(10) = MLMOTS.MOTS(2)
  153.       IMATRI.LISPRI(11) = MLMOTS.MOTS(3)
  154.       IMATRI.LISPRI(12) = MLMOTS.MOTS(4)
  155.       IMATRI.LISPRI(13) = MLMOTS.MOTS(1)
  156.       IMATRI.LISPRI(14) = MLMOTS.MOTS(2)
  157.       IMATRI.LISPRI(15) = MLMOTS.MOTS(3)
  158.       IMATRI.LISPRI(16) = MLMOTS.MOTS(4)
  159. C
  160.       SEGDES MLMOTS
  161.       MLMOTS=ILIINC
  162.       SEGACT MLMOTS
  163. C
  164.       IMATRI.LISDUA(1) = MLMOTS.MOTS(1)
  165.       IMATRI.LISDUA(2) = MLMOTS.MOTS(1)
  166.       IMATRI.LISDUA(3) = MLMOTS.MOTS(1)
  167.       IMATRI.LISDUA(4) = MLMOTS.MOTS(1)
  168.       IMATRI.LISDUA(5) = MLMOTS.MOTS(2)
  169.       IMATRI.LISDUA(6) = MLMOTS.MOTS(2)
  170.       IMATRI.LISDUA(7) = MLMOTS.MOTS(2)
  171.       IMATRI.LISDUA(8) = MLMOTS.MOTS(2)
  172.       IMATRI.LISDUA(9) = MLMOTS.MOTS(3)
  173.       IMATRI.LISDUA(10) = MLMOTS.MOTS(3)
  174.       IMATRI.LISDUA(11) = MLMOTS.MOTS(3)
  175.       IMATRI.LISDUA(12) = MLMOTS.MOTS(3)
  176.       IMATRI.LISDUA(13) = MLMOTS.MOTS(4)
  177.       IMATRI.LISDUA(14) = MLMOTS.MOTS(4)
  178.       IMATRI.LISDUA(15) = MLMOTS.MOTS(4)
  179.       IMATRI.LISDUA(16) = MLMOTS.MOTS(4)
  180. C
  181.       SEGDES MLMOTS
  182.       NBEL = NFAC
  183.       NBSOUS = 1
  184.       NP = 1
  185.       MP = 1
  186.       SEGINI   RR  , RUX , RUY , RRET ,
  187.      &         UXR , UXUX , UXUY , UXRET ,
  188.      &         UYR , UYUX , UYUY , UYRET ,
  189.      &         RETR , RETUX , RETUY , RETRET
  190. C
  191. C**** Duale = IMATRI.LISDUA(1) = 'RN'
  192. C     Primale = IMATRI.LISPRI(1) = 'RN'
  193. C     -> IMATRI.LIZAFM(1,1) = RR
  194. C
  195.       IMATRI.LIZAFM(1,1) = RR
  196.       IMATRI.LIZAFM(1,2) = RUX
  197.       IMATRI.LIZAFM(1,3) = RUY
  198.       IMATRI.LIZAFM(1,4) = RRET
  199.       IMATRI.LIZAFM(1,5) = UXR
  200.       IMATRI.LIZAFM(1,6) = UXUX
  201.       IMATRI.LIZAFM(1,7) = UXUY
  202.       IMATRI.LIZAFM(1,8) = UXRET
  203.       IMATRI.LIZAFM(1,9) = UYR
  204.       IMATRI.LIZAFM(1,10) = UYUX
  205.       IMATRI.LIZAFM(1,11) = UYUY
  206.       IMATRI.LIZAFM(1,12) = UYRET
  207.       IMATRI.LIZAFM(1,13) = RETR
  208.       IMATRI.LIZAFM(1,14) = RETUX
  209.       IMATRI.LIZAFM(1,15) = RETUY
  210.       IMATRI.LIZAFM(1,16) = RETRET
  211. C
  212.       SEGDES MATRIK
  213.       SEGDES IMATRI
  214. C
  215. C**** Fin definition MATRIK
  216. C
  217.       DO IFAC=1,NFAC,1
  218.          NGF=MELEFC.NUM(1,IFAC)
  219.          NGC=MELEFC.NUM(2,IFAC)
  220.          NLF=MLEMF.LECT(NGF)
  221.          NLC=MLEMC.LECT(NGC)
  222.          VOLU=MPVOL.VPOCHA(NLC,1)
  223.          SURF=MPSURF.VPOCHA(NLF,1)
  224. C        In CASTEM les normales sont sortantes
  225.          CNX=MPNORM.VPOCHA(NLF,1)
  226.          CNY=MPNORM.VPOCHA(NLF,2)
  227. C        Variables au centre
  228.          RC=MPRC.VPOCHA(NLC,1)
  229.          PC=MPPC.VPOCHA(NLC,1)
  230.          UXC=MPVC.VPOCHA(NLC,1)
  231.          UYC=MPVC.VPOCHA(NLC,2)
  232.          GAMC=MPGAMC.VPOCHA(NLC,1)
  233.          GM1=GAMC-1.0D0
  234.          USGM1=1.0D0/GM1
  235. C
  236. C******* On calcule UN, UT
  237. C
  238.          UNC=(UXC*CNX)+(UYC*CNY)
  239. C
  240. C******* Densite, vitesse, pression sur le bord
  241. C
  242.          COEF=-1*SURF/VOLU
  243. C
  244.          DRORO=UNC*COEF
  245.          DROUX=(RC*CNX)*COEF
  246.          DROUY=(RC*CNY)*COEF
  247.          DROP=0.0D0
  248. C
  249.          DUXRO=(UNC*UXC)*COEF
  250.          DUXUX=((RC*CNX*UXC)+(RC*UNC))*COEF
  251.          DUXUY=((RC*CNY*UXC))*COEF
  252.          DUXP=CNX*COEF
  253. C
  254.          DUYRO=(UNC*UYC)*COEF
  255.          DUYUX=((RC*CNX*UYC))*COEF
  256.          DUYUY=((RC*CNY*UYC)+(RC*UNC))*COEF
  257.          DUYP=CNY*COEF
  258. C
  259.          ECIN=0.5D0*((UXC*UXC)+(UYC*UYC))
  260.          HIN=GAMC*USGM1*PC
  261.          DPRO=(UNC*ECIN)*COEF
  262.          DPUX=((CNX*HIN)+(RC*CNX*ECIN)+(RC*UNC*UXC))*COEF
  263.          DPUY=((CNY*HIN)+(RC*CNY*ECIN)+(RC*UNC*UYC))*COEF
  264.          DPP=(UNC*GAMC*USGM1)*COEF
  265. CC
  266. CC******* Jacobian with respect to conservative variables
  267. CC
  268.          IF(IJAC.EQ.1)THEN
  269.  
  270.             COEF1=-1.0D0*UXC/RC
  271.             COEF2=-1.0D0*UYC/RC
  272.             COEF3=0.5D0*GM1*((UXC*UXC)+(UYC*UYC))
  273. C
  274.             RR.AM(IFAC,1,1)=DRORO+(DROUX*COEF1)+(DROUY*COEF2)+(DROP
  275.      $           *COEF3)
  276.             RUX.AM(IFAC,1,1)=(DROUX/RC)-((UXC*GM1)*DROP)
  277.             RUY.AM(IFAC,1,1)=(DROUY/RC)-((UYC*GM1)*DROP)
  278.             RRET.AM(IFAC,1,1)=GM1*DROP
  279. C
  280.             UXR.AM(IFAC,1,1)=DUXRO+(DUXUX*COEF1)+(DUXUY*COEF2)+(DUXP
  281.      $           *COEF3)
  282.             UXUX.AM(IFAC,1,1)=(DUXUX/RC)-((UXC*GM1)*DUXP)
  283.             UXUY.AM(IFAC,1,1)=(DUXUY/RC)-((UYC*GM1)*DUXP)
  284.             UXRET.AM(IFAC,1,1)=GM1*DUXP
  285. C
  286.             UYR.AM(IFAC,1,1)=DUYRO+(DUYUX*COEF1)+(DUYUY*COEF2)+(DUYP
  287.      $           *COEF3)
  288.             UYUX.AM(IFAC,1,1)=(DUYUX/RC)-((UXC*GM1)*DUYP)
  289.             UYUY.AM(IFAC,1,1)=(DUYUY/RC)-((UYC*GM1)*DUYP)
  290.             UYRET.AM(IFAC,1,1)=GM1*DUYP
  291. C
  292.             RETR.AM(IFAC,1,1)=DPRO+(DPUX*COEF1)+(DPUY*COEF2)+(DPP
  293.      $           *COEF3)
  294.             RETUX.AM(IFAC,1,1)=(DPUX/RC)-((UXC*GM1)*DPP)
  295.             RETUY.AM(IFAC,1,1)=(DPUY/RC)-((UYC*GM1)*DPP)
  296.             RETRET.AM(IFAC,1,1)=GM1*DPP
  297. C
  298.          ELSEIF(IJAC.EQ.2)THEN
  299.             RR.AM(IFAC,1,1)=DRORO
  300.             RUX.AM(IFAC,1,1)=DROUX
  301.             RUY.AM(IFAC,1,1)=DROUY
  302.             RRET.AM(IFAC,1,1)=DROP
  303. C
  304.             UXR.AM(IFAC,1,1)=DUXRO
  305.             UXUX.AM(IFAC,1,1)=DUXUX
  306.             UXUY.AM(IFAC,1,1)=DUXUY
  307.             UXRET.AM(IFAC,1,1)=DUXP
  308. C
  309.             UYR.AM(IFAC,1,1)=DUYRO
  310.             UYUX.AM(IFAC,1,1)=DUYUX
  311.             UYUY.AM(IFAC,1,1)=DUYUY
  312.             UYRET.AM(IFAC,1,1)=DUYP
  313. C
  314.             RETR.AM(IFAC,1,1)=DPRO
  315.             RETUX.AM(IFAC,1,1)=DPUX
  316.             RETUY.AM(IFAC,1,1)=DPUY
  317.             RETRET.AM(IFAC,1,1)=DPP
  318.          ENDIF
  319.       ENDDO
  320. C
  321.       SEGDES MELEFC
  322. C
  323.       SEGSUP MLEMC
  324.       SEGSUP MLEMCB
  325.       SEGSUP MLEMF
  326. C
  327.       SEGDES MPNORM
  328.       SEGDES MPVOL
  329.       SEGDES MPSURF
  330.       SEGDES MPRC
  331.       SEGDES MPPC
  332.       SEGDES MPVC
  333.       SEGDES MPGAMC
  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.  

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