Sources Esope | Cast3M

raccol
C RACCOL    SOURCE    CHAT      05/01/13    02:44:05     5004
      SUBROUTINE RACCOL(PVAL,UVAL,NORDP1,
     &                  RG,ACVTOG,RD,ACVTOD,
     &                  ROG,TG,ETHEG,UG,RTG,GAMG,CG,
     &                  ROD,TD,ETHED,UD,RTD,GAMD,CD,
     &                  ROGS,PGS,TGS,ETHEGS,UGS,DGS,GAMGS,
     &                  RODS,PDS,TDS,ETHEDS,UDS,DDS,GAMDS,
     &                  LOGNC)
C
C************************************************************************
C
C PROJET            :  CASTEM 2000
C
C NOM               :  RACCOL
C
C DESCRIPTION       :  voir aussi FCOLTE
C
C                      Calcul de l'intersection des conditions de
C                      Rankine-Hugoniot
C
C LANGAGE           :  FORTRAN 77
C
C AUTEUR            :  A. BECCANTINI DRN/DMT/SEMT/LTMF
C
C************************************************************************
C
C APPELES           :  FUNCOL, GRACOL
C
C************************************************************************
C
C**** Entrées:
C
C             PVAL,UVAL = pression, vitesse,  de  reference
C
C             NORDP1   = degree des polynoms cv + 1
C
C             RG, RD   = R du gaz a gauche et a droite
C
C             ACVTOG, ACVTOD  =  les sommes des coefficients des cv;
C                                ACVTOT(j) = \sum_{i=1,nesp} Y_i*ACV_{i,j}
C                                j = 1 , NORDP1
C
C             ROG, ROD        =  les densités
C
C             TG, TD          =  les temperatures
C
C             ETHERG, ETHERD  =  les energies thermiques
C
C             UG, UD          =  vitesses normales
C
C             RTG, RTD        =  RG * TG = PG / ROG, ...
C
C             GAMG, GAMD      =  les "gamma" du gaz (gauche et droite)
C
C             CG, CD          =  les vitesse du son
C
C**** Sorties:
C
C             Les etats intermediares, i.e.:
C
C             ROGS,PGS,TGS,ETHEGS,UGS,DGS,GAMGS = densite, pression,
C                temperature, energie termique, vitesse normale de
C                l'etat GS (Gauche Star), vitesse du choc gauche et gamma
C
C             RODS,PDS,TDS,ETHEDS,UDS,DDS,GAMDS = densite, pression,
C                temperature, energie termique, vitesse normale de
C                l'etat DS (Droite Star), vitesse du choc droite et gamma
C
C             LOGNC = si .TRUE. Newton ne converge pas
C
C************************************************************************
C
C HISTORIQUE (Anomalies et modifications éventuelles)
C
C HISTORIQUE :  Créé le 08.02.00
C
C************************************************************************
C
C N.B.: Toutes les variables sont DECLAREES
C
C
      IMPLICIT INTEGER(I-N)
      INTEGER NORDP1,IMAX,ITER,IZERMA,IZER
      REAL*8  ZERO,PVAL,UVAL
     &       ,RG,ACVTOG(*),RD,ACVTOD(*)
     &       ,ROG,TG,RTG,ETHEG,UG,GAMG,CG
     &       ,ROD,TD,RTD,ETHED,UD,UD1,GAMD,CD
     &       ,ROGS,PGS,TGS,ETHEGS,UGS
     &       ,RODS,PDS,TDS,ETHEDS,UDS
     &       ,RTGS,CVGS,DELSGS,UMXSOG,UPXSOG
     &       ,RC1G,AEQ1G,XSOLG,DUDTGS,DPDTGS
     &       ,RTDS,CVDS,DELSDS,UMXSOD,UPXSOD
     &       ,RC1D,AEQ1D,XSOLD,DUDTDS,DPDTDS
     &       ,DETJ,TGS1,TDS1,DGS,DDS,GAMGS,GAMDS
     &       ,TGZERO,TDZERO
      LOGICAL LOEQGS,LOEQDS,LOGNC,LOGDO
C
      PARAMETER(ZERO=1.0D-6,IMAX=20,IZERMA=6)
C
      TGZERO = TG
      TDZERO = TD
      LOGNC = .FALSE.
      ITER = 0
      IZER= 0
      UD1 = -1.0D0 * UD
      TGS = TG
      TDS = TD
