C PRLIN2    SOURCE    CHAT      09/10/09    21:21:50     6519           
      SUBROUTINE PRLIN2(CGEOM2,LGDISC,CSGEO2,TABCPR,TABCDU,METING,LAXI,
     $     LERF,LERJ,IRESO,IMREG,
     $     MATLIN,CHPLIN,
     $     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 SMPOUET) 
C                            lois de comportement
C VERSION    : v2, 22/09/03, refonte complète (modif SMPOUET)
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 CCOPTIO
-INC SMELEME
      POINTEUR CGEOME.MELEME
      POINTEUR CGEOM2.MELEME
      POINTEUR CSGEO2.MELEME
      POINTEUR CGEOM3.MELEME
      POINTEUR CSGEO3.MELEME
-INC SMTABLE
      POINTEUR TABCPR.MTABLE
      POINTEUR TABCDU.MTABLE
-INC SMRIGID
      POINTEUR MATLIN.MRIGID
-INC SMCHPOI
      POINTEUR CHPLIN.MCHPOI
* Segments à moi
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 MYLRFS.ELREFS
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
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 MYCOMS.COMPS
      POINTEUR MYCOM.COMP
CBEGININCLUDE SIQUAF
      SEGMENT IQUAF
      INTEGER NUMQUF
      REAL*8 XCONQR(NDIMQR,NBNOQR)
      INTEGER NUCENT
      POINTEUR LFACE.MELEME
      ENDSEGMENT
      SEGMENT IQUAFS
      POINTEUR LISQRF(NBQRF).IQUAF
      ENDSEGMENT
CENDINCLUDE SIQUAF
      POINTEUR MYQRFS.IQUAFS
CBEGININCLUDE SFACTIV
      SEGMENT FACTIV
      POINTEUR IFACTI(NBSOUV).SFACTI
      ENDSEGMENT
      SEGMENT SFACTI
      POINTEUR ISFACT(NBSOFV).SSFACT
      ENDSEGMENT
      SEGMENT SSFACT
      LOGICAL LFACTI(NBELFV,NBELEV)
      ENDSEGMENT
CENDINCLUDE SFACTIV
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
*
      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 REGMA2(CGEOM2,CGEOM3,IMPR,IRET)
         IF (IRET.NE.0) GOTO 9999
* In REGMAI : SEGINI CSGEO3
         CALL REGMA2(CSGEO2,CSGEO3,IMPR,IRET)
         IF (IRET.NE.0) GOTO 9999
*
* 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(CGEOM3,CSGEO3,MYQRFS,
     $        CGEOME,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(CGEOME,METING,MYFPGS,IMPR,IRET)
            IF (IRET.NE.0) GOTO 9999
            CALL VERFPG(CSGEO3,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 REGMA2(CGEOM2,CGEOME,IMPR,IRET)
         IF (IRET.NE.0) GOTO 9999
*   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(CGEOME,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(CGEOME,LGDISC,TABCPR,TABCDU,LERF,
     $     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(CGEOME,TABGEO,TABVDC,TATRAV,
     $        METING,LAXI,LERF,LERJ,IMREG,
     $        MYFALS,MYPGS,MYFPGS,
     $        TABMAT,
     $        IMPR,IRET)
         IF (IRET.NE.0) THEN
            IF (LERJ) GOTO 9666
            GOTO 9999
         ENDIF
      ELSE
         CALL NLIA(CGEOME,FACTIV,TABGEO,TABVDC,TATRAV,
     $        METING,LAXI,LERF,LERJ,
     $        MYFALS,MYPGS,MYFPGS,MYQRFS,
     $        TABMAT,
     $        IMPR,IRET)
         IF (IRET.NE.0) GOTO 9999
      ENDIF
* 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(TABVDC,TABMAT,
     $        MYFALS,
     $        MATLIN,CHPLIN,
     $        IMPR,IRET)
         IF (IRET.NE.0) GOTO 9999
      ELSEIF (IRESO.EQ.1) THEN
         CALL CV2MCA(CGEOME,TABVDC,TABMAT,
     $        MYFALS,
     $        MATLIN,CHPLIN,
     $        IMPR,IRET)
         IF (IRET.NE.0) GOTO 9999
      ELSEIF (IRESO.EQ.2) THEN
         CALL CV2MCB(TABVDC,TABMAT,
     $        MYFALS,
     $        MATLIN,CHPLIN,
     $        IMPR,IRET)
         IF (IRET.NE.0) GOTO 9999
      ELSE
         WRITE(IOIMP,*) 'Erreur grave' 
      ENDIF
*dbg      NSEGAP=OOOVAL(2,1)
*dbg      NSEGD=NSEGAP-NSEGAV
*dbg      WRITE(IOIMP,*) 'CV2MC9 : ',NSEGD,' segments crees ',
*dbg     $     ' MAT=',MATLIN,' CHP=',CHPLIN
*     
* 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
*      
      IF (CSGEO2.EQ.0) THEN
* In SUMEL : SEGSUP CGEOME         
         CALL SUMEL(CGEOME,IMPR,IRET)
      ELSE
* In SUFACT : SEGSUP FACTIV
         CALL SUFACT(FACTIV,IMPR,IRET)
         IF (IRET.NE.0) GOTO 9999
* In SUMEL : SEGSUP CGEOME         
         CALL SUMEL(CGEOME,IMPR,IRET)
* In SUMEL : SEGSUP CSGEO3         
         CALL SUMEL(CSGEO3,IMPR,IRET)
* In SUMEL : SEGSUP CGEOM3         
         CALL SUMEL(CGEOM3,IMPR,IRET)
*      SEGSUP MYQRFS
         CALL SUQRFS(MYQRFS,IMPR,IRET)
         IF (IRET.NE.0) GOTO 9999
      ENDIF
*
*      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