C IDCARB SOURCE CB215821 24/04/08 21:15:02 11895 SUBROUTINE IDCARB(MELE,IFOUR,IPNOMC,NBROBL,NBRFAC) *--------------------------------------------------------------------* * RECHERCHE DES NOMS DE CARACTERISTIQUES * *--------------------------------------------------------------------* * * * ENTREES: * * * * MELE numero de l'element * * IFOUR issu de CCOPTIO * * * * SORTIES: * * * * IPNOMC Pointeur sur les tables de noms de composantes * * obligatoires et facultatives * * NBROBL leur nombre ( =0 si pas trouve ) * * NBRFAC leur nombre ( =0 si pas trouve ) * * * *--------------------------------------------------------------------* * IMPLICIT INTEGER(I-N) SEGMENT NOMID CHARACTER*8 LESOBL(NBROBL),LESFAC(NBRFAC) ENDSEGMENT * MFR=NUMMFR(MELE) NBROBL = 0 NBRFAC = 0 NOMID=0 IF (MFR.EQ.1.OR.MFR.EQ.45) GOTO 9999 IF (IFOUR.LT.-3.OR.IFOUR.GT.2) GOTO 9999 * * element uy2 et ty3 pour advection * IF(MELE.EQ.269.or.mele.eq.270) then NBROBL=1 SEGINI NOMID LESOBL(1)= 'SECT' ENDIF * * ELEMENTS CIFL MACRO ELEMENT CISAILLEMENT FLEXION * IF (MELE.EQ.258)THEN IF (IFOUR.EQ.-1.OR.IFOUR.EQ.-2) THEN NBROBL=2 SEGINI NOMID LESOBL(1)= 'SECT' LESOBL(2)= 'INRZ' ENDIF ENDIF * * COQUE MINCE OU CISAILLEMENT TRANSVERSE * IF (MFR.EQ.3.OR.MFR.EQ.9) THEN NBROBL=1 NBRFAC=2 SEGINI NOMID LESOBL(1)='EPAI' LESFAC(1)='CALF' LESFAC(2)='EXCE' * * COQUE EPAISSE * ELSE IF (MFR.EQ.5) THEN NBROBL=1 NBRFAC=1 SEGINI NOMID LESOBL(1)='EPAI' LESFAC(1)='EXCE' * * POUTRES TRIDIM * ELSE IF (MFR.EQ.7) THEN IF (IFOUR.EQ.2) THEN NBRFAC=9 NBROBL=4 SEGINI NOMID LESOBL(1)= 'TORS' LESOBL(2)= 'INRY' LESOBL(3)= 'INRZ' LESOBL(4)= 'SECT' LESFAC(1)= 'SECY' LESFAC(2)= 'SECZ' LESFAC(3)= 'DX ' LESFAC(4)= 'DY ' LESFAC(5)= 'DZ ' LESFAC(6)= 'OMEG' LESFAC(7)= 'VX' LESFAC(8)= 'VY' LESFAC(9)= 'VZ' * * POUTRES 2D ELSEIF (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' * ENDIF * * LIA2 : ELEMENT 3D DE LIAISON A 2 NOEUDS * ELSE IF (MFR.EQ.51) THEN NBROBL=9 SEGINI NOMID LESOBL(1)='RLUX' LESOBL(2)='RLUY' LESOBL(3)='RLUZ' LESOBL(4)='RLRX' LESOBL(5)='RLRY' LESOBL(6)='RLRZ' LESOBL(7)='VX ' LESOBL(8)='VY ' LESOBL(9)='VZ ' * * BAEX : BARRE EXCENTRE * 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 ' * * TUYAU ACOUSTIQUE PURE * ELSE IF (MFR.EQ.41) THEN NBROBL=1 NBRFAC=1 SEGINI NOMID LESOBL(1)='RAYO' LESFAC(1)='RACO' * * TUYAU TRIDIM * ELSE IF (MFR.EQ.13) THEN IF (IFOUR.EQ.2) THEN NBROBL=2 NBRFAC=12 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' LESFAC(9)= 'OMEG' LESFAC(10)='VX' LESFAC(11)='VY' LESFAC(12)='VZ' ENDIF * * TUYO * ELSE IF (MFR.EQ.39) THEN IF (IFOUR.EQ.2) THEN NBROBL=2 NBRFAC=5 SEGINI NOMID LESOBL(1)='EPAI' LESOBL(2)='RAYO' LESFAC(1)='RACO' LESFAC(2)='PRES' LESFAC(3)='VX' LESFAC(4)='VY' LESFAC(5)='VZ' ENDIF * * LINESPRING * ELSE IF (MFR.EQ.15) THEN IF (IFOUR.EQ.2) THEN NBROBL=5 SEGINI NOMID LESOBL(1)='EPAI' LESOBL(2)='FISS' LESOBL(3)='VX ' LESOBL(4)='VY ' LESOBL(5)='VZ ' ENDIF * * TUYAU FISSURE * ELSE IF (MFR.EQ.17) THEN IF (IFOUR.EQ.2) THEN NBROBL=9 SEGINI NOMID c LESOBL(1)='RAYO' c LESOBL(2)='EPAI' c LESOBL(3)='ANGL' c LESOBL(4)='VX ' c LESOBL(5)='VY ' c LESOBL(6)='VZ ' c LESOBL(7)='VXF ' c LESOBL(8)='VYF ' c LESOBL(9)='VZF ' 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' ENDIF * * BARRE or COS2 * ELSE IF (MFR.EQ.27.OR.MFR.EQ.78) THEN NBROBL=1 SEGINI NOMID LESOBL(1)='SECT' * * ELEMENT HOMOGENE * ELSE IF (MFR.EQ.37) THEN IF (IFOUR.EQ.1.OR.IFOUR.EQ.0.OR.IFOUR.EQ.2) 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 * * RACCORD LIQUIDE TUYAU * ELSE IF (MFR.EQ.43) THEN NBROBL=1 NBRFAC=5 SEGINI NOMID LESOBL(1)='RAYO' LESFAC(1)='RACO' LESFAC(2)='VECT' LESFAC(3)='VEC1' LESFAC(4)='VEC2' LESFAC(5)='VEC3' * * ELEMENTS DE SECTION * ELSE IF (MFR.EQ.47) THEN IF (IFOUR.EQ.2) THEN NBROBL=2 SEGINI NOMID LESOBL(1)='ALPY' LESOBL(2)='ALPZ' ELSE NBROBL=1 NBRFAC=0 SEGINI NOMID LESOBL(1)='ALPY' ENDIF C * caracteristique supplementaire pour le SEGS IF(MELE.EQ.166)THEN NBROBL=NBROBL+1 SEGADJ,NOMID LESOBL(NBROBL)='LARG' ENDIF * caracteristique supplementaire pour le POJS IF(MELE.EQ.167)THEN NBROBL=NBROBL+1 SEGADJ,NOMID LESOBL(NBROBL)='SECT' ENDIF C * * JOINTS GENERALISE * ELSE IF (MFR.EQ.55) THEN CcPPj NBROBL=1 CcPPj NBRFAC=0 CcPPj SEGINI NOMID CcPPj LESOBL(1)='EPAI' NBROBL=0 NBRFAC=1 SEGINI NOMID LESFAC(1)='EPAI' * ENDIF * 9999 CONTINUE IF (NOMID.EQ.0) SEGINI NOMID * ajout de la densite (rendement) vectorielle du constituant kich ifac = nbrfac NBRFAC= nbrfac + 10 segadj nomid lesfac(ifac + 1) ='REND' lesfac(ifac + 2) ='W1X ' lesfac(ifac + 3) ='W1Y ' lesfac(ifac + 4) ='W1Z ' lesfac(ifac + 5) ='W2X ' lesfac(ifac + 6) ='W2Y ' lesfac(ifac + 7) ='W2Z ' lesfac(ifac + 8) ='REN1' lesfac(ifac + 9) ='REN2' lesfac(ifac + 10)='REN3' IPNOMC=NOMID RETURN END