Sources Esope | Cast3M

fimaxi
C FIMAXI    SOURCE    CHAT      06/08/24    21:35:37     5529
      SUBROUTINE FIMAXI
C************************************************************************
C
C PROJET            :  CASTEM 2000
C
C NOM               :  FIMAXI
C
C DESCRIPTION       :  Subroutine appellée par FIMPVF
C
C                      Modelisation 2D axi du trem de pression
C
C                      Calcul du flux/residu
C
C LANGAGE           :  FORTRAN 77 + ESOPE 2000 (avec estensions CISI)
C
C AUTEUR            :  A. BECCANTINI, DEN/DM2S/SFME/LTMF
C
C************************************************************************
C
C*** SYNTAXE
C
C  Discrétisation en VF "cell-centered" des équations d'Euler pour
C  un gaz parfait polytropique, axi
C  Inconnues: densités, quantité de mouvement, énergie totale par
C  unité de volumes (variables conservatives)
C
C  First order
C
C  RESU    = 'FIMP' 'VF' 'AXI'
C            'RESI' MODE LMOTC PN GRADP LIMP ;
C
C  MODE    : MODELE 'EULER'
C
C  LMOTC   : LISTMOTS, noms des variables conservatives
C
C  PN      : pression  (SPG = 'CENTRE', une seule
C            composante, 'SCAL')
C
C  GRADP   : gradient  (SPG = 'CENTRE', 2 composantes,
C            'PX', 'PY')
C
C  LIMP    : limiteur  (SPG = 'CENTRE', 1 composante,
C            'P1')
C
C SORTIES
C
C  RESU  : residu
C
C
C************************************************************************
C
C HISTORIQUE (Anomalies et modifications éventuelles)
C
C Created the 24/02/04
C
C
C************************************************************************
      IMPLICIT INTEGER(I-N)
 
-INC PPARAM
-INC CCOPTIO
-INC SMLMOTS
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, IREFOR, ISAFOR
C
      INTEGER NBOPT, IMET, IRET, MMODEL, ICOND, IDOMA, ICEN
     &     , IX2D, IY2D, ILIINC, IPN, IGPN, ILGPN, IRES, NBCOMP
     &     , JGN, JGM, INEFMD, IS2D, IVOL
C
      PARAMETER (NBOPT=2)
      CHARACTER*8 LOPT(NBOPT), TYPI
      CHARACTER*4 MOT1
C
      DATA LOPT/'RESI    ','JACOCONS'/
C
      CALL LIRMOT(LOPT,NBOPT,IMET,1)
      IF(IERR.NE.0)GOTO 9999
      IF(IFOMOD .NE. 0)THEN
C
C******* Message d'erreur standard
C        251 2
C        Tentative d'utilisation d'une option non implémentée
C
         CALL ERREUR(251)
         GOTO 9999
      ENDIF
C
C**** IMET = 1 -> residuu
C     IMET = 2 -> jacobienne
C
      IF(IMET .NE. 1)THEN
C
C******* Message d'erreur standard
C        251 2
C        Tentative d'utilisation d'une option non implémentée
C
         CALL ERREUR(251)
         GOTO 9999
      ENDIF
C
C**** Table domaine
C
      ICOND=1
      CALL LIROBJ('MMODEL',MMODEL,ICOND,IRET)
      IF(IERR.NE.0)GOTO 9999
      CALL LEKMOD(MMODEL,IDOMA,INEFMD)
      IF(IERR.NE.0)GOTO 9999
C
C**** Lecture du MELEME SPG des points CENTRE et
C     des centres 2D
C
      CALL LEKTAB(IDOMA,'CENTRE',ICEN)
      IF(IERR .NE. 0) GO TO 9999
      TYPI='CHPOINT '
      CALL ACMO(IDOMA,'XCEN2D',TYPI,IX2D)
      IF(IERR .NE. 0) GO TO 9999
      CALL ACMO(IDOMA,'YCEN2D',TYPI,IY2D)
      IF(IERR .NE. 0) GO TO 9999
      CALL ACMO(IDOMA,'XXSUR2D',TYPI,IS2D)
      IF(IERR .NE. 0) GO TO 9999
      CALL ACMO(IDOMA,'XXVOLUM',TYPI,IVOL)
      IF(IERR .NE. 0) GO TO 9999
C
C**** Noms de variables conservatives
C
      CALL LIROBJ('LISTMOTS',ILIINC,1,IRET)
      IF(IERR .NE. 0) GOTO 9999
      MLMOTS = ILIINC
      SEGACT MLMOTS
      NBCOMP = MLMOTS.MOTS(/2)
      IF(NBCOMP .NE. 4)THEN
         MOTERR(1:40) = 'LISTINCO = ???'
         WRITE(IOIMP,*) MOTERR
C
C******* Message d'erreur standard
C        21 2
C        Données incompatibles
C
         CALL ERREUR(21)
         GOTO 9999
      ELSE
         MOT1=MLMOTS.MOTS(2)
      ENDIF
      SEGDES MLMOTS
C
C**** Lecture de PN
C
      CALL LIROBJ('CHPOINT ',IPN,1,IRET)
      IF(IERR .NE. 0) GOTO 9999
C
C**** Control du CHPOINT
C
      JGN=4
      JGM=1
      SEGINI MLMOT1
      MLMOT1.MOTS(1)='SCAL'
      CALL QUEPO1(IPN, ICEN, MLMOT1)
      IF (IERR .NE. 0) GOTO 9999
      SEGDES MLMOT1
C
C**** Lecture de GPN
C
      CALL LIROBJ('CHPOINT ',IGPN,1,IRET)
      IF(IERR .NE. 0) GOTO 9999
C
C**** Control du CHPOINT
C
      JGN=4
      JGM=2
      SEGINI MLMOT2
      MLMOT2.MOTS(1)='P1DX'
      MLMOT2.MOTS(2)='P1DY'
      CALL QUEPO1(IGPN, ICEN, MLMOT2)
      IF (IERR .NE. 0) GOTO 9999
      SEGSUP MLMOT2
C
C**** Lecture de LGPN
C
      CALL LIROBJ('CHPOINT ',ILGPN,1,IRET)
      IF(IERR .NE. 0) GOTO 9999
C
C**** Control du CHPOINT
C
      SEGACT MLMOT1*MOD
      MLMOT1.MOTS(1)='P1  '
      CALL QUEPO1(ILGPN, ICEN, MLMOT1)
      IF (IERR .NE. 0) GOTO 9999
      SEGDES MLMOT1
C
C**** Creation of RESI
C
      SEGACT MLMOT1*MOD
      TYPI='CENTRE  '
      MLMOT1.MOTS(1)=MOT1
      CALL KRCHP1(TYPI,ICEN,IRES,MLMOT1)
      IF(IERR.NE.0) GOTO 9999
C
      SEGSUP MLMOT1
C
C**** Computation of the residual
C
      CALL FIMAX2(ICEN,IX2D,IY2D,IS2D,IVOL,IPN,IGPN,ILGPN,IRES)
      IF(IERR.NE.0) GOTO 9999
C
      IF(IRES .NE. 0) CALL ECROBJ('CHPOINT',IRES)
C
 9999 CONTINUE
      RETURN
      END