Sources Esope | Cast3M

rachus
C RACHUS    SOURCE    CHAT      05/01/13    02:44:18     5004
      SUBROUTINE RACHUS(NITMAX,ZERO,
     &                  GAMMAG,COEFFG,AG,UTILG,PG,
     &                  GAMMAD,COEFFD,AD,UTILD,PD,
     &                  USTAR,PSTAR,LOGNC,MESERR,LOGAN)
C
C************************************************************************
C
C PROJET            :  CASTEM 2000
C
C NOM               :  RACHUS
C
C DESCRIPTION       :  voir FLUHUS
C
C                      Calcul de l'intersection des invariants de
C                      Riemann
C
C LANGUAGE          :  FORTRAN 77
C
C AUTEUR            :  A. BECCANTINI DRN/DMT/SEMT/TTMF
C
C************************************************************************
C
C APPELES           :  aucun
C
C************************************************************************
C
C**** Entrées:
C
C     NITMAX          =  nombre maximum d'iterations in Newton-Rapson
C
C     ZERO            =  tolérance d'egalite pour REAL*8
C
C     GAMMAG, GAMMAD  =  les "gamma" du gaz (gauche et droite)
C
C     COEFFG, COEFFD  =  2/(GAMMA-1)
C
C     AG, AD          =  vitesses du son
C
C     UTILG           =  UNG + COEFFG * AG
C
C     UTILD           =  UND - COEFFD * AD
C
C                        (UNG et UND sont les vitesses normales
C
C     PG, PD          =  les pressions
C
C
C**** Sorties:
C
C     USTAR           =  vitesse sur la discontinuité de contact
C
C     PSTAR           =  pression sur la discontinuité de contact
C
C     LOGNC, MESSER   =  parametres qui segnalent des eventuels problems
C                        de convergence
C
C     LOGAN           =  .TRUE. -> anomalie detectée
C
C************************************************************************
C
C HISTORIQUE (Anomalies et modifications éventuelles)
C
C HISTORIQUE :  Créé le 6.1.98
C
C************************************************************************
C
C N.B.: Toutes les variables sont DECLAREES
C
C
      IMPLICIT INTEGER(I-N)
      INTEGER NITMAX,N0
      REAL*8  GAMMAG,COEFFG,AG,UTILG,PG,GAMMAD,COEFFD,AD,UTILD,PD
     &        ,DUTILD,ZERO,USTAR,PSTARG,PSTARD,PSTAR
     &        ,CELL,CGD,Z0,Z,COCELL,G1,DG1,DELTAZ,ZERO0
      CHARACTER*(40) MESERR
      LOGICAL LOGNC, LOGERR, LOGZER, LOGAN
C
      DUTILD = UTILG - UTILD
C
C**** Non convergence de la methode de NEWTON-RAPSON
C
      LOGNC  = .FALSE.
C
      CELL=GAMMAD*COEFFD-GAMMAG*COEFFG
      CGD=DUTILD**CELL
      CELL=(AG*COEFFG)**(GAMMAG*COEFFG)
      CELL=CELL/((AD*COEFFD)**(GAMMAD*COEFFD))
      CGD=CGD*CELL*PD/PG
C
C**** Solution du probleme g1(z)=0
C
C     Z0 = valeur de tentative
C
C     N.B.: GAMMAG = GAMMAD -> Z0 = Z = solution du problème
C
      Z0=1.0D0/(1.0D0+CGD**(1.0D0/COEFFG/GAMMAG))
      Z=1.0D0/(1.0D0+CGD**(1.0D0/COEFFD/GAMMAD))
      IF(Z0 .LT. 0.5D0) Z0=Z
C
C**** Trois situations possibles, i.e. gammag &lt; = > gammad,
C     trois formulations differentes du probleme
C
C     G1  = g1(z)
C     DG1 = dg1(z)/dz
C     N.B.: G1, DG1, Z sont variables adimensionales
C
      LOGZER = (ABS(GAMMAD-GAMMAG)/GAMMAG) .GT. ZERO
      IF(LOGZER)THEN
         IF(GAMMAG .GT. GAMMAD)THEN
C
C********** GAMMAG > GAMMAD
C
            CELL=CGD**(1.0D0/COEFFG/GAMMAG)
            COCELL=GAMMAD*COEFFD/GAMMAG/COEFFG
            LOGERR=.TRUE.
            N0=0
            DO WHILE(LOGERR)
               N0=N0+1
               G1=CELL*(Z0**COCELL)-1.0D0+Z0
               DG1=CELL*COCELL*(Z0**(COCELL-1.0D0))+1.0D0
               DELTAZ=-G1/DG1
               Z0=Z0+DELTAZ
               LOGERR=(ABS(G1) .GT. ZERO) .OR.
     &             (ABS(DELTAZ) .GT. ZERO)
               IF(N0 .GT. NITMAX) THEN
                  LOGNC = .TRUE.
                  MESERR(1:27) = 'HUS, SUBROUTINE rachus.eso.'
                  LOGERR = .FALSE.
               ENDIF
            ENDDO
         ELSE
C
C********** GAMMAG &lt; GAMMAD
C
            CELL=CGD**(1.0D0/COEFFD/GAMMAD)
            COCELL=GAMMAG*COEFFG/GAMMAD/COEFFD
            LOGERR = .TRUE.
            N0 = 0
            DO WHILE(LOGERR)
               N0=N0+1
               G1=CELL*Z0-((1.0D0-Z0)**COCELL)
               DG1=CELL+COCELL*((1.0D0-Z0)**(COCELL-1.0D0))
               DELTAZ=-G1/DG1
               Z0=Z0+DELTAZ
               LOGERR = (ABS(G1) .GT. ZERO) .OR.
     &               (ABS(DELTAZ) .GT. ZERO)
               IF(N0 .GT. NITMAX) THEN
                  LOGNC = .TRUE.
                  MESERR(1:27) = 'HUS, SUBROUTINE rachus.eso.'
                  LOGERR = .FALSE.
               ENDIF
            ENDDO
         ENDIF
      ENDIF
C
      Z=Z0
      USTAR=Z*UTILG+(1.0D0-Z)*UTILD
      PSTARG=PG*(DUTILD*(1.0D0-Z)/AG/COEFFG)**(GAMMAG*COEFFG)
      PSTARD=PD*(DUTILD*Z/AD/COEFFD)**(GAMMAD*COEFFD)
C
C**** N.B. On peut verifier aussi que pstarg = pstard
C
      PSTAR = 0.5D0*(PSTARG+PSTARD)
      ZERO0 = 1.D-6 * PSTAR * 10.0D0
      IF(ABS(PSTARG-PSTARD) .GT. ZERO0)THEN
         MESERR = 'HUS, SUBROUTINE rachus.eso.             '
         LOGAN = .TRUE.
      ENDIF
C
      RETURN
      END