Sources Esope | Cast3M

cli252
C CLI252    SOURCE    OF166741  24/12/13    21:15:36     12097          
      SUBROUTINE CLI252(NSP,MELEMF,MELEMC,MELECB,MELEFC,MELRES,INORM,
     &     ICHPVO,ICHPSU,LRECP,LRECV,
     &     IROC,IVITC,IPC,IYC,ICHLIM,ILIINC,ILIINP,IJAC,IJACO)
C************************************************************************
C
C PROJET            :  CASTEM 2000
C
C NOM               :  CLI252
C
C DESCRIPTION       :  Subroutine appellée par CLIM22
C                      Jacobian for 'OUTP  '
C
C LANGAGE           :  FORTRAN 77 + ESOPE 2000 (avec estensions CISI)
C
C AUTEUR            :  S. Kudriakov, DEN/DM2S/SFME/LTMF
C
C************************************************************************
C
C APPELES (Calcul)  :
C
C************************************************************************
C
C HISTORIQUE (Anomalies et modifications éventuelles)
C
C HISTORIQUE :
C
C************************************************************************
C
      IMPLICIT INTEGER(I-N)
      INTEGER MELEMF,MELEMC,MELECB,INORM,ICHPVO,ICHPSU, IROC,IVITC,IPC
     &     ,IGAMC,ICHLIM,ICEL,NFAC,IFAC,MELRES,IJACO
     &     ,NGF,NGC,NLF,NLC,NLCB
     &     ,ILIINC,ILIINP,IJAC,II,JJ
     &     ,MP, NBEL, NBME, NBSOUS, NKID, NKMT, NMATRI, NP, NRIGE
     &     ,NSP,I, IYC,J, LRECP,LRECV,KV
      REAL*8 VOLU,SURF,RC,PC,UXC,UYC,CNX,CNY,CTX,CTY
     &     ,PF,COEF
      REAL*8 WVEC_L(4), WVEC_R(4), NVECT(2), TVECT(2)
      CHARACTER*(8) TYPE
 
-INC PPARAM
-INC CCOPTIO
-INC SMLMOTS
-INC SMELEME
      POINTEUR MELEFC.MELEME
-INC SMLENTI
      POINTEUR MLEMC.MLENTI, MLEMCB.MLENTI,MLEMF.MLENTI
-INC SMCHPOI
      POINTEUR MPNORM.MPOVAL, MPVOL.MPOVAL, MPSURF.MPOVAL, MPRC.MPOVAL,
     &     MPVC.MPOVAL, MPPC.MPOVAL, MPLIM.MPOVAL, MPYC.MPOVAL
-INC SMMATRIK
      POINTEUR CELL.IZAFM
C-------------------------------------------------------
-INC SMLREEL
      POINTEUR MLRECP.MLREEL, MLRECV.MLREEL
C-------------------------------------------------------
C*********  Les Jacobians ******************************
C-------------------------------------------------------
      SEGMENT JACEL
         REAL*8 JAC(3+NSP,3+NSP)
      ENDSEGMENT
      POINTEUR JLL.JACEL,JPL.JACEL,JTL.JACEL,JTT.JACEL
C-------------------------------------------------------------
C******* Les fractionines massiques **************************
C-------------------------------------------------------------
       SEGMENT FRAMAS
         REAL*8 YET(NSP)
      ENDSEGMENT
      POINTEUR YC.FRAMAS
C-------------------------------------------------------
C**********  Les CP's and CV's   ***********************
C-------------------------------------------------------
      SEGMENT GCONST
         REAL*8 GC(NSP)
      ENDSEGMENT
      POINTEUR CP.GCONST, CV.GCONST
C----------------------------------------------------
C**** KRIPAD pour la correspondance global/local
C----------------------------------------------------
      CALL KRIPAD(MELEMC,MLEMC)
      CALL KRIPAD(MELECB,MLEMCB)
      CALL KRIPAD(MELEMF,MLEMF)
C----------------------------------------------------
C**** CHPOINTs de la table DOMAINE
C----------------------------------------------------
      CALL LICHT(INORM,MPNORM,TYPE,ICEL)
      CALL LICHT(ICHPVO,MPVOL,TYPE,ICEL)
      CALL LICHT(ICHPSU,MPSURF,TYPE,ICEL)
