Sources Esope | Cast3M

rdemup
C RDEMUP    SOURCE    BECC      11/01/05    21:15:21     6836
      SUBROUTINE RDEMUP(IDIM, NPAR,
     &     SCON1, SG1, SD1,
     &     SCON2, SG2, SD2,
     &     SURF,VOLG,VOLD,
     &     CNX,CNY,CNZ,CTX,CTY,CTZ,CT1X,CT1Y,CT1Z,
     &     FLU,FLULAG,RESG,RESD)
C************************************************************************
C
C PROJET            :  CASTEM 2000
C
C NOM               :  RDEMUP
C
C DESCRIPTION       :  Voir KODFL1
C                      Update of the residual in RDEM
C                      Cas deux/trois dimensions
C
C LANGAGE           :  FORTRAN 77 + ESOPE 2000 (avec estensions CISI)
C
C AUTEUR            :  A. BECCANTINI, DEN/DM2S/SFME/LTMF
C
C************************************************************************
C
C HISTORIQUE (Anomalies et modifications éventuelles)
C
C Crée le 11.06.2010
C Estension au 3D le 21.12.2010
C
*
* --- variables globales
*
      IMPLICIT INTEGER(I-N)
      INTEGER IDIM, NPAR, ICOMP
      REAL*8  SCON1, SG1, SD1,
     &     SCON2, SG2, SD2,
     &     SURF, VOLG, VOLD, CNX,CNY,CNZ,
     &     CTX, CTY, CTZ, CT1X, CT1Y, CT1Z,
     &     FLU(*),FLULAG(*), RESG(*),RESD(*),
     &     FG(3),FD(3)
C
C
C      do icomp = 1, (idim + 3)
C         write(*,*) icomp, flu(icomp), flulag(icomp)
C      enddo
C
C     PHASE 1
C
C     alpha1
C
      FD(1) = -1.0D0 * FLULAG(IDIM + 3) * SD1
      FG(1) = FLULAG(IDIM + 3) * SG1
      RESD(1) = (FD(1) * SURF / VOLD)
      RESG(1) = -1.0D0 * (FG(1) * SURF / VOLG)
C
C     rho1 alpha1
C
      FG(1) = FLU(1) * SCON1 + FLULAG(1) * SG1
      FD(1) = FLU(1) * SCON1 - FLULAG(1) * SD1
      RESG(2) = -1.D0 * (FG(1)  * SURF / VOLG)
      RESD(2) = (FD(1)  * SURF / VOLD)
C
C     rho1 alpha1 ux1, uy1, uz1
C
      FD(1) = (FLU(2) * CNX) *
     &        SCON1 -
     &        (FLULAG(2) *  CNX)
     $        * SD1
      FG(1) = (FLU(2) * CNX) *
     &        SCON1 +
     &        (FLULAG(2) * CNX)
     $        * SG1
      IF (IDIM .GE. 2) THEN
         FD(1) = FD(1) +
     &        ((FLU(3) * CTX) *
     &        SCON1 -
     &        (FLULAG(3) * CTX)
     $        * SD1)
         FG(1) = FG(1) +
     &        ((FLU(3) * CTX) *
     &        SCON1 +
     &        (FLULAG(3) * CTX)
     $        * SG1)
         FD(2) = (FLU(2) * CNY + FLU(3) * CTY)
     &        * SCON1 -
     &        (FLULAG(2) * CNY + FLULAG(3) * CTY)
     &        * SD1
         FG(2) = (FLU(2) * CNY + FLU(3) * CTY)
     &        * SCON1 +
     &        (FLULAG(2) * CNY + FLULAG(3) * CTY)
     &        * SG1
      ENDIF
      IF (IDIM .EQ. 3) THEN
         FD(1) = FD(1) +
     &        ((FLU(4) * CT1X) *
     &        SCON1 -
     &        (FLULAG(4) * CT1X)
     $        * SD1)
         FG(1) = FG(1) +
     &        ((FLU(4) * CT1X) *
     &        SCON1 +
     &        (FLULAG(4) * CT1X)
     $        * SG1)
         FD(2) = FD(2) +
     &        ((FLU(4) * CT1Y)
     &        * SCON1 -
     &        (FLULAG(4) * CT1Y)
     &        * SD1)
         FG(2) = FG(2) +
     &        ((FLU(4)* CT1Y)
     &        * SCON1 +
     &        (FLULAG(4) * CT1Y)
     &        * SG1)
         FD(3) = (FLU(2) * CNZ + FLU(3) * CTZ + FLU(4) * CT1Z)
     &        * SCON1 -
     &        (FLULAG(2) * CNZ + FLULAG(3) * CTZ + FLULAG(4) * CT1Z)
     &        * SD1
         FG(3) = (FLU(2) * CNZ + FLU(3) * CTZ + FLU(4) * CT1Z)
     &        * SCON1 +
     &        (FLULAG(2) * CNZ + FLULAG(3) * CTZ + FLULAG(4) * CT1Z)
     &        * SG1
      ENDIF
