C PRE41     SOURCE    OF166741  24/12/13    21:17:07     12097          
      SUBROUTINE PRE41()
C************************************************************************
C
C PROJET            :  CASTEM 2000
C
C NOM               :  PRE41
C
C DESCRIPTION       :  Voir PRE4
C
C                      Transport de scalaires passifs
C
C LANGAGE           :  FORTRAN 77 + ESOPE 2000 (avec extensions CISI)
C
C AUTEUR            :  A. BECCANTINI, DRN/DMT/SEMT/TTMF
C
C************************************************************************
C
C
C APPELES (Outils)  :  LIRTAB, ACMO, LEKTAB, QUETYP, ERREUR, LIROBJ,
C                      QUEPO1, ECROBJ
C
C APPELES (Calcul)  :  PRE411 (2D)
C
C
C************************************************************************
C
C HISTORIQUE (Anomalies et modifications éventuelles)
C
C HISTORIQUE :  Créée le 28.11.01
C
C************************************************************************
C
C**** Les variables
C
      IMPLICIT INTEGER(I-N)
      INTEGER   ICOND,  IRETOU, IERR0
     &     ,IDOMA, ICEN, IFACE, IFACEL, IROC, IROF, INEFMD
      CHARACTER*(8) MTYPR, TYPE
      CHARACTER*(40) MESERR
      LOGICAL LOGAN
C
C**** Les Includes
C
-INC PPARAM
-INC CCOPTIO
-INC SMLMOTS
      POINTEUR MLMCOM.MLMOTS
C
C**** Initialisation des parametres d'erreur
C
      LOGAN=.FALSE.
      MESERR = '                                        '
      MOTERR(1:40) = MESERR(1:40)
C
C**** Lecture de l'objet MODELE
C
      ICOND = 1
      CALL QUETYP(TYPE,ICOND,IRETOU)

      IF(IRETOU.EQ.0.AND.TYPE.NE.'MMODEL')THEN
        WRITE(6,*)' On attend un objet MMODEL'
        RETURN
      ENDIF
      CALL LIROBJ('MMODEL  ',MMODEL,ICOND,IRETOU)
      CALL ACTOBJ('MMODEL  ',MMODEL,1)
      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.
C
C
C     CALL LEKTAB(IDOMA,'CENTRE',IP)
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
      MTYPR = 'MAILLAGE'
      CALL ACMO(IDOMA,'CENTRE',MTYPR,ICEN)
      IF(IERR.NE.0)GOTO 9999
C
C**** Lecture du MELEME 'FACE'
C
      MTYPR = 'MAILLAGE'
      CALL ACMO(IDOMA,'FACE',MTYPR,IFACE)
      IF(IERR.NE.0)GOTO 9999
C
C**** Lecture du MELEME 'FACEL'
C
      MTYPR = 'MAILLAGE'
      CALL ACMO(IDOMA,'FACEL',MTYPR,IFACEL)
      IF(IERR.NE.0)GOTO 9999
C
C**** Lecture du CHPOINT ROC
C
      ICOND = 1
      MTYPR='CHPOINT '
      CALL LIROBJ(MTYPR,IROC,ICOND,IRETOU)
      CALL ACTOBJ(MTYPR,IROC,1)
      IF (IERR.NE.0) GOTO 9999
C
C**** Control du CHPOINT: QUEPO1
C
      MLMCOM=0
      CALL QUEPO1(IROC, ICEN, MLMCOM)
      IF(IERR .NE. 0)THEN
         IERR0 = IERR

C
C******* Message d'erreur standard
C        -301 0 %m1:40
C
         MOTERR(1:40) = 'CHPO1 = ???                             '
     $
         WRITE(IOIMP,*) MOTERR

         GOTO 9999
      ENDIF
C
C**** Centre -> Face
C
      CALL PRE411(ICEN,IFACE,IFACEL,MLMCOM,IROC,IROF,
     &     LOGAN,MESERR)
C
C**** Messages d'erreur
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
C
C******* Message d'erreur standard
C        5 3
C        Erreur anormale.contactez votre support
C
         CALL ERREUR(5)
         GOTO 9999
C
      ELSE
C
C******* Ecriture de ROF, VITF, PF, YF, GAMMAF
C
         MTYPR = 'MCHAML  '
         CALL ACTOBJ(MTYPR,IROF,1)
         CALL ECROBJ(MTYPR,IROF)
      ENDIF
C
      SEGSUP MLMCOM
 9999 CONTINUE
      END