Télécharger la plaquette Cast3M


fr en

Télécharger cli162.eso

Retour à la liste

Numérotation des lignes : 

cli162

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

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