C
C      write(*,*) 'Flux on momentum, 1'
C      write(*,*) fg(1), fd(1)
C      write(*,*) fg(2), fd(2)
C      if (idim .eq. 3) write(*,*) fg(3), fd(3)
C
      DO ICOMP = 1, IDIM, 1
         RESG(2 + ICOMP) = -1.D0 * (FG(ICOMP) * SURF / VOLG)
         RESD(2 + ICOMP) = (FD(ICOMP) * SURF / VOLD)
      ENDDO
C
C     rho1 alpha1 et1
C
      FG(1) = FLU(2 + IDIM) * SCON1 + FLULAG(2 + IDIM) * SG1
      FD(1) = FLU(2 + IDIM) * SCON1 - FLULAG(2 + IDIM) * SD1
      RESG(3 + IDIM) = -1.0D0 * (FG(1) * SURF / VOLG)
      RESD(3 + IDIM) = (FD(1) * SURF / VOLD)
C
      DO ICOMP = 4 + IDIM, 3 + IDIM + NPAR, 1
         FG(1) = FLU(ICOMP) * SCON1 + FLULAG(ICOMP) * SG1
         FD(1) = FLU(ICOMP) * SCON1 - FLULAG(ICOMP) * SD1
         RESG(ICOMP) = -1.0D0 * (FG(1) * SURF / VOLG)
         RESD(ICOMP) = (FD(1) * SURF / VOLD)
      ENDDO
C
C
C     PHASE 2.
C
C     alpha2
C
      FG(1) = FLULAG(IDIM + 3) * SG2
      FD(1) = -1.0D0 * FLULAG(IDIM + 3) * SD2
      RESD(4 + IDIM + NPAR) = (FD(1) * SURF / VOLD)
      RESG(4 + IDIM + NPAR) = -1.0D0 * (FG(1) * SURF / VOLG)
C
C     alpha2 rho2
C
      FG(1) = FLU(1) * SCON2 + FLULAG(1) * SG2
      FD(1) = FLU(1) * SCON2 - FLULAG(1) * SD2
      RESD(5 + IDIM + NPAR) = (FD(1) * SURF / VOLD)
      RESG(5 + IDIM + NPAR) = -1.0D0 * (FG(1) * SURF / VOLG)