C----------------------------------------------------
C**** CHPOINTs des variables
C----------------------------------------------------
      CALL LICHT(IROC,MPRC,TYPE,ICEL)
      CALL LICHT(IVITC,MPVC,TYPE,ICEL)
      CALL LICHT(IPC,MPPC,TYPE,ICEL)
      CALL LICHT(IYC,MPYC,TYPE,ICEL)
      CALL LICHT(ICHLIM,MPLIM,TYPE,ICEL)
C--------------------------------------------------------
C**** Boucle sur le face pour le calcul des invariants de
C     Riemann et du flux
C--------------------------------------------------------
      SEGACT MELEFC
      NFAC=MELEFC.NUM(/2)
C---------------------------------
C**** Objet MATRIK
C---------------------------------
      NRIGE = 7
      NMATRI = 1
      NKID = 9
      NKMT = 7
C---------------------------------
      SEGINI MATRIK
      IJACO = MATRIK
      MATRIK.IRIGEL(1,1) = MELRES
      MATRIK.IRIGEL(2,1) = MELRES
C---------------------------------
C**** Matrice non symetrique
C---------------------------------
      MATRIK.IRIGEL(7,1) = 2
C---------------------------------
      NBME = (3+NSP)*(3+NSP)
      NBSOUS = 1
      SEGINI IMATRI
      IF(IJAC.EQ.1)THEN
         MLMOTS=ILIINC
      ELSEIF(IJAC.EQ.2)THEN
         MLMOTS=ILIINP
      ENDIF
      SEGACT MLMOTS
      MATRIK.IRIGEL(4,1) = IMATRI
C-------------------------------------------
      DO 1 J=1,(NSP+3)
        KV=(J-1)*(3+NSP)
        IMATRI.LISPRI(KV+1) = MLMOTS.MOTS(1)
        IMATRI.LISPRI(KV+2) = MLMOTS.MOTS(2)
        IMATRI.LISPRI(KV+3) = MLMOTS.MOTS(3)
        IMATRI.LISPRI(KV+4) = MLMOTS.MOTS(4)
        DO 2 I=1,(NSP-1)
          IMATRI.LISPRI(KV+4+I) = MLMOTS.MOTS(4+I)
 2      CONTINUE
 1    CONTINUE
C-----------------------------------------------
      SEGDES MLMOTS
      MLMOTS=ILIINC
      SEGACT MLMOTS
C-----------------------------------------------
      DO 3 J=1,(NSP+3)
        KV=(J-1)*(3+NSP)
        IMATRI.LISDUA(KV+1) = MLMOTS.MOTS(j)
        IMATRI.LISDUA(KV+2) = MLMOTS.MOTS(j)
        IMATRI.LISDUA(KV+3) = MLMOTS.MOTS(j)
        IMATRI.LISDUA(KV+4) = MLMOTS.MOTS(j)
        DO 4 I=1,(NSP-1)
          IMATRI.LISDUA(KV+4+I) = MLMOTS.MOTS(j)
 4     CONTINUE
 3    CONTINUE
C-----------------------------------------------
C-----------------------------------------------
      SEGDES MLMOTS
      NBEL = NFAC
      NBSOUS = 1
      NP = 1
      MP = 1
C-----------------------------------------------------------
C-----------------------------------------------------------
      DO 5 I=1,NBME
        SEGINI CELL
        IMATRI.LIZAFM(1,I) = CELL
 5    CONTINUE
C---------------------------------
C**** Fin definition MATRIK
C---------------------------------
      DO IFAC=1,NFAC,1
         NGF=MELEFC.NUM(1,IFAC)
         NGC=MELEFC.NUM(2,IFAC)
         NLF=MLEMF.LECT(NGF)
         NLC=MLEMC.LECT(NGC)
         NLCB=MLEMCB.LECT(NGF)
         VOLU=MPVOL.VPOCHA(NLC,1)
         SURF=MPSURF.VPOCHA(NLF,1)
