Télécharger konv15.eso

Retour à la liste

konv15
C KONV15    SOURCE    BECC      11/05/26    21:15:51     6981
         SUBROUTINE KONV15
C************************************************************************
C
C PROJET            :  CASTEM 2000
C
C NOM               :  KONV15
C
C DESCRIPTION       :  Subroutine appellée par KONV1
C
C                      Modelisation 2D/3D des equations d'Euler.
C                      Ghost Fluid Method for the poor.
C
C                      Calcul du residu / DELTAT
C
C LANGAGE           :  FORTRAN 77 + ESOPE 2000 (avec estensions CISI)
C
C AUTEUR            :  A. BECCANTINI, DEN/DM2S/SFME/LTMF
C
C************************************************************************
C
C APPELES (Calcul)  :  KGFM12 (2D, GFMP)
C
C************************************************************************
C
C*** SINTAXE
C
C  Discrétisation en VF "cell-centered" des équations d'Euler pour
C  un "stiffened" gas. Methode GFMP.
C
C  Inconnues: phi, densité, quantité de mouvement, énergie totale par
C  unité de volume (variables conservatives), densité et fractions
C  volumiques des constituants.
C
C
C  RCHPO1 RFLOT1 = 'KONV' 'VF' 'GFMP' MOT1 MOT2 MOD1
C                         TABG
C                         LMOT1  MCHAPH MCHAR MCHAV MCHAP MCHAY
C                         MCHAA MCHAY MCHPPH  LOG1 MAILLIM ;
C  ENTREES
C
C
C  MOT1   : objet de type MOT
C           Il vaut 'RESI' si on veut calculer le résidu
C
C  MOT2   : objet de type MOT
C           Il indique la méthode de décentrement:
C           'GODUNOV'
C
C  MOD1   : objet modele de type Euler
C
C  TABG   : objet de type TABLE
C           il contient les proprietes du gaz:
C
C LMOT1   : objet de type LISTMOTS
C           Noms de composantes du résultat (RCHPO1)
C           Il contient dans l'ordre suivant les noms de
*           phi, de la densités, de la vitesse, de l'énergie totale
*           par unité de volume, des densités des espèces, des
C           fractions volumiques.
C
C MCHAPH  : MCHAML contenant la function phi,
C           qui a comme SPG (support géométrique) l'indice 'FACEL' de la
C           table associée à MOD1 (une composante, 'SCAL')
C
C MCHAR   : MCHAML contenant la masse volumique,
C           même SPG que MCHAA1, une composante, 'SCAL'
C
C MCHAV   : MCHAML  contenant la vitesse et les cosinus
C           directeurs du repère locale (n,t) dans le repère
C           global (x,y), même SPG que MCHAA1,
C           (dans le cas 2D 6 composantes:
C           * 'UN' = vitesse normale  (SPG =('DOMA' MOD1 'FACEL'))
C           * 'UT' = vitesse tangentielle  (SPG =('DOMA' MOD1 'FACEL'))
C           * 'NX' = n.x (SPG = 'FACE')
C           * 'NY' = n.y (SPG = 'FACE')
C           * 'TX' = t.x (SPG = 'FACE')
C           * 'TY' = t.y (SPG = 'FACE')).
C
C MCHAP   : MCHAML (SPG =('DOMA' MOD1 'FACEL')) contenant la pression
C          (une  seule composante, 'SCAL').
C
C MCHAY   : MCHAML (SPG =('DOMA' MOD1 'FACEL')) contenant les fractions
C           massiques (composantes dans TABG . 'ESPEULE').
C
C MCHAA   : MCHAML (SPG =('DOMA' MOD1 'FACEL')) contenant les fractions
C           volumiques (composantes dans TABG . 'ESPEULE').
C
C MCHPPH  : CHPO contenant phi,
C           qui a comme SPG (support géométrique) l'indice 'CENTRE' de la
C           table associée à MOD1 (une composante, 'SCAL')
C
C MCHPPH  : CHPO contenant la fraction volumique alpha de la phase 1,
C           qui a comme SPG (support géométrique) l'indice 'CENTRE' de la
C           table associée à MOD1 (une composante, 'SCAL')
C
C LOG1    : LOGIQUE, si VRAI phi et les fractions volumiques sont
C           traités avec une approche conservative
C
C MAILLIM : MAILLAGE -- describes the mesh where the flux is not
C                       determined; it will be found by using
C                       the subroutins for the Boundary Conditions
C
C SORTIES
C
C RCHPO1  : objet de type CHPOINT (composantes =  LMOT1)
C           Residu  si MOT2 = 'RESI' (SPG =('DOMA' MOD1 'CENTRE'))
C
C RFLOT1  : objet de type FLOTTANT
C           Il est le temps caracteristique associé à l'onde la plus
C           rapide.
C
C Remarque
C --------
C
C RCHPO1 est égal à:
C * la derivé temporelle des inconnues si l'option 'RESI' est utilisée
C
C
C***********************************************************************
C
C************************************************************************
C
C HISTORIQUE (Anomalies et modifications éventuelles)
C
C  04/12/2010 - Created
*  25/05/2011 - Evolution in CAST3M
C
C************************************************************************
C
      IMPLICIT INTEGER(I-N)