C
C     alpha2 rho2 ux uy uz
C
      FD(1) = (FLU(2) * CNX) *
     &     SCON2 -
     &     (FLULAG(2) *  CNX)
     $     * SD2
      FG(1) = (FLU(2) * CNX) *
     &     SCON2 +
     &     (FLULAG(2) * CNX)
     $     * SG2
      IF (IDIM .GE. 2) THEN
         FD(1) = FD(1) +
     &        ((FLU(3) * CTX) *
     &        SCON2 -
     &        (FLULAG(3) * CTX)
     $        * SD2)
         FG(1) = FG(1) +
     &        ((FLU(3) * CTX) *
     &        SCON2 +
     &        (FLULAG(3) * CTX)
     $        * SG2)
         FG(2) = (FLU(2) * CNY + FLU(3) * CTY)
     &        * SCON2 +
     &        (FLULAG(2) * CNY + FLULAG(3) * CTY)
     &        * SG2
         FD(2) = (FLU(2) * CNY + FLU(3) * CTY)
     &        * SCON2 -
     &        (FLULAG(2) * CNY + FLULAG(3) * CTY)
     &        * SD2
      ENDIF
      IF (IDIM .EQ. 3) THEN
         FD(1) = FD(1) +
     &        ((FLU(4) * CT1X) *
     &        SCON2 -
     &        (FLULAG(4) * CT1X)
     $        * SD2)
         FG(1) = FG(1) +
     &        ((FLU(4) * CT1X) *
     &        SCON2 +
     &        (FLULAG(4) * CT1X)
     $        * SG2)
         FG(2) = FG(2) +
     &        ((FLU(4) * CT1Y)
     &        * SCON2 +
     &        (FLULAG(4) * CT1Y)
     &        * SG2)
         FD(2) = FD(2) +
     &        ((FLU(4) * CT1Y)
     &        * SCON2 -
     &        (FLULAG(4) * CT1Y)
     &        * SD2)
         FG(3) = (FLU(2) * CNZ + FLU(3) * CTZ + FLU(4) * CT1Z)
     &        * SCON2 +
     &        (FLULAG(2) * CNZ + FLULAG(3) * CTZ + FLULAG(4) * CT1Z)
     &        * SG2
         FD(3) = (FLU(2) * CNZ + FLU(3) * CTZ + FLU(4) * CT1Z)
     &        * SCON2 -
     &        (FLULAG(2) * CNZ + FLULAG(3) * CTZ + FLULAG(4) * CT1Z)
     &        * SD2
      ENDIF
C
C      write(*,*) 'Flux on momentum, 2'
C      write(*,*) fg(1), fd(1)
C      write(*,*) fg(2), fd(2)
C      if (idim .eq. 3) write(*,*) fg(3), fd(3)
C
      DO ICOMP = 1, IDIM, 1
         RESD(5 + IDIM + NPAR + ICOMP) = (FD(ICOMP) * SURF / VOLD)
         RESG(5 + IDIM + NPAR + ICOMP) = -1.0D0 * (FG(ICOMP) * SURF /
     $        VOLG)
      ENDDO
C
C     rho2 alpha2 et2
C
      FG(1) = FLU(2 + IDIM) * SCON2 + FLULAG(2 + IDIM) * SG2
      FD(1) = FLU(2 + IDIM) * SCON2 - FLULAG(2 + IDIM) * SD2
      RESD(6 + (2 * IDIM) + NPAR) =  (FD(1) * SURF / VOLD)
      RESG(6 + (2 * IDIM) + NPAR) = -1.0D0 * (FG(1) * SURF / VOLG)
C
      DO ICOMP = 4 + IDIM, 3 + IDIM + NPAR, 1
         FG(1) = FLU(ICOMP) * SCON2 + FLULAG(ICOMP) * SG2
         FD(1) = FLU(ICOMP) * SCON2 - FLULAG(ICOMP) * SD2
         RESD(3 + IDIM + NPAR + ICOMP) =  (FD(1) * SURF / VOLD)
         RESG(3 + IDIM + NPAR + ICOMP) = -1.0D0 * (FG(1) * SURF /
     $        VOLG)
      ENDDO
C
C      write(*,*) 'S'
C      write(*,*) SCON1, SG1, SD1,
C     &     SCON2, SG2, SD2
C      DO ICOMP = 1, (3 + IDIM + NPAR), 1
C         write(*,*) 'icomp, resd, resg'
C         write(*,*) icomp, resd(icomp),resg(icomp)
C      ENDDO
C
C      write(*,*) 'Conservativity check'
C      do icomp = 1, 3 + IDIM + NPAR
C         write(*,*) ((resg(icomp) + resg(3 + IDIM + NPAR + icomp))
C     &        * volg) +
C     &        ((resd(icomp) + resd(3 + IDIM + NPAR + icomp))
C     &        * vold)
C      enddo
      RETURN
      END
*