Sources Esope | Cast3M

mhybr
C MHYBR     SOURCE    CB215821  24/04/12    21:16:43     11897          
      SUBROUTINE MHYBR
C-----------------------------------------------------------------------
C Cette subroutine permet de creer une matrice de type masse dans le
C cadre d'une formulation variationnelle mixte.
C-----------------------------------------------------------------------
C
C
C-----------------------------------------------------------------------
C OPTION DARCY
C                                                   t-->    =-1  -->
C La matrice en question integre                     shp *  k  * shp
C
C Dans cette option, l'objet rigidite reçoit l'inverse de la matrice
C Comme on ne se sert que de l'inverse de cette matrice, c'est cette
C derniere qui est stockee dans l'objet rigidite.
C
C
C---------------------------
C Phrase d'appel (GIBIANE) :
C---------------------------
C
C  MHY1 = MHYB MMODEL  CHMAT1 ('DARCY') ('LUMP');
C
C
C
C-----------------------------------------------------------------------
C OPTION MASSE
C                                                   t-->   -->
C La matrice en question integre                     shp * shp
C
C
C Le resultat de l'integration est stocke dans l'objet rigidite
C
C---------------------------
C Phrase d'appel (GIBIANE) :
C---------------------------
C
C  MHY1 = MHYB MMODEL  'MASSE' ;
C
C
C------------------------
C Operandes et resultat :
C------------------------
C
C  MHY1    : Matrice masse hybride
C  MMODEL  : Objet modele specifiant la formulation
C  CHMAT1  : 'CHAMELEM' de sous type 'CARACTERISTIQUES'
C
C  la table DOMAINE des connectivités est dans le modèle
C-----------------------------------------------------------------------
C
C Langage : ESOPE + FORTRAN77
C
C Auteurs : 08/93 F.DABBENE
C           12/94 F.DABBENE : Gestion des erreurs
C           02/96 L.V.BENET : introduction de l'option 'MASSE'
C
C-----------------------------------------------------------------------
      IMPLICIT INTEGER(I-N)
 
-INC PPARAM
-INC CCOPTIO
-INC SMCHAML
-INC SMELEME
-INC SMMODEL
-INC SMTABLE
-INC SMCOORD
*
      SEGMENT IPMAHY
         INTEGER MAHYBR(NSOUS)
      ENDSEGMENT
*
      REAL*8 XVALIN,XVALRE
      LOGICAL LOGRE,LOGIN
      INTEGER IPCHEL
      CHARACTER*8 TAPIND,TYPOBJ,CHARIN,CHARRE,LETYPE,LENOM
      CHARACTER*5 MCLE(3)
      CHARACTER*5 MOMO
      DATA NCLE /3/
      DATA MCLE /'DARCY','MASSE','LUMP '/
      CALL LIRMOT(MCLE,NCLE,ICLE,0)
*
* Initialisations
*
      segact mcoord
      ILUMP  = 0
      IPCHEL = 0
      IVALIN = 0
      XVALIN = 0.D0
      LOGIN  = .TRUE.
      IOBIN  = 0
      TAPIND = 'MOT     '
      TYPOBJ = 'MAILLAGE'
*
* Lecture du MMODEL
*
      CALL LIROBJ('MMODEL  ',IPMODE,1,IRET)
      CALL ACTOBJ('MMODEL  ',IPMODE,1)
      IF (IERR.NE.0) RETURN
      MMODEL = IPMODE
*
* Lecture de la TABLE domaine
*
      CALL LEKMOD(MMODEL,IPTABL,INEFMD)
      CHARIN = 'MAILLAGE'
      CALL LEKTAB(IPTABL,CHARIN, IOBRE)
      IF (IERR.NE.0) RETURN
      IPGEOM = IOBRE
      CALL LEKTAB(IPTABL,'ELTFA',IOBRE)
      IF (IERR.NE.0) RETURN
      IELTFA = IOBRE
