Sources Esope | Cast3M

pre411
C PRE411    SOURCE    CB215821  20/11/25    13:36:30     10792          
      SUBROUTINE PRE411(ICEN,IFACE,IFACEL,MLMCOM,IROC,IROF,
     &                  LOGAN,MESERR)
C************************************************************************
C
C PROJET            :  CASTEM 2000
C
C NOM               :  PRE411
C
C DESCRIPTION       :  Voir PRE41
C
C                      Cas 2D/3D
C                      1er ordre en espace, 1re ordre en temps
C
C                      Creations des objets MCHAML IROF
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)  :  KRIPAD, LICHT
C
C APPELES (Calcul)  :  AUCUN
C
C
C************************************************************************
C
C ENTREES
C
C     1) Pointeurs de MELEMEs et de CHPOINTs de la table DOMAINE
C
C     ICEN    : MELEME de 'POI1' SPG des CENTRES
C
C     IFACE   : MELEME de 'POI1' SPG des FACES
C
C     IFACEL  : MELEME de 'SEG3' avec
C               CENTRE d'Elt "gauche"
C               CENTRE de Face
C               CENTRE d'Elt "droite"
C
C               N.B. = IFACE.NUM(i,1) = IFACEL.NUM(i,2)
C
C     2) Pointeurs des  CHPOINTs
C
C     IROC    : CHPOINT "CENTRE" contenant les scalaires
C
C SORTIES
C
C
C     IROF    : MCHAML  defini sur le MELEME de pointeur IFACEL,
C               contenant les scalaires
C
C     LOGAN   : anomalie detectee (changement de la convention dans
C               la table domaine)
C
C     MESERR  : pour les messages d'erreur
C
C************************************************************************
C
C HISTORIQUE (Anomalies et modifications éventuelles)
C
C HISTORIQUE :  Créée le 28.12.01.
C
C************************************************************************
C
C
C**** Variables de COOPTIO
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
CC     &        ,MCOORD
C     &        ,IFOMOD, NIFOUR, IFOUR, NSDPGE, IONIVE
C     &        ,NGMAXY, IZROSF, ISOTYP, IOSCR,LTEXLU
C     &        ,NORINC,NORVAL,NORIND,NORVAD
C     &        ,NUCROU, IPSAUV
C
C**** Les variables
C
      IMPLICIT INTEGER(I-N)
      INTEGER ICEN, IFACE, IFACEL, IROC
     &       , IROF
     &       , IGEOM, NFAC
     &       , N1PTEL, N1EL, N2PTEL, N2EL, N2, N1, N3, L1
     &       , NLCF, NGCF, NGCEG, NLCEG, NGCED, NLCED, NGCF1, I1
      REAL*8 ROG, ROD
      CHARACTER*(40) MESERR
      CHARACTER*(8) TYPE
      LOGICAL LOGAN
C
C**** Les Includes
C
-INC SMCOORD
 
-INC PPARAM
-INC CCOPTIO
-INC SMCHPOI
      POINTEUR MPROC.MPOVAL
-INC SMCHAML
-INC SMLENTI
-INC SMELEME
-INC SMLMOTS
      POINTEUR MLMCOM.MLMOTS
C
C**** Initialisation des parametres d'erreur déjà faite, i.e.
C
C     MESERR = '                                        '
C     MOTERR(1:40) = MESERR(1:40)
C
C
C**** KRIPAD pour la correspondance global/local de centre
C
      CALL KRIPAD(ICEN,MLENT1)
C
C**** MLENTI1 a MCORD.XCOORD(/1)/(IDIM+1) elements
C
C     Si i est le numero global d'un noeud de ICEN,
C     MLENT1.LECT(i) contient sa position, i.e.
C
C     I              = numero global du noeud centre
C     MLENT1.LECT(i) = numero local du noeud centre
C
C     MLENT1 déjà activé, i.e.
C
C     SEGACT MLENT1
C
C**** Activation de CHPOINTs
C
      CALL LICHT(IROC, MPROC, TYPE, IGEOM)
