1 : C SORABA SOURCE PV 12/12/06 21:15:21 7594 2 : ************************************************************************ 3 : * NOM : soraba.eso 4 : * DESCRIPTION : Sortie d'un maillage au format .inp ABAQUS(TM) 5 : ************************************************************************ 6 : * HISTORIQUE : 8/01/2010 : FANDEUR : création de la subroutine 7 : * HISTORIQUE : 7/06/2012 : JCARDO : l'argument MOT1 devient optionnel 8 : * + ajout de l'extension .inp 9 : * HISTORIQUE : 10 : ************************************************************************ 11 : * Prière de PRENDRE LE TEMPS DE COMPLÉTER LES COMMENTAIRES 12 : * en cas de modification de ce sous-programme afin de faciliter 13 : * la maintenance ! 14 : ************************************************************************ 15 : * APPELÉ PAR : opérateur SORTir (prsort.eso) 16 : ************************************************************************ 17 : * ENTRÉES :: aucune 18 : * SORTIES :: aucune (sur fichier uniquement) 19 : ************************************************************************ 20 : * SYNTAXE (GIBIANE) : 21 : * 22 : * SORT 'ABAQ' MAIL1 23 : * 24 : ************************************************************************ 25 : 26 : SUBROUTINE SORABA 27 : 28 : IMPLICIT INTEGER(I-N) 29 : IMPLICIT REAL*8(A-H,O-Z) 30 : 31 : -INC CCOPTIO 32 : 33 : -INC SMCOORD 34 : -INC SMELEME 35 : -INC SMINTE 36 : -INC SMLENTI 37 : SEGMENT MLISEF.MLENTI 38 : -INC TMLCHA8 39 : 40 : SEGMENT MCHAEF 41 : CHARACTER*16 LCHA16(MEF) 42 : ENDSEGMENT 43 : 44 : SEGMENT ITAB(0) 45 : POINTEUR ITAB1.ITAB 46 : 47 : SEGMENT IMAIL 48 : INTEGER I_OBJ(NBMAIL),I_MAI(NBMAIL),L_OBJ(NBMAIL) 49 : CHARACTER*16 C_OBJ(NBMAIL) 50 : ENDSEGMENT 51 : 52 : SEGMENT MWRK 53 : INTEGER NOEELT(nbno) 54 : REAL*8 XEL(3,nbno) 55 : ENDSEGMENT 56 : 57 : EXTERNAL LONG 58 : 59 : CHARACTER*16 CHA16z,CODEEF 60 : 61 : C= Nombre d'informations par maillage elementaire dans MLISEF 62 : PARAMETER (IN_EF=3) 63 : 64 : C= Unite logique du fichier d'impression au format Abaqus(TM) 65 : PARAMETER (IUABA=66) 66 : CHARACTER*256 FicAba 67 : LOGICAL ZOPEN 68 : 69 : C= Base de conversion des elements MASSIFS Cast3m vers Abaqus 70 : PARAMETER (NNOMAX=20,NEFMAX=12) 71 : DIMENSION lTypEF(NEFMAX), 72 : & lInver(NNOMAX,NEFMAX),lOrdre(NNOMAX,NEFMAX) 73 : CHARACTER*6 NomAba(NEFMAX) 74 : 75 : C= Element : SEG2 SEG3 TRI3 QUA4 TRI6 76 : C= QUA8 TET4 PRI6 CUB8 TE10 77 : C= PR15 CU20 78 : DATA lTypEF / 2, 3, 4, 8, 6, 79 : & 10, 23, 16, 14, 24, 80 : & 17, 15 / 81 : DATA ((lInver(j,i),j=1,NNOMAX),i=1,NEFMAX) 82 : & / 2, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 83 : & 3, 2, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 84 : & 1, 3, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 85 : & 1, 4, 3, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 86 : & 1, 6, 5, 4, 3, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 87 : & 1, 8, 7, 6, 5, 4, 3, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 88 : & 1, 3, 2, 4, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 89 : & 4, 5, 6, 1, 2, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 90 : & 5, 6, 7, 8, 1, 2, 3, 4, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 91 : & 1, 7,10, 9, 5, 6, 2, 8, 4, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 92 : & 10,11,12,13,14,15, 7, 8, 9, 1, 2, 3, 4, 5, 6, 0, 0, 0, 0, 0, 93 : & 13,14,15,16,17,18,19,20, 9,10,11,12, 1, 2, 3, 4, 5, 6, 7, 8 / 94 : DATA ((lOrdre(j,i),j=1,NNOMAX),i=1,NEFMAX) 95 : & / 1, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 96 : & 1, 3, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 97 : & 1, 2, 3, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 98 : & 1, 2, 3, 4, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 99 : & 1, 3, 5, 2, 4, 6, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 100 : & 1, 3, 5, 7, 2, 4, 6, 8, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 101 : & 1, 2, 3, 4, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 102 : & 1, 2, 3, 4, 5, 6, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 103 : & 1, 2, 3, 4, 5, 6, 7, 8, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 104 : & 1, 3, 5,10, 2, 4, 6, 7, 8, 9, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 105 : & 1, 3, 5,10,12,14, 2, 4, 6,11,13,15, 7, 8, 9, 0, 0, 0, 0, 0, 106 : & 1, 3, 5, 7,13,15,17,19, 2, 4, 6, 8,14,16,18,20, 9,10,11,12 / 107 : DATA NomAba / '____ ','____ ','C__3 ','C__4 ','C__6 ', 108 : & 'C__8 ','C3D4 ','C3D6 ','C3D8 ','C3D10 ', 109 : & 'C3D15 ','C3D20 ' / 110 : 111 : C=== 112 : C 0 - Premieres initialisations 113 : C=== 114 : idimp1=IDIM+1 115 : C= Liste des elements MASSIFS qui sont sauvegardes (suivant IDIM) 116 : IF (IDIM.EQ.3) THEN 117 : I_DEB=7 118 : I_FIN=12 119 : ELSE IF (IDIM.EQ.2) THEN 120 : I_DEB=3 121 : I_FIN=6 122 : IF (IFOUR.EQ.-2) THEN 123 : DO i=I_DEB,I_FIN 124 : NomAba(i)(2:3)='PS' 125 : ENDDO 126 : ELSE IF (IFOUR.GE.0) THEN 127 : DO i=I_DEB,I_FIN 128 : NomAba(i)(2:3)='AX' 129 : ENDDO 130 : ELSE 131 : DO i=I_DEB,I_FIN 132 : NomAba(i)(2:3)='PE' 133 : ENDDO 134 : ENDIF 135 : ELSE IF (IDIM.EQ.1) THEN 136 : I_DEB=1 137 : I_FIN=2 138 : ELSE 138 : CALL ERREUR(832) 139 : RETURN 140 : ENDIF 141 : C En cas d erreur sur le fichier de sortie (si non nul) 142 : IOS=0 143 : 144 : C=== 145 : C 1 - Lecture des arguments (obligatoires) 146 : C=== 147 : C Lecture du maillage a sauvegarder 147 : CALL LIROBJ('MAILLAGE',MAIREF,1,IRETOU) 148 : IF (IERR.NE.0) RETURN 149 : * 150 : C Lecture du nom du fichier de sauvegarde (=> bypass de OPTI SORT) 151 : C (CONSERVE POUR COMPATIBILITE MAIS NON DOCUMENTE) 151 : CALL LIRCHA(FICABA,0,IRETOU) 152 : IF (IRETOU.EQ.0) THEN 153 : INQUIRE(UNIT=IOPER,OPENED=ZOPEN) 154 : IF (.NOT.ZOPEN) THEN 154 : CALL ERREUR(-212) 155 : WRITE(IOIMP,*) '(via OPTI "SORT")' 156 : MOTERR(1:8)='ABAQUS ' 156 : CALL ERREUR(705) 157 : RETURN 158 : ENDIF 159 : INQUIRE(UNIT=IOPER,NAME=NOMFIC) 160 : CLOSE(UNIT=IOPER,STATUS='DELETE') 161 : * 162 : * Ajout de l'extension au nom du fichier 162 : CALL LENCHA(NOMFIC,LC) 163 : FICABA=NOMFIC(1:LC) 164 : IF (NOMFIC(LC-3:LC).NE.'.inp') FICABA(LC+1:LC+4)='.inp' 165 : ENDIF 166 : 167 : * 168 : C= Prevoir des options supplementaires ? 169 : 170 : WRITE(IOIMP,*) 171 : C=== 172 : C 2 - Analyse de l objet MAILLAGE a sauvegarder 173 : C=== 174 : WRITE(IOIMP,500) 'Analyse du MAILLAGE a sauvegarder' 175 : C Verification du type des elements du maillage 176 : C Determination du nombre d'elements du maillage 177 : MELEME=MAIREF 178 : SEGACT,MELEME 179 : NB_OBJ=LISOUS(/1) 180 : NB_EF=MAX(1,NB_OBJ) 181 : JG=IN_EF*NB_EF 182 : SEGINI,MLISEF 183 : MEF=NB_EF 184 : SEGINI,MCHAEF 185 : CODEEF='0000000000000000' 186 : NB_ELT=0 187 : IF (NB_OBJ.EQ.0) THEN 188 : i_z=ITYPEL 189 : DO i=I_DEB,I_FIN 190 : IF (i_z.EQ.lTypEF(i)) GOTO 1 191 : ENDDO 191 : CALL ERREUR(16) 192 : GOTO 900 193 : 1 CONTINUE 194 : MLISEF.LECT(1)=MELEME 195 : MLISEF.LECT(2)=i 196 : MLISEF.LECT(3)=NB_ELT 197 : MCHAEF.LCHA16(1)='EF_'//NomAba(i) 198 : CODEEF(1:1)='1' 199 : NB_ELT=NB_ELT+NUM(/2) 200 : ELSE 201 : k=1 202 : DO j=1,NB_OBJ 203 : IPT1=LISOUS(j) 204 : SEGACT,IPT1 205 : i_z=IPT1.ITYPEL 206 : DO i=I_DEB,I_FIN 207 : IF (i_z.EQ.lTypEF(i)) GOTO 2 208 : ENDDO 208 : CALL ERREUR(16) 209 : GOTO 900 210 : 2 CONTINUE 211 : MLISEF.LECT(k)=IPT1 212 : MLISEF.LECT(k+1)=i 213 : MLISEF.LECT(k+2)=NB_ELT 214 : MCHAEF.LCHA16(j)='EF_'//NomAba(i) 215 : CODEEF(j:j)='1' 216 : NB_ELT=NB_ELT+IPT1.NUM(/2) 217 : k=k+IN_EF 218 : ENDDO 219 : ENDIF 220 : C*I WRITE(IOIMP,501) 'Type EF =',NB_EF 221 : C Appel a TASSER pour mettre les noeuds a sauvegarder en premier 222 : WRITE(IOIMP,502) 'Appel a TASSER (etape longue)' 223 : SEGINI,ITAB 224 : ITAB(**)=MAIREF 225 : MELEME=MAIREF 226 : IF (NB_OBJ.NE.0) THEN 227 : DO i=1,NB_OBJ 228 : ITAB(**)=LISOUS(i) 229 : ENDDO 230 : ENDIF 231 : ipt8=0 231 : CALL TASSPO(ITAB,ICOLAC,ipt8,0) 232 : IF (ipt8.GT.0) SEGSUP,ipt8 233 : IF (IERR.NE.0) THEN 234 : SEGSUP,ITAB 235 : GOTO 900 236 : ENDIF 237 : SEGINI,ITAB1=ITAB 237 : CALL SUPPIL(ICOLAC,-1) 238 : C= ITAB a ete supprime apres l'appel a SUPPIL. 239 : ITAB=ITAB1 240 : IF (IERR.NE.0) THEN 241 : SEGSUP,ITAB 242 : GOTO 900 243 : ENDIF 244 : C= Suite a l'appel a TASSER, les points sont classes en commencant par 245 : C= ceux associes au MAILLAGE qui nous interesse. Il suffit de trouver 246 : C= le noeud de numero max. dans le MAILLAGE. 247 : WRITE(IOIMP,502) 'Determination du numero du noeud max.' 248 : IMAX=0 249 : DO i=1,NB_EF 250 : MELEME=MLISEF.LECT(IN_EF*(i-1)+1) 251 : SEGACT,MELEME 252 : nbnn=NUM(/1) 253 : DO j=1,NUM(/2) 254 : DO k=1,nbnn 255 : IMAX=MAX(IMAX,NUM(k,j)) 256 : ENDDO 257 : ENDDO 258 : SEGDES,MELEME 259 : ENDDO 260 : C*I WRITE(IOIMP,501) 'Numero du noeud max. =',IMAX 261 : C Liste des objets MAILLAGEs eventuellement a sauvegarder (IMAIL) 262 : C= En sortie de TASSPO, ITAB a ete modifie et pointe sur tous les 263 : C= maillages references dans le MAILLAGE a sauvegarder. 264 : WRITE(IOIMP,502) 'Construction de la liste des maillages a sauver' 265 : C Rajout de tous les maillages elementaires dans ITAB non deja listes 266 : DO i=1,ITAB(/1) 267 : MELEME=ITAB(i) 268 : SEGACT,MELEME 269 : j=LISOUS(/1) 270 : IF (j.NE.0) THEN 271 : DO k=1,j 272 : IPT1=LISOUS(k) 273 : DO l=1,ITAB(/1) 274 : IF (IPT1.EQ.ITAB(l)) GOTO 3 275 : ENDDO 276 : ITAB(**)=IPT1 277 : 3 CONTINUE 278 : ENDDO 279 : ENDIF 280 : SEGDES,MELEME 281 : ENDDO 282 : C Analyse de tous les maillages elementaires 283 : C + Determination des groupes de noeuds 284 : C= Ne sont conserves que les maillages dont le type correspond 285 : C= a ceux du MAILLAGE a sauver et les maillages de type POI1. 286 : DO i=1,ITAB(/1) 287 : MELEME=ITAB(i) 288 : SEGACT,MELEME 289 : IF (LISOUS(/1).NE.0) GOTO 11 290 : IF (ITYPEL.EQ.1) GOTO 10 291 : DO j=1,IN_EF*NB_EF,IN_EF 292 : IF (MELEME.EQ.MLISEF.LECT(j)) GOTO 11 293 : IF (ITYPEL.EQ.lTypEF(MLISEF.LECT(j+1))) GOTO 10 294 : ENDDO 295 : C*I WRITE(ioimp,*) 'Maillage',i,MELEME,'type EF pas ok',ITYPEL 296 : ITAB(i)=0 297 : GOTO 11 298 : 10 CONTINUE 299 : nbnn=NUM(/1) 300 : nbel=NUM(/2) 301 : DO j=1,nbel 302 : DO k=1,nbnn 303 : IF (NUM(k,j).GT.IMAX) THEN 304 : C*I write(ioimp,*) 'Maillage avec noe > IMAX',i,MELEME 305 : ITAB(i)=0 306 : GOTO 11 307 : ENDIF 308 : ENDDO 309 : ENDDO 310 : IF (ITYPEL.EQ.1) ITAB(i)=-MELEME 311 : 11 CONTINUE 312 : SEGDES,MELEME 313 : ENDDO 314 : C ReAnalyse de tous les maillages complexes 315 : C= Les maillages de POI1 ne sont jamais complexes ! 316 : DO i=1,ITAB(/1) 317 : MELEME=ITAB(i) 318 : IF (MELEME.LE.0) GOTO 20 319 : SEGACT,MELEME 320 : j=LISOUS(/1) 321 : IF (j.EQ.0) GOTO 21 322 : DO k=1,j 323 : IPT1=LISOUS(k) 324 : DO l=1,ITAB(/1) 325 : IF (IPT1.EQ.ITAB(l)) GOTO 22 326 : ENDDO 327 : C*I write(ioimp,*) 'Maillage complexe sousref pas OK',i,k,IPT1 328 : ITAB(i)=0 329 : GOTO 21 330 : 22 CONTINUE 331 : ENDDO 332 : 21 CONTINUE 333 : SEGDES,MELEME 334 : 20 CONTINUE 335 : ENDDO 336 : C Liste des objets a considerer pour la sauvegarde (IMAIL) 337 : NBMAIL=0 338 : DO i=1,ITAB(/1) 339 : IF (ITAB(i).NE.0) NBMAIL=NBMAIL+1 340 : ENDDO 341 : C*I WRITE(IOIMP,*) 'NBMAIL=',NBMAIL,ITAB(/1) 342 : SEGINI,IMAIL 343 : j=0 344 : CHA16z='0000000000000000' 345 : DO i=1,ITAB(/1) 346 : k=ITAB(i) 347 : IF (k.NE.0) THEN 348 : j=j+1 349 : I_OBJ(j)=4 350 : IF (k.LT.0) I_OBJ(j)=1 351 : I_MAI(j)=ABS(k) 352 : C_OBJ(j)=' ' 353 : DO l=1,NB_EF 354 : m=IN_EF*(l-1)+1 355 : IF (k.EQ.MLISEF.LECT(m)) THEN 356 : I_OBJ(j)=2 357 : L_OBJ(j)=-l 358 : C_OBJ(j)=MCHAEF.LCHA16(l) 359 : CHA16z(l:l)='1' 360 : ENDIF 361 : ENDDO 362 : ENDIF 363 : ENDDO 364 : SEGSUP,ITAB 365 : IF (j.NE.NBMAIL) write(ioimp,*) '=> probleme !' 366 : IF (CHA16z.NE.CODEEF) THEN 367 : WRITE(IOIMP,510) 'codage incorrect' 368 : GOTO 901 369 : ENDIF 370 : C Poursuite de l'analyse des maillages elementaires 371 : C= Verification et remplissage de IMAIL 372 : JMAX=IMAX+1 373 : JG=JMAX 374 : SEGINI,MLENTI 375 : i_z=0 376 : DO i=1,NB_EF 377 : MELEME=MLISEF.LECT(i_z+1) 378 : SEGACT,MELEME 379 : nbnn=NUM(/1) 380 : nbel=NUM(/2) 381 : DO j=1,nbel 382 : DO k=1,nbnn 383 : j_z=NUM(k,j) 384 : LECT(j_z)=LECT(j_z)+1 385 : ENDDO 386 : ENDDO 387 : DO j=2,IMAX 388 : LECT(j)=LECT(j)+LECT(j-1) 389 : ENDDO 390 : JG=LECT(IMAX) 391 : LECT(JMAX)=JG 392 : SEGINI,MLENT1 393 : DO j=1,nbel 394 : DO k=1,nbnn 395 : j_z=NUM(k,j) 396 : k_z=LECT(j_z) 397 : MLENT1.LECT(k_z)=j 398 : LECT(j_z)=LECT(j_z)-1 399 : ENDDO 400 : ENDDO 401 : NumEF=MLISEF.LECT(i_z+3) 402 : DO j=1,NBMAIL 403 : IF (I_OBJ(j).LT.3) GOTO 30 404 : IPT1=I_MAI(j) 405 : IF (IPT1.EQ.MELEME) GOTO 30 406 : SEGACT,IPT1 407 : IF (IPT1.ITYPEL.NE.ITYPEL) GOTO 31 408 : nbnn=IPT1.NUM(/1) 409 : nbel=IPT1.NUM(/2) 410 : JG=nbel 411 : SEGINI,MLENT2 412 : j_z=0 413 : DO iel1=1,nbel 414 : iel=IPT1.NUM(1,iel1) 415 : ideb=LECT(iel)+1 416 : ifin=LECT(iel+1) 417 : IF (ifin.LT.ideb) GOTO 32 418 : DO k=ideb,ifin 419 : iel=MLENT1.LECT(k) 420 : DO l=1,nbnn 421 : IF (NUM(l,iel).NE.IPT1.NUM(l,iel1)) GOTO 34 422 : ENDDO 423 : j_z=j_z+1 424 : MLENT2.LECT(j_z)=NumEF+iel 425 : GOTO 33 426 : 34 CONTINUE 427 : ENDDO 428 : C*I write(ioimp,*) 'elt du maillage pas ds mlisef',j,IPT1,iel1,i 429 : GOTO 32 430 : 33 CONTINUE 431 : ENDDO 432 : 32 CONTINUE 433 : IF (j_z.NE.nbel) THEN 434 : I_OBJ(j)=0 435 : SEGSUP,MLENT2 436 : C*I write(ioimp,*) 'Mail',j,I_OBJ(j),' = non sauve' 437 : ELSE IF (j_z.EQ.NUM(/2)) THEN 438 : I_OBJ(j)=2 439 : L_OBJ(j)=-i 440 : SEGSUP,MLENT2 441 : C*I write(ioimp,*) 'Mail.',j,I_OBJ(j),'=Mail.EF',L_OBJ(j) 442 : ELSE 443 : I_OBJ(j)=3 444 : L_OBJ(j)=MLENT2 445 : SEGDES,MLENT2 446 : C*I write(ioimp,*) 'Mail.',j,I_OBJ(j),'=Mail.elem',L_OBJ(j) 447 : ENDIF 448 : 31 CONTINUE 449 : SEGDES,IPT1 450 : 30 CONTINUE 451 : ENDDO 452 : SEGSUP,MLENT1 453 : SEGDES,MELEME 454 : i_z=i_z+IN_EF 455 : C= Ne pas oublier de remettre a zero MLENTI pour le type EF suivant 456 : IF (NB_EF.NE.1) THEN 457 : DO j=1,JMAX 458 : LECT(j)=0 459 : ENDDO 460 : ENDIF 461 : ENDDO 462 : SEGSUP,MLENTI 463 : C ReAnalyse de tous les maillages complexes 464 : C + Fin du remplissage de IMAIL 465 : DO i=1,NBMAIL 466 : IF (I_OBJ(i).NE.4) GOTO 40 467 : MELEME=I_MAI(i) 468 : SEGACT,MELEME 469 : JG=LISOUS(/1) 470 : IF (JG.EQ.0) THEN 471 : C*I write(ioimp,*) 'Bizarre I_OBJ=4 et LISOUS(/1)=0 pour ITAB',i 472 : GOTO 41 473 : ENDIF 474 : SEGINI,MLENTI 475 : L_OBJ(i)=MLENTI 476 : DO j=1,JG 477 : IPT1=LISOUS(j) 478 : DO k=1,NBMAIL 479 : IF (IPT1.EQ.I_MAI(k)) GOTO 42 480 : ENDDO 481 : C*I write(ioimp,*) 'Maillage complexe sousref pas OK',i,k,IPT1 482 : I_OBJ(i)=0 483 : L_OBJ(i)=0 484 : SEGSUP,MLENTI 485 : GOTO 41 486 : 42 CONTINUE 487 : LECT(j)=k 488 : ENDDO 489 : 41 CONTINUE 490 : C*I write(ioimp,*) 'Mail.complexe',i,I_OBJ(i),L_OBJ(i) 491 : SEGDES,MELEME 492 : 40 CONTINUE 493 : ENDDO 494 : C Recuperation des MAILLAGEs nommes 495 : i_z=0 495 : CALL REPERT('MAILLAGE',i_z) 496 : IF (i_z.GT.0) THEN 496 : CALL REPLIS('MAILLAGE',MLCHA8) 497 : SEGACT,MLCHA8 498 : DO i=1,i_z 498 : CALL LIROBJ('MAILLAGE',IPT1,1,IRETOU) 499 : IF (IERR.NE.0) THEN 500 : SEGSUP,MLCHA8 501 : GOTO 901 502 : ENDIF 503 : DO j=1,NB_EF 504 : IF (IPT1.EQ.MLISEF.LECT(IN_EF*(j-1)+1)) 505 : & MCHAEF.LCHA16(j)=MLCHAR(i) 506 : ENDDO 507 : DO j=1,NBMAIL 508 : IF (IPT1.EQ.I_MAI(j)) C_OBJ(j)=MLCHAR(i) 509 : ENDDO 510 : ENDDO 511 : SEGSUP,MLCHA8 512 : ENDIF 513 : C Nom par defaut pour les maillages non nommes 514 : j=0 515 : iel=0 516 : DO i=1,NBMAIL 517 : IF (C_OBJ(i)(1:4).EQ.' ') THEN 518 : IF (I_OBJ(i).EQ.1) THEN 519 : j=j+1 520 : C_OBJ(i)(1:4)='Noe_' 521 : WRITE(C_OBJ(i)(5:8),FMT='(I4.4)') j 522 : ELSE IF (I_OBJ(i).GE.3) THEN 523 : iel=iel+1 524 : C_OBJ(i)(1:4)='Elt_' 525 : WRITE(C_OBJ(i)(5:8),FMT='(I4.4)') iel 526 : ENDIF 527 : ENDIF 528 : ENDDO 529 : C Determination du nombre de groupe de noeuds et de groupe d'elements 530 : NB_GNO=0 531 : NB_GEL=0 532 : DO i=1,NBMAIL 533 : IF (I_OBJ(i).EQ.1) THEN 534 : NB_GNO=NB_GNO+1 535 : ELSE IF (I_OBJ(i).EQ.2) THEN 536 : IF (C_OBJ(i).NE.MCHAEF.LCHA16(-L_OBJ(i))) NB_GEL=NB_GEL+1 537 : ELSE IF (I_OBJ(i).EQ.3) THEN 538 : NB_GEL=NB_GEL+1 539 : ELSE IF (I_OBJ(i).EQ.4) THEN 540 : NB_GEL=NB_GEL+1 541 : MLENTI=L_OBJ(i) 542 : k=0 543 : DO j=1,LECT(/1) 544 : j_z=I_OBJ(LECT(j)) 545 : IF (j_z.EQ.2.OR.j_z.EQ.3) k=k+1 546 : ENDDO 547 : IF (k.NE.LECT(/1)) THEN 548 : WRITE(IOIMP,510) 'ANORMALE (50)' 549 : GOTO 901 550 : ENDIF 551 : ENDIF 552 : 50 CONTINUE 553 : ENDDO 554 : 555 : C=== 556 : C 3 - Ecriture dans le fichier de sortie au format Abaqus(R) 557 : C=== 558 : C Ouverture du fichier au format Abaqus(R) 559 : WRITE(IOIMP,500) 'Ouverture du fichier au format Abaqus(R)' 560 : IOS=1 561 : CLOSE(UNIT=IUABA,ERR=901) 562 : IOS=0 563 : OPEN(UNIT=IUABA,STATUS='UNKNOWN',FILE=FicAba(1:LONG(FicAba)), 564 : & IOSTAT=IOS,FORM='FORMATTED') 565 : IF (IOS.NE.0) GOTO 901 566 : C Ecriture entete (a completer) 567 : WRITE(IOIMP,502) 'Ecriture de l entete du fichier' 568 : WRITE(IUABA,800) '****' 569 : C Ecriture des noeuds du maillage 570 : WRITE(IOIMP,502) 'Ecriture des noeuds du maillage' 571 : WRITE(IUABA,800) '** DEFINITION DES NOEUDS DU MAILLAGE' 572 : WRITE(IUABA,800) '****' 573 : WRITE(IUABA,800) '*NODE, SYSTEM=R' 574 : IF (IDIM.EQ.3) THEN 575 : DO i=1,IMAX 576 : j=idimp1*(i-1) 577 : WRITE(IUABA,FMT=810) i,XCOOR(j+1),XCOOR(j+2),XCOOR(j+3) 578 : ENDDO 579 : ELSE IF (IDIM.EQ.2) THEN 580 : DO i=1,IMAX 581 : j=idimp1*(i-1) 582 : WRITE(IUABA,FMT=811) i,XCOOR(j+1),XCOOR(j+2) 583 : ENDDO 584 : ELSE 585 : DO i=1,IMAX 586 : j=idimp1*(i-1) 587 : WRITE(IUABA,FMT=812) i,XCOOR(j+1) 588 : ENDDO 589 : ENDIF 590 : WRITE(IUABA,800) '****' 591 : WRITE(IOIMP,501) 'Nombre de noeuds =',IMAX 592 : C Ecriture des points nommes (un seul noeud) 593 : C Construction de la table des points nommes existants 594 : WRITE(IOIMP,502) 'Ecriture des points nommes' 595 : I_PTS=0 595 : CALL REPERT('POINT ',I_PTS) 596 : IF (I_PTS.NE.0) THEN 597 : WRITE(IUABA,800) '** DEFINITION DES NOEUDS NOMMES' 598 : WRITE(IUABA,800) '****' 598 : CALL REPLIS('POINT ',MLCHA8) 599 : SEGACT,MLCHA8 600 : DO i=1,I_PTS 600 : CALL LIROBJ('POINT ',IP1,1,IRETOU) 601 : IF (IERR.NE.0) THEN 602 : SEGSUP,MLCHA8 603 : GOTO 902 604 : ENDIF 605 : IF (IP1.GE.1 .AND. IP1.LE.IMAX) THEN 606 : WRITE(IUABA,820) MLCHAR(i)(1:LONG(MLCHAR(i))) 607 : WRITE(IUABA,821) IP1 608 : ENDIF 609 : ENDDO 610 : SEGSUP,MLCHA8 611 : WRITE(IUABA,800) '****' 612 : ENDIF 613 : WRITE(IOIMP,501) 'Nombre de noeuds nommes =',I_PTS 614 : C Ecriture des groupes de noeuds 615 : C= NSET au sens Abaqus et maillage de type POI1 au sens Cast3m 616 : WRITE(IOIMP,502) 'Ecriture des groupes de noeuds' 617 : IF (NB_GNO.NE.0) THEN 618 : WRITE(IUABA,800) '** DEFINITION DES GROUPES DE NOEUDS' 619 : WRITE(IUABA,800) '****' 620 : DO i=1,NBMAIL 621 : IF (I_OBJ(i).EQ.1) THEN 622 : MELEME=I_MAI(i) 623 : SEGACT,MELEME 624 : WRITE(IUABA,820) C_OBJ(i)(1:LONG(C_OBJ(i))) 625 : WRITE(IUABA,822) (NUM(1,k),k=1,NUM(/2)) 626 : SEGDES,MELEME 627 : ENDIF 628 : ENDDO 629 : WRITE(IUABA,800) '****' 630 : ENDIF 631 : WRITE(IOIMP,501) 'Nombre de groupe de noeuds =',NB_GNO 632 : C Ecriture des differents elements 633 : WRITE(IOIMP,502) 'Ecriture des elements du maillage' 634 : WRITE(IUABA,800) '** DEFINITION DES ELEMENTS' 635 : WRITE(IUABA,800) '****' 636 : DO i=1,NB_EF 637 : j=IN_EF*(i-1) 638 : MELEME=MLISEF.LECT(j+1) 639 : i_z =MLISEF.LECT(j+2) 640 : NumEF =MLISEF.LECT(j+3) 641 : CHA16z=MCHAEF.LCHA16(i) 642 : WRITE(IUABA,830) NomAba(i_z)(1:LONG(NomAba(i_z))), 643 : & CHA16z(1:LONG(CHA16z)) 644 : C*I WRITE(IOIMP,501) 'Orientation selon Abq ',i 645 : C Orientation des elements du maillage selon Abaqus : 646 : SEGACT,MELEME*MOD 647 : nbnn=NUM(/1) 648 : nbel=NUM(/2) 649 : IELE=ITYPEL 650 : C Recuperation des fonctions de forme et derivees associees de 651 : C l'element fini massif de type IELE 651 : CALL RESHPT(1,nbnn,IELE,IELE,0,ISPT,IRETOU) 652 : IF (IRETOU.NE.1) GOTO 60 653 : MINTE=ISPT 654 : SEGACT,MINTE 655 : nbno=nbnn 656 : SEGINI,MWRK 657 : DO iel=1,nbel 658 : C Recuperation des coordonnees des noeuds de l'element 658 : CALL DOXE(XCOOR,IDIM,nbnn,NUM,iel,XEL) 659 : C Calcul du jacobien au centre de gravite de l'element 660 : D11=0. 661 : D21=0. 662 : D12=0. 663 : D22=0. 664 : IF (IDIM.EQ.3) THEN 665 : D31=0. 666 : D32=0. 667 : D13=0. 668 : D23=0. 669 : D33=0. 670 : DO j=1,nbnn 671 : D11=D11+SHPTOT(2,j,1)*XEL(1,j) 672 : D21=D21+SHPTOT(3,j,1)*XEL(1,j) 673 : D31=D31+SHPTOT(4,j,1)*XEL(1,j) 674 : D12=D12+SHPTOT(2,j,1)*XEL(2,j) 675 : D22=D22+SHPTOT(3,j,1)*XEL(2,j) 676 : D32=D32+SHPTOT(4,j,1)*XEL(2,j) 677 : D13=D13+SHPTOT(2,j,1)*XEL(3,j) 678 : D23=D23+SHPTOT(3,j,1)*XEL(3,j) 679 : D33=D33+SHPTOT(4,j,1)*XEL(3,j) 680 : ENDDO 681 : DInv11=D22*D33-D23*D32 682 : DInv12=D32*D13-D12*D33 683 : DInv13=D12*D23-D22*D13 684 : DJAC=D11*DInv11+D21*DInv12+D31*DInv13 685 : ELSE IF (IDIM.EQ.2) THEN 686 : DO j=1,nbnn 687 : D11=D11+SHPTOT(2,j,1)*XEL(1,j) 688 : D21=D21+SHPTOT(3,j,1)*XEL(1,j) 689 : D12=D12+SHPTOT(2,j,1)*XEL(2,j) 690 : D22=D22+SHPTOT(3,j,1)*XEL(2,j) 691 : ENDDO 692 : DJAC=D11*D22-D21*D12 693 : C* ELSE IF (IDIM.EQ.1) THEN 694 : ELSE 695 : DJAC=XEL(1,nbnn)-XEL(1,1) 696 : ENDIF 697 : C Test si le jacobien est nul (pas bon) 698 : IF (ABS(DJAC).LE.0.) THEN 698 : CALL ERREUR(664) 699 : WRITE(IUABA,801) 'Element incorrect',NumEF+j 700 : ENDIF 701 : C Si le jacobien est negatif, on permute l'ordre des noeuds 702 : IF (DJAC.LT.0.) THEN 703 : DO k=1,nbno 704 : NOEELT(k)=NUM(lInver(k,i_z),iel) 705 : ENDDO 706 : DO k=1,nbno 707 : NUM(k,iel)=NOEELT(k) 708 : ENDDO 709 : ENDIF 710 : ENDDO 711 : SEGSUP,MWRK 712 : SEGDES,MINTE 713 : 60 CONTINUE 714 : IF (IERR.NE.0) THEN 715 : WRITE(IOIMP,510) 'ORIENTATION - Poursuite ecriture' 716 : WRITE(IUABA,800) '!! ERREUR ORIE - Verifier le maillage' 717 : ENDIF 718 : C*I WRITE(IOIMP,501) 'Ecriture des elements type '//NomAba(i_z) 719 : DO k=1,nbel 720 : NumEF=NumEF+1 721 : WRITE(IUABA,831) NumEF,(NUM(lOrdre(l,i_z),k),l=1,nbno) 722 : ENDDO 723 : SEGDES,MELEME 724 : ENDDO 725 : WRITE(IUABA,FMT='(A4)') '****' 726 : WRITE(IOIMP,501) 'Nb. type d elements =',NB_EF 727 : WRITE(IOIMP,501) 'Nombre d elements =',NB_ELT 728 : C Ecriture des groupes d elements 729 : WRITE(IOIMP,502) 'Ecriture des groupes d elements' 730 : IF (NB_GEL.GT.0) THEN 731 : WRITE(IUABA,800) '** DEFINITION DES GROUPES D ELEMENTS' 732 : WRITE(IUABA,800) '****' 733 : C Ecriture des groupes d elements (un seul type) 734 : k=0 735 : DO i=1,NBMAIL 736 : IF (I_OBJ(i).EQ.3) THEN 737 : WRITE(IUABA,840) C_OBJ(i)(1:LONG(C_OBJ(i))) 738 : MLENTI=L_OBJ(i) 739 : SEGACT,MLENTI 740 : WRITE(IUABA,841) (LECT(j),j=1,LECT(/1)) 741 : SEGDES,MLENTI 742 : k=k+1 743 : ENDIF 744 : ENDDO 745 : C* write(ioimp,501) 'Nb. groupe d elements un seul EF',k 746 : IF (k.NE.0) WRITE(IUABA,800) '****' 747 : k=0 748 : DO i=1,NBMAIL 749 : IF (I_OBJ(i).EQ.2) THEN 750 : CHA16z=MCHAEF.LCHA16(-L_OBJ(i)) 751 : IF (C_OBJ(i).NE.CHA16z) THEN 752 : WRITE(IUABA,840) C_OBJ(i)(1:LONG(C_OBJ(i))) 753 : WRITE(IUABA,800) ' '//CHA16z(1:LONG(CHA16z)) 754 : k=k+1 755 : ENDIF 756 : ENDIF 757 : ENDDO 758 : C* write(ioimp,501) 'Nb. groupe d elements def elt =',k 759 : IF (k.NE.0) WRITE(IUABA,800) '****' 760 : C Ecriture des groupes d elements complexes 761 : k=0 762 : DO i=1,NBMAIL 763 : IF (I_OBJ(i).EQ.4) THEN 764 : WRITE(IUABA,840) C_OBJ(i)(1:LONG(C_OBJ(i))) 765 : MLENTI=L_OBJ(i) 766 : WRITE(IUABA,842) (C_OBJ(LECT(j))(1:LONG(C_OBJ(LECT(j)))), 767 : & j=1,LECT(/1)) 768 : k=k+1 769 : ENDIF 770 : ENDDO 771 : C* write(ioimp,501) 'Nb. groupe d elements complexe =',k 772 : IF (k.NE.0) WRITE(IUABA,800) '****' 773 : ENDIF 774 : WRITE(IOIMP,501) 'Nombre de groupe d elements =',NB_GEL 775 : 776 : C=== 777 : C 4 - Sortie du sous-programme (menage...) 778 : C=== 779 : 902 CONTINUE 780 : WRITE(IOIMP,502) 'Fermeture du fichier au format Abaqus(R)' 781 : IOS=1 782 : CLOSE(UNIT=IUABA,ERR=901) 783 : IOS=0 784 : 901 CONTINUE 785 : DO i=1,NBMAIL 786 : MELEME=I_MAI(i) 787 : IF (MELEME.GT.0) SEGDES,MELEME 788 : MLENTI=L_OBJ(i) 789 : IF (MLENTI.GT.0) SEGSUP,MLENTI 790 : ENDDO 791 : SEGSUP,IMAIL 792 : 900 CONTINUE 793 : MELEME=MAIREF 794 : SEGACT,MELEME 795 : IF (NB_OBJ.NE.0) THEN 796 : DO i=1,NB_OBJ 797 : IPT1=LISOUS(i) 798 : SEGDES,IPT1 799 : ENDDO 800 : ENDIF 801 : SEGDES,MELEME 802 : SEGSUP,MLISEF,MCHAEF 803 : C Traitement des erreurs d ouverture ou de fermeture du fichier 804 : IF (IOS.NE.0) THEN 805 : l=LONG(FicAba) 806 : MOTERR(1:l)=FicAba(1:l) 807 : INTERR(1)=IOS 807 : CALL ERREUR(424) 808 : ENDIF 809 : WRITE(IOIMP,*) 810 : 811 : C===== 812 : C 5 - Formats Fortran 813 : C===== 814 : C Formats d impression de messages 815 : 500 FORMAT('SORABA : ',A) 816 : 501 FORMAT(' ',A,I8) 817 : 502 FORMAT(' ',A) 818 : 510 FORMAT('SORABA - ERREUR : ',A) 819 : C* 511 FORMAT('SORABA - ERREUR : ',A,' ',I4,' non defini') 820 : C* 512 FORMAT('SORABA - ERREUR : ',A,' ',I4,' mal defini') 821 : C* 513 FORMAT('SORABA - ERREUR : Lecture impossible ',A,' ',I4) 822 : C* 520 FORMAT('SORABA - ATTENTION : ',A) 823 : C* 521 FORMAT('SORABA - ATTENTION : ',A,' ',I4,' non defini') 824 : C* 522 FORMAT('SORABA - ATTENTION : ',A,' ',I4,' mal defini') 825 : C* 523 FORMAT('SORABA - ATTENTION : ',A,' ',A,' ',I4) 826 : C Formats d ecriture pour le fichier de sortie Abaqus(R) 827 : 800 FORMAT(A) 828 : 801 FORMAT(A,' ',I8) 829 : 810 FORMAT(I8,', ',SP,E14.8,', ',E14.8,', ',E14.8,S) 830 : 811 FORMAT(I8,', ',SP,E14.8,', ',E14.8,S) 831 : 812 FORMAT(I8,', ',SP,E14.8,S) 832 : 820 FORMAT('*NSET, NSET=',A) 833 : 821 FORMAT(I8) 834 : 822 FORMAT(10(I8,',')) 835 : 830 FORMAT('*ELEMENT, TYPE=',A,', ELSET=',A) 836 : 831 FORMAT(I8,', ',19(I8,','),I8) 837 : 840 FORMAT('*ELSET, ELSET=',A) 838 : 841 FORMAT(16(I8,',')) 839 : 842 FORMAT(1X,16(A10,',')) 840 : 841 : RETURN 842 : END 843 : 844 : 845 : 846 :
© Cast3M 2003 - All rights reserved.
Disclaimer