ckon
C CKON SOURCE CB215821 25/04/23 21:15:04 12247
C************************************************************************
C
C PROJET : CASTEM 2000
C
C NOM : CKON
C
C DESCRIPTION : Subroutine appellée par KONV
C
C Modelisation 2D/3D des equations d'Euler
C
C Calcul de flux aux interfaces
C
C LANGUAGE : FORTRAN 77 + ESOPE 2000 (avec estensions CISI)
C
C AUTEUR : A. BECCANTINI, DRN/DMT/SEMT/TTMF
C
C************************************************************************
C
C
C APPELES (E/S) : ACMO, ERREUR, ACME, ACMM, LEKTAB, CRTABL, ECMM,
C ECMO, ECMF
C
C
C APPELES (Calcul) : CKON1 (2D, gaz "calorically perfect")
C CKON2 (3D, gaz "calorically perfect")
C CKON3 (2D, gaz "thermally perfect")
C CKON4 (3D, gaz "thermally perfect")
C
C************************************************************************
C
C*** ENTREE
C
C Phrase d'appel (GIBIANE) :
C
C KONV TAB ;
C
C (NB: KIZX qui appairesse dans CKON(KIZX) est le pointeur de la
C table TAB)
C
C La table de sous type KIZX a été généré par EQEX et
C s'appelle RV.*KONV; elle contient differents arguments:
C
C 1) la table RV, généré par EQEX:
C
C KIZX . 'EQEX'
C
C 2) la table des options
C
C KIZX . 'KOPT'
C
C 3) la table domaine de KONV,
C
C KIZX . 'NOMZONE'
C KIZX . 'DOMZ '
C
C 4) tous les inconnues du probleme global
C
C KIZX . 'EQEX' . 'INCO'
C
C 5) la methode de calcul
C
C KIZX . 'KOPT' . 'IDCEN'
C
C 6) mono-espece, multi-especes, multi-especes "thermally perfect"
C
C KIZX . 'KOPT' . 'IDEUL'
C
C
C 7) le variables primales de KONV,
C i.e. les arguments de l'operateur KONV:
C
C KIZX . 'ARG1 '
C
C KIZX . 'ARG2 '
C
C ...
C
C
C 8) la liste des variables duales, i.e. les inconnues traites par
C KONV:
C
C KIZX . 'LISTINCO'
C
C
C**** SORTIE
C
C 1) les Flux aux faces, sont conservés dans la table
C
C KIZX . 'EQEX' . 'KIZG'
C
C 2) la table PASDETPS (***A CHANGER***)
C
C
C***********************************************************************
C
C************************************************************************
C
C HISTORIQUE (Anomalies et modifications éventuelles)
C
C HISTORIQUE :
C
C************************************************************************
C
IMPLICIT INTEGER(I-N)
INTEGER KIZX, IEQEX, IKOPT, IDOMA, INCO
& , IND, INDMET, INDEUL
& , NBRINC
& , NORD, NORDP1, IROF, IVITF, IPF, IGAMF
& , IFRMAF
& , LINCO
& , MELEMC, MELEMF, MELEFE
& , ICHPSU, ICHPDI
& , KIZG, IZG1, IZG2, IZG3, IZG4, IZG5
& , NLCEMI
& , MTABT
& , IRET, IENT, I1, I2, IESP, JGM, JGN
& , N, NAT, NC, NSOUPO, NCELL
C
REAL*8 DT, DIAMEL, XVAL
CHARACTER*(8) TYPE,NOMZ,MOTLU
CHARACTER*(8) ARG
CHARACTER*(40) MESERR
CHARACTER*(4) NOMTOT(2)
LOGICAL LOGME, LOGNC, LOGAN, XLOGI, LOGSCA
C
C**** Variables en ACCTAB
C
INTEGER IVALI, IRETI,IVALR, IRETR, MMODEL, INEFMD
REAL*8 XVALI, XVALR
LOGICAL LOGII, LOGIR
CHARACTER*(8) MTYPI, MTYPR, CHARR
C
C**** Segment des proprietes du gaz
C
SEGMENT PROPHY
REAL*8 ACV(NORDP1,NESP+1), R(NESP+1), H0K(NESP+1)
& ,ACVTOG(NORDP1), ACVTOD(NORDP1)
ENDSEGMENT
C
C**** Les Includes.
C
-INC PPARAM
-INC CCOPTIO
-INC SMCHPOI
-INC SMCOORD
-INC SMLMOTS
POINTEUR MLMOEU.MLMOTS, MLMOSC.MLMOTS
-INC SMLREEL
-INC SMELEME
C
C**** Initialisation des variables pour la gestion des erreurs.
C
LOGNC = .FALSE.
LOGAN = .FALSE.
MESERR = ' '
C
C**** Lecture de KIZX . 'EQEX'. (C'est le pointeur de la table RV)
C
IEQEX = 0
TYPE = 'TABLE '
IF(IERR .NE. 0) GOTO 9999
IF(TYPE .NE. 'TABLE ')THEN
MOTERR(1:40) = 'EULER, subroutine ckon.eso, EQEX = ? '
C
C******* Message d'erreur standard
C -301 0 %m1:40
C
C
C******* Message d'erreur standard
C 21 2
C Données incompatibles
C
GO TO 9999
ENDIF
C
C**** Lecture de KIZX . 'KOPT' (les optiones de KONV)
C
IKOPT = 0
TYPE = 'TABLE '
IF(IERR .NE. 0) GOTO 9999
IF(TYPE .NE. 'TABLE ')THEN
MOTERR(1:40) = 'EULER, subroutine ckon.eso, EQEX = ? '
C
C******* Message d'erreur standard
C -301 0 %m1:40
C
C
C On EQEX on a pas controlles qu'il n'y a pas KOPT
C
C******* Message d'erreur standard
C 5 3
C Erreur anormale.contactez votre support
C
GO TO 9999
ENDIF
C
C**** Lecture de KIZX . 'NOMZONE' (le domaine de KONV: le nom)
C
IF(IERR .NE. 0)GOTO 9999
C
C**** Lecture de KIZX . 'DOMZ ' (le domaine de KONV: le pointeur)
C
IDOMA = 0
TYPE = ' '
IF(IERR .NE. 0) GOTO 9999
IF(TYPE .NE. 'MMODEL ')THEN
MOTERR(1:40) = 'EULER, subroutine ckon.eso, ZONE = ? '
C
C******* Message d'erreur standard
C -301 0 %m1:40
C
C
C******* Message d'erreur standard
C 5 3
C Erreur anormale.contactez votre support
C
GO TO 9999
ELSE
ENDIF
C
C**** Lecture de KIZX . 'EQEX' . 'INCO'.
C Le pointeur de la table qui contient toutes les inconnues du
C probleme
C
TYPE = 'TABLE '
IF(IERR .NE. 0) GOTO 9999
IF(TYPE .NE. 'TABLE ')THEN
MOTERR(1:40) = 'EULER, subroutine ckon.eso, INCO = ? '
C
C******* Message d'erreur standard
C -301 0 %m1:40
C
C
C******* Message d'erreur standard
C 21 2
C Données incompatibles
C
GO TO 9999
ENDIF
C
C
C**** Model de gaz:
C EULER mono-espece "calorically perfect" (IDEUL = 1)
C EULER multi-espece "calorically perfect" (IDEUL = 2)
C EULER multi-espece "thermally perfect" (IDEUL = 3)
C
IF(IERR .NE. 0) GOTO 9999
IF((INDEUL .LT. 1) .OR. (INDEUL .GT. 3))THEN
MOTERR(1:40) = 'EULER, subroutine ckon.eso, IDEUL = ? '
C
C******** Message d'erreur standard
C -301 0 %m1:40
C
C
C******* Message d'erreur standard
C 5 3
C Erreur anormale.contactez votre support
C
GOTO 9999
ENDIF
IF(INDEUL .LE. 2)THEN
C
C*******************************************************************
C******************* GAZ CALORICALLY PERFECT ***********************
C*******************************************************************
C
IF(INDEUL .EQ.1)THEN
LOGME = .FALSE.
ELSE
LOGME = .TRUE.
ENDIF
C
C******* Lecture des options de KONV dans KIZX . 'KOPT'
C
C******* Metode utilisée
C
IF(IERR .NE. 0) GOTO 9999
IF(IND .EQ. 9)THEN
C
C********** GODUNOV
C
INDMET = 1
ELSEIF(IND .EQ. 10)THEN
C
C********** Van Leer FVS
C
INDMET = 2
ELSEIF(IND .EQ. 11)THEN
C
C********** Van Leer-HANEL FVS
C
INDMET = 3
ELSEIF(IND .EQ. 12)THEN
C
C********** HUS (Van Leer FVS + Osher FDS)
C
INDMET = 4
ELSEIF(IND .EQ. 13)THEN
C
C********** HUS (Van Leer-HANEL FVS + Osher FDS)
C
INDMET = 5
ELSEIF(IND .EQ. 14)THEN
C
C********** AUSM
C
C INDMET = 6
C ELSE
C
C********** Message d'erreur standard
C 251 2
C Tentative d'utilisation d'une option non implémentée
C
ENDIF
C
C******* Lecture des arguments de KONV KIZX . 'ARG*'
C
C Lecture du MCHAML 'FACEL' contenant la masse volumique.
C
C D'abord on va lire son nom in KIZX . 'ARG1 ' -> MOTLU
C
MOTLU=' '
IF(IERR.NE.0) GOTO 9999
C
C******* On va lire le pointeur du MCHAML
C
TYPE='MCHAML '
IF(IERR.NE.0) GOTO 9999
IF(TYPE .NE. 'MCHAML ')THEN
C
C********** Message d'erreur standard
C 37 2
C On ne trouve pas d'objet de type %m1:8
C
MOTERR(1:8) = 'MCHAML '
GOTO 9999
ENDIF
C
C******* Lecture du MCHAML 'FACEL' vitesse
C
MOTLU=' '
IF(IERR.NE.0)GOTO 9999
C
TYPE='MCHAML '
IF(IERR .NE. 0) GOTO 9999
IF(TYPE .NE. 'MCHAML ')THEN
C
C********** Message d'erreur standard
C 37 2
C On ne trouve pas d'objet de type %m1:8
C
MOTERR(1:8) = 'MCHAML '
GOTO 9999
ENDIF
C
C******** Lecture du MCHAML 'FACEL' contenant la pression
C
MOTLU=' '
IF(IERR .NE. 0) GOTO 9999
C
TYPE='MCHAML '
IF(IERR .NE. 0) GOTO 9999
IF(TYPE .NE. 'MCHAML ')THEN
C
C********** Message d'erreur standard
C 37 2
C On ne trouve pas d'objet de type %m1:8
C
MOTERR(1:8) = 'MCHAML '
GOTO 9999
ENDIF
C
C******* Lecture du MCHAML 'FACEL' contenant les gamma
C
MOTLU=' '
IF(IERR .NE. 0) GOTO 9999
C
TYPE='MCHAML '
IF(IERR .NE. 0) GOTO 9999
IF(TYPE .NE. 'MCHAML ')THEN
C
C********** Message d'erreur standard
C 37 2
C On ne trouve pas d'objet de type %m1:8
C
MOTERR(1:8) = 'MCHAML '
GOTO 9999
ENDIF
C
C******* Si LOGME -> MULTIESPECES
C
IF(LOGME)THEN
C
C********** Lecture du MCHAML 'FACEL' contenant les fractiones massiques
C
MOTLU=' '
IF(IERR .NE. 0) GOTO 9999
C
TYPE='MCHAML '
IF(IERR .NE. 0) GOTO 9999
IF(TYPE .NE. 'MCHAML ')THEN
C
C********** Message d'erreur standard
C 37 2
C On ne trouve pas d'objet de type %m1:8
C
MOTERR(1:8) = 'MCHAML '
GOTO 9999
ENDIF
C
C********** Lecture de la table qui contient le proprieté du gaz
C
MOTLU=' '
IF(IERR .NE. 0) GOTO 9999
C
TYPE='TABLE '
IF(IERR .NE. 0) GOTO 9999
IF(TYPE .NE. 'TABLE ')THEN
C
C************* Message d'erreur standard
C 37 2
C On ne trouve pas d'objet de type %m1:8
C
MOTERR(1:8) = 'TABLE '
GOTO 9999
ENDIF
ENDIF
C
C******* Lecture de Nom des Inconnues de KONV (KIZX . 'LISTINCO')
C
TYPE='LISTMOTS'
MLMOT1 = LINCO
IF(IERR.NE.0)GOTO 9999
SEGACT MLMOT1
C
C******* Verification du Nombre d'inconnues.
C
C Eulero mono-especie -> NBRINC = 3
C Eulero multi-especies -> NBRINC = 4
C
IF(LOGME)THEN
IF(NBRINC .NE. 4)THEN
C
C************* Message d'erreur standard
C -301 0 %m1:40
C
MOTERR(1:40) = 'EULERMS: LISTINCO = ? '
C
C************* Message d'erreur standard
C 21 2 Données incompatibles
C
GO TO 9999
ENDIF
ELSEIF(NBRINC .NE. 3)THEN
C
C********** Message d'erreur standard
C -301 0 %m1:40
C
MOTERR(1:40) = 'EULER: LISTINCO = ? '
C
C********** Message d'erreur standard
C 21 2 Données incompatibles
C
GO TO 9999
ENDIF
C
C
C******* Table DOMAINE en IDOMA (pointeur de la zone de KONV)
C
C
C******* Lecture du MELEME SPG des points CENTRE.
C
C
C CALL LEKTAB(IDOMA,'CENTRE',MELEMC)
C
C******* Probleme du LEKTAB: si IDOMA.'CENTRE' n'existe pas,
C il crèe IDOMA.'CENTRE' sans recrèer 'FACEL'
C -> la correspondance global des noeuds saut!
C
C On peut utilizer ACCTAB ou ACMO
C
TYPE = 'MAILLAGE'
IF(IERR .NE. 0) GOTO 9999
IF(TYPE .NE. 'MAILLAGE')THEN
MOTERR(1:8) = NOMZ
MOTERR(9:40) = ' . CENTRE = ? '
C
C********** Message d'erreur standard
C -301 0 %m1:40
C
C
C********** Message d'erreur standard
C 21 2
C Données incompatibles
C
GO TO 9999
ENDIF
C
C******* Lecture du MELEME 'FACE' SPG des points FACE
C
IF(IERR .NE. 0) GOTO 9999
IF(TYPE .NE. 'MAILLAGE')THEN
MOTERR(1:8) = NOMZ
MOTERR(9:40) = ' . FACE = ? '
C
C********** Message d'erreur standard
C -301 0 %m1:40
C
C
C********** Message d'erreur standard
C 21 2
C Données incompatibles
C
GO TO 9999
ENDIF
C
C******* Lecture du MELEME 'FACEL' de connect. FACE -> CENTRE
C
IF(IERR .NE. 0) GOTO 9999
IF(TYPE .NE. 'MAILLAGE')THEN
MOTERR(1:8) = NOMZ
MOTERR(9:40) = ' . FACEL = ? '
C
C******* Message d'erreur standard
C -301 0 %m1:40
C
C
C******* Message d'erreur standard
C 21 2
C Données incompatibles
C
GO TO 9999
ENDIF
C
C**** Lecture du CHPOINT contenant les surfaces des faces.
C
IF(IERR .NE. 0) GOTO 9999
C
C**** Lecture du CHPOINT contenant les diametres minimums.
C
IF(IERR .NE. 0) GOTO 9999
C
C
C**** Lecture de la TABLE contenant les FLUX aux interfaces,
C i.e. KIZX . 'EQEX' . 'KIZG'
C
C N.B. On recuper le pointeur des flux relatives aux
C inconnues de KONV.
C
TYPE= ' '
IF(IERR .NE. 0) GOTO 9999
IF(TYPE .NE. 'TABLE ')THEN
ENDIF
C
C**** Creation des CHPOINTs increment IZG1-2-3-4 pour les FLUX
C ou extraction des leurs pointeurs
C
C
C**** La masse volumique
C
C
TYPE=' '
IF(IERR .NE. 0) GOTO 9999
IF(TYPE .NE. 'CHPOINT ')THEN
TYPE = 'FACE'
IF(IERR .NE. 0)GOTO 9999
C
C******* Stokage du pointeur dans KIZG
C
ELSE
NOMTOT(1) = ' '
IF(IERR .NE. 0)GOTO 9999
ENDIF
C
C**** Les debits
C
TYPE=' '
IF(IERR .NE. 0) GOTO 9999
IF(TYPE .NE. 'CHPOINT ')THEN
TYPE='FACE'
NBCOMP = IDIM
IF(IERR .NE. 0) GOTO 9999
C
C******* Stokage du pointeur dans KIZG
C
ELSE
NBCOMP = IDIM
NOMTOT(1) = ' '
IF(IERR .NE. 0)GOTO 9999
ENDIF
C
C**** L'energie totale volumique
C
TYPE=' '
IF(IERR .NE. 0) GOTO 9999
IF(TYPE .NE. 'CHPOINT ')THEN
TYPE='FACE'
IF(IERR .NE. 0) GOTO 9999
C
C******* Stokage du pointeur dans KIZG
C
ELSE
NOMTOT(1) = ' '
IF(IERR .NE. 0)GOTO 9999
ENDIF
C
C**** Les Masses Volumiques
C
IF(LOGME)THEN
C
C******* D'abord on extrait de la table de pointeur IPGAZ
C la liste des especes splittes dans les equations
C d'Euler
C
TYPE=' '
IF(IERR .NE. 0) GOTO 9999
IF(TYPE .NE. 'LISTMOTS')THEN
C
C********** Message d'erreur standard
C -301 0 %m1:40
C
MOTERR(1:40) = 'KONV, ARG6 . ESPEULE = ??? '
C
C********** Message d'erreur standard
C 21 2
C Données incompatibles
C
GOTO 9999
ENDIF
C
SEGACT MLMOT2
C
TYPE=' '
IF(IERR .NE. 0) GOTO 9999
IF(TYPE .NE. 'CHPOINT ')THEN
NBCOMP = NESP
TYPE='FACE '
C
C********** On cree le chpoint FACE
C
IPT1 = MELEMF
SEGACT IPT1
N=IPT1.NUM(/2)
SEGDES IPT1
NSOUPO=1
NAT=1
NC = NESP
SEGINI, MCHPOI,MSOUPO,MPOVAL
MCHPOI.JATTRI(1)=2
MCHPOI.IFOPOI=IFOUR
MCHPOI.MTYPOI=TYPE
MCHPOI.MOCHDE(1:30)=' '
MCHPOI.MOCHDE(31:60)=' '
MCHPOI.MOCHDE(61:72)=' '
MCHPOI.IPCHP(1)=MSOUPO
SEGDES MCHPOI
MSOUPO.IGEOC=MELEMF
MSOUPO.IPOVAL=MPOVAL
DO I1 = 1, NC
ENDDO
SEGDES, MSOUPO,MPOVAL
IZG4 = MCHPOI
C
C********** Stokage du pointeur dans KIZG
C
ELSE
NBCOMP = NESP
NOMTOT(1) = ' '
IF(IERR .NE. 0)GOTO 9999
ENDIF
SEGDES MLMOT2
ENDIF
C
C**** Calcul des flux et du pas du temps.
C
IF( IDIM .EQ. 2)THEN
& IROF,IVITF,IPF,IGAMF,IFRMAF,
& ICHPSU,ICHPDI,
& MELEMC,MELEMF,MELEFE,
& IZG1,IZG2,IZG3,IZG4,DT,DIAMEL,NLCEMI,
& LOGNC,LOGAN,MESERR)
ELSE
& IROF,IVITF,IPF,IGAMF,IFRMAF,
& ICHPSU,ICHPDI,
& MELEMC,MELEMF,MELEFE,
& IZG1,IZG2,IZG3,IZG4,DT,DIAMEL,NLCEMI,
& LOGNC,LOGAN,MESERR)
ENDIF
C
IF(LOGAN)THEN
C
C******* Anomalie detectée
C
C
C******* Message d'erreur standard
C -301 0
C %m1:40
C
MOTERR(1:40) = MESERR(1:40)
C
C******* Message d'erreur standard
C 5 3
C Erreur anormale.contactez votre support
C
GOTO 9999
ENDIF
IF(LOGNC)THEN
C
C******* Message d'erreur standard
C -301 0
C %m1:40
C
MOTERR(1:40) = MESERR(1:40)
C
C******* Message d'erreur standard
C 460 2
C Pas de convergence dans les itérations internes
C
GOTO 9999
ENDIF
C
C**** Ecriture des RESULTATS
C
TYPE = 'TABLE '
IF(IERR .NE. 0) GOTO 9999
IF(TYPE .NE. 'TABLE ')THEN
MOTERR(1:40) = 'EULER, subroutine ckon.eso, PASDETPS = ?'
C
C******* Message d'erreur standard
C -301 0 %m1:40
C
C
C******* Message d'erreur standard
C 5 3
C Erreur anormale.contactez votre support
C
GO TO 9999
ENDIF
C
C******* On remplie la table d'indice PASDETPS
C
C
C**** Ecriture des CHPOINTs increments dans la table KIZG
C déjà faite
C
SEGDES MLMOT1
C
ELSE
C*******************************************************************
C*******************************************************************
C******************* GAZ THERMALLY PERFECT *************************
C*******************************************************************
C*******************************************************************
C
C*****************************
C******* Metode utilisée *****
C*****************************
C
C******* Metode utilisée
C
IF(IERR .NE. 0) GOTO 9999
C
C IND METHODE (voir EQEX)
C
C 9 GODUNOV
C 10 VANLEER (Van Leer FVS)
C 11 VLH (Van Leer-HANEL FVS)
C 12 HUSVL (Van Leer FVS + Osher FDS))
C 13 HUSVLH (Van Leer-HANEL FVS + Osher FDS)
C 14 AUSM (AUSM+, de Liou)
C 15 CG (Colella-Glaz)
C Pour l'instant van Leer - Hanel, Colella-Glaz
C
IF(IND .EQ. 11)THEN
INDMET = 1
ELSEIF(IND .EQ. 15)THEN
INDMET = 2
ELSE
C
C********** Message d'erreur standard
C 251 2
C Tentative d'utilisation d'une option non implémentée
C
ENDIF
C
C********************************************************
C******* Lecture des arguments de KONV KIZX . 'ARG*'*****
C********************************************************
C
C
C**** Lecture de la table qui contient le proprieté du gaz
C Cette table est controlle par l'operateur PRIM
C
MOTLU=' '
IF(IERR .NE. 0) GOTO 9999
C
TYPE='TABLE '
IF(IERR .NE. 0) GOTO 9999
IF(TYPE .NE. 'TABLE ')THEN
C
C******* Message d'erreur standard
C 37 2
C On ne trouve pas d'objet de type %m1:8
C
MOTERR(1:8) = 'TABLE '
GOTO 9999
ENDIF
C
C******* Degree des polynoms cv(T)
C
MTYPI = 'MOT '
MTYPR = ' '
& MTYPR,NORD,XVALR,CHARR,LOGIR,IRETR)
IF(MTYPR .NE. 'ENTIER ')THEN
C
C******* Message d'erreur standard
C -301 0 %m1:40
C
MOTERR(1:40) = 'ARG1 . NORD = ??? '
C
C******* Message d'erreur standard
C 21 2
C Données incompatibles
C
GOTO 9999
ENDIF
NORDP1 = NORD + 1
C
C******* Nom de l'espece qui n'est pas dans les equations d'Euler
C
MTYPI = 'MOT '
MTYPR = ' '
& MTYPR,IVALR,XVALR,CHARR,LOGIR,IESP)
IF(MTYPR .NE. 'MOT ')THEN
C
C******* Message d'erreur standard
C -301 0 %m1:40
C
MOTERR(1:40) = 'ARG1 . ESPNEULE = ??? '
C
C******* Message d'erreur standard
C 21 2
C Données incompatibles
C
GOTO 9999
ENDIF
C
C**** Les especes qui sont dans les Equations d'Euler
C
MTYPR = ' '
IF(MTYPR .EQ. ' ')THEN
NESP = 0
IFRMAF = 0
JGN = LOCOMP
JGM = 1
SEGINI MLMOT2
LOGME = .FALSE.
ELSEIF(MTYPR .NE. 'LISTMOTS')THEN
C
C******* Message d'erreur standard
C -301 0 %m1:40
C
MOTERR(1:40) = 'ARG1 . ESPEULE = ??? '
C
C******* Message d'erreur standard
C 21 2
C Données incompatibles
C
GOTO 9999
ELSE
LOGME = .TRUE.
SEGACT MLMOEU
JGN = LOCOMP
JGM = NESP + 1
SEGINI MLMOT2
DO I1 = 1, NESP
ENDDO
ENDIF
C
C**** Les scalaires passifs
C
MTYPR = ' '
IF(MTYPR .EQ. ' ')THEN
LOGSCA = .FALSE.
NSCA = 0
ISCAF = 0
ELSEIF(MTYPR .NE. 'LISTMOTS')THEN
C
C******* Message d'erreur standard
C -301 0 %m1:40
C
MOTERR(1:40) = 'ARG1 . SCALPASS = ??? '
C
C******* Message d'erreur standard
C 21 2
C Données incompatibles
C
GOTO 9999
ELSE
LOGSCA = .TRUE.
SEGACT MLMOSC
ENDIF
C
C**** On rempli les segment PROPHY
C Ordre: IPGAZ . 'ESPEULE' + IPGAZ . 'ESPNEULE'
C On controlle aussi la compatibilite des
C donnes de la table
C
SEGINI PROPHY
C
C**** N.B. NOMTOT est un CHARACTER*(4)
C
DO I1 = 1, NESP+1
C
C******* CALL ACMF(...) ne marche pas parce que on a
C des blanches dans nos composantes
C
MTYPI = 'MOT '
MTYPR = ' '
& MTYPR,IVALR,XVALR,CHARR,LOGIR,IESP)
C
C******* En IESP a la table IPGAZ.NOMTOT(1)
C
IF((IERR .NE. 0) .OR. (MTYPR .NE. 'TABLE ')) THEN
C
C********** Message d'erreur standard
C -301 0 %m1:40
C
MOTERR = ' '
MOTERR(1:7) = 'ARG1 . '
MOTERR(8:11) = NOMTOT(1)
MOTERR(13:17) = '= ???'
C
C********** Message d'erreur standard
C 21 2
C Données incompatibles
C
GOTO 9999
ENDIF
C
C******* R
C
MTYPI = 'MOT '
MTYPR = ' '
& MTYPR,IVALR, XVALR ,CHARR,LOGIR,IRETR)
IF((IERR .NE. 0) .OR. (MTYPR .NE. 'FLOTTANT')) THEN
C
C********** Message d'erreur standard
C -301 0 %m1:40
C
MOTERR = ' '
MOTERR(1:7) = 'ARG1 . '
MOTERR(8:11) = NOMTOT(1)
MOTERR(13:23) = ' . R = ??? '
C
C********** Message d'erreur standard
C 21 2
C Données incompatibles
C
GOTO 9999
ENDIF
PROPHY.R(I1)=XVALR
C
C******* H0K
C
MTYPI = 'MOT '
MTYPR = ' '
& MTYPR,IVALR, XVALR ,CHARR,LOGIR,IRETR)
IF((IERR .NE. 0) .OR. (MTYPR .NE. 'FLOTTANT')) THEN
C
C********** Message d'erreur standard
C -301 0 %m1:40
C
MOTERR = ' '
MOTERR(1:7) = 'ARG1 . '
MOTERR(8:11) = NOMTOT(1)
MOTERR(13:25) = ' . H0K = ??? '
C
C********** Message d'erreur standard
C 21 2
C Données incompatibles
C
GOTO 9999
ENDIF
PROPHY.H0K(I1)=XVALR
C
C******* A
C
MTYPI = 'MOT '
MTYPR = ' '
& MTYPR,IVALR, XVALR ,CHARR,LOGIR,IRETR)
IF((IERR .NE. 0) .OR. (MTYPR .NE. 'LISTREEL')) THEN
C
C********** Message d'erreur standard
C -301 0 %m1:40
C
MOTERR = ' '
MOTERR(1:7) = 'ARG1 . '
MOTERR(8:11) = NOMTOT(1)
MOTERR(13:23) = ' . A = ??? '
C
C********** Message d'erreur standard
C 21 2
C Données incompatibles
C
GOTO 9999
ENDIF
MLREEL = IRETR
SEGACT MLREEL
C
C******* Dans le calcul, c'est plus utile ACV dans la forme
C ACV(,exponente,espece)
C
ENDDO
SEGDES MLREEL
ENDDO
SEGSUP MLMOT2
C
C**** La table IPGAZ donc a ete controllee et PROPHY est rempli
C
C
C**** Lecture du MCHAML 'FACEL' contenant la masse volumique.
C
C D'abord on va lire son nom in KIZX . 'ARG1 ' -> MOTLU
C
MOTLU=' '
IF(IERR.NE.0) GOTO 9999
C
C**** On va lire le pointeur du MCHAML
C
TYPE='MCHAML '
IF(IERR.NE.0) GOTO 9999
IF(TYPE .NE. 'MCHAML ')THEN
C
C******* Message d'erreur standard
C 37 2
C On ne trouve pas d'objet de type %m1:8
C
MOTERR(1:8) = 'MCHAML '
GOTO 9999
ENDIF
C
C**** Lecture du MCHAML 'FACEL' vitesse
C
MOTLU=' '
IF(IERR.NE.0)GOTO 9999
C
TYPE='MCHAML '
IF(IERR .NE. 0) GOTO 9999
IF(TYPE .NE. 'MCHAML ')THEN
C
C******* Message d'erreur standard
C 37 2
C On ne trouve pas d'objet de type %m1:8
C
MOTERR(1:8) = 'MCHAML '
GOTO 9999
ENDIF
C
C***** Lecture du MCHAML 'FACEL' contenant la temperature
C
MOTLU=' '
IF(IERR .NE. 0) GOTO 9999
C
TYPE='MCHAML '
IF(IERR .NE. 0) GOTO 9999
IF(TYPE .NE. 'MCHAML ')THEN
C
C******* Message d'erreur standard
C 37 2
C On ne trouve pas d'objet de type %m1:8
C
MOTERR(1:8) = 'MCHAML '
GOTO 9999
ENDIF
C
C
C**** Multi-especes (LOGME = .TRUE.)
C Scalaires à transporter (LOGSCA = .TRUE.)
C
C
IF(LOGME .AND. LOGSCA)THEN
C
C********** On controle si KIZX . 'ARG5' et KIZX . 'ARG6' existent
C
TYPE = ' '
MOTLU=' '
& TYPE,IENT,XVAL,MOTLU,XLOGI,IRET)
IF(TYPE .EQ. 'MOT')THEN
C
C************* Lecture du MCHAML 'FACEL' contenant les fractiones massiques
C
C
TYPE='MCHAML '
IF(IERR .NE. 0) GOTO 9999
IF(TYPE .NE. 'MCHAML ')THEN
C
C************* Message d'erreur standard
C 37 2
C On ne trouve pas d'objet de type %m1:8
C
MOTERR(1:8) = 'MCHAML '
GOTO 9999
ENDIF
ELSE
C
C********** Message d'erreur standard
C 21 2
C Données incompatibles
C
GO TO 9999
ENDIF
C
TYPE = ' '
MOTLU=' '
& TYPE,IENT,XVAL,MOTLU,XLOGI,IRET)
IF(TYPE .EQ. 'MOT')THEN
C
C************* Lecture du MCHAML 'FACEL' contenant les fractiones massiques
C
C
TYPE='MCHAML '
IF(IERR .NE. 0) GOTO 9999
IF(TYPE .NE. 'MCHAML ')THEN
C
C************* Message d'erreur standard
C 37 2
C On ne trouve pas d'objet de type %m1:8
C
MOTERR(1:8) = 'MCHAML '
GOTO 9999
ENDIF
ELSE
C
C********** Message d'erreur standard
C 21 2
C Données incompatibles
C
GO TO 9999
ENDIF
C
ELSEIF(LOGME)THEN
C
C********** On controle si KIZX . 'ARG5' existe
C
TYPE = ' '
MOTLU=' '
& TYPE,IENT,XVAL,MOTLU,XLOGI,IRET)
IF(TYPE .EQ. 'MOT')THEN
C
C************* Lecture du MCHAML 'FACEL' contenant les fractiones massiques
C
C
TYPE='MCHAML '
IF(IERR .NE. 0) GOTO 9999
IF(TYPE .NE. 'MCHAML ')THEN
C
C************* Message d'erreur standard
C 37 2
C On ne trouve pas d'objet de type %m1:8
C
MOTERR(1:8) = 'MCHAML '
GOTO 9999
ENDIF
ELSE
C
C********** Message d'erreur standard
C 21 2
C Données incompatibles
C
GO TO 9999
ENDIF
ELSEIF(LOGSCA)THEN
C
C********** On controle si KIZX . 'ARG5' existe
C
TYPE = ' '
MOTLU=' '
& TYPE,IENT,XVAL,MOTLU,XLOGI,IRET)
IF(TYPE .EQ. 'MOT')THEN
C
C************* Lecture du MCHAML 'FACEL' contenant les fractiones massiques
C
TYPE='MCHAML '
IF(IERR .NE. 0) GOTO 9999
IF(TYPE .NE. 'MCHAML ')THEN
C
C************* Message d'erreur standard
C 37 2
C On ne trouve pas d'objet de type %m1:8
C
MOTERR(1:8) = 'MCHAML '
GOTO 9999
ENDIF
ELSE
C
C********** Message d'erreur standard
C 21 2
C Données incompatibles
C
GO TO 9999
ENDIF
ENDIF
C
C******* Lecture de Nom des Inconnues de KONV (KIZX . 'LISTINCO')
C
TYPE='LISTMOTS'
MLMOT1 = LINCO
IF(IERR.NE.0)GOTO 9999
SEGACT MLMOT1
C
C******* Verification du Nombre d'inconnues.
C
C Eulero mono-espece (+ scalaires passifs) -> NBRINC = 3 (+1)
C Eulero multi-especies (+ scalaires passifs) -> NBRINC = 4 (+1)
C
NCELL = 3
IF(LOGME) NCELL = NCELL + 1
IF(LOGSCA) NCELL = NCELL + 1
IF(NBRINC .NE. NCELL)THEN
C
C********** Message d'erreur standard
C -301 0 %m1:40
C
MOTERR(1:40) ='EULERMST: LISTINCO = ? '
C
C*********** Message d'erreur standard
C 21 2 Données incompatibles
C
GO TO 9999
ENDIF
C
C******* Table DOMAINE en IDOMA (pointeur de la zone de KONV)
C
C
C******* Lecture du MELEME SPG des points CENTRE.
C
C
C CALL LEKTAB(IDOMA,'CENTRE',MELEMC)
C
C******* Probleme du LEKTAB: si IDOMA.'CENTRE' n'existe pas,
C il crèe IDOMA.'CENTRE' sans recrèer 'FACEL'
C -> la correspondance global des noeuds saut!
C
C On peut utilizer ACCTAB ou ACMO
C
TYPE = 'MAILLAGE'
IF(IERR .NE. 0) GOTO 9999
IF(TYPE .NE. 'MAILLAGE')THEN
MOTERR(1:8) = NOMZ
MOTERR(9:40) = ' . CENTRE = ? '
C
C********** Message d'erreur standard
C -301 0 %m1:40
C
C
C********** Message d'erreur standard
C 21 2
C Données incompatibles
C
GO TO 9999
ENDIF
C
C******* Lecture du MELEME 'FACE' SPG des points FACE
C
IF(IERR .NE. 0) GOTO 9999
IF(TYPE .NE. 'MAILLAGE')THEN
MOTERR(1:8) = NOMZ
MOTERR(9:40) = ' . FACE = ? '
C
C********** Message d'erreur standard
C -301 0 %m1:40
C
C
C********** Message d'erreur standard
C 21 2
C Données incompatibles
C
GO TO 9999
ENDIF
C
C******* Lecture du MELEME 'FACEL' de connect. FACE -> CENTRE
C
IF(IERR .NE. 0) GOTO 9999
IF(TYPE .NE. 'MAILLAGE')THEN
MOTERR(1:8) = NOMZ
MOTERR(9:40) = ' . FACEL = ? '
C
C******* Message d'erreur standard
C -301 0 %m1:40
C
C
C******* Message d'erreur standard
C 21 2
C Données incompatibles
C
GO TO 9999
ENDIF
C
C**** Lecture du CHPOINT contenant les surfaces des faces.
C
IF(IERR .NE. 0) GOTO 9999
C
C**** Lecture du CHPOINT contenant les diametres minimums.
C
IF(IERR .NE. 0) GOTO 9999
C
C
C**** Lecture de la TABLE contenant les FLUX aux interfaces,
C i.e. KIZX . 'EQEX' . 'KIZG'
C
C N.B. On recuper le pointeur des flux relatives aux
C inconnues de KONV.
C
TYPE= ' '
IF(IERR .NE. 0) GOTO 9999
IF(TYPE .NE. 'TABLE ')THEN
ENDIF
C
C**** Creation des CHPOINTs increment IZG1-2-3-4 pour les FLUX
C ou extraction des leurs pointeurs
C
C
C**** La masse volumique
C
C
TYPE=' '
IF(IERR .NE. 0) GOTO 9999
IF(TYPE .NE. 'CHPOINT ')THEN
TYPE = 'FACE'
IF(IERR .NE. 0)GOTO 9999
C
C******* Stokage du pointeur dans KIZG
C
ELSE
NOMTOT(1) = ' '
IF(IERR .NE. 0)GOTO 9999
ENDIF
C
C**** Les debits
C
TYPE=' '
IF(IERR .NE. 0) GOTO 9999
IF(TYPE .NE. 'CHPOINT ')THEN
TYPE='FACE'
NBCOMP = IDIM
IF(IERR .NE. 0) GOTO 9999
C
C******* Stokage du pointeur dans KIZG
C
ELSE
NBCOMP = IDIM
NOMTOT(1) = ' '
IF(IERR .NE. 0)GOTO 9999
ENDIF
C
C**** L'energie totale volumique
C
TYPE=' '
IF(IERR .NE. 0) GOTO 9999
IF(TYPE .NE. 'CHPOINT ')THEN
TYPE='FACE'
IF(IERR .NE. 0) GOTO 9999
C
C******* Stokage du pointeur dans KIZG
C
ELSE
NOMTOT(1) = ' '
IF(IERR .NE. 0)GOTO 9999
ENDIF
C
C**** Les Masses Volumiques et les (scalaires passifs * \rho)
C
IF(LOGME .AND. LOGSCA)THEN
C
C********** Masses volumiques
C
TYPE=' '
IF(IERR .NE. 0) GOTO 9999
IF(TYPE .NE. 'CHPOINT ')THEN
NBCOMP = NESP
TYPE='FACE '
C
C********** On cree le chpoint FACE
C
IPT1 = MELEMF
SEGACT IPT1
N=IPT1.NUM(/2)
SEGDES IPT1
NSOUPO=1
NAT=1
NC = NESP
SEGINI, MCHPOI,MSOUPO,MPOVAL
MCHPOI.JATTRI(1)=2
MCHPOI.IFOPOI=IFOUR
MCHPOI.MTYPOI=TYPE
MCHPOI.MOCHDE(1:30)=' '
MCHPOI.MOCHDE(31:60)=' '
MCHPOI.MOCHDE(61:72)=' '
MCHPOI.IPCHP(1)=MSOUPO
SEGDES MCHPOI
MSOUPO.IGEOC=MELEMF
MSOUPO.IPOVAL=MPOVAL
DO I1 = 1, NC
ENDDO
SEGDES, MSOUPO,MPOVAL
IZG4 = MCHPOI
C
C********** Stokage du pointeur dans KIZG
C
ELSE
NBCOMP = NESP
NOMTOT(1) = ' '
IF(IERR .NE. 0)GOTO 9999
ENDIF
C
C********** Les scalaires passifs
C
TYPE=' '
IF(IERR .NE. 0) GOTO 9999
IF(TYPE .NE. 'CHPOINT ')THEN
NBCOMP = NSCA
TYPE='FACE '
C
C********** On cree le chpoint FACE
C
IPT1 = MELEMF
SEGACT IPT1
N=IPT1.NUM(/2)
SEGDES IPT1
NSOUPO=1
NAT=1
NC = NSCA
SEGINI, MCHPOI,MSOUPO,MPOVAL
MCHPOI.JATTRI(1)=2
MCHPOI.IFOPOI=IFOUR
MCHPOI.MTYPOI=TYPE
MCHPOI.MOCHDE(1:30)=' '
MCHPOI.MOCHDE(31:60)=' '
MCHPOI.MOCHDE(61:72)=' '
MCHPOI.IPCHP(1)=MSOUPO
SEGDES MCHPOI
MSOUPO.IGEOC=MELEMF
MSOUPO.IPOVAL=MPOVAL
DO I1 = 1, NC
ENDDO
SEGDES, MSOUPO,MPOVAL
IZG5 = MCHPOI
C
C********** Stokage du pointeur dans KIZG
C
ELSE
NBCOMP = NSCA
NOMTOT(1) = ' '
IF(IERR .NE. 0)GOTO 9999
ENDIF
C
ELSEIF(LOGME)THEN
C
C********** Masses volumiques
C
TYPE=' '
IF(IERR .NE. 0) GOTO 9999
IF(TYPE .NE. 'CHPOINT ')THEN
NBCOMP = NESP
TYPE='FACE '
C
C********** On cree le chpoint FACE
C
IPT1 = MELEMF
SEGACT IPT1
N=IPT1.NUM(/2)
SEGDES IPT1
NSOUPO=1
NAT=1
NC = NESP
SEGINI, MCHPOI,MSOUPO,MPOVAL
MCHPOI.JATTRI(1)=2
MCHPOI.IFOPOI=IFOUR
MCHPOI.MTYPOI=TYPE
MCHPOI.MOCHDE(1:30)=' '
MCHPOI.MOCHDE(31:60)=' '
MCHPOI.MOCHDE(61:72)=' '
MCHPOI.IPCHP(1)=MSOUPO
SEGDES MCHPOI
MSOUPO.IGEOC=MELEMF
MSOUPO.IPOVAL=MPOVAL
DO I1 = 1, NC
ENDDO
SEGDES, MSOUPO,MPOVAL
IZG4 = MCHPOI
C
C********** Stokage du pointeur dans KIZG
C
ELSE
NBCOMP = NESP
NOMTOT(1) = ' '
IF(IERR .NE. 0)GOTO 9999
ENDIF
IZG5 = 0
ELSEIF(LOGSCA)THEN
C
C********** Masses volumiques
C
IZG4 = 0
TYPE=' '
IF(IERR .NE. 0) GOTO 9999
IF(TYPE .NE. 'CHPOINT ')THEN
NBCOMP = NSCA
TYPE='FACE '
C
C********** On cree le chpoint FACE
C
IPT1 = MELEMF
SEGACT IPT1
N=IPT1.NUM(/2)
SEGDES IPT1
NSOUPO=1
NAT=1
NC = NSCA
SEGINI, MCHPOI,MSOUPO,MPOVAL
MCHPOI.JATTRI(1)=2
MCHPOI.IFOPOI=IFOUR
MCHPOI.MTYPOI=TYPE
MCHPOI.MOCHDE(1:30)=' '
MCHPOI.MOCHDE(31:60)=' '
MCHPOI.MOCHDE(61:72)=' '
MCHPOI.IPCHP(1)=MSOUPO
SEGDES MCHPOI
MSOUPO.IGEOC=MELEMF
MSOUPO.IPOVAL=MPOVAL
DO I1 = 1, NC
ENDDO
SEGDES, MSOUPO,MPOVAL
IZG5 = MCHPOI
C
C********** Stokage du pointeur dans KIZG
C
ELSE
NBCOMP = NSCA
NOMTOT(1) = ' '
IF(IERR .NE. 0)GOTO 9999
ENDIF
ELSE
IZG4 = 0
IZG5 = 0
ENDIF
C
C**** Calcul des flux et du pas du temps.
C
IF( IDIM .EQ. 2)THEN
C
C
C***** 2D
C
& IROF,IVITF,IPF,IFRMAF,ISCAF,PROPHY,
& ICHPSU,ICHPDI,
& MELEMC,MELEMF,MELEFE,
& IZG1,IZG2,IZG3,IZG4,IZG5,DT,DIAMEL,NLCEMI,
& LOGNC,LOGAN,MESERR)
ELSE
C
C
C***** 3D
C
& IROF,IVITF,IPF,IFRMAF,ISCAF,PROPHY,
& ICHPSU,ICHPDI,
& MELEMC,MELEMF,MELEFE,
& IZG1,IZG2,IZG3,IZG4,IZG5,DT,DIAMEL,NLCEMI,
& LOGNC,LOGAN,MESERR)
ENDIF
C
IF(LOGAN)THEN
C
C******* Anomalie detectée
C
C
C******* Message d'erreur standard
C -301 0
C %m1:40
C
MOTERR(1:40) = MESERR(1:40)
C
C******* Message d'erreur standard
C 5 3
C Erreur anormale.contactez votre support
C
GOTO 9999
ENDIF
IF(LOGNC)THEN
C
C******* Message d'erreur standard
C -301 0
C %m1:40
C
MOTERR(1:40) = MESERR(1:40)
C
C******* Message d'erreur standard
C 460 2
C Pas de convergence dans les itérations internes
C
GOTO 9999
ENDIF
C
C**** Ecriture des RESULTATS
C
TYPE = 'TABLE '
IF(IERR .NE. 0) GOTO 9999
IF(TYPE .NE. 'TABLE ')THEN
MOTERR(1:40) = 'EULER, subroutine ckon.eso, PASDETPS = ?'
C
C******* Message d'erreur standard
C -301 0 %m1:40
C
C
C******* Message d'erreur standard
C 5 3
C Erreur anormale.contactez votre support
C
GO TO 9999
ENDIF
C
C******* On remplie la table d'indice PASDETPS
C
C
C**** Ecriture des CHPOINTs increments dans la table KIZG
C déjà faite
C
SEGDES MLMOT1
SEGSUP PROPHY
IF(LOGME) SEGDES MLMOEU
IF(LOGSCA) SEGDES MLMOSC
C
C
C
ENDIF
9999 CONTINUE
RETURN
END
					© Cast3M 2003 - Tous droits réservés.
					Mentions légales