C     SEGACT MPROC
C
C**** Le MELEME FACEL
C
      IPT1 = IFACEL
      IPT2 = IFACE
      SEGACT IPT1
      SEGACT IPT2
      NFAC = IPT1.NUM(/2)
C
      SEGACT MLMCOM
C
C**** Creation de MCHAMLs contenant les etats gauche et droite,
C
C**** Densité
C
      N1 = 1
      N3 = 6
      L1 = 15
      SEGINI MCHEL2
      IROF = MCHEL2
      MCHEL2.IMACHE(1) = IFACEL
      MCHEL2.TITCHE = '               '
      MCHEL2.CONCHE(1) = '                '
C
C**** Valeurs independente du repére, i.e.
C
      MCHEL2.INFCHE(1,1) = 0
      MCHEL2.INFCHE(1,3) = NIFOUR
      MCHEL2.INFCHE(1,4) = 0
      MCHEL2.INFCHE(1,5) = 0
      MCHEL2.INFCHE(1,6) = 0
      MCHEL2.IFOCHE = IFOUR
      N2 = MLMCOM.MOTS(/2)
      SEGINI MCHAM1
      MCHEL2.ICHAML(1) = MCHAM1
      SEGDES MCHEL2
      N1EL = NFAC
      N1PTEL = 3
      N2EL = 0
      N2PTEL = 0
      DO I1=1,N2,1
         MCHAM1.NOMCHE(I1) = MLMCOM.MOTS(I1)
         MCHAM1.TYPCHE(I1) = 'REAL*8          '
         SEGINI MELVA1
         MCHAM1.IELVAL(I1) = MELVA1
      ENDDO
C
C**** Boucle sur le faces
C
      DO NLCF = 1, NFAC
C
C******* NLCF  = numero local du centre de face
C        NGCF  = numero global du centre de face
C        NGCEG = numero global du centre ELT "gauche"
C        NLCEG = numero local du centre ELT "gauche"
C        NGCED = numero global du centre ELT "droite"
C        NLCED = numero local du centre ELT "droite"
C
         NGCEG = IPT1.NUM(1,NLCF)
         NGCF  = IPT1.NUM(2,NLCF)
         NGCED = IPT1.NUM(3,NLCF)
         NLCEG = MLENT1.LECT(NGCEG)
         NLCED = MLENT1.LECT(NGCED)
C
C******* TEST: IPT2.NUM(1,NLCF) = IPT1.NUM(2,NLCF)
C
         NGCF1 = IPT2.NUM(1,NLCF)
         IF(NGCF1 .NE. NGCF) THEN
            LOGAN = .TRUE.
            MESERR(1:40) = 'PRET, subroutine pre411.eso             '
            GOTO 9999
         ENDIF
         DO I1 = 1, N2, 1
            IF(NGCEG .EQ. NGCED)THEN
               ROG = MPROC.VPOCHA(NLCEG , I1)
C
C********** Son etat droite
C
               ROD = ROG
            ELSE
C
C************* Etat gauche
C
               ROG = MPROC.VPOCHA(NLCEG, I1)
C
C********** Etat droit
C
               ROD = MPROC.VPOCHA(NLCED, I1)
            ENDIF
            MELVA1=MCHAM1.IELVAL(I1)
            MELVA1.VELCHE(1,NLCF) = ROG
            MELVA1.VELCHE(3,NLCF) = ROD
         ENDDO
      ENDDO
C
C**** Desactivation des SEGMENTs
C
      SEGDES IPT1
      SEGDES IPT2
      DO I1 = 1, N2, 1
         MELVA1=MCHAM1.IELVAL(I1)
         SEGDES MELVA1
      ENDDO
      SEGDES MCHAM1
C
      SEGDES MPROC
C
      SEGSUP MLENT1
      SEGDES MLMCOM
C
 9999 CONTINUE
C
      RETURN
      END