1 : C IDCARB SOURCE CHAT 12/06/07 21:15:20 7389 2 : SUBROUTINE IDCARB(MELE,IFOUR,IPNOMC,NBROBL,NBRFAC) 3 : *--------------------------------------------------------------------* 4 : * RECHERCHE DES NOMS DE CARACTERISTIQUES * 5 : *--------------------------------------------------------------------* 6 : * * 7 : * ENTREES: * 8 : * * 9 : * MELE numero de l'element * 10 : * IFOUR issu de CCOPTIO * 11 : * * 12 : * SORTIES: * 13 : * * 14 : * IPNOMC Pointeur sur les tables de noms de composantes * 15 : * obligatoires et facultatives * 16 : * NBROBL leur nombre ( =0 si pas trouve ) * 17 : * NBRFAC leur nombre ( =0 si pas trouve ) * 18 : * * 19 : *--------------------------------------------------------------------* 20 : * 21 : IMPLICIT INTEGER(I-N) 22 : SEGMENT NOMID 23 : CHARACTER*8 LESOBL(NBROBL),LESFAC(NBRFAC) 24 : ENDSEGMENT 25 : * 26 : MFR=NUMMFR(MELE) 27 : NBROBL = 0 28 : NBRFAC = 0 29 : NOMID=0 30 : IF (MFR.EQ.1.OR.MFR.EQ.45) GOTO 9999 31 : IF (IFOUR.LT.-3.OR.IFOUR.GT.2) GOTO 9999 32 : * 33 : * element uy2 et ty3 pour advection 34 : * 35 : IF(MELE.EQ.269.or.mele.eq.270) then 36 : NBROBL=1 37 : SEGINI NOMID 38 : LESOBL(1)= 'SECT' 39 : ENDIF 40 : * 41 : * ELEMENTS CIFL MACRO ELEMENT CISAILLEMENT FLEXION 42 : * 43 : IF (MELE.EQ.258)THEN 44 : IF (IFOUR.EQ.-1.OR.IFOUR.EQ.-2) THEN 45 : NBROBL=2 46 : SEGINI NOMID 47 : LESOBL(1)= 'SECT' 48 : LESOBL(2)= 'INRZ' 49 : ENDIF 50 : ENDIF 51 : * 52 : * COQUE MINCE OU CISAILLEMENT TRANSVERSE 53 : * 54 : IF (MFR.EQ.3.OR.MFR.EQ.9) THEN 55 : NBROBL=1 56 : NBRFAC=2 57 : SEGINI NOMID 58 : LESOBL(1)='EPAI' 59 : LESFAC(1)='CALF' 60 : LESFAC(2)='EXCE' 61 : * 62 : * COQUE EPAISSE 63 : * 64 : ELSE IF (MFR.EQ.5) THEN 65 : NBROBL=1 66 : NBRFAC=1 67 : SEGINI NOMID 68 : LESOBL(1)='EPAI' 69 : LESFAC(1)='EXCE' 70 : * 71 : * POUTRES TRIDIM 72 : * 73 : ELSE IF (MFR.EQ.7) THEN 74 : IF (IFOUR.EQ.2) THEN 75 : NBRFAC=7 76 : NBROBL=4 77 : SEGINI NOMID 78 : LESOBL(1)= 'TORS' 79 : LESOBL(2)= 'INRY' 80 : LESOBL(3)= 'INRZ' 81 : LESOBL(4)= 'SECT' 82 : LESFAC(1)= 'SECY' 83 : LESFAC(2)= 'SECZ' 84 : LESFAC(3)= 'DX ' 85 : LESFAC(4)= 'DY ' 86 : LESFAC(5)= 'DZ ' 87 : LESFAC(6)= 'OMEG' 88 : LESFAC(7)= 'VECT' 89 : * 90 : * POUTRES 2D 91 : ELSEIF (IFOUR.EQ.-2.OR.IFOUR.EQ.-1.OR.IFOUR.EQ.-3) THEN 92 : NBRFAC=1 93 : NBROBL=2 94 : SEGINI NOMID 95 : LESOBL(1)= 'SECT' 96 : LESOBL(2)='INRZ' 97 : LESFAC(1)= 'SECY' 98 : * 99 : ENDIF 100 : * 101 : * LIA2 : ELEMENT 3D DE LIAISON A 2 NOEUDS 102 : * 103 : ELSE IF (MFR.EQ.51) THEN 104 : NBROBL=9 105 : SEGINI NOMID 106 : LESOBL(1)='RLUX' 107 : LESOBL(2)='RLUY' 108 : LESOBL(3)='RLUZ' 109 : LESOBL(4)='RLRX' 110 : LESOBL(5)='RLRY' 111 : LESOBL(6)='RLRZ' 112 : LESOBL(7)='VX ' 113 : LESOBL(8)='VY ' 114 : LESOBL(9)='VZ ' 115 : 116 : * 117 : * BAEX : BARRE EXCENTRE 118 : * 119 : ELSE IF (MFR.EQ.49) THEN 120 : NBROBL=6 121 : SEGINI NOMID 122 : LESOBL(1)='SECT' 123 : LESOBL(2)='EXCZ' 124 : LESOBL(3)='EXCY' 125 : LESOBL(4)='VX ' 126 : LESOBL(5)='VY ' 127 : LESOBL(6)='VZ ' 128 : * 129 : * TUYAU ACOUSTIQUE PURE 130 : * 131 : ELSE IF (MFR.EQ.41) THEN 132 : NBROBL=1 133 : NBRFAC=1 134 : SEGINI NOMID 135 : LESOBL(1)='RAYO' 136 : LESFAC(1)='RACO' 137 : * 138 : * TUYAU TRIDIM 139 : * 140 : ELSE IF (MFR.EQ.13) THEN 141 : IF (IFOUR.EQ.2) THEN 142 : NBROBL=2 143 : NBRFAC=10 144 : SEGINI NOMID 145 : LESOBL(1)='EPAI' 146 : LESOBL(2)='RAYO' 147 : LESFAC(1)='RACO' 148 : LESFAC(2)='PRES' 149 : LESFAC(3)='CISA' 150 : LESFAC(4)='CFFX' 151 : LESFAC(5)='CFMX' 152 : LESFAC(6)='CFMY' 153 : LESFAC(7)='CFMZ' 154 : LESFAC(8)='CFPR' 155 : LESFAC(9)= 'OMEG' 156 : LESFAC(10)='VECT' 157 : ENDIF 158 : * 159 : * TUYO 160 : * 161 : ELSE IF (MFR.EQ.39) THEN 162 : IF (IFOUR.EQ.2) THEN 163 : NBROBL=2 164 : NBRFAC=3 165 : SEGINI NOMID 166 : LESOBL(1)='EPAI' 167 : LESOBL(2)='RAYO' 168 : LESFAC(1)='RACO' 169 : LESFAC(2)='PRES' 170 : LESFAC(3)='VECT' 171 : ENDIF 172 : * 173 : * LINESPRING 174 : * 175 : ELSE IF (MFR.EQ.15) THEN 176 : IF (IFOUR.EQ.2) THEN 177 : NBROBL=5 178 : SEGINI NOMID 179 : LESOBL(1)='EPAI' 180 : LESOBL(2)='FISS' 181 : LESOBL(3)='VX ' 182 : LESOBL(4)='VY ' 183 : LESOBL(5)='VZ ' 184 : ENDIF 185 : * 186 : * TUYAU FISSURE 187 : * 188 : ELSE IF (MFR.EQ.17) THEN 189 : IF (IFOUR.EQ.2) THEN 190 : NBROBL=9 191 : SEGINI NOMID 192 : c LESOBL(1)='RAYO' 193 : c LESOBL(2)='EPAI' 194 : c LESOBL(3)='ANGL' 195 : c LESOBL(4)='VX ' 196 : c LESOBL(5)='VY ' 197 : c LESOBL(6)='VZ ' 198 : c LESOBL(7)='VXF ' 199 : c LESOBL(8)='VYF ' 200 : c LESOBL(9)='VZF ' 201 : LESOBL(1)='RAYO' 202 : LESOBL(2)='EPAI' 203 : LESOBL(3)='VX ' 204 : LESOBL(4)='VY ' 205 : LESOBL(5)='VZ ' 206 : LESOBL(6)='VXF ' 207 : LESOBL(7)='VYF ' 208 : LESOBL(8)='VZF ' 209 : LESOBL(9)='ANGL' 210 : ENDIF 211 : * 212 : * BARRE 213 : * 214 : ELSE IF (MFR.EQ.27) THEN 215 : NBROBL=1 216 : SEGINI NOMID 217 : LESOBL(1)='SECT' 218 : * 219 : * ELEMENT HOMOGENE 220 : * 221 : ELSE IF (MFR.EQ.37) THEN 222 : IF (IFOUR.EQ.1.OR.IFOUR.EQ.0.OR.IFOUR.EQ.2) THEN 223 : NBROBL=5 224 : SEGINI NOMID 225 : LESOBL(1)='SCEL' 226 : LESOBL(2)='SFLU' 227 : LESOBL(3)='EPS ' 228 : LESOBL(4)='SECT' 229 : LESOBL(5)='INRZ' 230 : ELSE 231 : NBROBL=3 232 : NBRFAC=2 233 : SEGINI NOMID 234 : LESOBL(1)='SCEL' 235 : LESOBL(2)='SFLU' 236 : LESOBL(3)='EPS ' 237 : LESFAC(1)='NOF1' 238 : LESFAC(2)='NOF2' 239 : ENDIF 240 : * 241 : * RACCORD LIQUIDE TUYAU 242 : * 243 : ELSE IF (MFR.EQ.43) THEN 244 : NBROBL=1 245 : NBRFAC=2 246 : SEGINI NOMID 247 : LESOBL(1)='RAYO' 248 : LESFAC(1)='RACO' 249 : LESFAC(2)='VECT' 250 : * 251 : * ELEMENTS DE SECTION 252 : * 253 : ELSE IF (MFR.EQ.47) THEN 254 : IF (IFOUR.EQ.2) THEN 255 : NBROBL=2 256 : SEGINI NOMID 257 : LESOBL(1)='ALPY' 258 : LESOBL(2)='ALPZ' 259 : ELSE 260 : NBROBL=1 261 : NBRFAC=0 262 : SEGINI NOMID 263 : LESOBL(1)='ALPY' 264 : ENDIF 265 : C 266 : * caracteristique supplementaire pour le SEGS 267 : IF(MELE.EQ.166)THEN 268 : NBROBL=NBROBL+1 269 : SEGADJ,NOMID 270 : LESOBL(NBROBL)='LARG' 271 : ENDIF 272 : * caracteristique supplementaire pour le POJS 273 : IF(MELE.EQ.167)THEN 274 : NBROBL=NBROBL+1 275 : SEGADJ,NOMID 276 : LESOBL(NBROBL)='SECT' 277 : ENDIF 278 : C 279 : * 280 : * JOINTS GENERALISE 281 : * 282 : ELSE IF (MFR.EQ.55) THEN 283 : CcPPj NBROBL=1 284 : CcPPj NBRFAC=0 285 : CcPPj SEGINI NOMID 286 : CcPPj LESOBL(1)='EPAI' 287 : NBROBL=0 288 : NBRFAC=1 289 : SEGINI NOMID 290 : LESFAC(1)='EPAI' 291 : * 292 : ENDIF 293 : 294 : * 295 : 9999 CONTINUE 296 : IF (NOMID.EQ.0) SEGINI NOMID 297 : 298 : * ajout de la densite (rendement) vectorielle du constituant kich 299 : ifac = nbrfac 300 : NBRFAC= nbrfac + 10 301 : segadj nomid 302 : lesfac(ifac + 1) = 'REND' 303 : lesfac(ifac + 2) = 'W1X ' 304 : lesfac(ifac + 3) = 'W1Y ' 305 : lesfac(ifac + 4) = 'W1Z ' 306 : lesfac(ifac + 5) = 'W2X ' 307 : lesfac(ifac + 6) = 'W2Y ' 308 : lesfac(ifac + 7) = 'W2Z ' 309 : lesfac(ifac + 8) = 'REN1' 310 : lesfac(ifac + 9) = 'REN2' 311 : lesfac(ifac + 10) = 'REN3' 312 : 313 : 314 : IPNOMC=NOMID 315 : SEGDES NOMID 316 : RETURN 317 : END 318 : 319 : 320 : 321 : 322 : 323 : 324 : 325 : 326 : 327 : 328 : 329 :
© Cast3M 2003 - All rights reserved.
Disclaimer