C NLIN      SOURCE    GOUNAND   26/01/09    21:15:44     12441          
      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 : 2025/12/24 : Gestion Jacobien non inversible
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 PPARAM
-INC CCOPTIO
-INC CCGEOME
-INC TNLIN
*-INC SELREF
      POINTEUR ELCOUR.ELREF
*-INC SFALRF
      POINTEUR MYFALS.FALRFS
*-INC SPOGAU
      POINTEUR MYPGS.POGAUS
      POINTEUR PGCOUR.POGAU
*-INC SFAPG
      POINTEUR MYFPGS.FAPGS
*-INC SLCOMP
      POINTEUR MYCOMP.COMP
      POINTEUR IVCOMP.COMP
      POINTEUR IVCOMD.COMP
-INC SMLENTI
      POINTEUR IPOWCO.MLENTI
-INC SMELEME
      POINTEUR CGEOME.MELEME
      POINTEUR SOUGEO.MELEME
*
*-INC 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
*-INC SMTNLIN
      INTEGER NUMVPR,NUMVDU,NUMDER,NUMOP
      INTEGER JGVC,KGVC
*-INC 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.JGEO
      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 ou 0 (det nul ou change signe sur elt)
* In GEOLIN : SEGINI JDTJAC
         JCOOR=ICOOR.ICHEVA(ISOUS)
         CALL GEOLIK(DFFPG,JCOOR,NBELEM,
     $        JMAJAC,JMIJAC,JDTJAC,IMREG,
     $        IMPR,IRET)
         IF (IRET.NE.0) GOTO 9999
         IF (JMIJAC.EQ.0.AND.LERJ) GOTO 9666
*         IF (JMIJAC.EQ.0) THEN
*            SEGPRT,JDTJAC
*         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
*
* 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.JMACHE(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
         IF (JMIJAC.NE.0) 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