*
* Lecture eventuelle du CHAMELEM de caracteristiques materielles
*
      II=0
      IF(ICLE.NE.2)II=1
      CALL LIROBJ('MCHAML  ',IPIN,II,IRCHEL)
      IF (IERR.NE.0) RETURN      
      IF (IRCHEL .EQ. 1) THEN
        CALL ACTOBJ('MCHAML  ',IPIN,1)
        CALL REDUAF(IPIN,IPMODE,IPCHEL,0,IR,KER)
        IF(IR   .NE. 1) CALL ERREUR(KER)
        IF(IERR .NE. 0) RETURN
      ENDIF
      MCHELM = IPCHEL
*
* Lecture eventuelle des indications pour l'option LUMP
*
      IF(ICLE.EQ.3)ILUMP=1
      IF(ICLE.EQ.1)THEN
          IRET=0
          CALL LIRCHA(MOMO,0,IRET)
          IF(IRET.GT.0) THEN
              IF(MOMO(1:4).NE.'LUMP')THEN
                   MOTERR=MOMO
                   CALL ERREUR(7)
                   RETURN
              ENDIF
              ILUMP=1
          ENDIF
      ENDIF
*
*
*- Controle de la formulation
* Recuperation des pointeurs ELTFA pour les zones ou DARCY est defini
*
*
      SEGACT MMODEL
      NSOUS  = KMODEL(/1)
      SEGINI IPMAHY
      IDARCY = 0
      DO 10 ISOUS=1,NSOUS
         IMODEL = KMODEL(ISOUS)
         SEGACT IMODEL
         LETYPE = FORMOD(1)
         IF (LETYPE.EQ.'DARCY') THEN
            IDARCY = IDARCY + 1
            IF(NSOUS.EQ.1) THEN
            IPT3=IELTFA
            ELSE
            IPT2= IELTFA
            SEGACT IPT2
            IPT3=IPT2.LISOUS(ISOUS)
            ENDIF
            MAHYBR(ISOUS) = IPT3
         ENDIF
 10   CONTINUE
      IF (IDARCY.EQ.0) THEN
         MOTERR = LETYPE
         CALL ERREUR(193)
         GOTO 100
      ENDIF
*
      IF(ICLE.NE.2)THEN
*
*- Controle du MCHAML
*
          SEGACT MCHELM
*
* Test du sous type du MCHAML
*
          LETYPE = TITCHE
          IF (LETYPE.NE.'CARACTER') THEN
             MOTERR = 'CARACTERISTIQUES'
             CALL ERREUR(291)
             GOTO 100
          ENDIF
*
* Il manque les CARACTERISTIQUES d'une ou plusieurs parties du MODELE
*
          NBMAIC = IMACHE(/1)
          IF (NSOUS.GT.NBMAIC) THEN
             CALL ERREUR(404)
             GOTO 100
          ENDIF
*
* Test du support du MCHAML
*
          ISUP  = 0
          ICOND = 0
          CALL QUESUP(IPMODE,IPCHEL,ISUP,ICOND,IRET1,IRET2)
          IF (IRET1.GT.3) THEN
             MOTERR(1:8) = LETYPE
             CALL ERREUR(124)
             GOTO 100
          ENDIF
*
* Si support aux noeuds -> aux points de GAUSS
*
          IF (IRET1.EQ.1) THEN
             CALL CHASUP(IPMODE,IPCHEL,IPCHE1,IRET,ISUP)
             IF (IRET.NE.0) THEN
                CALL ERREUR(IRET)
                IRET1 = 0
                GOTO 100
             ENDIF
          ELSE
             IPCHE1 = IPCHEL
          ENDIF
*
* Construction de la matrice masse hybride
*
          CALL MHYBR1(IPMODE,IPCHE1,IPMAHY,IPRIGI,IPGEOM,ILUMP)
      ELSE
        IRET1 = 0
        IPCHE1 = 0
        IF(IRCHEL.NE.0)CALL ERREUR(21)
          CALL MHYBR1(IPMODE,IPCHE1,IPMAHY,IPRIGI,IPGEOM,ILUMP)
      ENDIF
      IF (IERR.EQ.0) CALL ECROBJ('RIGIDITE',IPRIGI)
*
* Ménage
*
 100  CONTINUE
      IF (IRET1.EQ.1) THEN
         CALL DTCHAM(IPCHE1)
      ENDIF
      SEGSUP IPMAHY
 
      END