C NLIN SOURCE GOUNAND 09/09/03 21:15:21 6481 SUBROUTINE NLIN(CGEOME,TABGEO,TABVDC,TATRAV, $ METING,LAXI,LERF,LERJ,IMREG, $ MYFALS,MYPGS,MYFPGS, $ TABMAT, $ IMPR,IRET) IMPLICIT REAL*8 (A-H,O-Z) IMPLICIT INTEGER (I-N) C*********************************************************************** C NOM : NLIN C DESCRIPTION : Création d'une matrice. C C LANGAGE : ESOPE C AUTEUR : Stéphane GOUNAND (CEA/DRN/DMT/SEMT/LTMF) C mél : gounand@semt2.smts.cea.fr C*********************************************************************** C APPELES : C APPELE PAR : PRLIN2 C*********************************************************************** C ENTREES : C ENTREES/SORTIES : - C SORTIES : C TRAVAIL : * SOUGEO (type MELEME) : maillage élémentaire. C * MLLRFS (type MLLRFS) : pointeurs sur les C éléments de référence associés aux 4 espaces de C discrétisation (géométrie, coefficient, primal, C dual) sur le maillage élémentaire. C * PGCOUR (type POGAU) : méthode d'intégration C courante. C * JCOOR (type MCHEVA) : valeurs du champ ICOOR C sur le maillage élémentaire. C Structure (cf.include SMCHAEL) : C (1, nb. ddl, 1, dim. esp. réel, C 1, nb. éléments) C * JCOEFF (type MCHEVA) : valeurs du champ ICOEFF C sur le maillage élémentaire. C Structure (cf.include SMCHAEL) : C (1, nb. ddl, nb. comp. duales, C nb. comp. primales, 1, nb. éléments) C * JMTLIN (type MCHEVA) : valeurs du champ IMTLIN C sur le maillage élémentaire. C Structure (cf.include SMCHAEL) : C (nb. ddl dual, nb. ddl primal, C nb. comp. duales, nb. comp. primales, C 1, nb. éléments) C nb. ddl primal=1 si la matrice est condensée. C * JMAJAC (type MCHEVA) : valeurs de la matrice C jacobienne aux points de Gauss sur le maillage C élémentaire. C Structure (cf.include SMCHAEL) : C (1, 1, dim. esp. réel, dim. esp. référence, C nb. poi. gauss, nb. éléments) C * JMIJAC (type MCHEVA) : valeurs de l'inverse de C la matrice jacobienne aux points de Gauss sur C le maillage élémentaire. C Structure (cf.include SMCHAEL) : C (1, 1, dim. esp. référence, dim. esp. réel, C nb. poi. gauss, nb. éléments) C JMIJAC n'existe que si dim.esp.réf=dim.esp.réel C * JDTJAC (type MCHEVA) : valeurs du déterminant C de la matrice jacobienne aux points de Gauss C sur le maillage élémentaire. C Structure (cf.include SMCHAEL) : C (1, 1, 1, 1, nb. poi. gauss, nb. éléments) C Si la matrice jacobienne n'est pas carrée, on C a calculé sqrt(det(trans(J).J)) C * JCOEFG (type MCHEVA) : valeurs du coefficient C tensoriel aux points de Gauss sur le maillage C élémentaire. C Structure (cf.include SMCHAEL) : C (1, 1, nb. comp. duales, nb. comp. primales, C nb. poi. gauss, nb. éléments) C * FFPG (type MCHEVA) : valeurs des fonctions C d'interpolation aux points de gauss sur C l'élément de référence. C Structure (cf.include SMCHAEL) : C (1, nb. ddl, 1, 1, nb. poi. gauss, 1) C * DFFPG (type MCHEVA) : valeurs des dérivées C premières des fonctions d'interpolation aux C points de gauss sur l'élément de référence. C Structure (cf.include SMCHAEL) : C (1, nb. ddl, 1, dim.esp.réf, nb. poi. gauss, 1) C * JDFFPG (type MCHEVA) : valeurs des dérivées C premières des fonctions d'interpolation C primales aux points de gauss sur l'élément C réel. C Structure (cf.include SMCHAEL) : C (1, nb. ddl, 1, dim.esp.réel, nb. poi. gauss, C nb. élém.) C * JDFFDG (type MCHEVA) : valeurs des dérivées C premières des fonctions d'interpolation C duales aux points de gauss sur l'élément réel. C Structure (cf.include SMCHAEL) : C (1, nb. ddl, 1, dim.esp.réel, nb. poi. gauss, C nb. élém.) C*********************************************************************** C VERSION : v3.1, 30/07/04, possiblité de travailler C dans l'espace de référence C VERSION : v1, 10/05/2004, version initiale C HISTORIQUE : v1, 10/05/2004, création C HISTORIQUE : C HISTORIQUE : C HISTORIQUE : C*********************************************************************** C Prière de PRENDRE LE TEMPS de compléter les commentaires C en cas de modification de ce sous-programme afin de faciliter C la maintenance ! C*********************************************************************** -INC CCOPTIO -INC CCGEOME CBEGININCLUDE SELREF SEGMENT ELREF CHARACTER*(LNNOM) NOMLRF CHARACTER*(LNFORM) FORME CHARACTER*(LNTYPL) TYPEL CHARACTER*(LNESP) ESPACE INTEGER DEGRE REAL*8 XCONOD(NDIMEL,NBNOD) INTEGER NPQUAF(NBDDL) INTEGER NUMCMP(NBDDL) INTEGER QUENOD(NBDDL) INTEGER ORDDER(NDIMEL,NBDDL) POINTEUR MBPOLY.POLYNS ENDSEGMENT SEGMENT ELREFS POINTEUR LISEL(0).ELREF ENDSEGMENT CENDINCLUDE SELREF POINTEUR ELCOUR.ELREF CBEGININCLUDE SFALRF SEGMENT FALRF CHARACTER*(LNNFA) NOMFA INTEGER NUQUAF(NBLRF) POINTEUR ELEMF(NBLRF).ELREF ENDSEGMENT SEGMENT FALRFS POINTEUR LISFA(0).FALRF ENDSEGMENT CENDINCLUDE SFALRF POINTEUR MYFALS.FALRFS CBEGININCLUDE SPOGAU SEGMENT POGAU CHARACTER*(LNNPG) NOMPG CHARACTER*(LNTPG) TYPMPG CHARACTER*(LNFPG) FORLPG INTEGER NORDPG REAL*8 XCOPG(NDLPG,NBPG) REAL*8 XPOPG(NBPG) ENDSEGMENT SEGMENT POGAUS POINTEUR LISPG(0).POGAU ENDSEGMENT CENDINCLUDE SPOGAU POINTEUR MYPGS.POGAUS POINTEUR PGCOUR.POGAU CBEGININCLUDE SFAPG SEGMENT FAPG CHARACTER*(LNNFAP) NOMFAP INTEGER NBQUAF(NBMPG) POINTEUR MPOGAU(NBMPG).POGAU ENDSEGMENT SEGMENT FAPGS POINTEUR LISFPG(0).FAPG ENDSEGMENT CENDINCLUDE SFAPG POINTEUR MYFPGS.FAPGS CBEGININCLUDE SLCOMP SEGMENT COMP CHARACTER*8 NOMCOM INTEGER DERCOF(NCOCOF) LOGICAL LTREF ENDSEGMENT SEGMENT COMPS POINTEUR LISCOM(NBCOMP).COMP ENDSEGMENT CENDINCLUDE SLCOMP POINTEUR MYCOMP.COMP POINTEUR IVCOMP.COMP POINTEUR IVCOMD.COMP -INC SMLENTI POINTEUR IPOWCO.MLENTI -INC SMELEME POINTEUR CGEOME.MELEME POINTEUR SOUGEO.MELEME * CBEGININCLUDE SMCHAEL SEGMENT MCHAEL POINTEUR IMACHE(N1).MELEME POINTEUR ICHEVA(N1).MCHEVA ENDSEGMENT SEGMENT MCHEVA REAL*8 VELCHE(NBLIG,NBCOL,N2LIG,N2COL,NBPOI,NBELM) ENDSEGMENT SEGMENT LCHEVA POINTEUR LISCHE(NBCHE).MCHEVA ENDSEGMENT CENDINCLUDE SMCHAEL INTEGER N1 POINTEUR ICOOR.MCHAEL POINTEUR MYMCHA.MCHAEL POINTEUR JCOOR.MCHEVA,JCOEFF.MCHEVA,JCOEFG.MCHEVA POINTEUR JDCOFG.MCHEVA POINTEUR JMAJAC.MCHEVA,JMIJAC.MCHEVA,JDTJAC.MCHEVA POINTEUR JDTJA2.MCHEVA POINTEUR JMAREG.MCHEVA POINTEUR JDIAMA.MCHEVA POINTEUR JPC.MCHEVA POINTEUR IPROCO.MCHEVA POINTEUR FC.MCHEVA POINTEUR FFPG.MCHEVA,DFFPG.MCHEVA,JDFFPG.MCHEVA POINTEUR FVPR.MCHEVA,FVDU.MCHEVA POINTEUR FCPR.MCHEVA,FCDU.MCHEVA POINTEUR JMTLIN.MCHEVA CBEGININCLUDE SMPOUET SEGMENT TABGEO CHARACTER*4 DISGEO POINTEUR IGEO.MCHAEL ENDSEGMENT SEGMENT TABVDC INTEGER VVARPR(NUMVPR) INTEGER VVARDU(NUMVDU) INTEGER VDATPR(NUMDPR) INTEGER VDATDU(NUMDDU) INTEGER VCOFPR(NUMCPR) INTEGER VCOFDU(NUMCDU) INTEGER ILCPR(NUMDER+1,NUMOP,NUMVPR) INTEGER ILCDU(NUMDER+1,NUMOP,NUMVDU) POINTEUR VLCOF(JLCOF).MLENTI POINTEUR VCOMP(JGCOF).COMP POINTEUR VLDAT(JGCOF).MLENTI INTEGER DJSVD(JGVD) POINTEUR NOMVD(JGVD).MLMOTS POINTEUR MVD(JGVD).MCHPOI REAL*8 XVD(JGVD) CHARACTER*4 DISVD(KGVD) ENDSEGMENT SEGMENT TATRAV POINTEUR VVCOF(JLCOF).MCHEVA POINTEUR VCOF(JGCOF).MCHEVA POINTEUR IVD(JGVD).MCHAEL POINTEUR VD(JGVD).MCHEVA POINTEUR DVD(JGVD).MCHEVA POINTEUR FFVD(KGVD).MCHEVA POINTEUR DFFVD(KGVD).MCHEVA LOGICAL LVCOF(JGCOF) LOGICAL LVD(JGVD) LOGICAL LDVD(JGVD) LOGICAL LFFVD(KGVD) LOGICAL LDFFVD(KGVD) ENDSEGMENT SEGMENT TABMAT POINTEUR VMAT(NUMVDU,NUMVPR).MCHAEL ENDSEGMENT CENDINCLUDE SMPOUET INTEGER NUMVPR,NUMVDU,NUMDER,NUMOP INTEGER JGVC,KGVC CBEGININCLUDE TMPREC SEGMENT MPREC POINTEUR DAT(NDAT).MCHEVA POINTEUR PREC(NPREC).MCHEVA ENDSEGMENT CENDINCLUDE TMPREC POINTEUR METRIQ.MPREC * CHARACTER*4 METING INTEGER LAXI INTEGER LERF LOGICAL LERJ INTEGER IMPR,IRET * CHARACTER*4 MYDISC * INTEGER ISOUS INTEGER IVARPR,IVARDU,KDERPR,KDERDU,IOP INTEGER ITQUAF,NBRSOU,NBELEM LOGICAL LF,LDF,LC,LDC LOGICAL MVVPR,MVVDU,LVID * * Executable statements * * IMPR=5 IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans nlin' * Activation et intialisation des chapeaux SEGACT CGEOME SEGACT TABGEO SEGACT TABVDC SEGACT TATRAV*MOD NBRSOU=CGEOME.LISOUS(/1) NUMVPR=TABVDC.VVARPR(/1) NUMVDU=TABVDC.VVARDU(/1) JLCOF=TABVDC.VLCOF(/1) JGCOF=TABVDC.VCOMP(/1) JGVD=TABVDC.DJSVD(/1) KGVD=TABVDC.DISVD(/2) NUMDER=TABVDC.ILCPR(/1)-1 NUMOP=TABVDC.ILCPR(/2) * N1=NBRSOU * NUMVPR et NUMVDU initialisés ci-dessus SEGINI TABMAT * Cette instruction n'a pas l'air de fonctionner * SEGINI TABMAT.VMAT(*) DO IVARPR=1,NUMVPR DO IVARDU=1,NUMVDU SEGINI,MYMCHA TABMAT.VMAT(IVARDU,IVARPR)=MYMCHA ENDDO ENDDO SEGACT MYPGS ICOOR=TABGEO.IGEO SEGACT ICOOR * SEGACT TABVDC.NOMVC(*) DO IJVD=1,JGVD MYMCHA=TATRAV.IVD(IJVD) IF (MYMCHA.NE.0) THEN SEGACT MYMCHA ENDIF ENDDO * * On travaille sur chaque sous-domaine * DO 1 ISOUS=1,NBRSOU SOUGEO=CGEOME.LISOUS(ISOUS) SEGACT SOUGEO ITQUAF=SOUGEO.ITYPEL * Détermination de la dimension de l'espace de référence CALL DIMELE(NOMS(ITQUAF),IESREF,IMPR,IRET) IF (IRET.NE.0) GOTO 9999 NBELEM=SOUGEO.NUM(/2) IF (IMPR.GT.2) THEN WRITE(IOIMP,*) 'Sous-domaine :',ISOUS ENDIF SEGDES SOUGEO * * Quel est la méthode d'intégration que l'on va utiliser si on n'en a * pas précisé ? * FIPGS est là pour nous le dire. * IF (METING.EQ.' ') THEN WRITE(IOIMP,*) 'Le choix automatique de la méthode ' $ ,'d''integration est désactivé' GOTO 9999 * CALL FIPGS(MLLRFS,MYPGS, * $ PGCOUR, * $ IMPR,IRET) * IF (IRET.GT.0) GOTO 9999 ELSE CALL KEPG(ITQUAF,METING, $ MYFPGS, $ PGCOUR, $ IMPR,IRET) IF (IRET.NE.0) GOTO 9999 ENDIF * * Géométrie * MYDISC=TABGEO.DISGEO CALL KEEF(ITQUAF,MYDISC, $ MYFALS, $ ELCOUR, $ IMPR,IRET) IF (IRET.NE.0) GOTO 9999 * In KFNREF : SEGINI FFPG * In KFNREF : SEGINI DFFPG CALL KFNREF(ELCOUR,PGCOUR, $ FFPG,DFFPG, $ IMPR,IRET) IF (IRET.NE.0) GOTO 9999 * * Création des matrices jacobiennes et déterminants * pour la transformation : élément volumique de référence <-> * élément volumique réel * Ici, on ne se servira que de l'inverse et du déterminant * de la matrice jacobienne. * In GEOLIN : SEGINI JMAJAC * In GEOLIN : SEGINI JMIJAC * In GEOLIN : SEGINI JDTJAC JCOOR=ICOOR.ICHEVA(ISOUS) CALL GEOLIK(DFFPG,JCOOR,NBELEM, $ JMAJAC,JMIJAC,JDTJAC,LERJ,IMREG, $ IMPR,IRET) IF (IRET.NE.0) THEN IF (LERJ) GOTO 9666 GOTO 9999 ENDIF *! SEG SUP JMAJAC SEGSUP DFFPG C Inutile normalement, on peut se débrouiller avec les coeffs C* En axi, on multiplie le determinant de la matrice C* jacobienne par 2piR (ou R est la premiere coordonnee) C IF (LAXI.GT.0) THEN C* In GEOMET : SEGINI JDTJA2 C CALL GEOMET(JCOOR,FFPG, C $ JDTJAC,LAXI, C $ JDTJA2, C $ IMPR,IRET) C IF (IRET.NE.0) GOTO 9999 C SEGSUP JDTJAC C JDTJAC=JDTJA2 C ENDIF * * On récupère la première coordonnée si LAXI(=IFOMOD).NE.-1 * IF (IFOMOD.NE.-1) THEN C* In GEOPC : SEGINI JPC CALL GEOPC(JCOOR,FFPG, $ JPC, $ IMPR,IRET) IF (IRET.NE.0) GOTO 9999 ELSE JPC=0 ENDIF SEGSUP FFPG * * Calcul du jacobien de la transformation : * élément volumique de référence -> élément réguliers * de côté 1 * Cela sert pour l'adaptativité. * In GEOREG : SEGINI JMAREG * CALL GEOREG(ITQUAF,MYFALS,MYFPGS, $ JMAREG, $ IMPR,IRET) IF (IRET.NE.0) GOTO 9999 * * Calcul d'une propriété géométrique d'un QUAF régulier de côté 1 : * ici le diamètre du cercle circonscrit. * Cela sert pour le decentrement. * In GEOQUA : SEGINI JDIAMA * CALL GEOQUA(ITQUAF, $ JDIAMA, $ IMPR,IRET) IF (IRET.NE.0) GOTO 9999 C C Initialisation d'une table de préconditionnement pour l'adaptation C contenant des infos sur la métrique (fait dans les subroutines qui C utilisent METRIQ C C SEGINI METRIQ METRIQ=0 * * Calcul des fonctions de forme et de leurs dérivées * DO IKVD=1,KGVD LF=TATRAV.LFFVD(IKVD).EQV..TRUE. LDF=TATRAV.LDFFVD(IKVD).EQV..TRUE. IF (LF.OR.LDF) THEN MYDISC=TABVDC.DISVD(IKVD) CALL KEEF(ITQUAF,MYDISC, $ MYFALS, $ ELCOUR, $ IMPR,IRET) IF (IRET.NE.0) GOTO 9999 * In KFNREF : SEGINI FFPG * In KFNREF : SEGINI DFFPG CALL KFNREF(ELCOUR,PGCOUR, $ FFPG,DFFPG, $ IMPR,IRET) IF (IRET.NE.0) GOTO 9999 IF (LF) THEN TATRAV.FFVD(IKVD)=FFPG ELSE * segini ffpg SEGSUP FFPG ENDIF IF (LDF) THEN IF (LERF.NE.0) THEN SEGINI,JDFFPG=DFFPG SEGDES JDFFPG ELSE * In DFNFR : SEGINI JDFFPG CALL DFNFR(DFFPG,JMIJAC, $ JDFFPG, $ IMPR,IRET) IF (IRET.NE.0) GOTO 9999 ENDIF TATRAV.DFFVD(IKVD)=JDFFPG ENDIF SEGSUP DFFPG ENDIF ENDDO * * Calcul des champs et de leurs dérivées * DO IJVD=1,JGVD LC=TATRAV.LVD(IJVD).EQV..TRUE. LDC=TATRAV.LDVD(IJVD).EQV..TRUE. IF (LC.OR.LDC) THEN MYMCHA=TATRAV.IVD(IJVD) JCOEFF=MYMCHA.ICHEVA(ISOUS) IF (LC) THEN FFPG=TATRAV.FFVD(TABVDC.DJSVD(IJVD)) * In COGAU : SEGINI JCOEFG CALL COGAU(JCOEFF,FFPG, $ JCOEFG, $ IMPR,IRET) IF (IRET.NE.0) GOTO 9999 TATRAV.VD(IJVD)=JCOEFG ENDIF IF (LDC) THEN JDFFPG=TATRAV.DFFVD(TABVDC.DJSVD(IJVD)) * In DCOGAU : SEGINI JDCOFG CALL DCOGAU(JCOEFF,JDFFPG, $ JDCOFG, $ IMPR,IRET) IF (IRET.NE.0) GOTO 9999 TATRAV.DVD(IJVD)=JDCOFG ENDIF ENDIF ENDDO *!!! SEG DES JMIJAC * * Calcul des coefficients * DO IJGCOF=1,JGCOF LC=TATRAV.LVCOF(IJGCOF).EQV..TRUE. IF (LC) THEN IVCOMP=TABVDC.VCOMP(IJGCOF) IICOMP=TABVDC.VLDAT(IJGCOF) * In CALCGA : SEGINI FC * In CALCGA : SEGINI METRIQ.MCHEVA CALL CALCGA(IVCOMP,IICOMP,JMAJAC,JMIJAC,JDTJAC, $ JMAREG,JDIAMA,JPC,METRIQ, $ TATRAV, $ FC,IMPR,IRET) IF (IRET.NE.0) GOTO 9999 TATRAV.VCOF(IJGCOF)=FC ENDIF ENDDO * * Calcul des produits de coefficients * DO IJLCOF=1,JLCOF IPOWCO=TABVDC.VLCOF(IJLCOF) * In CALPCO : SEGINI IPROCO CALL CALPCO(IPOWCO,TATRAV, $ IPROCO,IMPR,IRET) IF (IRET.NE.0) GOTO 9999 TATRAV.VVCOF(IJLCOF)=IPROCO ENDDO * * On peut faire le ménage dans les coefficients * DO IJGCOF=1,JGCOF FC=TATRAV.VCOF(IJGCOF) IF (FC.NE.0) THEN SEGSUP,FC TATRAV.VCOF(IJGCOF)=0 ENDIF ENDDO * * On effectue le calcul de la matrice * DO IVARPR=1,NUMVPR DO IVARDU=1,NUMVDU C WRITE(IOIMP,*) 'IVARPR= ',IVARPR,' IVARDU= ',IVARDU * Repris de nlia JMTLIN=0 MYMCHA=TABMAT.VMAT(IVARDU,IVARPR) JMTLIN=MYMCHA.ICHEVA(ISOUS) * IJVARP=TABVDC.VVARPR(IVARPR) IJVARD=TABVDC.VVARDU(IVARDU) IKVARP=TABVDC.DJSVD(IJVARP) IKVARD=TABVDC.DJSVD(IJVARD) MVVPR=(TABVDC.MVD(IJVARP).NE.0) MVVDU=(TABVDC.MVD(IJVARD).NE.0) DO IOP=1,NUMOP DO KDERPR=0,NUMDER IJLCPR=TABVDC.ILCPR(KDERPR+1,IOP,IVARPR) IF (IJLCPR.NE.0) THEN FCPR=TATRAV.VVCOF(IJLCPR) * variable primale IF (KDERPR.EQ.0) THEN IF (MVVPR) THEN FVPR=TATRAV.VD(IJVARP) ELSE FVPR=TATRAV.FFVD(IKVARP) ENDIF ELSE IF (MVVPR) THEN FVPR=TATRAV.DVD(IJVARP) ELSE FVPR=TATRAV.DFFVD(IKVARP) ENDIF ENDIF DO KDERDU=0,NUMDER IJLCDU=TABVDC.ILCDU(KDERDU+1,IOP,IVARDU) IF (IJLCDU.NE.0) THEN FCDU=TATRAV.VVCOF(IJLCDU) * Variable duale IF (KDERDU.EQ.0) THEN IF (MVVDU) THEN FVDU=TATRAV.VD(IJVARD) ELSE FVDU=TATRAV.FFVD(IKVARD) ENDIF ELSE IF (MVVDU) THEN FVDU=TATRAV.DVD(IJVARD) ELSE FVDU=TATRAV.DFFVD(IKVARD) ENDIF ENDIF C WRITE(IOIMP,*) 'FVPR=',FVPR C WRITE(IOIMP,*) 'FVDU=',FVDU C WRITE(IOIMP,*) 'FCPR=',FCPR C WRITE(IOIMP,*) 'FCDU=',FCDU C WRITE(IOIMP,*) 'KDERPR=',KDERPR C WRITE(IOIMP,*) 'KDERDU=',KDERDU C WRITE(IOIMP,*) 'LDERPR=',LDERPR C WRITE(IOIMP,*) 'LDERDU=',LDERDU C SEGPRT,PGCOUR C SEGPRT,FVPR C SEGPRT,FVDU C SEGPRT,FCPR C SEGPRT,FCDU C WRITE(IOIMP,*) 'KDERPR=',KDERPR C WRITE(IOIMP,*) 'KDERDU=',KDERDU C WRITE(IOIMP,*) 'LDERPR=',LDERPR C WRITE(IOIMP,*) 'LDERDU=',LDERDU C SEGPRT,JDTJAC C WRITE(IOIMP,*) 'NBELEM=',NBELEM CALL LINLIN(PGCOUR, $ FVPR,FVDU,FCPR,FCDU, $ KDERPR,KDERDU, $ JDTJAC,NBELEM,LERF,IESREF, $ JMTLIN, $ IMPR,IRET) IF (IRET.NE.0) GOTO 9999 C WRITE(IOIMP,*) 'JMTLIN=',JMTLIN C SEGPRT,JMTLIN C* STOP 16 ENDIF ENDDO ENDIF ENDDO ENDDO MYMCHA=TABMAT.VMAT(IVARDU,IVARPR) MYMCHA.IMACHE(ISOUS)=SOUGEO MYMCHA.ICHEVA(ISOUS)=JMTLIN * IF (JMTLIN.NE.0) THEN * SEGPRT,JMTLIN * ENDIF C WRITE(IOIMP,*) 'IVARPR=',IVARPR C WRITE(IOIMP,*) 'IVARDU=',IVARDU C WRITE(IOIMP,*) 'JMTLIN=',JMTLIN ENDDO ENDDO * Suppression de tous les MCHEVA DO IJLCOF=1,JLCOF IPROCO=TATRAV.VVCOF(IJLCOF) SEGSUP IPROCO TATRAV.VVCOF(IJLCOF)=IPROCO ENDDO * DO IJVD=1,JGVD JCOEFG=TATRAV.VD(IJVD) IF (JCOEFG.NE.0) THEN SEGSUP JCOEFG TATRAV.VD(IJVD)=JCOEFG ENDIF JDCOFG=TATRAV.DVD(IJVD) IF (JDCOFG.NE.0) THEN SEGSUP JDCOFG TATRAV.DVD(IJVD)=JDCOFG ENDIF ENDDO * DO IKVD=1,KGVD FFPG=TATRAV.FFVD(IKVD) IF (FFPG.NE.0) THEN SEGSUP FFPG TATRAV.FFVD(IKVD)=FFPG ENDIF JDFFPG=TATRAV.DFFVD(IKVD) IF (JDFFPG.NE.0) THEN SEGSUP JDFFPG TATRAV.DFFVD(IKVD)=JDFFPG ENDIF ENDDO * * Suppression table de préconditionnement métrique * IF (METRIQ.NE.0) THEN SEGACT,METRIQ NCH=METRIQ.PREC(/1) DO ICH=1,NCH MCHEVA=METRIQ.PREC(ICH) IF (MCHEVA.NE.0) THEN SEGSUP MCHEVA ENDIF ENDDO C SEGDES METRIQ SEGSUP METRIQ ENDIF SEGSUP JMAREG SEGSUP JDIAMA IF (JPC.NE.0) THEN SEGSUP JPC ENDIF SEGSUP JDTJAC SEGSUP JMAJAC SEGSUP JMIJAC * SEGPRT,JMTLIN 1 CONTINUE * DO IJVD=1,JGVD MYMCHA=TATRAV.IVD(IJVD) IF (MYMCHA.NE.0) THEN SEGDES MYMCHA ENDIF ENDDO * SEGDES TABVDC.NOMVC(*) SEGDES ICOOR SEGDES MYPGS * * Cette instruction n'a pas l'air de fonctionner * Un peu de ménage là où il n'y a pas d'info * SEGDES TABMAT.VMAT(*) DO IVARPR=1,NUMVPR DO IVARDU=1,NUMVDU MYMCHA=TABMAT.VMAT(IVARDU,IVARPR) SEGACT MYMCHA LVID=.TRUE. DO ISOUS=1,NBRSOU MCHEVA=MYMCHA.ICHEVA(ISOUS) LVID=LVID.AND.(MCHEVA.EQ.0) ENDDO IF (LVID) THEN SEGSUP MYMCHA TABMAT.VMAT(IVARDU,IVARPR)=0 ELSE SEGDES,MYMCHA ENDIF ENDDO ENDDO SEGDES TATRAV SEGDES TABMAT SEGDES TABVDC SEGDES TABGEO SEGDES CGEOME * * Normal termination * IRET=0 RETURN * * Format handling * * * Error handling * 9666 CONTINUE IRET=666 RETURN 9999 CONTINUE IRET=1 WRITE(IOIMP,*) 'An error was detected in subroutine nlin' RETURN * * End of subroutine nlin * END