C
C**** Calcul de l'etat UG*
C
      CALL FUNCOL(NORDP1,RG,ACVTOG,ROG,TG,RTG,ETHEG,UG,GAMG,CG,
     &           TGS,RTGS,CVGS,ROGS,PGS,ETHEGS,UGS,
     &           DELSGS,UMXSOG,UPXSOG,
     &           RC1G,AEQ1G,XSOLG,
     &           LOEQGS,DUDTGS,DPDTGS)
C
C**** Calcul de l'etat UD*
C
      CALL FUNCOL(NORDP1,RD,ACVTOD,ROD,TD,RTD,ETHED,UD1,GAMD,CD,
     &           TDS,RTDS,CVDS,RODS,PDS,ETHEDS,UDS,
     &           DELSDS,UMXSOD,UPXSOD,
     &           RC1D,AEQ1D,XSOLD,
     &           LOEQDS,DUDTDS,DPDTDS)
C
C***** Convergence
C
      LOGDO = (ABS(PGS - PDS)) .GT. (ZERO * PVAL) .OR.
     &        (ABS(UGS + UDS)) .GT. (ZERO * UVAL)
C
      DO WHILE(LOGDO)
         ITER = ITER + 1
         IF((IZER .GT. IZERMA) .OR. (ITER .GT. IMAX))THEN
            LOGDO = .FALSE.
            LOGNC = .TRUE.
         ELSE
C
C*********  Calcul de TGS1, TDS1
C
           IF(.NOT. LOEQGS)
     &        CALL GRACOL(RG,RTG,CVGS,AEQ1G,DELSGS,
     &               XSOLG,PGS,TGS,
     &               RC1G,UG,UGS,UPXSOG,UMXSOG,
     &               DUDTGS,DPDTGS)
            IF(.NOT. LOEQDS)THEN
               CALL GRACOL(RD,RTD,CVDS,AEQ1D,DELSDS,
     &               XSOLD,PDS,TDS,
     &               RC1D,UD1,UDS,UPXSOD,UMXSOD,
     &               DUDTDS,DPDTDS)
            ENDIF
C
C********** Calcul de TGS1, TDS1
C
            DETJ = (DPDTDS * DUDTGS) + (DPDTGS * DUDTDS)
            TGS1 = (DUDTDS * (PDS - PGS)) - (DPDTDS * (UDS + UGS))
            TGS1 = (TGS1 / DETJ) + TGS
            TDS1 = (DUDTGS * (PGS - PDS)) - (DPDTGS * (UDS + UGS))
            TDS1 = (TDS1 / DETJ) + TDS
            IF(TGS1 .LE. 0.0D0) THEN
               IZER = IZER + 1
               TGS = 1.0D-4 * TGZERO
               TGZERO = TGS
            ELSE
               TGS = TGS1
            ENDIF
            IF(TDS1 .LE. 0.0D0)THEN
               IZER = IZER + 1
               TDS = 1.0D-4 * TDZERO
               TDZERO = TDS
            ELSE
               TDS = TDS1
            ENDIF
C
C
C**** Calcul de l'etat UG*
C
            CALL FUNCOL(NORDP1,RG,ACVTOG,ROG,TG,RTG,ETHEG,UG,GAMG,CG,
     &           TGS,RTGS,CVGS,ROGS,PGS,ETHEGS,UGS,
     &           DELSGS,UMXSOG,UPXSOG,
     &           RC1G,AEQ1G,XSOLG,
     &           LOEQGS,DUDTGS,DPDTGS)
C
C**** Calcul de l'etat UD*
C
            CALL FUNCOL(NORDP1,RD,ACVTOD,ROD,TD,RTD,ETHED,UD1,GAMD,CD,
     &           TDS,RTDS,CVDS,RODS,PDS,ETHEDS,UDS,
     &           DELSDS,UMXSOD,UPXSOD,
     &           RC1D,AEQ1D,XSOLD,
     &           LOEQDS,DUDTDS,DPDTDS)
C
C***** Convergence
C
            LOGDO = (ABS(PGS - PDS)) .GT. (ZERO * PVAL) .OR.
     &              (ABS(UGS + UDS)) .GT. (ZERO * UVAL)
         ENDIF
      ENDDO
      UDS = -1.0D0 * UDS
      IF(LOEQGS)THEN
         DGS = UG - CG
      ELSE
         DGS = UG - SQRT(RC1G/UMXSOG/UPXSOG)
      ENDIF
      IF(LOEQDS)THEN
         DDS = UD + CD
      ELSE
         DDS = UD + SQRT(RC1D/UMXSOD/UPXSOD)
      ENDIF
      GAMGS = (CVGS+RG)/CVGS
      GAMDS = (CVDS+RD)/CVDS
      RETURN
      END