Sources Esope | Cast3M

cli271
C CLI271    SOURCE    CB215821  20/11/25    13:20:50     10792          
      SUBROUTINE CLI271(NSP,MELEMF,MELEMC,MELECB,MELEFC,INORM,ICHPVO,
     &    ICHPSU,LRECP,LRECV,IROC,IVITC,IPC,ICHLIM,ICHRES,ICHRLI)
C************************************************************************
C
C PROJET            :  CASTEM 2000
C
C NOM               :  CLI271
C
C DESCRIPTION       :  Subroutine appellée par CLIM22
C                      OPTION: 'INJE'
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)
 
-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, MPYC.MPOVAL, MPLIM.MPOVAL,
     &     MPRES.MPOVAL,  MPRLI.MPOVAL
C
C**** Variables de COOPTIO
C
C      INTEGER IPLLB, IERPER, IERMAX, IERR, INTERR
C     &        ,IOTER,   IOLEC,  IOIMP,     IOCAR,  IOACQ
C     &        ,IOPER,   IOSGB,  IOGRA,     IOSAU,  IORES
C     &        ,IECHO,   IIMPI,  IOSPI
C     &        ,IDIM,    IFICLE, IPREFI
C     &        ,MCOORD
C     &        ,IFOMOD, NIFOUR, IFOUR, NSDPGE, IONIVE
C     &        ,NGMAXY, IZROSF, ISOTYP, IOSCR,LTEXLU
C     &        ,NORINC,NORVAL,NORIND,NORVAD
C     &        ,NUCROU, IPSAUV
C
      INTEGER MELEMF,MELEMC,MELECB,INORM,ICHPVO,ICHPSU, IROC,IVITC,IPC
     &     ,IGAMC,ICHLIM,ICHRES,ICHRLI,ICEL,NFAC,IFAC
     &     ,NGF,NGC,NLF,NLC,NLCB,LRECP,LRECV,NSP,I
      REAL*8 VOLU,SURF,GAMF,CNX,CNY,CNZ,CTX,CTY,CTZ,GM1,USGM1
     &     ,CT2X,CT2Y,CT2Z,UTF,UT2F,TOP,BOT
     &     ,PC,PSRF,RHOUF,ECIN,P,RHO,UN,UT,UT2,UX,UY,UZ
      CHARACTER*(8) TYPE
C-------------------------------------------------------------------
-INC SMLREEL
       POINTEUR MLRECP.MLREEL, MLRECV.MLREEL
C-------------------------------------------------------
C**********  Les CP's and CV's   ***********************
C-------------------------------------------------------
      SEGMENT GCONST
         REAL*8 GC(NSP)
      ENDSEGMENT
      POINTEUR CP.GCONST, CV.GCONST
C-------------------------------------------------------------
C******* Les fractionines massiques **************************
C-------------------------------------------------------------
      SEGMENT FRAMAS
         REAL*8 YET(NSP)
      ENDSEGMENT
      POINTEUR YF.FRAMAS
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(ICHLIM,MPLIM,TYPE,ICEL)
      CALL LICHT(ICHRES,MPRES,TYPE,ICEL)
      CALL LICHT(ICHRLI,MPRLI,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)
      CNZ=0.0D0
      CTZ=0.0D0
      CT2X=0.0D0
      CT2Y=0.0D0
      CT2Z=0.0D0
      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=-1*MPNORM.VPOCHA(NLF,1)
         CNY=-1*MPNORM.VPOCHA(NLF,2)
         IF(IDIM.EQ.2)THEN
            CTX=-1.0D0*CNY
            CTY=CNX
         ELSE
            CNZ=-1*MPNORM.VPOCHA(NLF,3)
            CTX=-1*MPNORM.VPOCHA(NLF,4)
            CTY=-1*MPNORM.VPOCHA(NLF,5)
            CTZ=-1*MPNORM.VPOCHA(NLF,6)
            CT2X=-1*MPNORM.VPOCHA(NLF,7)
            CT2Y=-1*MPNORM.VPOCHA(NLF,8)
            CT2Z=-1*MPNORM.VPOCHA(NLF,9)
         ENDIF
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----------------------------------------
         PC=MPPC.VPOCHA(NLC,1)
C----------------------------------------
C        Variables à la face
C----------------------------------------
         RHOUF=MPLIM.VPOCHA(NLCB,1)
         PSRF=MPLIM.VPOCHA(NLCB,2)
         UTF=0.0D0
         UT2F=0.0D0
C----------------------------------------
C******* Variables à l'interface
C----------------------------------------
         P=PC
         RHO=P/PSRF
         UN=RHOUF/RHO
         UT=UTF
         UT2=UT2F
         SEGINI YF
         DO 101 I=1,(NSP-1)
           YF.YET(I)=MPLIM.VPOCHA(NLCB,2+I)
 101     CONTINUE
c-------------------------------------------------------------
c  Computing GAMMA at the face-center
c-------------------------------------------------------------
         top=0.0D0
         bot=0.0D0
         do 103  i=1,(nsp-1)
          top=top+yf.yet(i)*(cp.gc(i)-cp.gc(nsp))
          bot=bot+yf.yet(i)*(cv.gc(i)-cv.gc(nsp))
 103     continue
         top=cp.gc(nsp)+top
         bot=cv.gc(nsp)+bot
         GAMF=top/bot
C-----------------------------------------
C******* On calcule U
C-----------------------------------------
         UX=UN*CNX+UT*CTX+UT2*CT2X
         UY=UN*CNY+UT*CTY+UT2*CT2Y
         UZ=UN*CNZ+UT*CTZ+UT2*CT2Z
C---------------------------------------------
         ECIN=0.5D0*((UX*UX)+(UY*UY)+(UZ*UZ))
C------------------------------------------------
C******* Densite, vitesse, pression sur le bord
C------------------------------------------------
         MPRLI.VPOCHA(NLCB,1)=RHO
         MPRLI.VPOCHA(NLCB,2)=UX
         MPRLI.VPOCHA(NLCB,3)=UY
         IF(IDIM.EQ.3) MPRLI.VPOCHA(NLCB,4)=UZ
         MPRLI.VPOCHA(NLCB,IDIM+2)=P
         do 104  i=1,(nsp-1)
           MPRLI.VPOCHA(NLCB,IDIM+2+I)=YF.YET(I)
 104     continue
C--------------------------------------------------------
C******* Residuum (son SPG a le meme ordre que MELEFC)
C--------------------------------------------------------
         USGM1 = 1.0D0/(GAMF-1.0D0)
         MPRES.VPOCHA(IFAC,1)=RHOUF*SURF/VOLU
         MPRES.VPOCHA(IFAC,2)=(RHOUF*UX+P*CNX)*SURF/VOLU
         MPRES.VPOCHA(IFAC,3)=(RHOUF*UY+P*CNY)*SURF/VOLU
         IF(IDIM.EQ.3)MPRES.VPOCHA(IFAC,4)=(RHOUF*UZ+P*CNZ)*SURF/VOLU
         MPRES.VPOCHA(IFAC,IDIM+2)=(RHOUF*((GAMF*USGM1*PSRF)+ECIN))
     &        *SURF/VOLU
         do 105  i=1,(nsp-1)
           MPRES.VPOCHA(IFAC,IDIM+2+I)=RHOUF*YF.YET(I)*SURF/VOLU
 105     continue
      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 MPLIM
      SEGDES MPRES
      SEGDES MPRLI
      SEGDES MLRECP
      SEGDES MLRECV
      SEGDES YF
C
 9999 CONTINUE
      RETURN
      END