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

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