C
-INC PPARAM
-INC CCOPTIO
-INC SMLMOTS
      POINTEUR MLMVIT.MLMOTS, MLMESP.MLMOTS
-INC SMELEME
-INC SMLREEL
      POINTEUR MLRMGA.MLREEL, MLRPGA.MLREEL,
     &     MLRMPI.MLREEL, MLRPPI.MLREEL
C
      INTEGER NESP, NESP1, IPGAS
     &      , IDOMA, MELEMC, MELEMF, MELEFE, ICHPSU, ICHPDI , ICHPVO
     &      , INORM, MELLIM, IFLIM
     &      , NBMET, INDMET, IRET
     &      , JGM, JGN
     &      , INDIC, NBCOMP
     &      , IPHI1
     &      , IPHIF, IROF1, IVITF1, IPF1
     &      , NINC, ILIINC, NC, ICELL
     &      , ICHRES, INEFMD, ICOND, MMODEL
     &      , ITOTO, IFRMAF, IFRALF, IALC
C
      PARAMETER (NBMET=1)
      REAL*8 DT, PMIN
      CHARACTER*8 LMETO(NBMET), TYPE, MTYPI
      CHARACTER*4 LFLUX(1), MOT1(1)
      CHARACTER*(40) MESERR
      LOGICAL LOGNC, LOGAN, LOGCON
C
C**** Variables en ACCTAB
C
      INTEGER IVALI, IRETI,IVALR, IRETR
      REAL*8 XVALI,XVALR
      LOGICAL LOGII, LOGIR
      CHARACTER*(8) CHARR
C
      DATA LMETO/'GODUNOV '/
      DATA LFLUX/'RESI'/
C
C**** Initialisation des variables pour la gestion des erreurs.
C
      LOGNC  = .FALSE.
      LOGAN  = .FALSE.
      MESERR  = '                                        '
C
C******* Flux ou residu???
C
      CALL LIRMOT(LFLUX,1,ICELL,1)
      IF(IERR .NE. 0)GOTO 9999
      IF(ICELL .NE. 1)THEN
C         LOGRES = .TRUE.
C      ELSE
C
C******** Message d'erreur standard
C         251 2
C         Tentative d'utilisation d'une option non implémentée
C
         CALL ERREUR(251)
      ENDIF
C
C**** Metode utilisée
C
      CALL LIRMOT(LMETO,NBMET,INDMET,1)
      IF(IERR .NE. 0)GOTO 9999
      IF(INDMET .EQ. 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)
      ENDIF
C********************************
C****   La table IPGAZ    *******
C********************************
C
C      write(*,*) 'Son qui prima di gas'
C
C
C**** Initialisation des variables en ACCTAB
C
      IVALI = 0
      IVALR = 0
      XVALI = 0.0D0
      XVALR = 0.0D0
      LOGII = .FALSE.
      LOGIR = .FALSE.
      IRETI = 0
      IRETR = 0
      CHARR = '        '
C
C**************************************************
C**** Lecture de la table des proprietes du gaz ***
C**************************************************
C
      ICOND = 1
      CALL QUETYP(TYPE,ICOND,IRETOU)
      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   '
         CALL ERREUR(37)
         GOTO 9999
      ELSE
         ICOND = 1
         CALL LIROBJ(TYPE,IPGAS,ICOND,IRETOU)
         IF(IERR .NE. 0)GOTO 9999
      ENDIF
