C PRLIN2    SOURCE    GOUNAND   26/01/09    21:15:48     12441          
      SUBROUTINE PRLIN2(CGEOM2,LGDISC,CSGEO2,TABCPR,TABCDU,METING,LAXI,
     $     LERF,LERJ,IRESO,IMREG,LCHAM,
     $     MATLIN,ICHLIN,
     $     IMPR,IRET)
      IMPLICIT REAL*8 (A-H,O-Z)
      IMPLICIT INTEGER (I-N)
C***********************************************************************
C NOM         : PRLIN2
C DESCRIPTION : Initialisations, tests et formatage des données et des
C               résultats pour nlin.
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       : PRLIN
C***********************************************************************
C ENTREES            :
C SORTIES            :
C TRAVAIL            :
C
C***********************************************************************
C VERSION    : v3.1, 30/07/04, possiblité de travailler
C                              dans l'espace de référence
C VERSION    : v3, 10/05/04, refonte complète (modif SMTNLIN)
C                            lois de comportement
C VERSION    : v2, 22/09/03, refonte complète (modif SMTNLIN)
C VERSION    : v1, 22/08/2003, version initiale
C HISTORIQUE : v1, 22/08/2003, création
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 SMELEME
      POINTEUR CGEOME.MELEME
      POINTEUR CGEOMQ.MELEME
      POINTEUR CGEOM2.MELEME
      POINTEUR CSGEO2.MELEME
      POINTEUR CGEOM3.MELEME
      POINTEUR CSGEO3.MELEME
      POINTEUR CGEOQ3.MELEME
      POINTEUR CSGEQ3.MELEME
-INC SMTABLE
      POINTEUR TABCPR.MTABLE
      POINTEUR TABCDU.MTABLE
-INC SMRIGID
      POINTEUR MATLIN.MRIGID
-INC SMCHPOI
      POINTEUR ICHLIN.MCHPOI
* Segments à moi
-INC TNLIN
*-INC SELREF
      POINTEUR MYLRFS.ELREFS
*-INC SFALRF
      POINTEUR MYFALS.FALRFS
*-INC SPOGAU
      POINTEUR MYPGS.POGAUS
*-INC SFAPG
      POINTEUR MYFPGS.FAPGS
*-INC SLCOMP
      POINTEUR MYCOMS.COMPS
      POINTEUR MYCOM.COMP
*-INC SIQUAF
      POINTEUR MYQRFS.IQUAFS
*-INC SFACTIV
*-INC SMTNLIN
*
      SEGMENT ISQUAF(0)
      CHARACTER*4 LGDISC
      CHARACTER*4 METING
      CHARACTER*4 ITMP
      INTEGER LAXI
      INTEGER LERF
      LOGICAL LERJ
      INTEGER IMPR,IRET
*
      INTEGER OOOVAL
*
* Executable statements
*
      IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans prlin2'
