1 : C PRLIN2 SOURCE CHAT 09/10/09 21:21:50 6519 2 : SUBROUTINE PRLIN2(CGEOM2,LGDISC,CSGEO2,TABCPR,TABCDU,METING,LAXI, 3 : $ LERF,LERJ,IRESO,IMREG, 4 : $ MATLIN,CHPLIN, 5 : $ IMPR,IRET) 6 : IMPLICIT REAL*8 (A-H,O-Z) 7 : IMPLICIT INTEGER (I-N) 8 : C*********************************************************************** 9 : C NOM : PRLIN2 10 : C DESCRIPTION : Initialisations, tests et formatage des données et des 11 : C résultats pour nlin. 12 : C 13 : C LANGAGE : ESOPE 14 : C AUTEUR : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/LTMF) 15 : C mél : gounand@semt2.smts.cea.fr 16 : C*********************************************************************** 17 : C APPELES : 18 : C APPELE PAR : PRLIN 19 : C*********************************************************************** 20 : C ENTREES : 21 : C SORTIES : 22 : C TRAVAIL : 23 : C 24 : C*********************************************************************** 25 : C VERSION : v3.1, 30/07/04, possiblité de travailler 26 : C dans l'espace de référence 27 : C VERSION : v3, 10/05/04, refonte complète (modif SMPOUET) 28 : C lois de comportement 29 : C VERSION : v2, 22/09/03, refonte complète (modif SMPOUET) 30 : C VERSION : v1, 22/08/2003, version initiale 31 : C HISTORIQUE : v1, 22/08/2003, création 32 : C HISTORIQUE : 33 : C HISTORIQUE : 34 : C*********************************************************************** 35 : C Prière de PRENDRE LE TEMPS de compléter les commentaires 36 : C en cas de modification de ce sous-programme afin de faciliter 37 : C la maintenance ! 38 : C*********************************************************************** 39 : -INC CCOPTIO 40 : -INC SMELEME 41 : POINTEUR CGEOME.MELEME 42 : POINTEUR CGEOM2.MELEME 43 : POINTEUR CSGEO2.MELEME 44 : POINTEUR CGEOM3.MELEME 45 : POINTEUR CSGEO3.MELEME 46 : -INC SMTABLE 47 : POINTEUR TABCPR.MTABLE 48 : POINTEUR TABCDU.MTABLE 49 : -INC SMRIGID 50 : POINTEUR MATLIN.MRIGID 51 : -INC SMCHPOI 52 : POINTEUR CHPLIN.MCHPOI 53 : * Segments à moi 54 : CBEGININCLUDE SELREF 55 : SEGMENT ELREF 56 : CHARACTER*(LNNOM) NOMLRF 57 : CHARACTER*(LNFORM) FORME 58 : CHARACTER*(LNTYPL) TYPEL 59 : CHARACTER*(LNESP) ESPACE 60 : INTEGER DEGRE 61 : REAL*8 XCONOD(NDIMEL,NBNOD) 62 : INTEGER NPQUAF(NBDDL) 63 : INTEGER NUMCMP(NBDDL) 64 : INTEGER QUENOD(NBDDL) 65 : INTEGER ORDDER(NDIMEL,NBDDL) 66 : POINTEUR MBPOLY.POLYNS 67 : ENDSEGMENT 68 : SEGMENT ELREFS 69 : POINTEUR LISEL(0).ELREF 70 : ENDSEGMENT 71 : CENDINCLUDE SELREF 72 : POINTEUR MYLRFS.ELREFS 73 : CBEGININCLUDE SFALRF 74 : SEGMENT FALRF 75 : CHARACTER*(LNNFA) NOMFA 76 : INTEGER NUQUAF(NBLRF) 77 : POINTEUR ELEMF(NBLRF).ELREF 78 : ENDSEGMENT 79 : SEGMENT FALRFS 80 : POINTEUR LISFA(0).FALRF 81 : ENDSEGMENT 82 : CENDINCLUDE SFALRF 83 : POINTEUR MYFALS.FALRFS 84 : CBEGININCLUDE SPOGAU 85 : SEGMENT POGAU 86 : CHARACTER*(LNNPG) NOMPG 87 : CHARACTER*(LNTPG) TYPMPG 88 : CHARACTER*(LNFPG) FORLPG 89 : INTEGER NORDPG 90 : REAL*8 XCOPG(NDLPG,NBPG) 91 : REAL*8 XPOPG(NBPG) 92 : ENDSEGMENT 93 : SEGMENT POGAUS 94 : POINTEUR LISPG(0).POGAU 95 : ENDSEGMENT 96 : CENDINCLUDE SPOGAU 97 : POINTEUR MYPGS.POGAUS 98 : CBEGININCLUDE SFAPG 99 : SEGMENT FAPG 100 : CHARACTER*(LNNFAP) NOMFAP 101 : INTEGER NBQUAF(NBMPG) 102 : POINTEUR MPOGAU(NBMPG).POGAU 103 : ENDSEGMENT 104 : SEGMENT FAPGS 105 : POINTEUR LISFPG(0).FAPG 106 : ENDSEGMENT 107 : CENDINCLUDE SFAPG 108 : POINTEUR MYFPGS.FAPGS 109 : CBEGININCLUDE SLCOMP 110 : SEGMENT COMP 111 : CHARACTER*8 NOMCOM 112 : INTEGER DERCOF(NCOCOF) 113 : LOGICAL LTREF 114 : ENDSEGMENT 115 : SEGMENT COMPS 116 : POINTEUR LISCOM(NBCOMP).COMP 117 : ENDSEGMENT 118 : CENDINCLUDE SLCOMP 119 : POINTEUR MYCOMS.COMPS 120 : POINTEUR MYCOM.COMP 121 : CBEGININCLUDE SIQUAF 122 : SEGMENT IQUAF 123 : INTEGER NUMQUF 124 : REAL*8 XCONQR(NDIMQR,NBNOQR) 125 : INTEGER NUCENT 126 : POINTEUR LFACE.MELEME 127 : ENDSEGMENT 128 : SEGMENT IQUAFS 129 : POINTEUR LISQRF(NBQRF).IQUAF 130 : ENDSEGMENT 131 : CENDINCLUDE SIQUAF 132 : POINTEUR MYQRFS.IQUAFS 133 : CBEGININCLUDE SFACTIV 134 : SEGMENT FACTIV 135 : POINTEUR IFACTI(NBSOUV).SFACTI 136 : ENDSEGMENT 137 : SEGMENT SFACTI 138 : POINTEUR ISFACT(NBSOFV).SSFACT 139 : ENDSEGMENT 140 : SEGMENT SSFACT 141 : LOGICAL LFACTI(NBELFV,NBELEV) 142 : ENDSEGMENT 143 : CENDINCLUDE SFACTIV 144 : CBEGININCLUDE SMPOUET 145 : SEGMENT TABGEO 146 : CHARACTER*4 DISGEO 147 : POINTEUR IGEO.MCHAEL 148 : ENDSEGMENT 149 : SEGMENT TABVDC 150 : INTEGER VVARPR(NUMVPR) 151 : INTEGER VVARDU(NUMVDU) 152 : INTEGER VDATPR(NUMDPR) 153 : INTEGER VDATDU(NUMDDU) 154 : INTEGER VCOFPR(NUMCPR) 155 : INTEGER VCOFDU(NUMCDU) 156 : INTEGER ILCPR(NUMDER+1,NUMOP,NUMVPR) 157 : INTEGER ILCDU(NUMDER+1,NUMOP,NUMVDU) 158 : POINTEUR VLCOF(JLCOF).MLENTI 159 : POINTEUR VCOMP(JGCOF).COMP 160 : POINTEUR VLDAT(JGCOF).MLENTI 161 : INTEGER DJSVD(JGVD) 162 : POINTEUR NOMVD(JGVD).MLMOTS 163 : POINTEUR MVD(JGVD).MCHPOI 164 : REAL*8 XVD(JGVD) 165 : CHARACTER*4 DISVD(KGVD) 166 : ENDSEGMENT 167 : SEGMENT TATRAV 168 : POINTEUR VVCOF(JLCOF).MCHEVA 169 : POINTEUR VCOF(JGCOF).MCHEVA 170 : POINTEUR IVD(JGVD).MCHAEL 171 : POINTEUR VD(JGVD).MCHEVA 172 : POINTEUR DVD(JGVD).MCHEVA 173 : POINTEUR FFVD(KGVD).MCHEVA 174 : POINTEUR DFFVD(KGVD).MCHEVA 175 : LOGICAL LVCOF(JGCOF) 176 : LOGICAL LVD(JGVD) 177 : LOGICAL LDVD(JGVD) 178 : LOGICAL LFFVD(KGVD) 179 : LOGICAL LDFFVD(KGVD) 180 : ENDSEGMENT 181 : SEGMENT TABMAT 182 : POINTEUR VMAT(NUMVDU,NUMVPR).MCHAEL 183 : ENDSEGMENT 184 : CENDINCLUDE SMPOUET 185 : * 186 : CHARACTER*4 LGDISC 187 : CHARACTER*4 METING 188 : CHARACTER*4 ITMP 189 : INTEGER LAXI 190 : INTEGER LERF 191 : LOGICAL LERJ 192 : INTEGER IMPR,IRET 193 : * 194 : INTEGER OOOVAL 195 : * 196 : * Executable statements 197 : * 198 : IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans prlin2' 199 : * 200 : * Initialisation du segment contenant les informations sur les 201 : * éléments de référence. 202 : * 203 : * SEGINI MYLRFS.LISEL(*) 203 : CALL INLRFS(MYLRFS,IMPR,IRET) 204 : IF (IRET.NE.0) GOTO 9999 205 : * 206 : * Initialisation du segment contenant les informations sur les 207 : * familles d'éléments de référence. 208 : * 209 : * SEGINI MYFALS.LISFA(*) 209 : CALL INFALS(MYFALS,MYLRFS,IMPR,IRET) 210 : IF (IRET.NE.0) GOTO 9999 211 : * 212 : * Initialisation du segment contenant les informations sur les 213 : * méthodes d'intégration (type Gauss). 214 : * 215 : * SEGINI MYPGS.LISPG(*) 215 : CALL INPGS(MYPGS,IMPR,IRET) 216 : IF (IRET.NE.0) GOTO 9999 217 : * 218 : * Initialisation du segment contenant les informations sur les 219 : * familles de méthodes d'intégration (type Gauss). 220 : * 221 : * SEGINI MYFPGS.LISFPG(*) 221 : CALL INFPGS(MYFPGS,MYPGS,IMPR,IRET) 222 : IF (IRET.NE.0) GOTO 9999 223 : * 224 : * Initialisation du segment contenant les informations sur les 225 : * lois de comportements 226 : * 227 : * SEGINI MYCOMS.LISCOM(*) 228 : * 19/01/2006 228 : * CALL INCOMS(MYCOMS,IMPR,IRET) 228 : CALL INCOMS(MYCOMS,CGEOM2,LERF,IMPR,IRET) 229 : IF (IRET.NE.0) GOTO 9999 230 : * 231 : * Initialisation du segment contenant les informations sur les 232 : * éléments QUAFs de référence. 233 : * 234 : IF (CSGEO2.NE.0) THEN 235 : * SEGINI MYQRFS 235 : CALL INQRFS(MYQRFS,IMPR,IRET) 236 : IF (IRET.NE.0) GOTO 9999 237 : * On régularise le maillage pour plus se faire chier si LISOUS(/1).EQ.0 238 : * In REGMAI : SEGINI CGEOM3 238 : CALL REGMA2(CGEOM2,CGEOM3,IMPR,IRET) 239 : IF (IRET.NE.0) GOTO 9999 240 : * In REGMAI : SEGINI CSGEO3 240 : CALL REGMA2(CSGEO2,CSGEO3,IMPR,IRET) 241 : IF (IRET.NE.0) GOTO 9999 242 : * 243 : * On extrait de CGEOM3 les éléments qui ont au moins une face 244 : * appartenant à CSGEO3 et un objet contenant les faces actives. 245 : * 246 : * In EXTFAC : SEGINI CGEOME 247 : * In EXTFAC : SEGINI FACTIV 247 : CALL EXTFAC(CGEOM3,CSGEO3,MYQRFS, 248 : $ CGEOME,FACTIV, 249 : $ IMPR,IRET) 250 : IF (IRET.NE.0) GOTO 9999 251 : * 252 : * Après EXTFAC : 253 : * 254 : C Write(ioimp,*) 'Après extfac' 255 : C Write(ioimp,*) ' cgeom3' 256 : C ITMP='RESU' 256 : C CALL ECROBJ('MAILLAGE',CGEOM3) 256 : C CALL ECRCHA(ITMP) 256 : C CALL PRLIST 257 : C ITMP='RESU' 257 : C CALL ECROBJ('MAILLAGE',CSGEO3) 257 : C CALL ECRCHA(ITMP) 257 : C CALL PRLIST 257 : C CALL ECROBJ('MAILLAGE',CGEOME) 257 : C CALL PRLIST 258 : C SEGPRT,FACTIV 259 : IF (METING.NE.' ') THEN 259 : CALL VERFPG(CGEOME,METING,MYFPGS,IMPR,IRET) 260 : IF (IRET.NE.0) GOTO 9999 260 : CALL VERFPG(CSGEO3,METING,MYFPGS,IMPR,IRET) 261 : IF (IRET.NE.0) GOTO 9999 262 : ENDIF 263 : ELSE 264 : * 265 : * On régularise le maillage pour ne plus se faire chier si LISOUS(/1).EQ.0 266 : * In REGMAI : SEGINI CGEOME 266 : CALL REGMA2(CGEOM2,CGEOME,IMPR,IRET) 267 : IF (IRET.NE.0) GOTO 9999 268 : * On vérifie pour la famille de méthode d'intégration : 269 : * - qu'elle est valide ; 270 : * - qu'il y a bien un élément fini qui correspond à chaque élément géométrique 271 : IF (METING.NE.' ') THEN 271 : CALL VERFPG(CGEOME,METING,MYFPGS,IMPR,IRET) 272 : IF (IRET.NE.0) GOTO 9999 273 : ENDIF 274 : ENDIF 275 : * 276 : * In PRLIN3 : SEGINI TABGEO 277 : * In PRLIN3 : SEGINI TABVDC 278 : * In PRLIN3 : SEGINI TATRAV 278 : CALL PRLIN3(CGEOME,LGDISC,TABCPR,TABCDU,LERF, 279 : $ MYFALS,MYCOMS, 280 : $ TABGEO,TABVDC,TATRAV, 281 : $ IMPR,IRET) 282 : IF (IRET.NE.0) GOTO 9999 283 : * 284 : * Dans PRLIN4, on explicite ce que l'on va vraiment devoir 285 : * calculer dans TATRAV 286 : * 286 : CALL PRLIN4(TABVDC,TATRAV, 287 : $ IMPR,IRET) 288 : IF (IRET.NE.0) GOTO 9999 289 : * 290 : * Calculons la matrice des opérateurs 291 : * In NLIN : SEGINI TABMAT 292 : IF (CSGEO2.EQ.0) THEN 292 : CALL NLIN(CGEOME,TABGEO,TABVDC,TATRAV, 293 : $ METING,LAXI,LERF,LERJ,IMREG, 294 : $ MYFALS,MYPGS,MYFPGS, 295 : $ TABMAT, 296 : $ IMPR,IRET) 297 : IF (IRET.NE.0) THEN 298 : IF (LERJ) GOTO 9666 299 : GOTO 9999 300 : ENDIF 301 : ELSE 301 : CALL NLIA(CGEOME,FACTIV,TABGEO,TABVDC,TATRAV, 302 : $ METING,LAXI,LERF,LERJ, 303 : $ MYFALS,MYPGS,MYFPGS,MYQRFS, 304 : $ TABMAT, 305 : $ IMPR,IRET) 306 : IF (IRET.NE.0) GOTO 9999 307 : ENDIF 308 : * Ménage de TATRAV 309 : * In SUTRAV : SEGSUP TATRAV 309 : CALL SUTRAV(TATRAV,IMPR,IRET) 310 : IF (IRET.NE.0) GOTO 9999 311 : *dbg NSEGAV=OOOVAL(2,1) 312 : * Transformer la matrice de moindres carrés en RIGIDITE ou en MATRIK 313 : IF (IRESO.EQ.0) THEN 313 : CALL CV2MC9(TABVDC,TABMAT, 314 : $ MYFALS, 315 : $ MATLIN,CHPLIN, 316 : $ IMPR,IRET) 317 : IF (IRET.NE.0) GOTO 9999 318 : ELSEIF (IRESO.EQ.1) THEN 318 : CALL CV2MCA(CGEOME,TABVDC,TABMAT, 319 : $ MYFALS, 320 : $ MATLIN,CHPLIN, 321 : $ IMPR,IRET) 322 : IF (IRET.NE.0) GOTO 9999 323 : ELSEIF (IRESO.EQ.2) THEN 323 : CALL CV2MCB(TABVDC,TABMAT, 324 : $ MYFALS, 325 : $ MATLIN,CHPLIN, 326 : $ IMPR,IRET) 327 : IF (IRET.NE.0) GOTO 9999 328 : ELSE 329 : WRITE(IOIMP,*) 'Erreur grave' 330 : ENDIF 331 : *dbg NSEGAP=OOOVAL(2,1) 332 : *dbg NSEGD=NSEGAP-NSEGAV 333 : *dbg WRITE(IOIMP,*) 'CV2MC9 : ',NSEGD,' segments crees ', 334 : *dbg $ ' MAT=',MATLIN,' CHP=',CHPLIN 335 : * 336 : * Destructions finales... 337 : * 338 : * In SUPOUE : SEGSUP TABMAT 339 : * In SUPOUE : SEGSUP TABVDC 340 : * In SUPOUE : SEGSUP TABGEO 340 : CALL SUPOUE(TABGEO,TABVDC,TABMAT,IMPR,IRET) 341 : IF (IRET.NE.0) GOTO 9999 342 : * 343 : IF (CSGEO2.EQ.0) THEN 344 : * In SUMEL : SEGSUP CGEOME 344 : CALL SUMEL(CGEOME,IMPR,IRET) 345 : ELSE 346 : * In SUFACT : SEGSUP FACTIV 346 : CALL SUFACT(FACTIV,IMPR,IRET) 347 : IF (IRET.NE.0) GOTO 9999 348 : * In SUMEL : SEGSUP CGEOME 348 : CALL SUMEL(CGEOME,IMPR,IRET) 349 : * In SUMEL : SEGSUP CSGEO3 349 : CALL SUMEL(CSGEO3,IMPR,IRET) 350 : * In SUMEL : SEGSUP CGEOM3 350 : CALL SUMEL(CGEOM3,IMPR,IRET) 351 : * SEGSUP MYQRFS 351 : CALL SUQRFS(MYQRFS,IMPR,IRET) 352 : IF (IRET.NE.0) GOTO 9999 353 : ENDIF 354 : * 355 : * SEGSUP MYLRFS.LISEL(*) 355 : CALL SULRFS(MYLRFS,IMPR,IRET) 356 : IF (IRET.NE.0) GOTO 9999 357 : * SEGSUP MYFALS.LISFA(*) 357 : CALL SUFALS(MYFALS,IMPR,IRET) 358 : IF (IRET.NE.0) GOTO 9999 359 : * SEGSUP MYPGS.LISPG(*) 359 : CALL SUPGS(MYPGS,IMPR,IRET) 360 : IF (IRET.NE.0) GOTO 9999 361 : * SEGSUP MYFPGS.LISFPG(*) 361 : CALL SUFPGS(MYFPGS,IMPR,IRET) 362 : IF (IRET.NE.0) GOTO 9999 363 : SEGACT MYCOMS 364 : NBCOMP=MYCOMS.LISCOM(/1) 365 : DO IBCOMP=1,NBCOMP 366 : MYCOM=MYCOMS.LISCOM(IBCOMP) 367 : SEGSUP,MYCOM 368 : ENDDO 369 : SEGSUP MYCOMS 370 : * 371 : * Normal termination 372 : * 373 : IRET=0 374 : RETURN 375 : * 376 : * Format handling 377 : * 378 : * 379 : * Error handling 380 : * 381 : 9666 CONTINUE 382 : IRET=666 383 : RETURN 384 : 9999 CONTINUE 385 : IRET=1 386 : WRITE(IOIMP,*) 'An error was detected in subroutine prlin2' 387 : RETURN 388 : * 389 : * End of subroutine PRLIN2 390 : * 391 : END 392 : 393 : 394 : 395 : 396 : 397 : 398 : 399 :
© Cast3M 2003 - All rights reserved.
Disclaimer