C
C**** Nom de l'espece qui n'est pas dans les equations d'Euler
C
      MTYPI = 'MOT     '
      TYPE = '        '
      CALL ACCTAB(IPGAS,MTYPI,IVALI,XVALI,'ESPNEULE', LOGII,IRETI,
     &                  TYPE,IVALR,XVALR ,CHARR,LOGIR,IRETR)
      IF((IERR .NE. 0) .OR. (TYPE .NE. 'MOT     ')) THEN
C
C******* Message d'erreur standard
C        -301 0 %m1:40
C
         MOTERR = 'TAB1 . ESPNEULE = ???        '
         WRITE(IOIMP,*) MOTERR(1:40)
C
C********** Message d'erreur standard
C           21 2
C           Données incompatibles
C
         CALL ERREUR(21)
         GOTO 9999
      ENDIF
C
C**** Les especes qui sont dans les Equations d'Euler
C
      TYPE = '        '
      CALL ACMO(IPGAS,'ESPEULE',TYPE,MLMESP)
      IF(TYPE .NE. 'LISTMOTS')THEN
C
C******* Message d'erreur standard
C        -301 0 %m1:40
C
         MOTERR(1:40) = 'TAB1 . ESPEULE = ???                    '
         WRITE(IOIMP,*) MOTERR(1:40)
C
C******* Message d'erreur standard
C        21 2
C        Données incompatibles
C
         CALL ERREUR(21)
         GOTO 9999
      ENDIF
      SEGACT MLMESP
      NESP = MLMESP.MOTS(/2)
      SEGDES MLMESP
C
C**** List de gamma, PHI < 0 (MLRMGA, MLRrel Minus GAMMA)
C
      MTYPI = 'MOT     '
      TYPE = '        '
      CALL ACCTAB(IPGAS,MTYPI,IVALI,XVALI,'MGAM', LOGII,IRETI,
     &                  TYPE,IVALR,XVALR ,CHARR,LOGIR,IRETR)
      IF((IERR .NE. 0) .OR. (TYPE .NE. 'LISTREEL')) THEN
C
C********** Message d'erreur standard
C           -301 0 %m1:40
C
         MOTERR = ' TAB1 . MGAM = ???                      '
         WRITE(IOIMP,*) MOTERR
C
C********** Message d'erreur standard
C           21 2
C           Données incompatibles
C
         CALL ERREUR(21)
         GOTO 9999
      ENDIF
      MLRMGA = IRETR
      SEGACT MLRMGA
      NESP1 = MLRMGA.PROG(/1)
      IF(NESP1 .NE. (NESP + 1))THEN
C
C********** Message d'erreur standard
C           -301 0 %m1:40
C
         MOTERR = 'DIME(TAB1.MGAM)    != NESP              '
         WRITE(IOIMP,*) MOTERR(1:40)
C
C********** Message d'erreur standard
C           21 2
C           Données incompatibles
C
         CALL ERREUR(21)
         GOTO 9999
      ENDIF
C
C**** List de gamma, PHI > 0 (MLRPGA, MLRrel Plus GAMMA)
C
      MTYPI = 'MOT     '
      TYPE = '        '
      CALL ACCTAB(IPGAS,MTYPI,IVALI,XVALI,'PGAM', LOGII,IRETI,
     &                  TYPE,IVALR,XVALR ,CHARR,LOGIR,IRETR)
      IF((IERR .NE. 0) .OR. (TYPE .NE. 'LISTREEL')) THEN
C
C********** Message d'erreur standard
C           -301 0 %m1:40
C
         MOTERR = ' TAB1 . PGAM = ???                      '
         WRITE(IOIMP,*) MOTERR
C
C********** Message d'erreur standard
C           21 2
C           Données incompatibles
C
         CALL ERREUR(21)
         GOTO 9999
      ENDIF
      MLRPGA = IRETR
      SEGACT MLRPGA
      NESP1 = MLRPGA.PROG(/1)
      IF(NESP1 .NE. (NESP + 1))THEN
C
C********** Message d'erreur standard
C           -301 0 %m1:40
C
         MOTERR = 'DIME(TAB1.PGAM)    != NESP              '
         WRITE(IOIMP,*) MOTERR(1:40)
C
C********** Message d'erreur standard
C           21 2
C           Données incompatibles
C
         CALL ERREUR(21)
         GOTO 9999
      ENDIF
