C MHYBR SOURCE CB215821 23/07/12 21:15:09 11704 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