Télécharger la plaquette Cast3M


fr en

Télécharger cli262.eso

Retour à la liste

Numérotation des lignes : 

cli262

  1. C CLI262    SOURCE    CB215821  20/11/25    13:20:47     10792          
  2.       SUBROUTINE CLI262(NSP,MELEMF,MELEMC,MELECB,MELEFC,MELRES,INORM,
  3.      &     ICHPVO,ICHPSU,LRECP,LRECV,
  4.      &     IROC,IVITC,IPC,IYC,ICHLIM,ILIINC,ILIINP,IJAC,IJACO)
  5. C************************************************************************
  6. C
  7. C PROJET            :  CASTEM 2000
  8. C
  9. C NOM               :  CLI112
  10. C
  11. C DESCRIPTION       :  Subroutine appellée par CLIM22
  12. C                      OPTION: 'INSU' -- Jacobian
  13. C
  14. C LANGAGE           :  FORTRAN 77 + ESOPE 2000 (avec estensions CISI)
  15. C
  16. C AUTEUR            :  S. Kudriakov, DEN/DM2S/SFME/LTMF
  17. C
  18. C************************************************************************
  19. C
  20. C APPELES (Calcul)  :
  21. C
  22. C************************************************************************
  23. C
  24. C HISTORIQUE (Anomalies et modifications éventuelles)
  25. C
  26. C HISTORIQUE :
  27. C
  28. C************************************************************************
  29. C
  30. C----------------------------------------------------
  31. C**** Variables de COOPTIO
  32. C----------------------------------------------------
  33. c      INTEGER IPLLB, IERPER, IERMAX, IERR, INTERR
  34. c     &        ,IOTER,   IOLEC,  IOIMP, IOCAR,  IOACQ
  35. c     &        ,IOPER,   IOSGB,  IOGRA, IOSAU,  IORES
  36. c     &        ,IECHO,   IIMPI,  IOSPI
  37. c     &        ,IDIM,    IFICLE, IPREFI
  38. c     &        ,MCOORD
  39. c     &        ,IFOMOD, NIFOUR, IFOUR, NSDPGE, IONIVE
  40. c     &        ,NGMAXY, IZROSF, ISOTYP, IOSCR,LTEXLU
  41. c     &        ,NORINC,NORVAL,NORIND,NORVAD
  42. c     &        ,NUCROU, IPSAUV
  43. C
  44.       IMPLICIT INTEGER(I-N)
  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,II,JJ,K
  49.      &     ,MP, NBEL, NBME, NBSOUS, NKID, NKMT, NMATRI, NP, NRIGE
  50.      &     ,NSP,I, IYC,J, LRECP,LRECV,KV
  51.       REAL*8 VOLU,SURF,RC,PC,UXC,UYC,GAMC,CNX,CNY,CTX,CTY
  52.      &     ,PSRF,COEF
  53.      &     ,BR1,BOT,TOP,DUNDUY,GAMF,UNC
  54.      &     ,COEF5,DPSRUN,DUXDUN,DRDUN,DUYDUN,DUNDUX,DPDUN
  55.      &     ,GM1,USGM1,RF,UNF,UTF,UXF,UYF,HTF,PF,SF,ECIN
  56.      &     ,TVECT(2),NVECT(2),WVEC_L(4),WVEC_R(4)
  57.       CHARACTER*(8) TYPE
  58. -INC PPARAM
  59. -INC CCOPTIO
  60. -INC SMLMOTS
  61. -INC SMELEME
  62.       POINTEUR MELEFC.MELEME
  63. -INC SMLENTI
  64.       POINTEUR MLEMC.MLENTI, MLEMCB.MLENTI,MLEMF.MLENTI
  65. -INC SMCHPOI
  66.       POINTEUR MPNORM.MPOVAL, MPVOL.MPOVAL, MPSURF.MPOVAL, MPRC.MPOVAL,
  67.      &     MPVC.MPOVAL, MPPC.MPOVAL, MPLIM.MPOVAL, MPYC.MPOVAL
  69.       POINTEUR CELL.IZAFM
  70. C-------------------------------------------------------
  71. -INC SMLREEL
  72.       POINTEUR MLRECP.MLREEL, MLRECV.MLREEL
  73. C-------------------------------------------------------
  74. C*********  Les Jacobians ******************************
  75. C-------------------------------------------------------
  76.       SEGMENT JACEL
  77.          REAL*8 JAC(3+NSP,3+NSP)
  78.       ENDSEGMENT
  79.       POINTEUR JLL.JACEL, WL.JACEL, JRR.JACEL, JTT.JACEL,
  80.      &         JFL.JACEL, JFR.JACEL, JR.JACEL
  81. C-------------------------------------------------------------
  82. C******* Les fractionines massiques **************************
  83. C-------------------------------------------------------------
  84.        SEGMENT FRAMAS
  85.          REAL*8 YET(NSP)
  86.       ENDSEGMENT
  87.       POINTEUR YC.FRAMAS, YF.FRAMAS
  88. C-------------------------------------------------------
  89. C**********  Les CP's and CV's   ***********************
  90. C-------------------------------------------------------
  91.       SEGMENT GCONST
  92.          REAL*8 GC(NSP)
  93.       ENDSEGMENT
  94.       POINTEUR CP.GCONST, CV.GCONST
  95. C-------------------------------------------------------------
  96. C**********  Segments for the vectors  ***********************
  97. C-------------------------------------------------------------
  98.        SEGMENT VECEL
  99.          REAL*8 VV(NSP)
  100.        ENDSEGMENT
  101.        POINTEUR DGDYC.VECEL
  102. C--------------------------------------------------
  103.       SEGINI JTT
  104.       SEGINI JLL
  105.       SEGINI JRR
  106.       SEGINI JFL
  107.       SEGINI JFR
  108.       SEGINI WL
  109. C----------------------------------------------------
  110. C**** KRIPAD pour la correspondance global/local
  111. C----------------------------------------------------
  112.       CALL KRIPAD(MELEMC,MLEMC)
  113.       CALL KRIPAD(MELECB,MLEMCB)
  114.       CALL KRIPAD(MELEMF,MLEMF)
  115. C----------------------------------------------------
  116. C**** CHPOINTs de la table DOMAINE
  117. C----------------------------------------------------
  118.       CALL LICHT(INORM,MPNORM,TYPE,ICEL)
  119.       CALL LICHT(ICHPVO,MPVOL,TYPE,ICEL)
  120.       CALL LICHT(ICHPSU,MPSURF,TYPE,ICEL)
  121. C----------------------------------------------------
  122. C**** CHPOINTs des variables
  123. C----------------------------------------------------
  124.       CALL LICHT(IROC,MPRC,TYPE,ICEL)
  125.       CALL LICHT(IVITC,MPVC,TYPE,ICEL)
  126.       CALL LICHT(IPC,MPPC,TYPE,ICEL)
  127.       CALL LICHT(IYC,MPYC,TYPE,ICEL)
  128.       CALL LICHT(ICHLIM,MPLIM,TYPE,ICEL)
  129. C--------------------------------------------------------
  130. C**** Boucle sur le face pour le calcul des invariants de
  131. C     Riemann et du flux
  132. C--------------------------------------------------------
  133.       SEGACT MELEFC
  134.       NFAC=MELEFC.NUM(/2)
  135. C---------------------------------
  136. C**** Objet MATRIK
  137. C---------------------------------
  138.       NRIGE = 7
  139.       NMATRI = 1
  140.       NKID = 9
  141.       NKMT = 7
  142. C---------------------------------
  143.       SEGINI MATRIK
  144.       IJACO = MATRIK
  145.       MATRIK.IRIGEL(1,1) = MELRES
  146.       MATRIK.IRIGEL(2,1) = MELRES
  147. C---------------------------------
  148. C**** Matrice non symetrique
  149. C---------------------------------
  150.       MATRIK.IRIGEL(7,1) = 2
  151. C---------------------------------
  152.       NBME = (3+NSP)*(3+NSP)
  153.       NBSOUS = 1
  154.       SEGINI IMATRI
  155.       IF(IJAC.EQ.1)THEN
  156.          MLMOTS=ILIINC
  157.       ELSEIF(IJAC.EQ.2)THEN
  158.          MLMOTS=ILIINP
  159.       ENDIF
  160.       SEGACT MLMOTS
  161.       MATRIK.IRIGEL(4,1) = IMATRI
  162. C-------------------------------------------
  163.       DO 1 J=1,(NSP+3)
  164.         KV=(J-1)*(3+NSP)
  165.         IMATRI.LISPRI(KV+1) = MLMOTS.MOTS(1)
  166.         IMATRI.LISPRI(KV+2) = MLMOTS.MOTS(2)
  167.         IMATRI.LISPRI(KV+3) = MLMOTS.MOTS(3)
  168.         IMATRI.LISPRI(KV+4) = MLMOTS.MOTS(4)
  169.         DO 2 I=1,(NSP-1)
  170.           IMATRI.LISPRI(KV+4+I) = MLMOTS.MOTS(4+I)
  171.  2      CONTINUE
  172.  1    CONTINUE
  173. C-----------------------------------------------
  174.       SEGDES MLMOTS
  175.       MLMOTS=ILIINC
  176.       SEGACT MLMOTS
  177. C-----------------------------------------------
  178.       DO 3 J=1,(NSP+3)
  179.         KV=(J-1)*(3+NSP)
  180.         IMATRI.LISDUA(KV+1) = MLMOTS.MOTS(j)
  181.         IMATRI.LISDUA(KV+2) = MLMOTS.MOTS(j)
  182.         IMATRI.LISDUA(KV+3) = MLMOTS.MOTS(j)
  183.         IMATRI.LISDUA(KV+4) = MLMOTS.MOTS(j)
  184.         DO 4 I=1,(NSP-1)
  185.           IMATRI.LISDUA(KV+4+I) = MLMOTS.MOTS(j)
  186.  4     CONTINUE
  187.  3    CONTINUE
  188. C-----------------------------------------------
  189. C-----------------------------------------------
  190.       SEGDES MLMOTS
  191.       NBEL = NFAC
  192.       NBSOUS = 1
  193.       NP = 1
  194.       MP = 1
  195. C-----------------------------------------------------------
  196. C-----------------------------------------------------------
  197.       DO 5 I=1,NBME
  198.         SEGINI CELL
  199.         IMATRI.LIZAFM(1,I) = CELL
  200.  5    CONTINUE
  201. C---------------------------------
  202. C---------------------------------
  203. C**** Fin definition MATRIK
  204. C---------------------------------
  205.       DO IFAC=1,NFAC,1
  206.          NGF=MELEFC.NUM(1,IFAC)
  207.          NGC=MELEFC.NUM(2,IFAC)
  208.          NLF=MLEMF.LECT(NGF)
  209.          NLC=MLEMC.LECT(NGC)
  210.          NLCB=MLEMCB.LECT(NGF)
  211.          VOLU=MPVOL.VPOCHA(NLC,1)
  212.          SURF=MPSURF.VPOCHA(NLF,1)
  213. C        In CASTEM les normales sont sortantes
  214.          CNX=-1*MPNORM.VPOCHA(NLF,1)
  215.          CNY=-1*MPNORM.VPOCHA(NLF,2)
  216.          CTX=-1.0D0*CNY
  217.          CTY=CNX
  218. C----------------------------------------------
  219.          SEGINI CP, CV
  220.          MLRECP = LRECP
  221.          MLRECV = LRECV
  222.          SEGACT MLRECP, MLRECV
  223.          DO 10 I=1,(NSP-1)
  224.            CP.GC(I)=MLRECP.PROG(I)
  225.            CV.GC(I)=MLRECV.PROG(I)
  226.  10      CONTINUE
  227.          CP.GC(NSP)=MLRECP.PROG(NSP)
  228.          CV.GC(NSP)=MLRECV.PROG(NSP)
  229. C---------------------------------
  230. C        Variables au centre
  231. C---------------------------------
  232.          RC=MPRC.VPOCHA(NLC,1)
  233.          PC=MPPC.VPOCHA(NLC,1)
  234.          UXC=MPVC.VPOCHA(NLC,1)
  235.          UYC=MPVC.VPOCHA(NLC,2)
  236.          SEGINI YC
  237.          SEGACT MPYC
  238.          DO 100 I=1,(NSP-1)
  239.            YC.YET(I)=MPYC.VPOCHA(NLC,I)
  240.  100     CONTINUE
  241.          UNC=(UXC*CNX)+(UYC*CNY)
  242. C---------------------------------
  243. C        Variables à la face
  244. C---------------------------------
  245.          SEGACT MPLIM
  246.          HTF=MPLIM.VPOCHA(NLCB,1)
  247.          SF=MPLIM.VPOCHA(NLCB,2)
  248.          SEGINI YF
  249.          DO 101 I=1,(NSP-1)
  250.            YF.YET(I)=MPLIM.VPOCHA(NLCB,2+I)
  251.  101     CONTINUE
  252.          UNF=UNC
  253.          UTF=0.0D0
  254.          UXF=UNF*CNX+UTF*CTX
  255.          UYF=UNF*CNY+UTF*CTY
  256. c-------------------------------------------------------------
  257. c  Computing GAMMA at the face
  258. c-------------------------------------------------------------
  259.          top=0.0D0
  260.          bot=0.0D0
  261.          do 102  i=1,(nsp-1)
  262.           top=top+yf.yet(i)*(cp.gc(i)-cp.gc(nsp))
  263.           bot=bot+yf.yet(i)*(cv.gc(i)-cv.gc(nsp))
  264.  102     continue
  265.          top=cp.gc(nsp)+top
  266.          bot=cv.gc(nsp)+bot
  267.          GAMF=top/bot
  268.          GM1=GAMF-1.0D0
  269.          USGM1=1.0D0/GM1
  270. c-------------------------------------------------------------
  271. c  Computing GAMMA at the cell-centre
  272. c-------------------------------------------------------------
  273.          top=0.0D0
  274.          bot=0.0D0
  275.          do 103  i=1,(nsp-1)
  276.           top=top+yc.yet(i)*(cp.gc(i)-cp.gc(nsp))
  277.           bot=bot+yc.yet(i)*(cv.gc(i)-cv.gc(nsp))
  278.  103     continue
  279.          top=cp.gc(nsp)+top
  280.          bot=cv.gc(nsp)+bot
  281.          GAMC=top/bot
  282. C-------------------------------------------------------------
  283.          SEGINI DGDYC
  284.          do 41 i=1,(nsp-1)
  285.            dgdyc.vv(i)=(cp.gc(i)-cp.gc(nsp)-
  286.      &       GAMC*(cv.gc(i)-cv.gc(nsp)))/bot
  287.  41    continue
  288. c-------------------------------------------------------------
  289. C------------------------------------------------
  290. C******* Densite, vitesse, pression sur le bord
  291. C------------------------------------------------
  292.          ECIN=0.5D0*((UXF*UXF)+(UYF*UYF))
  293.          PSRF=(GM1/GAMF)*(HTF-ECIN)
  294.          RF=PSRF/SF
  295.          RF=RF**(1.0D0/GM1)
  296.          PF=SF*(RF**GAMF)
  297. C------------------------------
  298. C******* Derivatives w.r.t. PC
  299. C------------------------------
  300.          DPSRUN=-1*(GM1/GAMF)*UNC
  301.          DRDUN=USGM1*RF/PSRF*DPSRUN
  302.          DPDUN=GAMF*PSRF*DRDUN
  303.          DUXDUN=CNX
  304.          DUYDUN=CNY
  305. C-------------------------------
  306.          DUNDUX=CNX
  307.          DUNDUY=CNY
  308. C--------------------------------------------------------------
  309. C------------------------------
  310. C******* Derivatives
  311. C------------------------------
  312.         wvec_l(1)=RF
  313.         wvec_l(2)=UXF
  314.         wvec_l(3)=UYF
  315.         wvec_l(4)=PF
  316. C--------------------------
  317.         wvec_r(1)=RC
  318.         wvec_r(2)=UXC
  319.         wvec_r(3)=UYC
  320.         wvec_r(4)=PC
  321. C--------------------------
  322.         nvect(1)=CNX
  323.         nvect(2)=CNY
  324.         tvect(1)=CTX
  325.         tvect(2)=CTY
  326.         call copms2(nsp,jfl,jfr,wvec_l,wvec_r,nvect,tvect,
  327.      &                 yf,mpyc,lrecp,lrecv,nlc)
  328. C--------------------------------------------------------------
  329.         COEF=SURF/VOLU
  330.         JLL=JFL
  331.         JRR=JFR
  332.         SEGACT JLL
  333.         SEGACT JRR
  334.         SEGINI JR
  335. C-------------------------------------------------------------
  336. C   Taking in to account the dependance of the variables
  337. C   at the face on the variables at the centre (UNC)
  338. C-------------------------------------------------------------
  339.        DO 105 I=1,(3+NSP)
  340.        DO 1050 J=1,(3+NSP)
  341.         IF(J .EQ. 2) THEN
  342.           COEF5=(JLL.JAC(I,1)*DRDUN)+(JLL.JAC(I,2)*DUXDUN)+
  343.      &        (JLL.JAC(I,3)*DUYDUN)+(JLL.JAC(I,4)*DPDUN)
  344.           JR.JAC(I,J)=(COEF5*DUNDUX+JRR.JAC(I,J))*COEF
  345.         ELSEIF(J .EQ. 3) THEN
  346.           COEF5=(JLL.JAC(I,1)*DRDUN)+(JLL.JAC(I,2)*DUXDUN)+
  347.      &        (JLL.JAC(I,3)*DUYDUN)+(JLL.JAC(I,4)*DPDUN)
  348.           JR.JAC(I,J)=(COEF5*DUNDUY+JRR.JAC(I,J))*COEF
  349.         ELSE
  350.           JR.JAC(I,J)=JRR.JAC(I,J)*COEF
  351.         ENDIF
  352.  1050  CONTINUE
  353.  105   CONTINUE
  354. C-------------------------------------------------------------
  355. c  matrix wl(i,j) represents the derivative of the i-component
  356. c  of the vector of primitive variables of the left state with
  357. c  respect to the j-component of the vector of the conservative
  358. c  variables of the left state.
  359. c
  360. c  Here: (rho, ux, uy, p, Y_1,...,Y_(nsp-1)) -
  361. c                               vector of primitive variables;
  362. c  (rho, rho ux, rho uy, rho e, rho Y_1,..., rho Y_(nsp-1)) -
  363. c                            vector of conservative variables.
  364. c-------------------------------------------------------------
  365.        wl.jac(1,1)=1.0d0
  366.        wl.jac(1,2)=0.0d0
  367.        wl.jac(1,3)=0.0d0
  368.        wl.jac(1,4)=0.0d0
  369.        do 83 i=1,(nsp-1)
  370.          wl.jac(1,4+i)=0.0d0
  371.  83    continue
  372. c------------------------------
  373.        wl.jac(2,1)=-UXC/RC
  374.        wl.jac(2,2)=1.0d0/RC
  375.        wl.jac(2,3)=0.0d0
  376.        wl.jac(2,4)=0.0d0
  377.        do 84 i=1,(nsp-1)
  378.          wl.jac(2,4+i)=0.0d0
  379.  84    continue
  380. c------------------------------
  381.        wl.jac(3,1)=-UYC/RC
  382.        wl.jac(3,2)=0.0d0
  383.        wl.jac(3,3)=1.0d0/RC
  384.        wl.jac(3,4)=0.0d0
  385.        do 85 i=1,(nsp-1)
  386.          wl.jac(3,4+i)=0.0d0
  387.  85    continue
  388. c------------------------------
  389.        br1=0.0d0
  390.        do 86 i=1,(nsp-1)
  391.          br1=br1+dgdyc.vv(i)*yc.yet(i)
  392.  86    continue
  393.        br1=br1*PC/(RC*(GAMC-1.0D0))
  394.        wl.jac(4,1)=(GAMC-1.0D0)*(UXC*UXC+UYC*UYC)/2.0d0-br1
  395.        wl.jac(4,2)=-UXC*(GAMC-1.0D0)
  396.        wl.jac(4,3)=-UYC*(GAMC-1.0D0)
  397.        wl.jac(4,4)=(GAMC-1.0D0)
  398.        do 87 i=1,(nsp-1)
  399.          wl.jac(4,4+i)=dgdyc.vv(i)*PC/(RC*(GAMC-1.0D0))
  400.  87    continue
  401. c------------------------------
  402.        do 88 i=1,(nsp-1)
  403.         do 89 j=1,4
  404.           wl.jac(4+i,j)=0.0d0
  405.           if(j.eq.1) wl.jac(4+i,j)=-yc.yet(i)/RC
  406.  89     continue
  407. c------------
  408.         do 890 j=5,(4+nsp-1)
  409.           wl.jac(4+i,j)=0.0d0
  410.           if(4+i.eq.j)  then
  411.             wl.jac(4+i,j)=1.0d0/RC
  412.           endif
  413.  890    continue
  414.  88    continue
  415. c------------------------------------------------
  416. C------------------------------------------------
  417.        do 114 i=1,(3+nsp)
  418.         do 115 j=1,(3+nsp)
  419.          jtt.jac(i,j)=0.0d0
  420.          do 116 k=1,(3+nsp)
  421.           jtt.jac(i,j)=jtt.jac(i,j)+
  422.      &       jr.jac(i,k)*wl.jac(k,j)/COEF
  423.  116     continue
  424.  115    continue
  425.  114  continue
  426. C----------------------------------------------------------------
  427. C******* Jacobian with respect to conservative variables
  428. C----------------------------------------------------------------
  429.          IF(IJAC.EQ.1)THEN
  430.            DO 9 II = 1,(3+NSP)
  431.               DO 15 JJ = 1,(3+NSP)
  432.                 KV = (II-1)*(3+NSP)
  433. C----------------------------------
  434.                 CELL = IMATRI.LIZAFM(1,KV+JJ)
  435.                 CELL.AM(IFAC,1,1) = JTT.JAC(II,JJ)*COEF
  436.  15           CONTINUE
  437.  9         CONTINUE
  438.          ELSEIF(IJAC.EQ.2)THEN
  439.            DO 20 II = 1,(3+NSP)
  440.               DO 25 JJ = 1,(3+NSP)
  441.                 KV = (II-1)*(3+NSP)
  442. C----------------------------------
  443.                 CELL = IMATRI.LIZAFM(1,KV+JJ)
  444.                 CELL.AM(IFAC,1,1) = JR.JAC(II,JJ)
  445.  25           CONTINUE
  446.  20         CONTINUE
  447.          ENDIF
  448. c--------------------------------------------------
  449.       ENDDO
  450. C
  451.       SEGDES MELEFC
  452. C
  453.       SEGDES MLEMC
  454.       SEGDES MLEMCB
  455.       SEGDES MLEMF
  456. C
  457.       SEGDES MPNORM
  458.       SEGDES MPVOL
  459.       SEGDES MPSURF
  460.       SEGDES MPRC
  461.       SEGDES MPPC
  462.       SEGDES MPVC
  463.       SEGDES MPYC
  464.       SEGDES MPLIM
  465.       SEGDES YC
  466.       SEGDES YF
  467.       SEGDES CP
  468.       SEGDES CV
  469.       SEGDES JLL
  470.       SEGDES JRR
  471.       SEGDES JTT
  472.       SEGDES JFL
  473.       SEGDES JFR
  474.       SEGDES JR
  475.       SEGDES WL
  476.       SEGDES  DGDYC
  477.       SEGDES MATRIK
  478.       DO 80 II=1,NBME
  479.        CELL = IMATRI.LIZAFM(1,II)
  480.        SEGDES CELL
  481.  80   CONTINUE
  482.       SEGDES IMATRI
  483. C---------------------------------------------
  484.  9999 CONTINUE
  485.       RETURN
  486.       END
  487.  
  488.  
  489.  
  490.  
  491.  
  492.  
  493.  
  494.  
  495.  
  496.  
  497.  
  498.  
  499.  
  500.  
  501.  
  502.  
  503.  

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