Télécharger la plaquette Cast3M


fr en

Télécharger cli252.eso

Retour à la liste

Numérotation des lignes : 

cli252

  1. C CLI252    SOURCE    CB215821  20/11/25    13:20:42     10792          
  2.       SUBROUTINE CLI252(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               :  CLI252
  10. C
  11. C DESCRIPTION       :  Subroutine appellée par CLIM22
  12. C                      Jacobian for 'OUTP  '
  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
  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,CNX,CNY,CTX,CTY
  52.      &     ,PF,COEF
  53.       REAL*8 WVEC_L(4), WVEC_R(4), NVECT(2), TVECT(2)
  54.       CHARACTER*(8) TYPE
  55.  
  56. -INC PPARAM
  57. -INC CCOPTIO
  58. -INC SMLMOTS
  59. -INC SMELEME
  60.       POINTEUR MELEFC.MELEME
  61. -INC SMLENTI
  62.       POINTEUR MLEMC.MLENTI, MLEMCB.MLENTI,MLEMF.MLENTI
  63. -INC SMCHPOI
  64.       POINTEUR MPNORM.MPOVAL, MPVOL.MPOVAL, MPSURF.MPOVAL, MPRC.MPOVAL,
  65.      &     MPVC.MPOVAL, MPPC.MPOVAL, MPLIM.MPOVAL, MPYC.MPOVAL
  67.       POINTEUR CELL.IZAFM
  68. C-------------------------------------------------------
  69. -INC SMLREEL
  70.       POINTEUR MLRECP.MLREEL, MLRECV.MLREEL
  71. C-------------------------------------------------------
  72. C*********  Les Jacobians ******************************
  73. C-------------------------------------------------------
  74.       SEGMENT JACEL
  75.          REAL*8 JAC(3+NSP,3+NSP)
  76.       ENDSEGMENT
  77.       POINTEUR JLL.JACEL,JPL.JACEL,JTL.JACEL,JTT.JACEL
  78. C-------------------------------------------------------------
  79. C******* Les fractionines massiques **************************
  80. C-------------------------------------------------------------
  81.        SEGMENT FRAMAS
  82.          REAL*8 YET(NSP)
  83.       ENDSEGMENT
  84.       POINTEUR YC.FRAMAS
  85. C-------------------------------------------------------
  86. C**********  Les CP's and CV's   ***********************
  87. C-------------------------------------------------------
  88.       SEGMENT GCONST
  89.          REAL*8 GC(NSP)
  90.       ENDSEGMENT
  91.       POINTEUR CP.GCONST, CV.GCONST
  92. C----------------------------------------------------
  93. C**** KRIPAD pour la correspondance global/local
  94. C----------------------------------------------------
  95.       CALL KRIPAD(MELEMC,MLEMC)
  96.       CALL KRIPAD(MELECB,MLEMCB)
  97.       CALL KRIPAD(MELEMF,MLEMF)
  98. C----------------------------------------------------
  99. C**** CHPOINTs de la table DOMAINE
  100. C----------------------------------------------------
  101.       CALL LICHT(INORM,MPNORM,TYPE,ICEL)
  102.       CALL LICHT(ICHPVO,MPVOL,TYPE,ICEL)
  103.       CALL LICHT(ICHPSU,MPSURF,TYPE,ICEL)
  104. C----------------------------------------------------
  105. C**** CHPOINTs des variables
  106. C----------------------------------------------------
  107.       CALL LICHT(IROC,MPRC,TYPE,ICEL)
  108.       CALL LICHT(IVITC,MPVC,TYPE,ICEL)
  109.       CALL LICHT(IPC,MPPC,TYPE,ICEL)
  110.       CALL LICHT(IYC,MPYC,TYPE,ICEL)
  111.       CALL LICHT(ICHLIM,MPLIM,TYPE,ICEL)
  112. C--------------------------------------------------------
  113. C**** Boucle sur le face pour le calcul des invariants de
  114. C     Riemann et du flux
  115. C--------------------------------------------------------
  116.       SEGACT MELEFC
  117.       NFAC=MELEFC.NUM(/2)
  118. C---------------------------------
  119. C**** Objet MATRIK
  120. C---------------------------------
  121.       NRIGE = 7
  122.       NMATRI = 1
  123.       NKID = 9
  124.       NKMT = 7
  125. C---------------------------------
  126.       SEGINI MATRIK
  127.       IJACO = MATRIK
  128.       MATRIK.IRIGEL(1,1) = MELRES
  129.       MATRIK.IRIGEL(2,1) = MELRES
  130. C---------------------------------
  131. C**** Matrice non symetrique
  132. C---------------------------------
  133.       MATRIK.IRIGEL(7,1) = 2
  134. C---------------------------------
  135.       NBME = (3+NSP)*(3+NSP)
  136.       NBSOUS = 1
  137.       SEGINI IMATRI
  138.       IF(IJAC.EQ.1)THEN
  139.          MLMOTS=ILIINC
  140.       ELSEIF(IJAC.EQ.2)THEN
  141.          MLMOTS=ILIINP
  142.       ENDIF
  143.       SEGACT MLMOTS
  144.       MATRIK.IRIGEL(4,1) = IMATRI
  145. C-------------------------------------------
  146.       DO 1 J=1,(NSP+3)
  147.         KV=(J-1)*(3+NSP)
  148.         IMATRI.LISPRI(KV+1) = MLMOTS.MOTS(1)
  149.         IMATRI.LISPRI(KV+2) = MLMOTS.MOTS(2)
  150.         IMATRI.LISPRI(KV+3) = MLMOTS.MOTS(3)
  151.         IMATRI.LISPRI(KV+4) = MLMOTS.MOTS(4)
  152.         DO 2 I=1,(NSP-1)
  153.           IMATRI.LISPRI(KV+4+I) = MLMOTS.MOTS(4+I)
  154.  2      CONTINUE
  155.  1    CONTINUE
  156. C-----------------------------------------------
  157.       SEGDES MLMOTS
  158.       MLMOTS=ILIINC
  159.       SEGACT MLMOTS
  160. C-----------------------------------------------
  161.       DO 3 J=1,(NSP+3)
  162.         KV=(J-1)*(3+NSP)
  163.         IMATRI.LISDUA(KV+1) = MLMOTS.MOTS(j)
  164.         IMATRI.LISDUA(KV+2) = MLMOTS.MOTS(j)
  165.         IMATRI.LISDUA(KV+3) = MLMOTS.MOTS(j)
  166.         IMATRI.LISDUA(KV+4) = MLMOTS.MOTS(j)
  167.         DO 4 I=1,(NSP-1)
  168.           IMATRI.LISDUA(KV+4+I) = MLMOTS.MOTS(j)
  169.  4     CONTINUE
  170.  3    CONTINUE
  171. C-----------------------------------------------
  172. C-----------------------------------------------
  173.       SEGDES MLMOTS
  174.       NBEL = NFAC
  175.       NBSOUS = 1
  176.       NP = 1
  177.       MP = 1
  178. C-----------------------------------------------------------
  179. C-----------------------------------------------------------
  180.       DO 5 I=1,NBME
  181.         SEGINI CELL
  182.         IMATRI.LIZAFM(1,I) = CELL
  183.  5    CONTINUE
  184. C---------------------------------
  185. C**** Fin definition MATRIK
  186. C---------------------------------
  187.       DO IFAC=1,NFAC,1
  188.          NGF=MELEFC.NUM(1,IFAC)
  189.          NGC=MELEFC.NUM(2,IFAC)
  190.          NLF=MLEMF.LECT(NGF)
  191.          NLC=MLEMC.LECT(NGC)
  192.          NLCB=MLEMCB.LECT(NGF)
  193.          VOLU=MPVOL.VPOCHA(NLC,1)
  194.          SURF=MPSURF.VPOCHA(NLF,1)
  195. C        In CASTEM les normales sont sortantes
  196.          CNX=MPNORM.VPOCHA(NLF,1)
  197.          CNY=MPNORM.VPOCHA(NLF,2)
  198.          CTX=-1.0D0*CNY
  199.          CTY=CNX
  200. C----------------------------------------------
  201.          SEGINI CP, CV
  202.          MLRECP = LRECP
  203.          MLRECV = LRECV
  204.          SEGACT MLRECP, MLRECV
  205.          DO 10 I=1,(NSP-1)
  206.            CP.GC(I)=MLRECP.PROG(I)
  207.            CV.GC(I)=MLRECV.PROG(I)
  208.  10      CONTINUE
  209.          CP.GC(NSP)=MLRECP.PROG(NSP)
  210.          CV.GC(NSP)=MLRECV.PROG(NSP)
  211. C---------------------------------
  212. C        Variables au centre
  213. C---------------------------------
  214.          RC=MPRC.VPOCHA(NLC,1)
  215.          PC=MPPC.VPOCHA(NLC,1)
  216.          UXC=MPVC.VPOCHA(NLC,1)
  217.          UYC=MPVC.VPOCHA(NLC,2)
  218.          SEGINI YC
  219.          SEGACT MPYC
  220.          DO 100 I=1,(NSP-1)
  221.            YC.YET(I)=MPYC.VPOCHA(NLC,I)
  222.  100     CONTINUE
  223. C---------------------------------
  224. C        Variables à la face
  225. C---------------------------------
  226.          PF=MPLIM.VPOCHA(NLCB,1)
  227. C------------------------------
  228. C******* Derivatives
  229. C------------------------------
  230.         wvec_l(1)=RC
  231.         wvec_l(2)=UXC
  232.         wvec_l(3)=UYC
  233.         wvec_l(4)=PC
  234. C--------------------------
  235.         wvec_r(1)=RC
  236.         wvec_r(2)=UXC
  237.         wvec_r(3)=UYC
  238.         wvec_r(4)=PF
  239. C--------------------------
  240.         nvect(1)=CNX
  241.         nvect(2)=CNY
  242.         tvect(1)=CTX
  243.         tvect(2)=CTY
  244.         call copmsp(nsp,jpl,jll,wvec_l,wvec_r,nvect,tvect,
  245.      &                   mpyc,lrecp,lrecv,nlc,nlc)
  246. C-----------------------------------------------
  247.          COEF=-SURF/VOLU
  248. C----------------------------------------
  249.          JTT=JLL
  250.          JTL=JPL
  251.          SEGACT JTT
  252.          SEGACT JTL
  253. C----------------------------------------
  254. C----------------------------------------------------------------
  255. C******* Jacobian with respect to conservative variables
  256. C----------------------------------------------------------------
  257.          IF(IJAC.EQ.1)THEN
  258.            DO 9 II = 1,(3+NSP)
  259.               DO 15 JJ = 1,(3+NSP)
  260.                 KV = (II-1)*(3+NSP)
  261. C----------------------------------
  262.                 CELL = IMATRI.LIZAFM(1,KV+JJ)
  263.                 CELL.AM(IFAC,1,1) = JTT.JAC(II,JJ)*COEF
  264.  15           CONTINUE
  265.  9         CONTINUE
  266.          ELSEIF(IJAC.EQ.2)THEN
  267.            DO 20 II = 1,(3+NSP)
  268.               DO 25 JJ = 1,(3+NSP)
  269.                 KV = (II-1)*(3+NSP)
  270. C----------------------------------
  271.                 CELL = IMATRI.LIZAFM(1,KV+JJ)
  272.                 CELL.AM(IFAC,1,1) = JTL.JAC(II,JJ)*COEF
  273.  25           CONTINUE
  274.  20         CONTINUE
  275.          ENDIF
  276. c--------------------------------------------------
  277.       ENDDO
  278. C
  279.       SEGDES MELEFC
  280. C
  281.       SEGSUP MLEMC
  282.       SEGSUP MLEMCB
  283.       SEGSUP MLEMF
  284. C
  285.       SEGDES MPNORM
  286.       SEGDES MPVOL
  287.       SEGDES MPSURF
  288.       SEGDES MPRC
  289.       SEGDES MPPC
  290.       SEGDES MPVC
  291.       SEGDES MPYC
  292.       SEGDES MPLIM
  293.       SEGDES YC
  294. c      SEGDES YF
  295.       SEGDES CP
  296.       SEGDES CV
  297.       SEGDES JTL
  298.       SEGDES JTT
  299. c      SEGDES WL
  300. c      SEGDES  DYDG1, DFRYG1,
  301. c     &          DG1DY, DGDYC
  302.       SEGDES MATRIK
  303.       DO 80 II=1,NBME
  304.        CELL = IMATRI.LIZAFM(1,II)
  305.        SEGDES CELL
  306.  80   CONTINUE
  307.       SEGDES IMATRI
  308. C---------------------------------------------
  309.  9999 CONTINUE
  310.       RETURN
  311.       END
  312.  
  313.  
  314.  
  315.  
  316.  
  317.  
  318.  
  319.  
  320.  
  321.  
  322.  
  323.  
  324.  
  325.  
  326.  

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