C CARMAT SOURCE BP208322 16/11/18 21:15:25 9177 SUBROUTINE CARMAT(IPMODE,IPCHE1,IPMAIL,MFR,MELE,CMATE, 1 ISUP5,INFOS,CONM,IMAT,ICAR,NUMAT,NUCAR,IRET) C_______________________________________________________________________ C C Entrees: C ________ C C IPMODE Pointeur sur un IMODEL C IPCHE1 Pointeur sur un MCHAML de caracteristiques C IPMAIL Pointeur sur un maillage elementaire C MFR Formulation de l element fini C MELE Numero de l element fini C CMATE Nom du materiau C ISUP5 Critere d existence des caracteristiques C INFOS Tableau d infos C CONM Nom du maillage elementaire C C Sorties: C ________ C C IMAT = Pointeur sur un tableau de MELVAL de MATERIAU C ICAR = Pointeur sur un tableau de MELVAL de CARACTERISTIQUES C NUMAT = Nombre des composantes de materiau C NUCAR = Nombre des composantes des caract. geometriques C IRET 1 si tout OK 0 sinon C C_______________________________________________________________________ C IMPLICIT INTEGER(I-N) IMPLICIT REAL*8 (A-H,O-Z) -INC CCHAMP -INC PPARAM -INC CCOPTIO -INC SMCHAML -INC SMMODEL -INC CCGEOME SEGMENT NOTYPE CHARACTER*16 TYPE(NBTYPE) ENDSEGMENT * SEGMENT MPTVAL INTEGER IPOS(NS) ,NSOF(NS) INTEGER IVAL(NCOSOU) CHARACTER*16 TYVAL(NCOSOU) ENDSEGMENT * CHARACTER*8 CMATE CHARACTER*(NCONCH) CONM PARAMETER (NINF=3) INTEGER INFOS(NINF) LOGICAL lsupma C IRET=1 IMAT=0 ICAR=0 MOCARA=0 MOMATR=0 NUMAT=0 NUCAR=0 NBTYPE=0 IPPORE=0 IF(MFR.EQ.33) IPPORE= NBNNE(NUMGEO(MELE)) C C TRAITEMENT DU MODELE C IMODEL=IPMODE lsupma=.true. * * TRAITEMENT DES CHAMPS DE MATERIAU * IF (FORMOD(1).EQ.'MECANIQUE') THEN IF (CMATE.EQ.'ISOTROPE') THEN NBROBL=2 NBRFAC=0 SEGINI NOMID MOMATR=NOMID IF (MFR.EQ.35) THEN LESOBL(1)='KS ' LESOBL(2)='KN ' * ELSE IF(MFR.EQ.53)THEN NBROBL=1 SEGADJ,NOMID LESOBL(1)='KS ' * ELSE LESOBL(1)='YOUN' LESOBL(2)='NU ' ENDIF NMATR=NBROBL NMATF=NBRFAC ELSEIF (CMATE.EQ.'ORTHOTRO') THEN IF (MFR.EQ.3) THEN * COQUES MINCES NBROBL=6 NBRFAC=0 SEGINI NOMID MOMATR=NOMID LESOBL(1)='YG1 ' LESOBL(2)='YG2 ' LESOBL(3)='NU12' LESOBL(4)='G12 ' LESOBL(5)='V1X ' LESOBL(6)='V1Y ' ELSE IF (MFR.EQ.9.OR.MFR.EQ.5) THEN * COQUES AVEC CISAILLEMENT TRANSVERSE NBROBL=8 NBRFAC=0 SEGINI NOMID MOMATR=NOMID LESOBL(1)='YG1 ' LESOBL(2)='YG2 ' LESOBL(3)='NU12' LESOBL(4)='G12 ' LESOBL(5)='G23 ' LESOBL(6)='G13 ' LESOBL(7)='V1X ' LESOBL(8)='V1Y ' ELSE IF (MFR.EQ.1) THEN * ELEMENTS MASSIFS IF(IDIM.EQ.3)THEN * ELEMENTS 3D NBROBL=15 NBRFAC=0 SEGINI NOMID MOMATR=NOMID LESOBL(1)='YG1 ' LESOBL(2)='YG2 ' LESOBL(3)='YG3 ' LESOBL(4)='NU12' LESOBL(5)='NU23' LESOBL(6)='NU13' LESOBL(7)='G12 ' LESOBL(8)='G23 ' LESOBL(9)='G13 ' LESOBL(10)='V1X ' LESOBL(11)='V1Y ' LESOBL(12)='V1Z ' LESOBL(13)='V2X ' LESOBL(14)='V2Y ' LESOBL(15)='V2Z ' ELSE IF (IDIM.EQ.2) THEN IF(IFOUR.EQ.-2)THEN * CONTRAINTE PLANE NBROBL=6 NBRFAC=0 SEGINI NOMID MOMATR=NOMID LESOBL(1)='YG1 ' LESOBL(2)='YG2 ' LESOBL(3)='NU12' LESOBL(4)='G12 ' LESOBL(5)='V1X ' LESOBL(6)='V1Y ' ELSE IF (IFOUR.EQ.-1.OR.IFOUR.EQ.0.OR.IFOUR.EQ.-3) THEN * DEFORMATION PLANE ,AXISYMETRIE NBROBL=9 NBRFAC=0 SEGINI NOMID MOMATR=NOMID LESOBL(1)='YG1 ' LESOBL(2)='YG2 ' LESOBL(3)='YG3 ' LESOBL(4)='NU12' LESOBL(5)='NU23' LESOBL(6)='NU13' LESOBL(7)='G12 ' LESOBL(8)='V1X ' LESOBL(9)='V1Y ' ELSE IF (IFOUR.EQ.1) THEN * AXISYMETRIE DE FOURIER NBROBL=11 NBRFAC=0 SEGINI NOMID MOMATR=NOMID LESOBL(1)='YG1 ' LESOBL(2)='YG2 ' LESOBL(3)='YG3 ' LESOBL(4)='NU12' LESOBL(5)='NU23' LESOBL(6)='NU13' LESOBL(7)='G12 ' LESOBL(8)='G23 ' LESOBL(9)='G13 ' LESOBL(10)='V1X ' LESOBL(11)='V1Y ' ENDIF ENDIF ELSE IF (MFR.EQ.35) THEN * ELEMENTS JOINTS IF (IFOUR.EQ.2) THEN NBROBL=5 NBRFAC=0 SEGINI NOMID MOMATR=NOMID LESOBL(1)='KS1 ' LESOBL(2)='KS2 ' LESOBL(3)='KN ' LESOBL(4)='V1X ' LESOBL(5)='V1Y ' ENDIF ENDIF NMATR=NBROBL NMATF=NBRFAC ELSEIF (CMATE.EQ.'ANISOTRO') THEN IF(MFR.EQ.1)THEN * ELEMENTS MASSIFS IF(IDIM.EQ.3)THEN * ELEMENTS 3D IF (IFOUR.EQ.2) THEN NBROBL=27 NBRFAC=0 SEGINI NOMID MOMATR=NOMID LESOBL(1)='D11 ' LESOBL(2)='D21 ' LESOBL(3)='D22 ' LESOBL(4)='D31 ' LESOBL(5)='D32 ' LESOBL(6)='D33 ' LESOBL(7)='D41 ' LESOBL(8)='D42 ' LESOBL(9)='D43 ' LESOBL(10)='D44 ' LESOBL(11)='D51 ' LESOBL(12)='D52 ' LESOBL(13)='D53 ' LESOBL(14)='D54 ' LESOBL(15)='D55 ' LESOBL(16)='D61 ' LESOBL(17)='D62 ' LESOBL(18)='D63 ' LESOBL(19)='D64 ' LESOBL(20)='D65 ' LESOBL(21)='D66 ' LESOBL(22)='V1X ' LESOBL(23)='V1Y ' LESOBL(24)='V1Z ' LESOBL(25)='V2X ' LESOBL(26)='V2Y ' LESOBL(27)='V2Z ' ENDIF ELSE IF (IDIM.EQ.2) THEN IF (IFOUR.EQ.-2) THEN * CONTRAINTE PLANE NBROBL=8 NBRFAC=0 SEGINI NOMID MOMATR=NOMID LESOBL(1)='D11 ' LESOBL(2)='D21 ' LESOBL(3)='D22 ' LESOBL(4)='D41 ' LESOBL(5)='D42 ' LESOBL(6)='D44 ' LESOBL(7)='V1X ' LESOBL(8)='V1Y ' ELSE IF (IFOUR.EQ.-1.OR.IFOUR.EQ.0.OR.IFOUR.EQ.-3) THEN * DEFORMATION PLANE ,AXISYMETRIE NBROBL=12 NBRFAC=0 SEGINI NOMID MOMATR=NOMID LESOBL(1)='D11 ' LESOBL(2)='D21 ' LESOBL(3)='D22 ' LESOBL(4)='D31 ' LESOBL(5)='D32 ' LESOBL(6)='D33 ' LESOBL(7)='D41 ' LESOBL(8)='D42 ' LESOBL(9)='D43 ' LESOBL(10)='D44 ' LESOBL(11)='V1X ' LESOBL(12)='V1Y ' ELSE IF (IFOUR.EQ.1) THEN * AXISYMETRIE DE FOURIER NBROBL=15 NBRFAC=0 SEGINI NOMID MOMATR=NOMID LESOBL(1)='D11 ' LESOBL(2)='D21 ' LESOBL(3)='D22 ' LESOBL(4)='D31 ' LESOBL(5)='D32 ' LESOBL(6)='D33 ' LESOBL(7)='D41 ' LESOBL(8)='D42 ' LESOBL(9)='D43 ' LESOBL(10)='D44 ' LESOBL(11)='D55 ' LESOBL(12)='D65 ' LESOBL(13)='D66 ' LESOBL(14)='V1X ' LESOBL(15)='V1Y ' ENDIF ENDIF ENDIF NMATR=NBROBL NMATF=NBRFAC ELSEIF (CMATE.EQ.'UNIDIREC') THEN IF ((MFR.EQ.1.OR.MFR.EQ.31).AND.IDIM.EQ.3) THEN NBROBL=7 NBRFAC=0 SEGINI NOMID MOMATR=NOMID LESOBL(1)='YOUN' LESOBL(2)='V1X ' LESOBL(3)='V1Y ' LESOBL(4)='V1Z ' LESOBL(5)='V2X ' LESOBL(6)='V2Y ' LESOBL(7)='V2Z ' ELSE NBROBL=3 NBRFAC=0 SEGINI NOMID MOMATR=NOMID LESOBL(1)='YOUN' LESOBL(2)='V1X ' LESOBL(3)='V1Y ' ENDIF NMATR=NBROBL NMATF=NBRFAC ELSE if(lnomid(6).ne.0) then nomid=lnomid(6) segact nomid momatr=nomid nmatr=lesobl(/2) nmatf=lesfac(/2) lsupma=.false. else lsupma=.true. CALL IDMATR(MFR,IMODEL,MOMATR,NMATR,NMATF) endif ENDIF ELSE if(lnomid(6).ne.0) then nomid=lnomid(6) segact nomid momatr=nomid nmatr=lesobl(/2) nmatf=lesfac(/2) lsupma=.false. else lsupma=.true. CALL IDMATR(MFR,IMODEL,MOMATR,NMATR,NMATF) endif ENDIF * IF (MFR.EQ.7.AND.CMATE.EQ.'SECTION') THEN NBTYPE=3 SEGINI NOTYPE TYPE(1)='POINTEURMMODEL' TYPE(2)='POINTEURMCHAML' TYPE(3)='POINTEURLISTREEL' ELSE NBTYPE=1 SEGINI NOTYPE TYPE(1)='REAL*8' ENDIF MOTYPE=NOTYPE CALL KOMCHA(IPCHE1,IPMAIL,CONM,MOMATR,MOTYPE,1,INFOS,3,IMAT) SEGSUP NOTYPE IF (IERR.NE.0) GOTO 9990 NUMAT=NMATR+NMATF * IF (MOMATR.NE.0.AND.ISUP5.EQ.1) THEN CALL VALCHE (IMAT,NUMAT,IPMINT,IPPORE,MOMATR,MELE) ENDIF * C____________________________________________________________________ C * TRAITEMENT DES CHAMPS DE CARACTERISTIQUES * C____________________________________________________________________ C NBROBL=0 NBRFAC=0 NOMID=0 * * EPAISSEUR ET EXCENTREMENT DANS LE CAS DES COQUES * IF (MFR.EQ.3.OR.MFR.EQ.5.OR.MFR.EQ.9) THEN NBROBL=1 NBRFAC=1 SEGINI NOMID LESOBL(1)='EPAI' LESFAC(1)='EXCE' * * SECTION POUR LES BARRES * ELSE IF (MFR.EQ.27) THEN NBROBL=1 SEGINI NOMID LESOBL(1)='SECT' c+mdj * * section, excentrements et orientation pour les barres excentrees * ELSE IF (MFR.EQ.49) THEN NBROBL=6 SEGINI NOMID LESOBL(1)='SECT' LESOBL(2)='EXCZ' LESOBL(3)='EXCY' LESOBL(4)='VX ' LESOBL(5)='VY ' LESOBL(6)='VZ ' * NBTYPE=1 SEGINI NOTYPE MOTYPE=NOTYPE TYPE(1)='REAL*8' c+mdj * * CARACTERISTIQUES POUR LES POUTRES * ELSE IF (MFR.EQ.7 ) THEN IF (CMATE.NE.'SECTION') THEN IF (IFOUR.EQ.-2.OR.IFOUR.EQ.-1.OR.IFOUR.EQ.-3) THEN NBRFAC=1 NBROBL=2 SEGINI NOMID LESOBL(1)= 'SECT' LESOBL(2)= 'INRZ' LESFAC(1)= 'SECY' ELSE NBROBL=4 NBRFAC=2 SEGINI NOMID LESOBL(1)='TORS' LESOBL(2)='INRY' LESOBL(3)='INRZ' LESOBL(4)='SECT' LESFAC(1)='SECY' LESFAC(2)='SECZ' ENDIF ELSE NBROBL=0 NBRFAC=1 SEGINI NOMID LESFAC(1)='VECT' ENDIF * * CARACTERISTIQUES POUR LES TUYAUX * ELSE IF (MFR.EQ.13) THEN NBROBL=2 NBRFAC=8 SEGINI NOMID LESOBL(1)='EPAI' LESOBL(2)='RAYO' LESFAC(1)='RACO' LESFAC(2)='PRES' LESFAC(3)='CISA' LESFAC(4)='CFFX' LESFAC(5)='CFMX' LESFAC(6)='CFMY' LESFAC(7)='CFMZ' LESFAC(8)='CFPR' * * CARACTERISTIQUES POUR LES LINESPRING * ELSE IF (MFR.EQ.15) THEN NBROBL=5 SEGINI NOMID LESOBL(1)='EPAI' LESOBL(2)='FISS' LESOBL(3)='VX ' LESOBL(4)='VY ' LESOBL(5)='VZ ' * * CARACTERISTIQUES POUR LES TUYAUX FISSURES * ELSE IF (MFR.EQ.17) THEN NBROBL=9 SEGINI NOMID LESOBL(1)='RAYO' LESOBL(2)='EPAI' LESOBL(3)='VX ' LESOBL(4)='VY ' LESOBL(5)='VZ ' LESOBL(6)='VXF ' LESOBL(7)='VYF ' LESOBL(8)='VZF ' LESOBL(9)='ANGL' * * CARACTERISTIQUES DES ELEMENTS HOMOGENEISES * ELSE IF (MFR.EQ.37) THEN IF(IFOUR.EQ.1.OR.IFOUR.EQ.0) THEN NBROBL=5 SEGINI NOMID LESOBL(1)='SCEL' LESOBL(2)='SFLU' LESOBL(3)='EPS ' LESOBL(4)='SECT' LESOBL(5)='INRZ' ELSE NBROBL=3 NBRFAC=2 SEGINI NOMID LESOBL(1)='SCEL' LESOBL(2)='SFLU' LESOBL(3)='EPS ' LESFAC(1)='NOF1' LESFAC(2)='NOF2' ENDIF ENDIF * MOCARA=NOMID NCARA=NBROBL NCARF=NBRFAC NUCAR=NCARA+NCARF IF (IPCHE1.NE.0.AND.MOCARA.NE.0) THEN NBTYPE=1 SEGINI NOTYPE TYPE(1)='REAL*8' IF(CMATE.EQ.'SECTION')TYPE(1)='POINTEURPOINT ' MOTYPE=NOTYPE CALL KOMCHA(IPCHE1,IPMAIL,CONM,MOCARA,MOTYPE,1,INFOS,3,ICAR) SEGSUP NOTYPE IF (IERR.NE.0) GOTO 9990 NOMID=MOCARA SEGDES NOMID ENDIF * IF (MOCARA.NE.0.AND.ISUP5.EQ.1) THEN CALL VALCHE (ICAR,NUCAR,IPMINT,IPPORE,MOCARA,MELE) ENDIF * RETURN * 9990 CONTINUE * * ERREUR DANS UNE SOUS ZONE, DESACTIVATION ET RETOUR * IRET =0 * IF (ISUP5.EQ.1) THEN CALL DTMVAL(IMAT,3) CALL DTMVAL(ICAR,3) ELSE CALL DTMVAL(IMAT,1) CALL DTMVAL(ICAR,1) ENDIF * NOMID=MOCARA IF (MOCARA.NE.0) SEGSUP NOMID NOMID=MOMATR IF (MOMATR.NE.0.and.lsupma) SEGSUP NOMID * SEGDES IMODEL * IF (IPCHE1.NE.0) THEN MCHEL1=IPCHE1 SEGDES MCHEL1 ENDIF RETURN END