Télécharger la plaquette Cast3M


fr en

Télécharger cli183.eso

Retour à la liste

Numérotation des lignes : 

cli183

  1. C CLI183    SOURCE    OF166741  24/12/13    21:15:28     12097          
  2.       SUBROUTINE CLI183(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               :  CLI183
  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,CC,UNC
  56.      &     ,PC,PSRF,RHOUF,P,RHO,UN,ACEL,BCEL,CCEL,PSTAR,UX,UY,UZ,ECIN
  57.      &     ,DADR,DADP,DBDR,DBDP,DBDUX,DBDUY,DBDUZ,DCDP
  58.      &     ,DPSDA,DPSDB,DPSDC,DPDR,DPDP,DPDUX,DPDUY,DPDUZ
  59.      &     ,DUXDP,DUYDP,DUZDP,DECINP,DF2DP,DF3DP,DF4DP,DF5DP
  60.      &     ,DRORO,DROUX,DROUY,DROP
  61.      &     ,DUXRO,DUXUX,DUXUY,DUXP
  62.      &     ,DUYRO,DUYUX,DUYUY,DUYP
  63.      &     ,DPRO,DPUX,DPUY,DPP
  64.      &     ,COEF1,COEF2,COEF3,COEF,COEF4
  65.      &     ,DROUZ,DUXUZ,DUYUZ,DPUZ
  66.      &     ,DUZRO,DUZUX,DUZUY,DUZUZ,DUZP
  67. C     &     ,YCAC,YCAC2,YCAC3,YCAC4,XCAC,F1,F2,F3,F4,F5,USGM1
  68.       CHARACTER*(8) TYPE
  69. C
  70. C
  71. C**** KRIPAD pour la correspondance global/local
  72. C
  73.       CALL KRIPAD(MELEMC,MLEMC)
  74. C     SEGINI MLEMC
  75.       CALL KRIPAD(MELECB,MLEMCB)
  76. C     SEGINI MLEMCB
  77.       CALL KRIPAD(MELEMF,MLEMF)
  78. C     SEGINI MLEMF
  79. C
  80. C**** CHPOINTs de la table DOMAINE
  81. C
  82.       CALL LICHT(INORM,MPNORM,TYPE,ICEL)
  83.       CALL LICHT(ICHPVO,MPVOL,TYPE,ICEL)
  84.       CALL LICHT(ICHPSU,MPSURF,TYPE,ICEL)
  85. C
  86. C**** LICHT active les MPOVALs en *MOD
  87. C
  88. C     SEGACT MPNORM*MOD
  89. C     SEGACT MPOVSU*MOD
  90. C     SEGACT MPOVOL*MOD
  91. C
  92. C
  93. C**** CHPOINTs des variables
  94. C
  95.       CALL LICHT(IROC,MPRC,TYPE,ICEL)
  96.       CALL LICHT(IVITC,MPVC,TYPE,ICEL)
  97.       CALL LICHT(IPC,MPPC,TYPE,ICEL)
  98.       CALL LICHT(IGAMC,MPGAMC,TYPE,ICEL)
  99.       CALL LICHT(ICHLIM,MPLIM,TYPE,ICEL)
  100. C
  101. C     SEGACT *MOD
  102. C     SEGACT *MOD
  103. C     SEGACT *MOD
  104. C     SEGACT *MOD
  105. C     SEGACT *MOD
  106. C
  107. C
  108. C**** Boucle sur le face pour le calcul des invariants de
  109. C     Riemann et du flux
  110. C
  111.       SEGACT MELEFC
  112.       NFAC=MELEFC.NUM(/2)
  113. C
  114. C**** Objet MATRIK
  115. C
  116.       NRIGE = 7
  117.       NMATRI = 1
  118.       NKID = 9
  119.       NKMT = 7
  120. C
  121.       SEGINI MATRIK
  122.       IJACO = MATRIK
  123.       MATRIK.IRIGEL(1,1) = MELRES
  124.       MATRIK.IRIGEL(2,1) = MELRES
  125. C
  126. C**** Matrice non symetrique
  127. C
  128.       MATRIK.IRIGEL(7,1) = 2
  129. C
  130.       NBME = 25
  131.       NBSOUS = 1
  132.       SEGINI IMATRI
  133.       IF(IJAC.EQ.1)THEN
  134.          MLMOTS=ILIINC
  135.       ELSEIF(IJAC.EQ.2)THEN
  136.          MLMOTS=ILIINP
  137.       ENDIF
  138.       SEGACT MLMOTS
  139.       MATRIK.IRIGEL(4,1) = IMATRI
  140. C
  141.       IMATRI.LISPRI(1) = MLMOTS.MOTS(1)
  142.       IMATRI.LISPRI(2) = MLMOTS.MOTS(2)
  143.       IMATRI.LISPRI(3) = MLMOTS.MOTS(3)
  144.       IMATRI.LISPRI(4) = MLMOTS.MOTS(4)
  145.       IMATRI.LISPRI(5) = MLMOTS.MOTS(5)
  146. C
  147.       IMATRI.LISPRI(6) = MLMOTS.MOTS(1)
  148.       IMATRI.LISPRI(7) = MLMOTS.MOTS(2)
  149.       IMATRI.LISPRI(8) = MLMOTS.MOTS(3)
  150.       IMATRI.LISPRI(9) = MLMOTS.MOTS(4)
  151.       IMATRI.LISPRI(10) = MLMOTS.MOTS(5)
  152. C
  153.       IMATRI.LISPRI(11) = MLMOTS.MOTS(1)
  154.       IMATRI.LISPRI(12) = MLMOTS.MOTS(2)
  155.       IMATRI.LISPRI(13) = MLMOTS.MOTS(3)
  156.       IMATRI.LISPRI(14) = MLMOTS.MOTS(4)
  157.       IMATRI.LISPRI(15) = MLMOTS.MOTS(5)
  158. C
  159.       IMATRI.LISPRI(16) = MLMOTS.MOTS(1)
  160.       IMATRI.LISPRI(17) = MLMOTS.MOTS(2)
  161.       IMATRI.LISPRI(18) = MLMOTS.MOTS(3)
  162.       IMATRI.LISPRI(19) = MLMOTS.MOTS(4)
  163.       IMATRI.LISPRI(20) = MLMOTS.MOTS(5)
  164. C
  165.       IMATRI.LISPRI(21) = MLMOTS.MOTS(1)
  166.       IMATRI.LISPRI(22) = MLMOTS.MOTS(2)
  167.       IMATRI.LISPRI(23) = MLMOTS.MOTS(3)
  168.       IMATRI.LISPRI(24) = MLMOTS.MOTS(4)
  169.       IMATRI.LISPRI(25) = MLMOTS.MOTS(5)
  170. C
  171.       SEGDES MLMOTS
  172.       MLMOTS=ILIINC
  173.       SEGACT MLMOTS
  174. C
  175. C
  176.       IMATRI.LISDUA(1) = MLMOTS.MOTS(1)
  177.       IMATRI.LISDUA(2) = MLMOTS.MOTS(1)
  178.       IMATRI.LISDUA(3) = MLMOTS.MOTS(1)
  179.       IMATRI.LISDUA(4) = MLMOTS.MOTS(1)
  180.       IMATRI.LISDUA(5) = MLMOTS.MOTS(1)
  181. C
  182.       IMATRI.LISDUA(6) = MLMOTS.MOTS(2)
  183.       IMATRI.LISDUA(7) = MLMOTS.MOTS(2)
  184.       IMATRI.LISDUA(8) = MLMOTS.MOTS(2)
  185.       IMATRI.LISDUA(9) = MLMOTS.MOTS(2)
  186.       IMATRI.LISDUA(10) = MLMOTS.MOTS(2)
  187. C
  188.       IMATRI.LISDUA(11) = MLMOTS.MOTS(3)
  189.       IMATRI.LISDUA(12) = MLMOTS.MOTS(3)
  190.       IMATRI.LISDUA(13) = MLMOTS.MOTS(3)
  191.       IMATRI.LISDUA(14) = MLMOTS.MOTS(3)
  192.       IMATRI.LISDUA(15) = MLMOTS.MOTS(3)
  193. C
  194.       IMATRI.LISDUA(16) = MLMOTS.MOTS(4)
  195.       IMATRI.LISDUA(17) = MLMOTS.MOTS(4)
  196.       IMATRI.LISDUA(18) = MLMOTS.MOTS(4)
  197.       IMATRI.LISDUA(19) = MLMOTS.MOTS(4)
  198.       IMATRI.LISDUA(20) = MLMOTS.MOTS(4)
  199. C
  200.       IMATRI.LISDUA(21) = MLMOTS.MOTS(5)
  201.       IMATRI.LISDUA(22) = MLMOTS.MOTS(5)
  202.       IMATRI.LISDUA(23) = MLMOTS.MOTS(5)
  203.       IMATRI.LISDUA(24) = MLMOTS.MOTS(5)
  204.       IMATRI.LISDUA(25) = MLMOTS.MOTS(5)
  205. C
  206.       SEGDES MLMOTS
  207.       NBEL = NFAC
  208.       NBSOUS = 1
  209.       NP = 1
  210.       MP = 1
  211.       SEGINI   RR  , RUX , RUY , RUZ ,RRET ,
  212.      &         UXR , UXUX , UXUY , UXUZ ,UXRET ,
  213.      &         UYR , UYUX , UYUY , UYUZ , UYRET ,
  214.      &         UZR , UZUX , UZUY , UZUZ , UZRET ,
  215.      &         RETR , RETUX , RETUY, RETUZ , RETRET
  216. C
  217. C**** Duale = IMATRI.LISDUA(1) = 'RN'
  218. C     Primale = IMATRI.LISPRI(1) = 'RN'
  219. C     -> IMATRI.LIZAFM(1,1) = RR
  220. C
  221.       IMATRI.LIZAFM(1,1) = RR
  222.       IMATRI.LIZAFM(1,2) = RUX
  223.       IMATRI.LIZAFM(1,3) = RUY
  224.       IMATRI.LIZAFM(1,4) = RUZ
  225.       IMATRI.LIZAFM(1,5) = RRET
  226. C
  227.       IMATRI.LIZAFM(1,6) = UXR
  228.       IMATRI.LIZAFM(1,7) = UXUX
  229.       IMATRI.LIZAFM(1,8) = UXUY
  230.       IMATRI.LIZAFM(1,9) = UXUZ
  231.       IMATRI.LIZAFM(1,10) = UXRET
  232. C
  233.       IMATRI.LIZAFM(1,11) = UYR
  234.       IMATRI.LIZAFM(1,12) = UYUX
  235.       IMATRI.LIZAFM(1,13) = UYUY
  236.       IMATRI.LIZAFM(1,14) = UYUZ
  237.       IMATRI.LIZAFM(1,15) = UYRET
  238. C
  239.       IMATRI.LIZAFM(1,16) = UZR
  240.       IMATRI.LIZAFM(1,17) = UZUX
  241.       IMATRI.LIZAFM(1,18) = UZUY
  242.       IMATRI.LIZAFM(1,19) = UZUZ
  243.       IMATRI.LIZAFM(1,20) = UZRET
  244. C
  245.       IMATRI.LIZAFM(1,21) = RETR
  246.       IMATRI.LIZAFM(1,22) = RETUX
  247.       IMATRI.LIZAFM(1,23) = RETUY
  248.       IMATRI.LIZAFM(1,24) = RETUZ
  249.       IMATRI.LIZAFM(1,25) = RETRET
  250. C
  251.       SEGDES MATRIK
  252.       SEGDES IMATRI
  253. C
  254. C**** Fin definition MATRIK
  255. C
  256.       DO IFAC=1,NFAC,1
  257.          NGF=MELEFC.NUM(1,IFAC)
  258.          NGC=MELEFC.NUM(2,IFAC)
  259.          NLF=MLEMF.LECT(NGF)
  260.          NLC=MLEMC.LECT(NGC)
  261.          NLCB=MLEMCB.LECT(NGF)
  262.          VOLU=MPVOL.VPOCHA(NLC,1)
  263.          SURF=MPSURF.VPOCHA(NLF,1)
  264. C        In CASTEM les normales sont sortantes
  265.          CNX=-1*MPNORM.VPOCHA(NLF,1)
  266.          CNY=-1*MPNORM.VPOCHA(NLF,2)
  267.          CNZ=-1*MPNORM.VPOCHA(NLF,3)
  268. C        Variables au centre
  269.          RC=MPRC.VPOCHA(NLC,1)
  270.          PC=MPPC.VPOCHA(NLC,1)
  271.          UXC=MPVC.VPOCHA(NLC,1)
  272.          UYC=MPVC.VPOCHA(NLC,2)
  273.          UZC=MPVC.VPOCHA(NLC,3)
  274.          GAMC=MPGAMC.VPOCHA(NLC,1)
  275.          UNC=(UXC*CNX)+(UYC*CNY)+(UZC*CNZ)
  276.          CC=GAMC*PC/RC
  277.          CC=CC**0.5D0
  278.          GM1=GAMC-1.0D0
  279. C        Variables à la face
  280.          RHOUF=MPLIM.VPOCHA(NLCB,1)
  281.          PSRF=MPLIM.VPOCHA(NLCB,2)
  282. C
  283. C******* Variables à l'interface
  284. C
  285.          ACEL=CC/GAMC
  286.          BCEL=ACEL - UNC
  287.          CCEL=(RHOUF / PC) * PSRF
  288.          PSTAR=BCEL+(((BCEL*BCEL) + (4*ACEL*CCEL))**0.5D0)
  289.          PSTAR=PSTAR/(2*ACEL)
  290.          P=PSTAR*PC
  291.          RHO=P/PSRF
  292.          UN=RHOUF/RHO
  293.          UX=UN*CNX
  294.          UY=UN*CNY
  295.          UZ=UN*CNZ
  296.          ECIN=0.5D0*((UX*UX)+(UY*UY)+(UZ*UZ))
  297. C
  298. C******* Derivatives of ACEL, BCEL, CCEL with respect to the
  299. C        variables at centers
  300. C
  301.          DADR = -0.5D0*CC/(RC*GAMC)
  302.          DADP =  0.5D0*CC/(PC*GAMC)
  303.          DBDR = DADR
  304.          DBDP = DADP
  305.          DBDUX = -1*CNX
  306.          DBDUY = -1*CNY
  307.          DBDUZ = -1*CNZ
  308.          DCDP = -1*CCEL/PC
  309. C
  310. C******* Derivatives of PSTAR with respect to ACEL,BCEL,CCEL
  311. C
  312.          DPSDA = -1*(PSTAR*PSTAR)/((2*ACEL*PSTAR)-BCEL)
  313.          DPSDB = PSTAR/((2*ACEL*PSTAR)-BCEL)
  314.          DPSDC = 1/((2*ACEL*PSTAR)-BCEL)
  315. C
  316. C******* Derivatives of PC*PSTAR with respect to RC,PC,UXC,UYC
  317. C
  318.          DPDR=(DPSDA*DADR)+(DPSDB*DBDR)
  319.          DPDR=DPDR*PC
  320.          DPDP=(DPSDA*DADP)+(DPSDB*DBDP)+(DPSDC*DCDP)
  321.          DPDP=(DPDP*PC)+PSTAR
  322.          DPDUX=(DPSDB*DBDUX)*PC
  323.          DPDUY=(DPSDB*DBDUY)*PC
  324.          DPDUZ=(DPSDB*DBDUZ)*PC
  325. CC
  326. CC******* Test 1
  327. CC
  328. CC        We check dpdp
  329. CC
  330. C         YCAC=P
  331. C         XCAC=PC
  332. C         PC=PC*(1+1.0D-4)
  333. C         CC=GAMC*PC/RC
  334. C         CC=CC**0.5D0
  335. CC
  336. C         ACEL=CC/GAMC
  337. C         BCEL=ACEL - UNC
  338. C         CCEL=(RHOUF / PC) * PSRF
  339. C         PSTAR=BCEL+(((BCEL*BCEL) + (4*ACEL*CCEL))**0.5D0)
  340. C         PSTAR=PSTAR/(2*ACEL)
  341. C         P=PSTAR*PC
  342. C         write(*,*) ((P - YCAC)/(PC - XCAC)), DPDP
  343. CC
  344. CC        We check dpdr
  345. CC
  346. C         YCAC=P
  347. C         XCAC=RC
  348. C         RC=RC*(1+1.0D-4)
  349. C         CC=GAMC*PC/RC
  350. C         CC=CC**0.5D0
  351. CC
  352. C         ACEL=CC/GAMC
  353. C         BCEL=ACEL - UNC
  354. C         CCEL=(RHOUF / PC) * PSRF
  355. C         PSTAR=BCEL+(((BCEL*BCEL) + (4*ACEL*CCEL))**0.5D0)
  356. C         PSTAR=PSTAR/(2*ACEL)
  357. C         P=PSTAR*PC
  358. C         write(*,*) ((P - YCAC)/(RC - XCAC)), DPDR
  359. CC
  360. CC        We check dpdux
  361. CC
  362. C         YCAC=P
  363. C         XCAC=UXC
  364. C         UXC=UXC*(1+1.0D-4)
  365. C         UNC=(UXC*CNX)+(UYC*CNY)+(UZC*CNZ)
  366. C         CC=GAMC*PC/RC
  367. C         CC=CC**0.5D0
  368. CC
  369. C         ACEL=CC/GAMC
  370. C         BCEL=ACEL - UNC
  371. C         CCEL=(RHOUF / PC) * PSRF
  372. C         PSTAR=BCEL+(((BCEL*BCEL) + (4*ACEL*CCEL))**0.5D0)
  373. C         PSTAR=PSTAR/(2*ACEL)
  374. C         P=PSTAR*PC
  375. C         write(*,*) ((P - YCAC)/(UXC - XCAC)), DPDUX
  376. CC
  377. CC        We check dpduy
  378. CC
  379. C         YCAC=P
  380. C         XCAC=UYC
  381. C         UYC=UYC*(1+1.0D-4)
  382. C         UNC=(UXC*CNX)+(UYC*CNY)+(UZC*CNZ)
  383. C         CC=GAMC*PC/RC
  384. C         CC=CC**0.5D0
  385. CC
  386. C         ACEL=CC/GAMC
  387. C         BCEL=ACEL - UNC
  388. C         CCEL=(RHOUF / PC) * PSRF
  389. C         PSTAR=BCEL+(((BCEL*BCEL) + (4*ACEL*CCEL))**0.5D0)
  390. C         PSTAR=PSTAR/(2*ACEL)
  391. C         P=PSTAR*PC
  392. C         write(*,*) ((P - YCAC)/(UYC - XCAC)), DPDUY
  393. CC
  394. CC        We check dpduz
  395. CC
  396. C         YCAC=P
  397. C         XCAC=UZC
  398. C         UZC=UZC*(1+1.0D-4)
  399. C         UNC=(UXC*CNX)+(UYC*CNY)+(UZC*CNZ)
  400. C         CC=GAMC*PC/RC
  401. C         CC=CC**0.5D0
  402. CC
  403. C         ACEL=CC/GAMC
  404. C         BCEL=ACEL - UNC
  405. C         CCEL=(RHOUF / PC) * PSRF
  406. C         PSTAR=BCEL+(((BCEL*BCEL) + (4*ACEL*CCEL))**0.5D0)
  407. C         PSTAR=PSTAR/(2*ACEL)
  408. C         P=PSTAR*PC
  409. C         write(*,*) ((P - YCAC)/(UZC - XCAC)), DPDUZ
  410. CC
  411. CC
  412. CC******* Fin test 1
  413. C
  414. C
  415. C******* The interfacial state is thus given by
  416. C        RHOUF,PSRF,P and UT (UT=0), UT2 (UT2=0)
  417. C        Let us now compute the derivative of the residuum with
  418. C        respect to P.
  419. C        The residuum is given by
  420. C
  421. C        F1=RHOUF*SURF/VOLU
  422. C        F2=(RHOUF*UX+P*CNX)*SURF/VOLU
  423. C        F3=(RHOUF*UY+P*CNY)*SURF/VOLU
  424. C        F4=(RHOUF*UZ+P*CNZ)*SURF/VOLU
  425. C        F5=(RHOUF*((GAMC*USGM1*PSRF)+ECIN))*SURF/VOLU
  426. C
  427. C        In these expression: UX, UY, P and ECIN depends on P
  428. C
  429.          COEF=SURF/VOLU
  430.          DUXDP=-1*UX/P
  431.          DUYDP=-1*UY/P
  432.          DUZDP=-1*UZ/P
  433.          DECINP=-2*ECIN/P
  434.          DF2DP=((RHOUF*DUXDP)+CNX)*COEF
  435.          DF3DP=((RHOUF*DUYDP)+CNY)*COEF
  436.          DF4DP=((RHOUF*DUZDP)+CNZ)*COEF
  437.          DF5DP=(RHOUF*DECINP)*COEF
  438. CC
  439. CC******* Test 2
  440. CC
  441. CC        We check DF2P
  442. CC
  443. C         USGM1=1/GM1
  444. C         F2=(RHOUF*UX+P*CNX)*COEF
  445. C         F3=(RHOUF*UY+P*CNY)*COEF
  446. C         F4=(RHOUF*UZ+P*CNZ)*COEF
  447. C         F5=(RHOUF*((GAMC*USGM1*PSRF)+ECIN))*COEF
  448. CC
  449. C         YCAC=F2
  450. C         YCAC2=F3
  451. C         YCAC3=F4
  452. C         YCAC4=F5
  453. C         XCAC=P
  454. C         P=P*(1+1.0D-4)
  455. C         RHO=P/PSRF
  456. C         UN=RHOUF/RHO
  457. C         UX=UN*CNX
  458. C         UY=UN*CNY
  459. C         UZ=UN*CNZ
  460. C         ECIN=0.5D0*((UX*UX)+(UY*UY)+(UZ*UZ))
  461. C
  462. C         F2=(RHOUF*UX+P*CNX)*COEF
  463. C         F3=(RHOUF*UY+P*CNY)*COEF
  464. C         F4=(RHOUF*UZ+P*CNZ)*COEF
  465. C         F5=(RHOUF*((GAMC*USGM1*PSRF)+ECIN))*COEF
  466. C         write(*,*) ((F2 -YCAC)/(P-XCAC)),DF2DP
  467. C         write(*,*) ((F3 -YCAC2)/(P-XCAC)),DF3DP
  468. C         write(*,*) ((F4 -YCAC3)/(P-XCAC)),DF4DP
  469. C         write(*,*) ((F5 -YCAC4)/(P-XCAC)),DF5DP
  470. C
  471. C******* Fin test 2
  472. C
  473. C
  474. C******* Jacobian with respect to primitive variables
  475. C
  476. C
  477. C        DF1D...
  478. C
  479.          DRORO=0.0D0
  480.          DROUX=0.0D0
  481.          DROUY=0.0D0
  482.          DROUZ=0.0D0
  483.          DROP=0.0D0
  484. C
  485. C        DF5D...
  486. C
  487.          DPRO=DF5DP*DPDR
  488.          DPUX=DF5DP*DPDUX
  489.          DPUY=DF5DP*DPDUY
  490.          DPUZ=DF5DP*DPDUZ
  491.          DPP=DF5DP*DPDP
  492. C
  493. C        DF2D...
  494. C
  495.          DUXRO=DF2DP*DPDR
  496.          DUXUX=DF2DP*DPDUX
  497.          DUXUY=DF2DP*DPDUY
  498.          DUXUZ=DF2DP*DPDUZ
  499.          DUXP =DF2DP*DPDP
  500. C
  501. C        DF3D
  502. C
  503.          DUYRO=DF3DP*DPDR
  504.          DUYUX=DF3DP*DPDUX
  505.          DUYUY=DF3DP*DPDUY
  506.          DUYUZ=DF3DP*DPDUZ
  507.          DUYP =DF3DP*DPDP
  508. C
  509. C        DF4D
  510. C
  511.          DUZRO=DF4DP*DPDR
  512.          DUZUX=DF4DP*DPDUX
  513.          DUZUY=DF4DP*DPDUY
  514.          DUZUZ=DF4DP*DPDUZ
  515.          DUZP =DF4DP*DPDP
  516. C
  517. C******* Jacobian with respect to conservative variables
  518. C
  519.          IF(IJAC.EQ.1)THEN
  520.             GM1=GAMC-1.0D0
  521. C
  522.             COEF1=-1.0D0*UXC/RC
  523.             COEF2=-1.0D0*UYC/RC
  524.             COEF3=-1.0D0*UZC/RC
  525.             COEF4=0.5D0*GM1*((UXC*UXC)+(UYC*UYC)+(UZC*UZC))
  526. C
  527.             RR.AM(IFAC,1,1)=DRORO+(DROUX*COEF1)+(DROUY*COEF2)+(DROUZ
  528.      $           *COEF3)+(DROP*COEF4)
  529.             RUX.AM(IFAC,1,1)=(DROUX/RC)-((UXC*GM1)*DROP)
  530.             RUY.AM(IFAC,1,1)=(DROUY/RC)-((UYC*GM1)*DROP)
  531.             RUZ.AM(IFAC,1,1)=(DROUZ/RC)-((UZC*GM1)*DROP)
  532.             RRET.AM(IFAC,1,1)=GM1*DROP
  533. C
  534.             UXR.AM(IFAC,1,1)=DUXRO+(DUXUX*COEF1)+(DUXUY*COEF2)+(DUXUZ
  535.      $           *COEF3)+(DUXP*COEF4)
  536.             UXUX.AM(IFAC,1,1)=(DUXUX/RC)-((UXC*GM1)*DUXP)
  537.             UXUY.AM(IFAC,1,1)=(DUXUY/RC)-((UYC*GM1)*DUXP)
  538.             UXUZ.AM(IFAC,1,1)=(DUXUZ/RC)-((UZC*GM1)*DUXP)
  539.             UXRET.AM(IFAC,1,1)=GM1*DUXP
  540. C
  541.             UYR.AM(IFAC,1,1)=DUYRO+(DUYUX*COEF1)+(DUYUY*COEF2)+(DUYUZ
  542.      $           *COEF3)+(DUYP*COEF4)
  543.             UYUX.AM(IFAC,1,1)=(DUYUX/RC)-((UXC*GM1)*DUYP)
  544.             UYUY.AM(IFAC,1,1)=(DUYUY/RC)-((UYC*GM1)*DUYP)
  545.             UYUZ.AM(IFAC,1,1)=(DUYUZ/RC)-((UZC*GM1)*DUYP)
  546.             UYRET.AM(IFAC,1,1)=GM1*DUYP
  547. C
  548.             UZR.AM(IFAC,1,1)=DUZRO+(DUZUX*COEF1)+(DUZUY*COEF2)+(DUZUZ
  549.      $           *COEF3)+(DUZP*COEF4)
  550.             UZUX.AM(IFAC,1,1)=(DUZUX/RC)-((UXC*GM1)*DUZP)
  551.             UZUY.AM(IFAC,1,1)=(DUZUY/RC)-((UYC*GM1)*DUZP)
  552.             UZUZ.AM(IFAC,1,1)=(DUZUZ/RC)-((UZC*GM1)*DUZP)
  553.             UZRET.AM(IFAC,1,1)=GM1*DUZP
  554. C
  555.             RETR.AM(IFAC,1,1)=DPRO+(DPUX*COEF1)+(DPUY*COEF2)+(DPUZ
  556.      $           *COEF3)+(DPP*COEF4)
  557.             RETUX.AM(IFAC,1,1)=(DPUX/RC)-((UXC*GM1)*DPP)
  558.             RETUY.AM(IFAC,1,1)=(DPUY/RC)-((UYC*GM1)*DPP)
  559.             RETUZ.AM(IFAC,1,1)=(DPUZ/RC)-((UZC*GM1)*DPP)
  560.             RETRET.AM(IFAC,1,1)=GM1*DPP
  561. C
  562.          ELSEIF(IJAC.EQ.2)THEN
  563.             RR.AM(IFAC,1,1)=DRORO
  564.             RUX.AM(IFAC,1,1)=DROUX
  565.             RUY.AM(IFAC,1,1)=DROUY
  566.             RUZ.AM(IFAC,1,1)=DROUZ
  567.             RRET.AM(IFAC,1,1)=DROP
  568. C
  569.             UXR.AM(IFAC,1,1)=DUXRO
  570.             UXUX.AM(IFAC,1,1)=DUXUX
  571.             UXUY.AM(IFAC,1,1)=DUXUY
  572.             UXUZ.AM(IFAC,1,1)=DUXUZ
  573.             UXRET.AM(IFAC,1,1)=DUXP
  574. C
  575.             UYR.AM(IFAC,1,1)=DUYRO
  576.             UYUX.AM(IFAC,1,1)=DUYUX
  577.             UYUY.AM(IFAC,1,1)=DUYUY
  578.             UYUZ.AM(IFAC,1,1)=DUYUZ
  579.             UYRET.AM(IFAC,1,1)=DUYP
  580. C
  581.             UZR.AM(IFAC,1,1)=DUZRO
  582.             UZUX.AM(IFAC,1,1)=DUZUX
  583.             UZUY.AM(IFAC,1,1)=DUZUY
  584.             UZUZ.AM(IFAC,1,1)=DUZUZ
  585.             UZRET.AM(IFAC,1,1)=DUZP
  586. C
  587.             RETR.AM(IFAC,1,1)=DPRO
  588.             RETUX.AM(IFAC,1,1)=DPUX
  589.             RETUY.AM(IFAC,1,1)=DPUY
  590.             RETUZ.AM(IFAC,1,1)=DPUZ
  591.             RETRET.AM(IFAC,1,1)=DPP
  592.          ENDIF
  593.       ENDDO
  594. C
  595.       SEGDES MELEFC
  596. C
  597.       SEGSUP MLEMC
  598.       SEGSUP MLEMCB
  599.       SEGSUP MLEMF
  600. C
  601.       SEGDES MPNORM
  602.       SEGDES MPVOL
  603.       SEGDES MPSURF
  604.       SEGDES MPRC
  605.       SEGDES MPPC
  606.       SEGDES MPVC
  607.       SEGDES MPGAMC
  608.       SEGDES MPLIM
  609. C
  610.       SEGDES   RR  , RUX , RUY , RUZ ,RRET ,
  611.      &         UXR , UXUX , UXUY , UXUZ ,UXRET ,
  612.      &         UYR , UYUX , UYUY , UYUZ , UYRET ,
  613.      &         UZR , UZUX , UZUY , UZUZ , UZRET ,
  614.      &         RETR , RETUX , RETUY, RETUZ , RETRET
  615. C
  616.  9999 CONTINUE
  617.       RETURN
  618.       END
  619.  
  620.  
  621.  
  622.  
  623.  
  624.  
  625.  
  626.  
  627.  
  628.  
  629.  
  630.  
  631.  
  632.  
  633.  
  634.  

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