1 : C NLIN SOURCE GOUNAND 09/09/03 21:15:21 6481 2 : SUBROUTINE NLIN(CGEOME,TABGEO,TABVDC,TATRAV, 3 : $ METING,LAXI,LERF,LERJ,IMREG, 4 : $ MYFALS,MYPGS,MYFPGS, 5 : $ TABMAT, 6 : $ IMPR,IRET) 7 : IMPLICIT REAL*8 (A-H,O-Z) 8 : IMPLICIT INTEGER (I-N) 9 : C*********************************************************************** 10 : C NOM : NLIN 11 : C DESCRIPTION : Création d'une matrice. 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 : PRLIN2 19 : C*********************************************************************** 20 : C ENTREES : 21 : C ENTREES/SORTIES : - 22 : C SORTIES : 23 : C TRAVAIL : * SOUGEO (type MELEME) : maillage élémentaire. 24 : C * MLLRFS (type MLLRFS) : pointeurs sur les 25 : C éléments de référence associés aux 4 espaces de 26 : C discrétisation (géométrie, coefficient, primal, 27 : C dual) sur le maillage élémentaire. 28 : C * PGCOUR (type POGAU) : méthode d'intégration 29 : C courante. 30 : C * JCOOR (type MCHEVA) : valeurs du champ ICOOR 31 : C sur le maillage élémentaire. 32 : C Structure (cf.include SMCHAEL) : 33 : C (1, nb. ddl, 1, dim. esp. réel, 34 : C 1, nb. éléments) 35 : C * JCOEFF (type MCHEVA) : valeurs du champ ICOEFF 36 : C sur le maillage élémentaire. 37 : C Structure (cf.include SMCHAEL) : 38 : C (1, nb. ddl, nb. comp. duales, 39 : C nb. comp. primales, 1, nb. éléments) 40 : C * JMTLIN (type MCHEVA) : valeurs du champ IMTLIN 41 : C sur le maillage élémentaire. 42 : C Structure (cf.include SMCHAEL) : 43 : C (nb. ddl dual, nb. ddl primal, 44 : C nb. comp. duales, nb. comp. primales, 45 : C 1, nb. éléments) 46 : C nb. ddl primal=1 si la matrice est condensée. 47 : C * JMAJAC (type MCHEVA) : valeurs de la matrice 48 : C jacobienne aux points de Gauss sur le maillage 49 : C élémentaire. 50 : C Structure (cf.include SMCHAEL) : 51 : C (1, 1, dim. esp. réel, dim. esp. référence, 52 : C nb. poi. gauss, nb. éléments) 53 : C * JMIJAC (type MCHEVA) : valeurs de l'inverse de 54 : C la matrice jacobienne aux points de Gauss sur 55 : C le maillage élémentaire. 56 : C Structure (cf.include SMCHAEL) : 57 : C (1, 1, dim. esp. référence, dim. esp. réel, 58 : C nb. poi. gauss, nb. éléments) 59 : C JMIJAC n'existe que si dim.esp.réf=dim.esp.réel 60 : C * JDTJAC (type MCHEVA) : valeurs du déterminant 61 : C de la matrice jacobienne aux points de Gauss 62 : C sur le maillage élémentaire. 63 : C Structure (cf.include SMCHAEL) : 64 : C (1, 1, 1, 1, nb. poi. gauss, nb. éléments) 65 : C Si la matrice jacobienne n'est pas carrée, on 66 : C a calculé sqrt(det(trans(J).J)) 67 : C * JCOEFG (type MCHEVA) : valeurs du coefficient 68 : C tensoriel aux points de Gauss sur le maillage 69 : C élémentaire. 70 : C Structure (cf.include SMCHAEL) : 71 : C (1, 1, nb. comp. duales, nb. comp. primales, 72 : C nb. poi. gauss, nb. éléments) 73 : C * FFPG (type MCHEVA) : valeurs des fonctions 74 : C d'interpolation aux points de gauss sur 75 : C l'élément de référence. 76 : C Structure (cf.include SMCHAEL) : 77 : C (1, nb. ddl, 1, 1, nb. poi. gauss, 1) 78 : C * DFFPG (type MCHEVA) : valeurs des dérivées 79 : C premières des fonctions d'interpolation aux 80 : C points de gauss sur l'élément de référence. 81 : C Structure (cf.include SMCHAEL) : 82 : C (1, nb. ddl, 1, dim.esp.réf, nb. poi. gauss, 1) 83 : C * JDFFPG (type MCHEVA) : valeurs des dérivées 84 : C premières des fonctions d'interpolation 85 : C primales aux points de gauss sur l'élément 86 : C réel. 87 : C Structure (cf.include SMCHAEL) : 88 : C (1, nb. ddl, 1, dim.esp.réel, nb. poi. gauss, 89 : C nb. élém.) 90 : C * JDFFDG (type MCHEVA) : valeurs des dérivées 91 : C premières des fonctions d'interpolation 92 : C duales aux points de gauss sur l'élément réel. 93 : C Structure (cf.include SMCHAEL) : 94 : C (1, nb. ddl, 1, dim.esp.réel, nb. poi. gauss, 95 : C nb. élém.) 96 : C*********************************************************************** 97 : C VERSION : v3.1, 30/07/04, possiblité de travailler 98 : C dans l'espace de référence 99 : C VERSION : v1, 10/05/2004, version initiale 100 : C HISTORIQUE : v1, 10/05/2004, création 101 : C HISTORIQUE : 102 : C HISTORIQUE : 103 : C HISTORIQUE : 104 : C*********************************************************************** 105 : C Prière de PRENDRE LE TEMPS de compléter les commentaires 106 : C en cas de modification de ce sous-programme afin de faciliter 107 : C la maintenance ! 108 : C*********************************************************************** 109 : -INC CCOPTIO 110 : -INC CCGEOME 111 : CBEGININCLUDE SELREF 112 : SEGMENT ELREF 113 : CHARACTER*(LNNOM) NOMLRF 114 : CHARACTER*(LNFORM) FORME 115 : CHARACTER*(LNTYPL) TYPEL 116 : CHARACTER*(LNESP) ESPACE 117 : INTEGER DEGRE 118 : REAL*8 XCONOD(NDIMEL,NBNOD) 119 : INTEGER NPQUAF(NBDDL) 120 : INTEGER NUMCMP(NBDDL) 121 : INTEGER QUENOD(NBDDL) 122 : INTEGER ORDDER(NDIMEL,NBDDL) 123 : POINTEUR MBPOLY.POLYNS 124 : ENDSEGMENT 125 : SEGMENT ELREFS 126 : POINTEUR LISEL(0).ELREF 127 : ENDSEGMENT 128 : CENDINCLUDE SELREF 129 : POINTEUR ELCOUR.ELREF 130 : CBEGININCLUDE SFALRF 131 : SEGMENT FALRF 132 : CHARACTER*(LNNFA) NOMFA 133 : INTEGER NUQUAF(NBLRF) 134 : POINTEUR ELEMF(NBLRF).ELREF 135 : ENDSEGMENT 136 : SEGMENT FALRFS 137 : POINTEUR LISFA(0).FALRF 138 : ENDSEGMENT 139 : CENDINCLUDE SFALRF 140 : POINTEUR MYFALS.FALRFS 141 : CBEGININCLUDE SPOGAU 142 : SEGMENT POGAU 143 : CHARACTER*(LNNPG) NOMPG 144 : CHARACTER*(LNTPG) TYPMPG 145 : CHARACTER*(LNFPG) FORLPG 146 : INTEGER NORDPG 147 : REAL*8 XCOPG(NDLPG,NBPG) 148 : REAL*8 XPOPG(NBPG) 149 : ENDSEGMENT 150 : SEGMENT POGAUS 151 : POINTEUR LISPG(0).POGAU 152 : ENDSEGMENT 153 : CENDINCLUDE SPOGAU 154 : POINTEUR MYPGS.POGAUS 155 : POINTEUR PGCOUR.POGAU 156 : CBEGININCLUDE SFAPG 157 : SEGMENT FAPG 158 : CHARACTER*(LNNFAP) NOMFAP 159 : INTEGER NBQUAF(NBMPG) 160 : POINTEUR MPOGAU(NBMPG).POGAU 161 : ENDSEGMENT 162 : SEGMENT FAPGS 163 : POINTEUR LISFPG(0).FAPG 164 : ENDSEGMENT 165 : CENDINCLUDE SFAPG 166 : POINTEUR MYFPGS.FAPGS 167 : CBEGININCLUDE SLCOMP 168 : SEGMENT COMP 169 : CHARACTER*8 NOMCOM 170 : INTEGER DERCOF(NCOCOF) 171 : LOGICAL LTREF 172 : ENDSEGMENT 173 : SEGMENT COMPS 174 : POINTEUR LISCOM(NBCOMP).COMP 175 : ENDSEGMENT 176 : CENDINCLUDE SLCOMP 177 : POINTEUR MYCOMP.COMP 178 : POINTEUR IVCOMP.COMP 179 : POINTEUR IVCOMD.COMP 180 : -INC SMLENTI 181 : POINTEUR IPOWCO.MLENTI 182 : -INC SMELEME 183 : POINTEUR CGEOME.MELEME 184 : POINTEUR SOUGEO.MELEME 185 : * 186 : CBEGININCLUDE SMCHAEL 187 : SEGMENT MCHAEL 188 : POINTEUR IMACHE(N1).MELEME 189 : POINTEUR ICHEVA(N1).MCHEVA 190 : ENDSEGMENT 191 : SEGMENT MCHEVA 192 : REAL*8 VELCHE(NBLIG,NBCOL,N2LIG,N2COL,NBPOI,NBELM) 193 : ENDSEGMENT 194 : SEGMENT LCHEVA 195 : POINTEUR LISCHE(NBCHE).MCHEVA 196 : ENDSEGMENT 197 : CENDINCLUDE SMCHAEL 198 : INTEGER N1 199 : POINTEUR ICOOR.MCHAEL 200 : POINTEUR MYMCHA.MCHAEL 201 : POINTEUR JCOOR.MCHEVA,JCOEFF.MCHEVA,JCOEFG.MCHEVA 202 : POINTEUR JDCOFG.MCHEVA 203 : POINTEUR JMAJAC.MCHEVA,JMIJAC.MCHEVA,JDTJAC.MCHEVA 204 : POINTEUR JDTJA2.MCHEVA 205 : POINTEUR JMAREG.MCHEVA 206 : POINTEUR JDIAMA.MCHEVA 207 : POINTEUR JPC.MCHEVA 208 : POINTEUR IPROCO.MCHEVA 209 : POINTEUR FC.MCHEVA 210 : POINTEUR FFPG.MCHEVA,DFFPG.MCHEVA,JDFFPG.MCHEVA 211 : POINTEUR FVPR.MCHEVA,FVDU.MCHEVA 212 : POINTEUR FCPR.MCHEVA,FCDU.MCHEVA 213 : POINTEUR JMTLIN.MCHEVA 214 : CBEGININCLUDE SMPOUET 215 : SEGMENT TABGEO 216 : CHARACTER*4 DISGEO 217 : POINTEUR IGEO.MCHAEL 218 : ENDSEGMENT 219 : SEGMENT TABVDC 220 : INTEGER VVARPR(NUMVPR) 221 : INTEGER VVARDU(NUMVDU) 222 : INTEGER VDATPR(NUMDPR) 223 : INTEGER VDATDU(NUMDDU) 224 : INTEGER VCOFPR(NUMCPR) 225 : INTEGER VCOFDU(NUMCDU) 226 : INTEGER ILCPR(NUMDER+1,NUMOP,NUMVPR) 227 : INTEGER ILCDU(NUMDER+1,NUMOP,NUMVDU) 228 : POINTEUR VLCOF(JLCOF).MLENTI 229 : POINTEUR VCOMP(JGCOF).COMP 230 : POINTEUR VLDAT(JGCOF).MLENTI 231 : INTEGER DJSVD(JGVD) 232 : POINTEUR NOMVD(JGVD).MLMOTS 233 : POINTEUR MVD(JGVD).MCHPOI 234 : REAL*8 XVD(JGVD) 235 : CHARACTER*4 DISVD(KGVD) 236 : ENDSEGMENT 237 : SEGMENT TATRAV 238 : POINTEUR VVCOF(JLCOF).MCHEVA 239 : POINTEUR VCOF(JGCOF).MCHEVA 240 : POINTEUR IVD(JGVD).MCHAEL 241 : POINTEUR VD(JGVD).MCHEVA 242 : POINTEUR DVD(JGVD).MCHEVA 243 : POINTEUR FFVD(KGVD).MCHEVA 244 : POINTEUR DFFVD(KGVD).MCHEVA 245 : LOGICAL LVCOF(JGCOF) 246 : LOGICAL LVD(JGVD) 247 : LOGICAL LDVD(JGVD) 248 : LOGICAL LFFVD(KGVD) 249 : LOGICAL LDFFVD(KGVD) 250 : ENDSEGMENT 251 : SEGMENT TABMAT 252 : POINTEUR VMAT(NUMVDU,NUMVPR).MCHAEL 253 : ENDSEGMENT 254 : CENDINCLUDE SMPOUET 255 : INTEGER NUMVPR,NUMVDU,NUMDER,NUMOP 256 : INTEGER JGVC,KGVC 257 : CBEGININCLUDE TMPREC 258 : SEGMENT MPREC 259 : POINTEUR DAT(NDAT).MCHEVA 260 : POINTEUR PREC(NPREC).MCHEVA 261 : ENDSEGMENT 262 : CENDINCLUDE TMPREC 263 : POINTEUR METRIQ.MPREC 264 : * 265 : CHARACTER*4 METING 266 : INTEGER LAXI 267 : INTEGER LERF 268 : LOGICAL LERJ 269 : INTEGER IMPR,IRET 270 : * 271 : CHARACTER*4 MYDISC 272 : * 273 : INTEGER ISOUS 274 : INTEGER IVARPR,IVARDU,KDERPR,KDERDU,IOP 275 : INTEGER ITQUAF,NBRSOU,NBELEM 276 : LOGICAL LF,LDF,LC,LDC 277 : LOGICAL MVVPR,MVVDU,LVID 278 : * 279 : * Executable statements 280 : * 281 : * IMPR=5 282 : IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans nlin' 283 : * Activation et intialisation des chapeaux 284 : SEGACT CGEOME 285 : SEGACT TABGEO 286 : SEGACT TABVDC 287 : SEGACT TATRAV*MOD 288 : NBRSOU=CGEOME.LISOUS(/1) 289 : NUMVPR=TABVDC.VVARPR(/1) 290 : NUMVDU=TABVDC.VVARDU(/1) 291 : JLCOF=TABVDC.VLCOF(/1) 292 : JGCOF=TABVDC.VCOMP(/1) 293 : JGVD=TABVDC.DJSVD(/1) 294 : KGVD=TABVDC.DISVD(/2) 295 : NUMDER=TABVDC.ILCPR(/1)-1 296 : NUMOP=TABVDC.ILCPR(/2) 297 : * 298 : N1=NBRSOU 299 : * NUMVPR et NUMVDU initialisés ci-dessus 300 : SEGINI TABMAT 301 : * Cette instruction n'a pas l'air de fonctionner 302 : * SEGINI TABMAT.VMAT(*) 303 : DO IVARPR=1,NUMVPR 304 : DO IVARDU=1,NUMVDU 305 : SEGINI,MYMCHA 306 : TABMAT.VMAT(IVARDU,IVARPR)=MYMCHA 307 : ENDDO 308 : ENDDO 309 : SEGACT MYPGS 310 : ICOOR=TABGEO.IGEO 311 : SEGACT ICOOR 312 : * SEGACT TABVDC.NOMVC(*) 313 : DO IJVD=1,JGVD 314 : MYMCHA=TATRAV.IVD(IJVD) 315 : IF (MYMCHA.NE.0) THEN 316 : SEGACT MYMCHA 317 : ENDIF 318 : ENDDO 319 : * 320 : * On travaille sur chaque sous-domaine 321 : * 322 : DO 1 ISOUS=1,NBRSOU 323 : SOUGEO=CGEOME.LISOUS(ISOUS) 324 : SEGACT SOUGEO 325 : ITQUAF=SOUGEO.ITYPEL 326 : * Détermination de la dimension de l'espace de référence 326 : CALL DIMELE(NOMS(ITQUAF),IESREF,IMPR,IRET) 327 : IF (IRET.NE.0) GOTO 9999 328 : NBELEM=SOUGEO.NUM(/2) 329 : IF (IMPR.GT.2) THEN 330 : WRITE(IOIMP,*) 'Sous-domaine :',ISOUS 331 : ENDIF 332 : SEGDES SOUGEO 333 : * 334 : * Quel est la méthode d'intégration que l'on va utiliser si on n'en a 335 : * pas précisé ? 336 : * FIPGS est là pour nous le dire. 337 : * 338 : IF (METING.EQ.' ') THEN 339 : WRITE(IOIMP,*) 'Le choix automatique de la méthode ' 340 : $ ,'d''integration est désactivé' 341 : GOTO 9999 341 : * CALL FIPGS(MLLRFS,MYPGS, 342 : * $ PGCOUR, 343 : * $ IMPR,IRET) 344 : * IF (IRET.GT.0) GOTO 9999 345 : ELSE 345 : CALL KEPG(ITQUAF,METING, 346 : $ MYFPGS, 347 : $ PGCOUR, 348 : $ IMPR,IRET) 349 : IF (IRET.NE.0) GOTO 9999 350 : ENDIF 351 : * 352 : * Géométrie 353 : * 354 : MYDISC=TABGEO.DISGEO 354 : CALL KEEF(ITQUAF,MYDISC, 355 : $ MYFALS, 356 : $ ELCOUR, 357 : $ IMPR,IRET) 358 : IF (IRET.NE.0) GOTO 9999 359 : * In KFNREF : SEGINI FFPG 360 : * In KFNREF : SEGINI DFFPG 360 : CALL KFNREF(ELCOUR,PGCOUR, 361 : $ FFPG,DFFPG, 362 : $ IMPR,IRET) 363 : IF (IRET.NE.0) GOTO 9999 364 : * 365 : * Création des matrices jacobiennes et déterminants 366 : * pour la transformation : élément volumique de référence <-> 367 : * élément volumique réel 368 : * Ici, on ne se servira que de l'inverse et du déterminant 369 : * de la matrice jacobienne. 370 : * In GEOLIN : SEGINI JMAJAC 371 : * In GEOLIN : SEGINI JMIJAC 372 : * In GEOLIN : SEGINI JDTJAC 373 : JCOOR=ICOOR.ICHEVA(ISOUS) 373 : CALL GEOLIK(DFFPG,JCOOR,NBELEM, 374 : $ JMAJAC,JMIJAC,JDTJAC,LERJ,IMREG, 375 : $ IMPR,IRET) 376 : IF (IRET.NE.0) THEN 377 : IF (LERJ) GOTO 9666 378 : GOTO 9999 379 : ENDIF 380 : *! SEG SUP JMAJAC 381 : SEGSUP DFFPG 382 : C Inutile normalement, on peut se débrouiller avec les coeffs 383 : C* En axi, on multiplie le determinant de la matrice 384 : C* jacobienne par 2piR (ou R est la premiere coordonnee) 385 : C IF (LAXI.GT.0) THEN 386 : C* In GEOMET : SEGINI JDTJA2 386 : C CALL GEOMET(JCOOR,FFPG, 387 : C $ JDTJAC,LAXI, 388 : C $ JDTJA2, 389 : C $ IMPR,IRET) 390 : C IF (IRET.NE.0) GOTO 9999 391 : C SEGSUP JDTJAC 392 : C JDTJAC=JDTJA2 393 : C ENDIF 394 : * 395 : * On récupère la première coordonnée si LAXI(=IFOMOD).NE.-1 396 : * 397 : IF (IFOMOD.NE.-1) THEN 398 : C* In GEOPC : SEGINI JPC 398 : CALL GEOPC(JCOOR,FFPG, 399 : $ JPC, 400 : $ IMPR,IRET) 401 : IF (IRET.NE.0) GOTO 9999 402 : ELSE 403 : JPC=0 404 : ENDIF 405 : SEGSUP FFPG 406 : * 407 : * Calcul du jacobien de la transformation : 408 : * élément volumique de référence -> élément réguliers 409 : * de côté 1 410 : * Cela sert pour l'adaptativité. 411 : * In GEOREG : SEGINI JMAREG 412 : * 412 : CALL GEOREG(ITQUAF,MYFALS,MYFPGS, 413 : $ JMAREG, 414 : $ IMPR,IRET) 415 : IF (IRET.NE.0) GOTO 9999 416 : * 417 : * Calcul d'une propriété géométrique d'un QUAF régulier de côté 1 : 418 : * ici le diamètre du cercle circonscrit. 419 : * Cela sert pour le decentrement. 420 : * In GEOQUA : SEGINI JDIAMA 421 : * 421 : CALL GEOQUA(ITQUAF, 422 : $ JDIAMA, 423 : $ IMPR,IRET) 424 : IF (IRET.NE.0) GOTO 9999 425 : C 426 : C Initialisation d'une table de préconditionnement pour l'adaptation 427 : C contenant des infos sur la métrique (fait dans les subroutines qui 428 : C utilisent METRIQ 429 : C 430 : C SEGINI METRIQ 431 : METRIQ=0 432 : * 433 : * Calcul des fonctions de forme et de leurs dérivées 434 : * 435 : DO IKVD=1,KGVD 436 : LF=TATRAV.LFFVD(IKVD).EQV..TRUE. 437 : LDF=TATRAV.LDFFVD(IKVD).EQV..TRUE. 438 : IF (LF.OR.LDF) THEN 439 : MYDISC=TABVDC.DISVD(IKVD) 439 : CALL KEEF(ITQUAF,MYDISC, 440 : $ MYFALS, 441 : $ ELCOUR, 442 : $ IMPR,IRET) 443 : IF (IRET.NE.0) GOTO 9999 444 : * In KFNREF : SEGINI FFPG 445 : * In KFNREF : SEGINI DFFPG 445 : CALL KFNREF(ELCOUR,PGCOUR, 446 : $ FFPG,DFFPG, 447 : $ IMPR,IRET) 448 : IF (IRET.NE.0) GOTO 9999 449 : IF (LF) THEN 450 : TATRAV.FFVD(IKVD)=FFPG 451 : ELSE 452 : * segini ffpg 453 : SEGSUP FFPG 454 : ENDIF 455 : IF (LDF) THEN 456 : IF (LERF.NE.0) THEN 457 : SEGINI,JDFFPG=DFFPG 458 : SEGDES JDFFPG 459 : ELSE 460 : * In DFNFR : SEGINI JDFFPG 460 : CALL DFNFR(DFFPG,JMIJAC, 461 : $ JDFFPG, 462 : $ IMPR,IRET) 463 : IF (IRET.NE.0) GOTO 9999 464 : ENDIF 465 : TATRAV.DFFVD(IKVD)=JDFFPG 466 : ENDIF 467 : SEGSUP DFFPG 468 : ENDIF 469 : ENDDO 470 : * 471 : * Calcul des champs et de leurs dérivées 472 : * 473 : DO IJVD=1,JGVD 474 : LC=TATRAV.LVD(IJVD).EQV..TRUE. 475 : LDC=TATRAV.LDVD(IJVD).EQV..TRUE. 476 : IF (LC.OR.LDC) THEN 477 : MYMCHA=TATRAV.IVD(IJVD) 478 : JCOEFF=MYMCHA.ICHEVA(ISOUS) 479 : IF (LC) THEN 480 : FFPG=TATRAV.FFVD(TABVDC.DJSVD(IJVD)) 481 : * In COGAU : SEGINI JCOEFG 481 : CALL COGAU(JCOEFF,FFPG, 482 : $ JCOEFG, 483 : $ IMPR,IRET) 484 : IF (IRET.NE.0) GOTO 9999 485 : TATRAV.VD(IJVD)=JCOEFG 486 : ENDIF 487 : IF (LDC) THEN 488 : JDFFPG=TATRAV.DFFVD(TABVDC.DJSVD(IJVD)) 489 : * In DCOGAU : SEGINI JDCOFG 489 : CALL DCOGAU(JCOEFF,JDFFPG, 490 : $ JDCOFG, 491 : $ IMPR,IRET) 492 : IF (IRET.NE.0) GOTO 9999 493 : TATRAV.DVD(IJVD)=JDCOFG 494 : ENDIF 495 : ENDIF 496 : ENDDO 497 : *!!! SEG DES JMIJAC 498 : * 499 : * Calcul des coefficients 500 : * 501 : DO IJGCOF=1,JGCOF 502 : LC=TATRAV.LVCOF(IJGCOF).EQV..TRUE. 503 : IF (LC) THEN 504 : IVCOMP=TABVDC.VCOMP(IJGCOF) 505 : IICOMP=TABVDC.VLDAT(IJGCOF) 506 : * In CALCGA : SEGINI FC 507 : * In CALCGA : SEGINI METRIQ.MCHEVA 507 : CALL CALCGA(IVCOMP,IICOMP,JMAJAC,JMIJAC,JDTJAC, 508 : $ JMAREG,JDIAMA,JPC,METRIQ, 509 : $ TATRAV, 510 : $ FC,IMPR,IRET) 511 : IF (IRET.NE.0) GOTO 9999 512 : TATRAV.VCOF(IJGCOF)=FC 513 : ENDIF 514 : ENDDO 515 : * 516 : * Calcul des produits de coefficients 517 : * 518 : DO IJLCOF=1,JLCOF 519 : IPOWCO=TABVDC.VLCOF(IJLCOF) 520 : * In CALPCO : SEGINI IPROCO 520 : CALL CALPCO(IPOWCO,TATRAV, 521 : $ IPROCO,IMPR,IRET) 522 : IF (IRET.NE.0) GOTO 9999 523 : TATRAV.VVCOF(IJLCOF)=IPROCO 524 : ENDDO 525 : * 526 : * On peut faire le ménage dans les coefficients 527 : * 528 : DO IJGCOF=1,JGCOF 529 : FC=TATRAV.VCOF(IJGCOF) 530 : IF (FC.NE.0) THEN 531 : SEGSUP,FC 532 : TATRAV.VCOF(IJGCOF)=0 533 : ENDIF 534 : ENDDO 535 : * 536 : * On effectue le calcul de la matrice 537 : * 538 : DO IVARPR=1,NUMVPR 539 : DO IVARDU=1,NUMVDU 540 : C WRITE(IOIMP,*) 'IVARPR= ',IVARPR,' IVARDU= ',IVARDU 541 : * Repris de nlia JMTLIN=0 542 : MYMCHA=TABMAT.VMAT(IVARDU,IVARPR) 543 : JMTLIN=MYMCHA.ICHEVA(ISOUS) 544 : * 545 : IJVARP=TABVDC.VVARPR(IVARPR) 546 : IJVARD=TABVDC.VVARDU(IVARDU) 547 : IKVARP=TABVDC.DJSVD(IJVARP) 548 : IKVARD=TABVDC.DJSVD(IJVARD) 549 : MVVPR=(TABVDC.MVD(IJVARP).NE.0) 550 : MVVDU=(TABVDC.MVD(IJVARD).NE.0) 551 : DO IOP=1,NUMOP 552 : DO KDERPR=0,NUMDER 553 : IJLCPR=TABVDC.ILCPR(KDERPR+1,IOP,IVARPR) 554 : IF (IJLCPR.NE.0) THEN 555 : FCPR=TATRAV.VVCOF(IJLCPR) 556 : * variable primale 557 : IF (KDERPR.EQ.0) THEN 558 : IF (MVVPR) THEN 559 : FVPR=TATRAV.VD(IJVARP) 560 : ELSE 561 : FVPR=TATRAV.FFVD(IKVARP) 562 : ENDIF 563 : ELSE 564 : IF (MVVPR) THEN 565 : FVPR=TATRAV.DVD(IJVARP) 566 : ELSE 567 : FVPR=TATRAV.DFFVD(IKVARP) 568 : ENDIF 569 : ENDIF 570 : DO KDERDU=0,NUMDER 571 : IJLCDU=TABVDC.ILCDU(KDERDU+1,IOP,IVARDU) 572 : IF (IJLCDU.NE.0) THEN 573 : FCDU=TATRAV.VVCOF(IJLCDU) 574 : * Variable duale 575 : IF (KDERDU.EQ.0) THEN 576 : IF (MVVDU) THEN 577 : FVDU=TATRAV.VD(IJVARD) 578 : ELSE 579 : FVDU=TATRAV.FFVD(IKVARD) 580 : ENDIF 581 : ELSE 582 : IF (MVVDU) THEN 583 : FVDU=TATRAV.DVD(IJVARD) 584 : ELSE 585 : FVDU=TATRAV.DFFVD(IKVARD) 586 : ENDIF 587 : ENDIF 588 : C WRITE(IOIMP,*) 'FVPR=',FVPR 589 : C WRITE(IOIMP,*) 'FVDU=',FVDU 590 : C WRITE(IOIMP,*) 'FCPR=',FCPR 591 : C WRITE(IOIMP,*) 'FCDU=',FCDU 592 : C WRITE(IOIMP,*) 'KDERPR=',KDERPR 593 : C WRITE(IOIMP,*) 'KDERDU=',KDERDU 594 : C WRITE(IOIMP,*) 'LDERPR=',LDERPR 595 : C WRITE(IOIMP,*) 'LDERDU=',LDERDU 596 : C SEGPRT,PGCOUR 597 : C SEGPRT,FVPR 598 : C SEGPRT,FVDU 599 : C SEGPRT,FCPR 600 : C SEGPRT,FCDU 601 : C WRITE(IOIMP,*) 'KDERPR=',KDERPR 602 : C WRITE(IOIMP,*) 'KDERDU=',KDERDU 603 : C WRITE(IOIMP,*) 'LDERPR=',LDERPR 604 : C WRITE(IOIMP,*) 'LDERDU=',LDERDU 605 : C SEGPRT,JDTJAC 606 : C WRITE(IOIMP,*) 'NBELEM=',NBELEM 606 : CALL LINLIN(PGCOUR, 607 : $ FVPR,FVDU,FCPR,FCDU, 608 : $ KDERPR,KDERDU, 609 : $ JDTJAC,NBELEM,LERF,IESREF, 610 : $ JMTLIN, 611 : $ IMPR,IRET) 612 : IF (IRET.NE.0) GOTO 9999 613 : C WRITE(IOIMP,*) 'JMTLIN=',JMTLIN 614 : C SEGPRT,JMTLIN 615 : C* STOP 16 616 : ENDIF 617 : ENDDO 618 : ENDIF 619 : ENDDO 620 : ENDDO 621 : MYMCHA=TABMAT.VMAT(IVARDU,IVARPR) 622 : MYMCHA.IMACHE(ISOUS)=SOUGEO 623 : MYMCHA.ICHEVA(ISOUS)=JMTLIN 624 : * IF (JMTLIN.NE.0) THEN 625 : * SEGPRT,JMTLIN 626 : * ENDIF 627 : C WRITE(IOIMP,*) 'IVARPR=',IVARPR 628 : C WRITE(IOIMP,*) 'IVARDU=',IVARDU 629 : C WRITE(IOIMP,*) 'JMTLIN=',JMTLIN 630 : ENDDO 631 : ENDDO 632 : * Suppression de tous les MCHEVA 633 : DO IJLCOF=1,JLCOF 634 : IPROCO=TATRAV.VVCOF(IJLCOF) 635 : SEGSUP IPROCO 636 : TATRAV.VVCOF(IJLCOF)=IPROCO 637 : ENDDO 638 : * 639 : DO IJVD=1,JGVD 640 : JCOEFG=TATRAV.VD(IJVD) 641 : IF (JCOEFG.NE.0) THEN 642 : SEGSUP JCOEFG 643 : TATRAV.VD(IJVD)=JCOEFG 644 : ENDIF 645 : JDCOFG=TATRAV.DVD(IJVD) 646 : IF (JDCOFG.NE.0) THEN 647 : SEGSUP JDCOFG 648 : TATRAV.DVD(IJVD)=JDCOFG 649 : ENDIF 650 : ENDDO 651 : * 652 : DO IKVD=1,KGVD 653 : FFPG=TATRAV.FFVD(IKVD) 654 : IF (FFPG.NE.0) THEN 655 : SEGSUP FFPG 656 : TATRAV.FFVD(IKVD)=FFPG 657 : ENDIF 658 : JDFFPG=TATRAV.DFFVD(IKVD) 659 : IF (JDFFPG.NE.0) THEN 660 : SEGSUP JDFFPG 661 : TATRAV.DFFVD(IKVD)=JDFFPG 662 : ENDIF 663 : ENDDO 664 : * 665 : * Suppression table de préconditionnement métrique 666 : * 667 : IF (METRIQ.NE.0) THEN 668 : SEGACT,METRIQ 669 : NCH=METRIQ.PREC(/1) 670 : DO ICH=1,NCH 671 : MCHEVA=METRIQ.PREC(ICH) 672 : IF (MCHEVA.NE.0) THEN 673 : SEGSUP MCHEVA 674 : ENDIF 675 : ENDDO 676 : C SEGDES METRIQ 677 : SEGSUP METRIQ 678 : ENDIF 679 : SEGSUP JMAREG 680 : SEGSUP JDIAMA 681 : IF (JPC.NE.0) THEN 682 : SEGSUP JPC 683 : ENDIF 684 : SEGSUP JDTJAC 685 : SEGSUP JMAJAC 686 : SEGSUP JMIJAC 687 : * SEGPRT,JMTLIN 688 : 1 CONTINUE 689 : * 690 : DO IJVD=1,JGVD 691 : MYMCHA=TATRAV.IVD(IJVD) 692 : IF (MYMCHA.NE.0) THEN 693 : SEGDES MYMCHA 694 : ENDIF 695 : ENDDO 696 : * SEGDES TABVDC.NOMVC(*) 697 : SEGDES ICOOR 698 : SEGDES MYPGS 699 : * 700 : * Cette instruction n'a pas l'air de fonctionner 701 : * Un peu de ménage là où il n'y a pas d'info 702 : * SEGDES TABMAT.VMAT(*) 703 : DO IVARPR=1,NUMVPR 704 : DO IVARDU=1,NUMVDU 705 : MYMCHA=TABMAT.VMAT(IVARDU,IVARPR) 706 : SEGACT MYMCHA 707 : LVID=.TRUE. 708 : DO ISOUS=1,NBRSOU 709 : MCHEVA=MYMCHA.ICHEVA(ISOUS) 710 : LVID=LVID.AND.(MCHEVA.EQ.0) 711 : ENDDO 712 : IF (LVID) THEN 713 : SEGSUP MYMCHA 714 : TABMAT.VMAT(IVARDU,IVARPR)=0 715 : ELSE 716 : SEGDES,MYMCHA 717 : ENDIF 718 : ENDDO 719 : ENDDO 720 : SEGDES TATRAV 721 : SEGDES TABMAT 722 : SEGDES TABVDC 723 : SEGDES TABGEO 724 : SEGDES CGEOME 725 : * 726 : * Normal termination 727 : * 728 : IRET=0 729 : RETURN 730 : * 731 : * Format handling 732 : * 733 : * 734 : * Error handling 735 : * 736 : 9666 CONTINUE 737 : IRET=666 738 : RETURN 739 : 9999 CONTINUE 740 : IRET=1 741 : WRITE(IOIMP,*) 'An error was detected in subroutine nlin' 742 : RETURN 743 : * 744 : * End of subroutine nlin 745 : * 746 : END 747 : 748 : 749 : 750 : 751 : 752 : 753 : 754 :
© Cast3M 2003 - All rights reserved.
Disclaimer