1 : C CV2MAA SOURCE CHAT 09/10/09 21:16:50 6519 2 : SUBROUTINE CV2MAA(CGEOME,TABVDC,TABMAT, 3 : $ MYFALS, 4 : $ MATLSA, 5 : $ IMPR,IRET) 6 : IMPLICIT REAL*8 (A-H,O-Z) 7 : IMPLICIT INTEGER (I-N) 8 : C*********************************************************************** 9 : C NOM : CV2MAA 10 : C DESCRIPTION : Transforme un MCHAEL (mon champ par éléments) 11 : C représentant un ensemble de matrices élémentaires en 12 : C RIGIDITE... 13 : C 14 : C LANGAGE : ESOPE 15 : C AUTEUR : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/LTMF) 16 : C mél : gounand@semt2.smts.cea.fr 17 : C*********************************************************************** 18 : C APPELES : 19 : C APPELES (E/S) : 20 : C APPELE PAR : CV2MCA 21 : C*********************************************************************** 22 : C ENTREES : 23 : C ENTREES/SORTIES : - 24 : C SORTIES : 25 : C CODE RETOUR (IRET) : = 0 si tout s'est bien passé 26 : C*********************************************************************** 27 : C VERSION : v1, 06/03/06, version initiale 28 : C HISTORIQUE : v1, 06/03/06, création 29 : C HISTORIQUE : 30 : C HISTORIQUE : 31 : C*********************************************************************** 32 : C Prière de PRENDRE LE TEMPS de compléter les commentaires 33 : C en cas de modification de ce sous-programme afin de faciliter 34 : C la maintenance ! 35 : C*********************************************************************** 36 : -INC CCOPTIO 37 : -INC CCHAMP 38 : -INC SMLMOTS 39 : POINTEUR NCVAPR.MLMOTS 40 : POINTEUR NCVADU.MLMOTS 41 : -INC SMELEME 42 : POINTEUR CGEOME.MELEME 43 : POINTEUR MYMEL.MELEME 44 : POINTEUR RIGMEL.MELEME 45 : INTEGER NBNN,NBELEM,NBSOUS,NBREF 46 : -INC SMLENTI 47 : INTEGER JG 48 : POINTEUR LINCPR.MLENTI,LINCDU.MLENTI 49 : POINTEUR KINCPR.MLENTI,KINCDU.MLENTI 50 : POINTEUR LPOQUF.MLENTI,KPOQUF.MLENTI 51 : POINTEUR NOFSPR.MLENTI,NOFSDU.MLENTI 52 : POINTEUR COPRDU.MLENTI,LINCD2.MLENTI 53 : -INC SMRIGID 54 : POINTEUR MATLSA.MRIGID 55 : POINTEUR MYDSCR.DESCR 56 : POINTEUR MYIMAT.IMATRI 57 : POINTEUR MYXMAT.XMATRI 58 : INTEGER NRIGE,NRIGEL,NELRIG,NLIGRP,NLIGRD 59 : * 60 : * Includes persos 61 : * 62 : CBEGININCLUDE SMPOUET 63 : SEGMENT TABGEO 64 : CHARACTER*4 DISGEO 65 : POINTEUR IGEO.MCHAEL 66 : ENDSEGMENT 67 : SEGMENT TABVDC 68 : INTEGER VVARPR(NUMVPR) 69 : INTEGER VVARDU(NUMVDU) 70 : INTEGER VDATPR(NUMDPR) 71 : INTEGER VDATDU(NUMDDU) 72 : INTEGER VCOFPR(NUMCPR) 73 : INTEGER VCOFDU(NUMCDU) 74 : INTEGER ILCPR(NUMDER+1,NUMOP,NUMVPR) 75 : INTEGER ILCDU(NUMDER+1,NUMOP,NUMVDU) 76 : POINTEUR VLCOF(JLCOF).MLENTI 77 : POINTEUR VCOMP(JGCOF).COMP 78 : POINTEUR VLDAT(JGCOF).MLENTI 79 : INTEGER DJSVD(JGVD) 80 : POINTEUR NOMVD(JGVD).MLMOTS 81 : POINTEUR MVD(JGVD).MCHPOI 82 : REAL*8 XVD(JGVD) 83 : CHARACTER*4 DISVD(KGVD) 84 : ENDSEGMENT 85 : SEGMENT TATRAV 86 : POINTEUR VVCOF(JLCOF).MCHEVA 87 : POINTEUR VCOF(JGCOF).MCHEVA 88 : POINTEUR IVD(JGVD).MCHAEL 89 : POINTEUR VD(JGVD).MCHEVA 90 : POINTEUR DVD(JGVD).MCHEVA 91 : POINTEUR FFVD(KGVD).MCHEVA 92 : POINTEUR DFFVD(KGVD).MCHEVA 93 : LOGICAL LVCOF(JGCOF) 94 : LOGICAL LVD(JGVD) 95 : LOGICAL LDVD(JGVD) 96 : LOGICAL LFFVD(KGVD) 97 : LOGICAL LDFFVD(KGVD) 98 : ENDSEGMENT 99 : SEGMENT TABMAT 100 : POINTEUR VMAT(NUMVDU,NUMVPR).MCHAEL 101 : ENDSEGMENT 102 : CENDINCLUDE SMPOUET 103 : CBEGININCLUDE SMCHAEL 104 : SEGMENT MCHAEL 105 : POINTEUR IMACHE(N1).MELEME 106 : POINTEUR ICHEVA(N1).MCHEVA 107 : ENDSEGMENT 108 : SEGMENT MCHEVA 109 : REAL*8 VELCHE(NBLIG,NBCOL,N2LIG,N2COL,NBPOI,NBELM) 110 : ENDSEGMENT 111 : SEGMENT LCHEVA 112 : POINTEUR LISCHE(NBCHE).MCHEVA 113 : ENDSEGMENT 114 : CENDINCLUDE SMCHAEL 115 : POINTEUR IMTLSA.MCHAEL 116 : POINTEUR JMTLSA.MCHEVA 117 : INTEGER NBLIG,NBCOL,N2LIG,N2COL,NBPOI,NBELM 118 : CBEGININCLUDE SFALRF 119 : SEGMENT FALRF 120 : CHARACTER*(LNNFA) NOMFA 121 : INTEGER NUQUAF(NBLRF) 122 : POINTEUR ELEMF(NBLRF).ELREF 123 : ENDSEGMENT 124 : SEGMENT FALRFS 125 : POINTEUR LISFA(0).FALRF 126 : ENDSEGMENT 127 : CENDINCLUDE SFALRF 128 : POINTEUR MYFALS.FALRFS 129 : CBEGININCLUDE SELREF 130 : SEGMENT ELREF 131 : CHARACTER*(LNNOM) NOMLRF 132 : CHARACTER*(LNFORM) FORME 133 : CHARACTER*(LNTYPL) TYPEL 134 : CHARACTER*(LNESP) ESPACE 135 : INTEGER DEGRE 136 : REAL*8 XCONOD(NDIMEL,NBNOD) 137 : INTEGER NPQUAF(NBDDL) 138 : INTEGER NUMCMP(NBDDL) 139 : INTEGER QUENOD(NBDDL) 140 : INTEGER ORDDER(NDIMEL,NBDDL) 141 : POINTEUR MBPOLY.POLYNS 142 : ENDSEGMENT 143 : SEGMENT ELREFS 144 : POINTEUR LISEL(0).ELREF 145 : ENDSEGMENT 146 : CENDINCLUDE SELREF 147 : POINTEUR LRFPR.ELREF 148 : POINTEUR LRFDU.ELREF 149 : * 150 : CHARACTER*4 MDISPR,MDISDU,MOPR,MODU 151 : INTEGER IMPR,IRET 152 : * 153 : INTEGER IBNN,IBELEM 154 : INTEGER ITQUAF,NDDLPR,NDDLDU 155 : INTEGER IDDLPR,IDDLDU 156 : INTEGER NSOUS,NPOQUF 157 : INTEGER ISOUS 158 : INTEGER ILIGRP,ILIGRD,IELRIG,ICMPP,ICMPD 159 : LOGICAL LOK,LFOUND,LCORES,LEQ1,LEQ2,LFIRST 160 : 161 : * 162 : * Executable statements 163 : * 164 : IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans cv2maa' 165 : * 166 : * Vérification sur les inconnues 167 : * 168 : SEGACT TABVDC 169 : SEGACT TABMAT 170 : * SEGPRT,TABVDC 171 : * SEGPRT,TABMAT 172 : 173 : NUMVPR=TABMAT.VMAT(/2) 174 : NUMVDU=TABMAT.VMAT(/1) 175 : * 176 : * Construction des listes d'inconnues primales et duales 177 : * qui interviennent dans la matrice et dont la valeur n'est pas 178 : * donnée 179 : JG=0 180 : SEGINI LINCPR 181 : SEGINI LINCDU 182 : DO IVARPR=1,NUMVPR 183 : IPR=TABVDC.VVARPR(IVARPR) 184 : IF (TABVDC.MVD(IPR).EQ.0) THEN 185 : DO IVARDU=1,NUMVDU 186 : IDU=TABVDC.VVARDU(IVARDU) 187 : IF (TABVDC.MVD(IDU).EQ.0) THEN 188 : IF (TABMAT.VMAT(IVARDU,IVARPR).NE.0) THEN 189 : LINCDU.LECT(**)=IDU 190 : LINCPR.LECT(**)=IPR 191 : ENDIF 192 : ENDIF 193 : ENDDO 194 : ENDIF 195 : ENDDO 196 : NINCPR=LINCPR.LECT(/1) 197 : NINCDU=LINCDU.LECT(/1) 198 : * Sortie anticipée s'il n'y a pas de matrices à construire 199 : IF (NINCPR.EQ.0.AND.NINCDU.EQ.0) THEN 200 : * SEGACT LINCPR 201 : * SEGACT LINCDU 202 : SEGSUP LINCPR 203 : SEGSUP LINCDU 204 : MATLSA=0 205 : RETURN 206 : ENDIF 207 : * 208 : * WRITE(IOIMP,*) 'LINCPR et LINCDU' 209 : * SEGPRT,LINCPR 210 : * SEGPRT,LINCDU 211 : * Suppression des doublons 211 : CALL IUNIQ(LINCPR.LECT,LINCPR.LECT(/1), 212 : $ LINCPR.LECT,NINCPR, 213 : $ IMPR,IRET) 214 : IF (IRET.NE.0) GOTO 9999 215 : JG=NINCPR 216 : SEGADJ,LINCPR 216 : CALL IUNIQ(LINCDU.LECT,LINCDU.LECT(/1), 217 : $ LINCDU.LECT,NINCDU, 218 : $ IMPR,IRET) 219 : IF (IRET.NE.0) GOTO 9999 220 : JG=NINCDU 221 : SEGADJ,LINCDU 222 : * WRITE(IOIMP,*) 'LINCPR et LINCDU sans doublons' 223 : * SEGPRT,LINCPR 224 : * SEGPRT,LINCDU 225 : * 226 : * Si les listes d'inconnues ont même taille, on se fatigue 227 : * à chercher une permutation des inconnues duales qui les 228 : * recollent sur les primales 229 : * Ca ne marche pas pour l'instant : COPRDU n'est pas forcément 230 : * une permutation ex : primale = 'TN' ; duale = 'SCAL' 231 : * 232 : IF (.FALSE.) THEN 233 : IF (NINCPR.EQ.NINCDU) THEN 234 : JG=NINCPR 235 : SEGINI COPRDU 236 : LOK=.TRUE. 237 : IINCPR=0 238 : 3 CONTINUE 239 : IF (LOK.AND.IINCPR.LT.NINCPR) THEN 240 : IINCPR=IINCPR+1 241 : JGVDPR=LINCPR.LECT(IINCPR) 242 : NCVAPR=TABVDC.NOMVD(JGVDPR) 243 : SEGACT NCVAPR 244 : * SEGPRT,NCVAPR 245 : NMOVPR=NCVAPR.MOTS(/2) 246 : IINCDU=0 247 : LFOUND=.FALSE. 248 : 1 CONTINUE 249 : * WRITE(IOIMP,*) '1' 250 : IF (.NOT.LFOUND.AND.IINCDU.LT.NINCDU) THEN 251 : IINCDU=IINCDU+1 252 : JGVDDU=LINCDU.LECT(IINCDU) 253 : NCVADU=TABVDC.NOMVD(JGVDDU) 254 : SEGACT NCVADU 255 : * SEGPRT,NCVADU 256 : NMOVDU=NCVADU.MOTS(/2) 257 : LCORES=.FALSE. 258 : IF (NMOVDU.EQ.NMOVPR) THEN 259 : LCORES=.TRUE. 260 : IMOV=0 261 : 2 CONTINUE 262 : * WRITE(IOIMP,*) '2' 263 : IF (LCORES.AND.IMOV.LT.NMOVDU) THEN 264 : 265 : IMOV=IMOV+1 266 : MOPR=NCVAPR.MOTS(IMOV) 267 : MODU=NCVADU.MOTS(IMOV) 268 : * WRITE(IOIMP,*) 'avant fimot2' 268 : CALL FIMOT2(MOPR,NOMDD,LNOMDD, 269 : $ IPR,IMPR,IRET) 270 : IF (IRET.NE.0) GOTO 9999 271 : * WRITE(IOIMP,*) 'apres fimot2' 272 : LEQ1=MOPR.EQ.MODU 273 : * WRITE(IOIMP,*) 'LEQ1=',LEQ1 274 : * WRITE(IOIMP,*) 'IPR=',IPR 275 : IF (IPR.NE.0) THEN 276 : LEQ2=MODU.EQ.NOMDU(IPR) 277 : ELSE 278 : LEQ2=.FALSE. 279 : ENDIF 280 : * WRITE(IOIMP,*) 'LEQ2=',LEQ2 281 : LCORES=LCORES.AND.(LEQ1.OR.LEQ2) 282 : GOTO 2 283 : ENDIF 284 : ENDIF 285 : SEGDES NCVADU 286 : LFOUND=LCORES 287 : GOTO 1 288 : ENDIF 289 : IF (LFOUND) THEN 290 : COPRDU.LECT(IINCPR)=IINCDU 291 : ENDIF 292 : SEGDES NCVAPR 293 : LOK=LOK.AND.LFOUND 294 : GOTO 3 295 : ENDIF 296 : * SEGPRT,COPRDU 297 : * 298 : * On permute LINCDU 299 : * 300 : LINCD2=LINCDU 301 : JG=NINCDU 302 : SEGINI LINCDU 303 : DO IINCDU=1,NINCDU 304 : LINCDU.LECT(IINCDU)=LINCD2.LECT(COPRDU.LECT(IINCDU)) 305 : ENDDO 306 : SEGSUP LINCD2 307 : SEGSUP COPRDU 308 : ENDIF 309 : * WRITE(IOIMP,*) 'LINCDU permuté' 310 : * SEGPRT,LINCPR 311 : * SEGPRT,LINCDU 312 : ENDIF 313 : * 314 : * Maintenant on construit la table de repérage dans LINCPR et LINCDU 315 : * 316 : JG=TABVDC.DJSVD(/1) 317 : SEGINI KINCPR 317 : CALL RSETXI(KINCPR.LECT,LINCPR.LECT,LINCPR.LECT(/1)) 318 : SEGINI KINCDU 318 : CALL RSETXI(KINCDU.LECT,LINCDU.LECT,LINCDU.LECT(/1)) 319 : * WRITE(IOIMP,*) 'KINCPR et KINCDU' 320 : * SEGPRT,KINCPR 321 : * SEGPRT,KINCDU 322 : * 323 : SEGACT CGEOME 324 : NSOUS=CGEOME.LISOUS(/1) 325 : * 326 : * Initialisation de la matrice 327 : * 328 : NRIGE=7 329 : NRIGEL=NSOUS 330 : SEGINI,MATLSA 331 : MATLSA.MTYMAT='LEASTSQU' 332 : * Parcours 333 : DO ISOUS=1,NSOUS 334 : * WRITE(IOIMP,*) 'ISOUS=',ISOUS 335 : MYMEL=CGEOME.LISOUS(ISOUS) 336 : SEGACT MYMEL 337 : * SEGPRT,MYMEL 338 : ITQUAF=MYMEL.ITYPEL 339 : * 340 : * Maintenant on construit : 341 : * - L'objet géométrie 342 : * - La table d'offset pour les variables primales et duales 343 : * - Le segment descripteur 344 : * 345 : * Liste des points du QUAF sur lequels il y a des ddl 346 : JG=0 347 : SEGINI LPOQUF 348 : * Tables d'offset 349 : JG=NINCPR+1 350 : SEGINI NOFSPR 351 : NOFSPR.LECT(1)=0 352 : JG=NINCDU+1 353 : SEGINI NOFSDU 354 : NOFSDU.LECT(1)=0 355 : NLIGRP=0 356 : NLIGRD=0 357 : * Primale 358 : DO IINCPR=1,NINCPR 359 : IJGVD=LINCPR.LECT(IINCPR) 360 : IKGVD=TABVDC.DJSVD(IJGVD) 361 : MDISPR=TABVDC.DISVD(IKGVD) 361 : CALL KEEF(ITQUAF,MDISPR,MYFALS, 362 : $ LRFPR,IMPR,IRET) 363 : IF (IRET.NE.0) GOTO 9999 364 : SEGACT LRFPR 365 : NDDLPR=LRFPR.NPQUAF(/1) 366 : DO IDDLPR=1,NDDLPR 367 : LPOQUF.LECT(**)=LRFPR.NPQUAF(IDDLPR) 368 : ENDDO 369 : SEGDES LRFPR 370 : NLIGRP=NLIGRP+NDDLPR 371 : NOFSPR.LECT(IINCPR+1)=NLIGRP 372 : ENDDO 373 : * Duale 374 : DO IINCDU=1,NINCDU 375 : IJGVD=LINCDU.LECT(IINCDU) 376 : IKGVD=TABVDC.DJSVD(IJGVD) 377 : MDISDU=TABVDC.DISVD(IKGVD) 377 : CALL KEEF(ITQUAF,MDISDU,MYFALS, 378 : $ LRFDU,IMPR,IRET) 379 : IF (IRET.NE.0) GOTO 9999 380 : SEGACT LRFDU 381 : NDDLDU=LRFDU.NPQUAF(/1) 382 : DO IDDLDU=1,NDDLDU 383 : LPOQUF.LECT(**)=LRFDU.NPQUAF(IDDLDU) 384 : ENDDO 385 : SEGDES LRFDU 386 : NLIGRD=NLIGRD+NDDLDU 387 : NOFSDU.LECT(IINCDU+1)=NLIGRD 388 : ENDDO 389 : * Suppression des doublons de LPOQUF 389 : CALL IUNIQ(LPOQUF.LECT,LPOQUF.LECT(/1), 390 : $ LPOQUF.LECT,NPOQUF, 391 : $ IMPR,IRET) 392 : IF (IRET.NE.0) GOTO 9999 393 : JG=NPOQUF 394 : SEGADJ,LPOQUF 395 : * Segment de repérage dans LPOQUF 396 : JG=MYMEL.NUM(/1) 397 : SEGINI,KPOQUF 397 : CALL RSETXI(KPOQUF.LECT,LPOQUF.LECT,LPOQUF.LECT(/1)) 398 : * SEGPRT,LPOQUF 399 : * SEGPRT,KPOQUF 400 : * 401 : * Remplissage de l'objet géométrie 402 : * 403 : NBNN=NPOQUF 404 : NBELEM=MYMEL.NUM(/2) 405 : NBSOUS=0 406 : NBREF=0 407 : SEGINI,RIGMEL 408 : * Type 32 POLY 409 : RIGMEL.ITYPEL=32 410 : DO IBELEM=1,NBELEM 411 : DO IBNN=1,NBNN 412 : RIGMEL.NUM(IBNN,IBELEM)= 413 : $ MYMEL.NUM(LPOQUF.LECT(IBNN),IBELEM) 414 : ENDDO 415 : ENDDO 416 : SEGDES RIGMEL 417 : SEGSUP LPOQUF 418 : * SEGPRT,RIGMEL 419 : * 420 : * Remplissage du segment DESCR 421 : * 422 : SEGINI MYDSCR 423 : * Primale 424 : DO IINCPR=1,NINCPR 425 : IJGVD=LINCPR.LECT(IINCPR) 426 : IKGVD=TABVDC.DJSVD(IJGVD) 427 : MDISPR=TABVDC.DISVD(IKGVD) 427 : CALL KEEF(ITQUAF,MDISPR,MYFALS, 428 : $ LRFPR,IMPR,IRET) 429 : IF (IRET.NE.0) GOTO 9999 430 : SEGACT LRFPR 431 : NCVAPR=TABVDC.NOMVD(IJGVD) 432 : SEGACT NCVAPR 433 : NDDLPR=LRFPR.NPQUAF(/1) 434 : DO IDDLPR=1,NDDLPR 435 : ILIGPR=IDDLPR+NOFSPR.LECT(IINCPR) 436 : ICMPR=LRFPR.NUMCMP(IDDLPR) 437 : MYDSCR.LISINC(ILIGPR)=NCVAPR.MOTS(ICMPR) 438 : MYDSCR.NOELEP(ILIGPR)= 439 : $ KPOQUF.LECT(LRFPR.NPQUAF(IDDLPR)) 440 : ENDDO 441 : SEGDES NCVAPR 442 : SEGDES LRFPR 443 : ENDDO 444 : * Duale 445 : DO IINCDU=1,NINCDU 446 : IJGVD=LINCDU.LECT(IINCDU) 447 : IKGVD=TABVDC.DJSVD(IJGVD) 448 : MDISDU=TABVDC.DISVD(IKGVD) 448 : CALL KEEF(ITQUAF,MDISDU,MYFALS, 449 : $ LRFDU,IMPR,IRET) 450 : IF (IRET.NE.0) GOTO 9999 451 : SEGACT LRFDU 452 : NCVADU=TABVDC.NOMVD(IJGVD) 453 : SEGACT NCVADU 454 : NDDLDU=LRFDU.NPQUAF(/1) 455 : DO IDDLDU=1,NDDLDU 456 : ILIGDU=IDDLDU+NOFSDU.LECT(IINCDU) 457 : ICMDU=LRFDU.NUMCMP(IDDLDU) 458 : MYDSCR.LISDUA(ILIGDU)=NCVADU.MOTS(ICMDU) 459 : MYDSCR.NOELED(ILIGDU)= 460 : $ KPOQUF.LECT(LRFDU.NPQUAF(IDDLDU)) 461 : ENDDO 462 : SEGDES NCVADU 463 : SEGDES LRFDU 464 : ENDDO 465 : SEGDES MYDSCR 466 : * SEGPRT,MYDSCR 467 : SEGSUP KPOQUF 468 : * 469 : * Remplissage du IMATRI 470 : * 471 : NELRIG=MYMEL.NUM(/2) 472 : SEGDES MYMEL 473 : SEGINI MYxMAT 474 : * NLIGRP et NLIGRD déjà calculés 475 : DO IVARPR=1,NUMVPR 476 : * write(ioimp,*) 'ivarpr=',ivarpr 477 : JGVDPR=TABVDC.VVARPR(IVARPR) 478 : IF (TABVDC.MVD(JGVDPR).EQ.0) THEN 479 : IINCPR=KINCPR.LECT(JGVDPR) 480 : * write(ioimp,*) 'iincpr=',iincpr 481 : DO IVARDU=1,NUMVDU 482 : * write(ioimp,*) 'ivardu=',ivardu 483 : JGVDDU=TABVDC.VVARDU(IVARDU) 484 : IF (TABVDC.MVD(JGVDDU).EQ.0) THEN 485 : IINCDU=KINCDU.LECT(JGVDDU) 486 : * write(ioimp,*) 'iincdu=',iincdu 487 : IMTLSA=TABMAT.VMAT(IVARDU,IVARPR) 488 : IF (IMTLSA.NE.0) THEN 489 : SEGACT IMTLSA 490 : JMTLSA=IMTLSA.ICHEVA(ISOUS) 491 : SEGACT JMTLSA 492 : NBLIG=JMTLSA.VELCHE(/1) 493 : NBCOL=JMTLSA.VELCHE(/2) 494 : N2LIG=JMTLSA.VELCHE(/3) 495 : N2COL=JMTLSA.VELCHE(/4) 496 : NBPOI=JMTLSA.VELCHE(/5) 497 : NBELM=JMTLSA.VELCHE(/6) 498 : IOFSPR=NOFSPR.LECT(IINCPR) 499 : IOFSDU=NOFSDU.LECT(IINCDU) 500 : * write(ioimp,*) 'iofspr=',iofspr 501 : * write(ioimp,*) 'iofsdu=',iofsdu 502 : NDDLPR=NOFSPR.LECT(IINCPR+1)-IOFSPR 503 : NDDLDU=NOFSDU.LECT(IINCDU+1)-IOFSDU 504 : IF (NBLIG.NE.NDDLDU.OR.NBCOL.NE.NDDLPR.OR.N2LIG 505 : $ .NE.1.OR.N2COL.NE.1.OR.NBPOI.NE.1.OR.NBELM 506 : $ .NE.NELRIG) THEN 507 : WRITE(IOIMP,*) 'NBLIG=',NBLIG 508 : WRITE(IOIMP,*) 'NBCOL=',NBCOL 509 : WRITE(IOIMP,*) 'NBELM=',NBELM 510 : WRITE(IOIMP,*) 'NDDLDU=',NDDLDU 511 : WRITE(IOIMP,*) 'NDDLPR=',NDDLPR 512 : WRITE(IOIMP,*) 'NELRIG=',NELRIG 513 : 514 : 515 : WRITE(IOIMP,*) 'Erreur dims JMTLSA' 516 : GOTO 9999 517 : ENDIF 518 : * WRITE(IOIMP,*) 'IINCPR=',IINCPR 519 : * WRITE(IOIMP,*) 'IINCDU=',IINCDU 520 : DO IELRIG=1,NELRIG 521 : * WRITE(IOIMP,*) 'IELRIG=',IELRIG 522 : * MYXMAT=MYIMAT.IMATTT(IELRIG) 523 : * IF (MYXMAT.EQ.0) THEN 524 : * LFIRST=.TRUE. 525 : * SEGINI MYXMAT 526 : * ELSE 527 : * LFIRST=.FALSE. 528 : * SEGACT MYXMAT*MOD 529 : * ENDIF 530 : DO IDDLPR=1,NDDLPR 531 : * write(ioimp,*) 'iddlpr=',iddlpr 532 : DO IDDLDU=1,NDDLDU 533 : * write(ioimp,*) 'iddldu=',iddldu 534 : MYXMAT.RE(IOFSDU+IDDLDU,IOFSPR+IDDLPR 535 : $ ,ielrig)=JMTLSA.VELCHE(IDDLDU 536 : $ ,IDDLPR,1,1,1,IELRIG) 537 : ENDDO 538 : ENDDO 539 : * IF (LFIRST) THEN 540 : * SEGDES MYXMAT 541 : * MYIMAT.IMATTT(IELRIG)=MYXMAT 542 : * ELSE 543 : * SEGDES MYXMAT 544 : * ENDIF 545 : * SEGPRT,MYXMAT 546 : ENDDO 547 : SEGDES JMTLSA 548 : SEGDES IMTLSA 549 : ENDIF 550 : ENDIF 551 : ENDDO 552 : ENDIF 553 : ENDDO 554 : SEGSUP NOFSDU 555 : SEGSUP NOFSPR 556 : SEGDES MYxMAT 557 : * SEGPRT,MYIMAT 558 : * 559 : * Remplissage du chapeau 560 : * 561 : MATLSA.COERIG(ISOUS)=1.D0 562 : MATLSA.IRIGEL(1,ISOUS)=RIGMEL 563 : MATLSA.IRIGEL(2,ISOUS)=0 564 : MATLSA.IRIGEL(3,ISOUS)=MYDSCR 565 : MATLSA.IRIGEL(4,ISOUS)=MYxMAT 566 : MATLSA.IRIGEL(5,ISOUS)=0 567 : MATLSA.IRIGEL(6,ISOUS)=0 568 : * 569 : * la matrice ne possède pas de symétries (a priori...) 570 : * 571 : MATLSA.IRIGEL(7,ISOUS)=2 572 : ENDDO 573 : SEGDES MATLSA 574 : IF (IMPR.GT.3) THEN 575 : WRITE(IOIMP,*) 'On a créé MATLSA=',MATLSA 575 : CALL ECROBJ('RIGIDITE',MATLSA) 575 : CALL PRLIST 576 : ENDIF 577 : 578 : SEGDES CGEOME 579 : SEGSUP KINCPR 580 : SEGSUP KINCDU 581 : SEGSUP LINCPR 582 : SEGSUP LINCDU 583 : SEGDES TABMAT 584 : SEGDES TABVDC 585 : * 586 : * Normal termination 587 : * 588 : IRET=0 589 : RETURN 590 : * 591 : * Format handling 592 : * 593 : * 594 : * Error handling 595 : * 596 : 9999 CONTINUE 597 : IRET=1 598 : WRITE(IOIMP,*) 'An error was detected in subroutine cv2maa' 599 : RETURN 600 : * 601 : * End of subroutine CV2MAA 602 : * 603 : END 604 : 605 : 606 : 607 : 608 : 609 : 610 :
© Cast3M 2003 - All rights reserved.
Disclaimer