C
C**** List de PINF, PHI < 0 (MLRMPI)
C
      MTYPI = 'MOT     '
      TYPE = '        '
      CALL ACCTAB(IPGAS,MTYPI,IVALI,XVALI,'MPIN', LOGII,IRETI,
     &                  TYPE,IVALR,XVALR ,CHARR,LOGIR,IRETR)
      IF((IERR .NE. 0) .OR. (TYPE .NE. 'LISTREEL')) THEN
C
C********** Message d'erreur standard
C           -301 0 %m1:40
C
         MOTERR = ' TAB1 . MPIN = ???                      '
         WRITE(IOIMP,*) MOTERR
C
C********** Message d'erreur standard
C           21 2
C           Données incompatibles
C
         CALL ERREUR(21)
         GOTO 9999
      ENDIF
      MLRMPI = IRETR
      SEGACT MLRMPI
      NESP1 = MLRMPI.PROG(/1)
      IF(NESP1 .NE. (NESP + 1))THEN
C
C********** Message d'erreur standard
C           -301 0 %m1:40
C
         MOTERR = 'DIME(TAB1.MPIN)    != NESP              '
         WRITE(IOIMP,*) MOTERR(1:40)
C
C********** Message d'erreur standard
C           21 2
C           Données incompatibles
C
         CALL ERREUR(21)
         GOTO 9999
      ENDIF
C
C**** List de PINF, PHI > 0 (MLRPPI)
C
      MTYPI = 'MOT     '
      TYPE = '        '
      CALL ACCTAB(IPGAS,MTYPI,IVALI,XVALI,'PPIN', LOGII,IRETI,
     &                  TYPE,IVALR,XVALR ,CHARR,LOGIR,IRETR)
      IF((IERR .NE. 0) .OR. (TYPE .NE. 'LISTREEL')) THEN
C
C********** Message d'erreur standard
C           -301 0 %m1:40
C
         MOTERR = ' TAB1 . PPIN = ???                      '
         WRITE(IOIMP,*) MOTERR
C
C********** Message d'erreur standard
C           21 2
C           Données incompatibles
C
         CALL ERREUR(21)
         GOTO 9999
      ENDIF
      MLRPPI = IRETR
      SEGACT MLRPPI
      NESP1 = MLRPPI.PROG(/1)
      IF(NESP1 .NE. (NESP + 1))THEN
C
C********** Message d'erreur standard
C           -301 0 %m1:40
C
         MOTERR = 'DIME(TAB1.PPIN)    != NESP              '
         WRITE(IOIMP,*) MOTERR(1:40)
C
C********** Message d'erreur standard
C           21 2
C           Données incompatibles
C
         CALL ERREUR(21)
         GOTO 9999
      ENDIF
C
C***********************************************************************
C******************** Lecture du reste *********************************
C***********************************************************************
C
C**********************************
C**** Lecture de l'objet MODELE ***
C**********************************
C
      ICOND = 1
      CALL QUETYP(TYPE,ICOND,IRET)
 
      IF(IRET.EQ.0.AND.TYPE.NE.'MMODEL')THEN
        WRITE(IOIMP,*)' On attend un objet MMODEL'
        RETURN
      ENDIF
      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**** Centre, FACE et FACEL
C
      CALL LEKTAB(IDOMA,'CENTRE',MELEMC)
      IF(IERR .NE. 0) GOTO 9999
C
      CALL LEKTAB(IDOMA,'FACE',MELEMF)
      IF(IERR .NE. 0) GOTO 9999
C
      CALL LEKTAB(IDOMA,'FACEL',MELEFE)
      IF(IERR .NE. 0) GOTO 9999
C
C**** Lecture du CHPOINT contenant les surfaces des faces.
C
      CALL LEKTAB(IDOMA,'XXSURFAC',ICHPSU)
      IF(IERR .NE. 0) GOTO 9999
C
C**** Lecture du CHPOINT contenant les diametres minimums.
C
      CALL LEKTAB(IDOMA,'XXDIEMIN',ICHPDI)
      IF(IERR .NE. 0) GOTO 9999
C
C**** Lecture du CHPOINT contenant les volumes
C
      CALL LEKTAB(IDOMA,'XXVOLUM',ICHPVO)
      IF(IERR .NE. 0) GOTO 9999