C        In CASTEM les normales sont sortantes
         CNX=MPNORM.VPOCHA(NLF,1)
         CNY=MPNORM.VPOCHA(NLF,2)
         CTX=-1.0D0*CNY
         CTY=CNX
C----------------------------------------------
         SEGINI CP, CV
         MLRECP = LRECP
         MLRECV = LRECV
         SEGACT MLRECP, MLRECV
         DO 10 I=1,(NSP-1)
           CP.GC(I)=MLRECP.PROG(I)
           CV.GC(I)=MLRECV.PROG(I)
 10      CONTINUE
         CP.GC(NSP)=MLRECP.PROG(NSP)
         CV.GC(NSP)=MLRECV.PROG(NSP)
C---------------------------------
C        Variables au centre
C---------------------------------
         RC=MPRC.VPOCHA(NLC,1)
         PC=MPPC.VPOCHA(NLC,1)
         UXC=MPVC.VPOCHA(NLC,1)
         UYC=MPVC.VPOCHA(NLC,2)
         SEGINI YC
         SEGACT MPYC
         DO 100 I=1,(NSP-1)
           YC.YET(I)=MPYC.VPOCHA(NLC,I)
 100     CONTINUE
C---------------------------------
C        Variables à la face
C---------------------------------
         PF=MPLIM.VPOCHA(NLCB,1)
C------------------------------
C******* Derivatives
C------------------------------
        wvec_l(1)=RC
        wvec_l(2)=UXC
        wvec_l(3)=UYC
        wvec_l(4)=PC
C--------------------------
        wvec_r(1)=RC
        wvec_r(2)=UXC
        wvec_r(3)=UYC
        wvec_r(4)=PF
C--------------------------
        nvect(1)=CNX
        nvect(2)=CNY
        tvect(1)=CTX
        tvect(2)=CTY
        call copmsp(nsp,jpl,jll,wvec_l,wvec_r,nvect,tvect,
     &                   mpyc,lrecp,lrecv,nlc,nlc)
C-----------------------------------------------
         COEF=-SURF/VOLU
C----------------------------------------
         JTT=JLL
         JTL=JPL
         SEGACT JTT
         SEGACT JTL
C----------------------------------------
C----------------------------------------------------------------
C******* Jacobian with respect to conservative variables
C----------------------------------------------------------------
         IF(IJAC.EQ.1)THEN
           DO 9 II = 1,(3+NSP)
              DO 15 JJ = 1,(3+NSP)
                KV = (II-1)*(3+NSP)
C----------------------------------
                CELL = IMATRI.LIZAFM(1,KV+JJ)
                CELL.AM(IFAC,1,1) = JTT.JAC(II,JJ)*COEF
 15           CONTINUE
 9         CONTINUE
         ELSEIF(IJAC.EQ.2)THEN
           DO 20 II = 1,(3+NSP)
              DO 25 JJ = 1,(3+NSP)
                KV = (II-1)*(3+NSP)
C----------------------------------
                CELL = IMATRI.LIZAFM(1,KV+JJ)
                CELL.AM(IFAC,1,1) = JTL.JAC(II,JJ)*COEF
 25           CONTINUE
 20         CONTINUE
         ENDIF
c--------------------------------------------------
      ENDDO
C
      SEGDES MELEFC
C
      SEGSUP MLEMC
      SEGSUP MLEMCB
      SEGSUP MLEMF
C
      SEGDES MPNORM
      SEGDES MPVOL
      SEGDES MPSURF
      SEGDES MPRC
      SEGDES MPPC
      SEGDES MPVC
      SEGDES MPYC
      SEGDES MPLIM
      SEGDES YC
c      SEGDES YF
      SEGDES CP
      SEGDES CV
      SEGDES JTL
      SEGDES JTT
c      SEGDES WL
c      SEGDES  DYDG1, DFRYG1,
c     &          DG1DY, DGDYC
      SEGDES MATRIK
      DO 80 II=1,NBME
       CELL = IMATRI.LIZAFM(1,II)
       SEGDES CELL
 80   CONTINUE
      SEGDES IMATRI
C---------------------------------------------
 9999 CONTINUE
      RETURN
      END