*
* Initialisation du segment contenant les informations sur les
* éléments de référence.
*
*      SEGINI MYLRFS.LISEL(*)
      CALL INLRFS(MYLRFS,IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
*
* Initialisation du segment contenant les informations sur les
* familles d'éléments de référence.
*
*      SEGINI MYFALS.LISFA(*)
      CALL INFALS(MYFALS,MYLRFS,IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
*
* Initialisation du segment contenant les informations sur les
* méthodes d'intégration (type Gauss).
*
*      SEGINI MYPGS.LISPG(*)
      CALL INPGS(MYPGS,IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
*
* Initialisation du segment contenant les informations sur les
* familles de méthodes d'intégration (type Gauss).
*
*      SEGINI MYFPGS.LISFPG(*)
      CALL INFPGS(MYFPGS,MYPGS,IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
*
* Initialisation du segment contenant les informations sur les
* lois de comportements
*
*      SEGINI MYCOMS.LISCOM(*)
* 19/01/2006
*      CALL INCOMS(MYCOMS,IMPR,IRET)
      CALL INCOMS(MYCOMS,CGEOM2,LERF,IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
*
* Initialisation du segment contenant les informations sur les
* éléments QUAFs de référence.
*
      IF (CSGEO2.NE.0) THEN
*      SEGINI MYQRFS
         CALL INQRFS(MYQRFS,IMPR,IRET)
         IF (IRET.NE.0) GOTO 9999
* On régularise le maillage pour plus se faire chier si LISOUS(/1).EQ.0
* In REGMAI : SEGINI CGEOM3
         CALL REGMAI(CGEOM2,CGEOM3)
* In REGMAI : SEGINI CSGEO3
         CALL REGMAI(CSGEO2,CSGEO3)
*
* Transformation de CGEOM3 et CSGEO3 en QUAF si ça n'est pas le cas
* S'il y a eu transformation, les MELEME originaux sont stockés dans LISREF
*
         CALL TRQUAF(CGEOM3,CGEOQ3,MYFALS)
         IF (IERR.NE.0) RETURN
         CALL TRQUAF(CSGEO3,CSGEQ3,MYFALS)
         IF (IERR.NE.0) RETURN
*
*     Si les maillages d'origine n'étaient pas QUAF, le NLIN avec
*     maillage de surface ne marchera pas compte tenu de la logique
*     actuelle de extfac (compare les numéros de noeuds milieux de face)
*
         SEGINI ISQUAF
         ISQUAF(**)=CGEOQ3
         ISQUAF(**)=CSGEQ3
         DO ii=1,ISQUAF(/1)
            MELEME=ISQUAF(ii)
            SEGACT MELEME
            NSOUS=LISOUS(/1)
            DO ISOUS=1,NSOUS
               IPT2=LISREF(ISOUS)
               IF (IPT2.NE.0) THEN
                  MOTERR(1:8)='MAILLAGE'
                  MOTERR(9:16)='QUAF'
                  CALL ERREUR(66)
                  RETURN
               ENDIF
            ENDDO
            SEGDES MELEME
         ENDDO
         SEGSUP ISQUAF

*
* On extrait de CGEOM3 les éléments qui ont au moins une face
* appartenant à CSGEO3 et un objet contenant les faces actives.
*
* In EXTFAC : SEGINI CGEOME
* In EXTFAC : SEGINI FACTIV
         CALL EXTFAC(CGEOQ3,CSGEQ3,MYQRFS,
     $        CGEOMQ,FACTIV,
     $        IMPR,IRET)
         IF (IRET.NE.0) GOTO 9999
*
*  Après EXTFAC :
*
C         Write(ioimp,*) 'Après extfac'
C         Write(ioimp,*) '  cgeom3'
C         ITMP='RESU'
C         CALL ECROBJ('MAILLAGE',CGEOM3)
C         CALL ECRCHA(ITMP)
C         CALL PRLIST
C         ITMP='RESU'
C         CALL ECROBJ('MAILLAGE',CSGEO3)
C         CALL ECRCHA(ITMP)
C         CALL PRLIST
C         CALL ECROBJ('MAILLAGE',CGEOME)
C         CALL PRLIST
C         SEGPRT,FACTIV
         IF (METING.NE.'    ') THEN
            CALL VERFPG(CGEOMQ,METING,MYFPGS,IMPR,IRET)
            IF (IRET.NE.0) GOTO 9999
            CALL VERFPG(CSGEQ3,METING,MYFPGS,IMPR,IRET)
            IF (IRET.NE.0) GOTO 9999
         ENDIF
      ELSE
*
* On régularise le maillage pour ne plus se faire chier si LISOUS(/1).EQ.0
*     In REGMAI : SEGINI CGEOME
         CALL REGMAI(CGEOM2,CGEOME)
*
* Transformation de CGEOME en QUAF si ça n'est pas le cas
* S'il y a eu transformation, les MELEME originaux sont stockés dans LISREF
*
         CALL TRQUAF(CGEOME,CGEOMQ,MYFALS)
         IF (IERR.NE.0) RETURN
*
*   On vérifie pour la famille de méthode d'intégration :
*   - qu'elle est valide ;
*   - qu'il y a bien un élément fini qui correspond à chaque élément géométrique
         IF (METING.NE.'    ') THEN
            CALL VERFPG(CGEOMQ,METING,MYFPGS,IMPR,IRET)
            IF (IRET.NE.0) GOTO 9999
         ENDIF
      ENDIF
*
* In PRLIN3 : SEGINI TABGEO
* In PRLIN3 : SEGINI TABVDC
* In PRLIN3 : SEGINI TATRAV
      CALL PRLIN3(CGEOMQ,LGDISC,TABCPR,TABCDU,LERF,LCHAM,
     $     MYFALS,MYCOMS,
     $     TABGEO,TABVDC,TATRAV,
     $     IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
*
* Dans PRLIN4, on explicite ce que l'on va vraiment devoir
* calculer dans TATRAV
*
      CALL PRLIN4(TABVDC,TATRAV,
     $     IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
*
* Calculons la matrice des opérateurs
* In NLIN : SEGINI TABMAT
      IF (CSGEO2.EQ.0) THEN
         CALL NLIN(CGEOMQ,TABGEO,TABVDC,TATRAV,
     $        METING,LAXI,LERF,LERJ,IMREG,
     $        MYFALS,MYPGS,MYFPGS,
     $        TABMAT,
     $        IMPR,IRET)
      ELSE
         CALL NLIA(CGEOMQ,FACTIV,TABGEO,TABVDC,TATRAV,
     $        METING,LAXI,LERF,LERJ,
     $        MYFALS,MYPGS,MYFPGS,MYQRFS,
     $        TABMAT,
     $        IMPR,IRET)
      ENDIF
      IF (IRET.EQ.666.AND.LERJ) RETURN
      IF (IRET.NE.0) GOTO 9999
* Ménage de TATRAV
* In SUTRAV : SEGSUP TATRAV
      CALL SUTRAV(TATRAV,IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
*dbg      NSEGAV=OOOVAL(2,1)
* Transformer la matrice de moindres carrés en RIGIDITE ou en MATRIK
      IF (IRESO.EQ.0) THEN
         CALL CV2MC9(CGEOMQ,TABVDC,TABMAT,
     $        MYFALS,LCHAM,
     $        MATLIN,ICHLIN,
     $        IMPR,IRET)
         IF (IRET.NE.0) GOTO 9999
      ELSEIF (IRESO.EQ.1) THEN
         CALL CV2MCA(CGEOMQ,TABVDC,TABMAT,
     $        MYFALS,LCHAM,
     $        MATLIN,ICHLIN,
     $        IMPR,IRET)
         IF (IRET.NE.0) GOTO 9999
      ELSEIF (IRESO.EQ.2) THEN
         CALL CV2MCB(CGEOMQ,TABVDC,TABMAT,
     $        MYFALS,LCHAM,
     $        MATLIN,ICHLIN,
     $        IMPR,IRET)
         IF (IRET.NE.0) GOTO 9999
      ELSE
         WRITE(IOIMP,*) 'Erreur grave'
         GOTO 9999
      ENDIF
*dbg      NSEGAP=OOOVAL(2,1)
*dbg      NSEGD=NSEGAP-NSEGAV
*dbg      WRITE(IOIMP,*) 'CV2MC9 : ',NSEGD,' segments crees ',
*dbg     $     ' MAT=',MATLIN,' CHP=',ICHLIN
*
* Destructions finales...
*
* In SUPOUE : SEGSUP TABMAT
* In SUPOUE : SEGSUP TABVDC
* In SUPOUE : SEGSUP TABGEO
      CALL SUPOUE(TABGEO,TABVDC,TABMAT,IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
*
      SEGINI ISQUAF
      IF (CSGEO2.NE.0) THEN
* In SUFACT : SEGSUP FACTIV
         CALL SUFACT(FACTIV,IMPR,IRET)
         IF (IRET.NE.0) GOTO 9999
         SEGSUP CSGEO3
         SEGSUP CGEOM3
*      SEGSUP MYQRFS
         CALL SUQRFS(MYQRFS,IMPR,IRET)
         IF (IRET.NE.0) GOTO 9999
* Suppression éventuelle des QUAFs créés dans TRQUAF
         ISQUAF(**)=CGEOQ3
         ISQUAF(**)=CSGEQ3
         ISQUAF(**)=CGEOMQ
      ELSE
* REGMAI crée un nouveau chapeau
         SEGSUP CGEOME
         ISQUAF(**)=CGEOMQ
      ENDIF
      DO ii=1,ISQUAF(/1)
* Suppression éventuelle des QUAFs créés dans TRQUAF
         MELEME=ISQUAF(ii)
         SEGACT MELEME
         NSOUS=LISOUS(/1)
         DO ISOUS=1,NSOUS
            IPT2=LISREF(ISOUS)
            IF (IPT2.NE.0) THEN
               IPT1=LISOUS(ISOUS)
               SEGSUP IPT1
            ENDIF
         ENDDO
         SEGSUP MELEME
      ENDDO
      SEGSUP ISQUAF
*
*      SEGSUP MYLRFS.LISEL(*)
      CALL SULRFS(MYLRFS,IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
*      SEGSUP MYFALS.LISFA(*)
      CALL SUFALS(MYFALS,IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
*      SEGSUP MYPGS.LISPG(*)
      CALL SUPGS(MYPGS,IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
*      SEGSUP MYFPGS.LISFPG(*)
      CALL SUFPGS(MYFPGS,IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
      SEGACT MYCOMS
      NBCOMP=MYCOMS.LISCOM(/1)
      DO IBCOMP=1,NBCOMP
         MYCOM=MYCOMS.LISCOM(IBCOMP)
         SEGSUP,MYCOM
      ENDDO
      SEGSUP MYCOMS
*
* 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 prlin2'
      RETURN
*
* End of subroutine PRLIN2
*
      END