C
C********** Les normales aux faces
C
      IF(IDIM .EQ. 2)THEN
C        Que les normales
         CALL LEKTAB(IDOMA,'XXNORMAF',INORM)
         IF(IERR .NE. 0) GOTO 9999
         JGN = 4
         JGM = 2
         SEGINI MLMVIT
         MLMVIT.MOTS(1) = 'UX  '
         MLMVIT.MOTS(2) = 'UY  '
         CALL QUEPO1(INORM, MELEMF, MLMVIT)
         SEGSUP MLMVIT
         IF(IERR .NE. 0) GOTO 9999
      ELSE
C        Les normales et les tangentes
         TYPE = ' '
         CALL ACMO(IDOMA,'MATROT',TYPE,INORM)
         IF (TYPE .NE. 'CHPOINT ') THEN
            CALL MATRAN(IDOMA,INORM)
            IF(IERR .NE. 0) GOTO 9999
         ENDIF
         JGN = 4
         JGM = 9
         SEGINI MLMVIT
         MLMVIT.MOTS(1) = 'UX  '
         MLMVIT.MOTS(2) = 'UY  '
         MLMVIT.MOTS(3) = 'UZ  '
         MLMVIT.MOTS(4) = 'RX  '
         MLMVIT.MOTS(5) = 'RY  '
         MLMVIT.MOTS(6) = 'RZ  '
         MLMVIT.MOTS(7) = 'MX  '
         MLMVIT.MOTS(8) = 'MY  '
         MLMVIT.MOTS(9) = 'MZ  '
         CALL QUEPO1(INORM, MELEMF, MLMVIT)
         SEGSUP MLMVIT
      ENDIF
C
C********************************
C**** Fin table domaine *********
C********************************
C
C**** Lecture du CHPOINT PHI1 (level set)
C
      TYPE='CHPOINT '
      ICOND = 1
      CALL LIROBJ(TYPE,IPHI1,ICOND,IRET)
      IF(IERR .NE. 0)GOTO 9999
C
C**** Control du CHPOINT: QUEPOI
C
C     INDIC = 1   -> on impose le pointeur du support geometrique (ICEN)
C                   N.B. Le CHPOINT peut changer de structure pour
C                        avoir SPG = ICEN!!!!
C     INDIC = 0   -> on ne fait que verifier le support geometrique
C                   (ICEN). Si le SPG sont differents INDIC = -4 en sortie
C
C     NBCOMP > 0 -> numero des composantes
C
C     MOT1(1) = ' ' obligatoire s'on connais pas les noms des composantes
C
      INDIC = 1
      NBCOMP = 1
      MOT1(1) = 'SCAL'
      CALL QUEPOI(IPHI1, MELEMC, INDIC, NBCOMP, MOT1)
      IF(IERR .NE. 0)THEN
C
C******** Message d'erreur standard
C        -301 0 %m1:40
C
         MOTERR  = 'IPHI1 = ???                             '
         WRITE(IOIMP,*) MOTERR(1:40)
         GOTO 9999
      ENDIF
C
      IF (NESP .GE. 1) THEN
C
C******* ALPHA au centre.
C
         ICOND = 1
         TYPE = 'CHPOINT '
         CALL LIROBJ(TYPE,IALC,1,IRET)
         IF (IERR.NE.0) GOTO 9999
C
C****    Control du CHPOINT
C
         CALL QUEPO1(IALC, MELEMC, MLMESP)
         IF(IERR .NE. 0) GOTO 9999
      ENDIF
C
C**** On va lire les pointeurs des MCHAMLs
C     Lecture du MCHAML 'FACEL' alpha
C
      TYPE='MCHAML  '
      CALL  LIROBJ(TYPE,IPHIF,1,IRET)
      IF(IERR.NE.0) GOTO 9999
C     Lecture du MCHAML 'FACEL' densité
C
      TYPE='MCHAML  '
      CALL  LIROBJ(TYPE,IROF1,1,IRET)
      IF(IERR.NE.0) GOTO 9999
C
C**** Lecture du MCHAML 'FACEL' vitesse
C
      TYPE='MCHAML  '
      CALL  LIROBJ(TYPE,IVITF1,1,IRET)
      IF(IERR .NE. 0) GOTO 9999
C
C**** Lecture du MCHAML 'FACEL' contenant la pression
C
      TYPE='MCHAML  '
      CALL  LIROBJ(TYPE,IPF1,1,IRET)
      IF(IERR .NE. 0) GOTO 9999
C
      IF (NESP .GE. 1) THEN
C
C******** Lecture du MCHAML 'FACEL' contenant les fractiones massiques
C         ET ALPHA
C
         TYPE='MCHAML  '
         CALL  LIROBJ(TYPE,IFRMAF,1,IRET)
         IF(IERR .NE. 0) GOTO 9999
C
         TYPE='MCHAML  '
         CALL  LIROBJ(TYPE,IFRALF,1,IRET)
         IF(IERR .NE. 0) GOTO 9999
C
      ELSE
C
         IFRMAF = 0
         IFRALF = 0
C
      ENDIF
C
C**** NINC = nombre d'inconnues
C
      NINC=(IDIM+3)+(2*NESP)
C
      TYPE='LISTMOTS'
      CALL LIROBJ(TYPE,ILIINC,1,IRET)
      IF(IERR .NE. 0) GOTO 9999
      MLMOTS = ILIINC
      SEGACT MLMOTS
      NC = MLMOTS.MOTS(/2)
      SEGDES MLMOTS
      IF(NC .NE. NINC)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
      ENDIF
C
C**** Boundary condition
C
      IRET=0
      TYPE='MAILLAGE'
      CALL LIROBJ(TYPE,IFLIM,0,IRET)
      IF(IERR.NE.0)GOTO 9999
      IF(IRET .EQ. 0)THEN
         MELLIM = 0
      ELSE
         MELEME=IFLIM
         SEGACT MELEME
         ITOTO=MELEME.NUM(/2)
         IF(ITOTO .EQ. 0)THEN
            MELLIM = 0
         ELSE
            MELLIM = IFLIM
         ENDIF
         SEGDES MELEME
      ENDIF
C
C**** Conservative or non-conservative approach
C
      CALL LIRLOG(LOGCON , ICOND , IRET)
      IF (IERR.NE.0) GOTO 9999
C
C**** Minimum pressure for vacuum
C
      CALL LIRREE(PMIN, ICOND , IRET)
      IF (IERR.NE.0) GOTO 9999
C
C
C      write(*,*) 'Son qui dopo la lettura degli inputs'
C
C**** Creation du residu
C
      TYPE = 'CHPOINT '
      CALL KRCHP1(TYPE, MELEMC, ICHRES, MLMOTS)
C
C**** Calcul des flux et du pas du temps.
C
      IF( IDIM .EQ. 2)THEN
         CALL KGFM12(LOGCON,
     &        NESP,
     &        INDMET,
     &        MLRMGA, MLRMPI, MLRPGA, MLRPPI,
     &        PMIN,
     &        IPHI1, IALC,
     &        IPHIF,IROF1,IVITF1,IPF1,
     &        IFRMAF, IFRALF,
     &        ICHPSU,ICHPDI,ICHPVO,
     &        MELEMC,MELEMF,MELEFE,MELLIM,
     &        ICHRES,
     &        DT,
     &        LOGNC,LOGAN,MESERR)
C      ELSE
C         CALL KONFL4(LOGME,LOGSCA,INDMET,NORDP1,
C     &        IROF,IVITF,IPF,IFRMAF,ISCAF,PROPHY,
C     &        ICHPSU,ICHPDI,
C     &        MELEMC,MELEMF,MELEFE,MELLIM,
C     &        ICHRES,
C     &        DT,
C     &        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)
         WRITE(IOIMP,*) MOTERR(1:40)
C
C******* Message d'erreur standard
C        5 3
C        Erreur anormale.contactez votre support
C
         CALL ERREUR(5)
         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)
         WRITE(IOIMP,*) MOTERR(1:40)
C
C******* Message d'erreur standard
C        460 2
C        Pas de convergence dans les itérations internes
C
         CALL ERREUR(460)
         GOTO 9999
      ENDIF
C
C**** Ecriture des resultats
C
      CALL ECRREE(DT)
      TYPE = 'CHPOINT '
      IF(ICHRES .NE. 0) CALL ECROBJ(TYPE,ICHRES)
C
 9999 CONTINUE
      RETURN
      END
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 

© Cast3M 2003 - Tous droits réservés.
Mentions légales