C FRIGIE    SOURCE    CHAT      11/03/16    21:23:29     6902           
      SUBROUTINE FRIGIE(IPMODL,IPCAR,CRIGI,CMASS)
**********************************************************************
*
*     CALCUL DES COMPOSANTES DE LA RIGIDITE (HOOK) ELASTIQUE
*     CALCUL DES COMPOSANTES DE LA MATRICE (HOOK) DE MASSE
*     ... AU SIGNE PRES
*     CONTRIBUTION DE CHAQUE ELEMENT DE CHAQUE SS_ZONE DU MODELE
*     DE SECTION
*
**********************************************************************
*
*  ENTREES:
*
*  IPMODL = POINTEUR SUR UN OBJET MMODEL
*  IPCAR  = POINTEUR SUR UN MCHAML DE CARACTERISTIQUES
*
* SORTIES:
*
*  CRIGI(12) ELEMENT DE REDUCTION DE LA RIGIDITE
*  CMASS(12) ELEMENT DE REDUCTION DE LA MASSE
*
************************************************************************
*      Pierre Pegon (ISPRA) Juillet/Aout 1993
***********************************************************************
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
*
-INC CCOPTIO
-INC SMCHAML
-INC SMELEME
-INC SMCOORD
-INC SMMODEL
-INC SMINTE
-INC CCHAMP
C
      DIMENSION  CRIGI(12),CMASS(12)
*
      SEGMENT NOTYPE
        CHARACTER*16 TYPE(NBTYPE)
      ENDSEGMENT
*
      SEGMENT MPTVAL
        INTEGER IPOS(NS)    ,NSOF(NS)
        INTEGER      IVAL(NCOSOU)
        CHARACTER*16 TYVAL(NCOSOU)
      ENDSEGMENT
*
      CHARACTER*8 CMATE
      CHARACTER*(NCONCH) CONM
      CHARACTER*16 MOMODL(10)
      PARAMETER ( NINF=3 )
      INTEGER INFOS(NINF)
      LOGICAL lsupma,lsupca
C
      NHRM=NIFOUR
C
C     VERIFICATION DU LIEU SUPPORT DU MCHAML DE CARACTERISTIQUES
C
      CALL  QUESUP(IPMODL,IPCAR,5,0,ISUP5,IRET5)
      IF (ISUP5.GT.1) RETURN
C
C     ACTIVATION DU MODELE
C
      MMODEL=IPMODL
      SEGACT MMODEL
      NSOUS=KMODEL(/1)
C
C     MISE A ZERO DES RIGIDITES
C
      DO IE1=1,12
        CRIGI(IE1)=0.D0
        CMASS(IE1)=0.D0
      ENDDO
C____________________________________________________________________
C
C     DEBUT DE LA BOUCLE SUR LES DIFFERENTES ZONES
C____________________________________________________________________
C
      DO 1000 ISOUS=1,NSOUS
*
*   INITIALISATION
*
         NMATF=0
         NMATR=0
         MOMATR=0
         IVAMAT=0
         NCARA=0
         NCARF=0
         MOCARA=0
         IVACAR=0
C
C     ON RECUPERE L INFORMATION GENERALE
C
         IMODEL=KMODEL(ISOUS)
         SEGACT IMODEL
         IPMAIL=IMAMOD
         CONM  =CONMOD
*
         MELE=NEFMOD
         MELEME=IMAMOD
C
C     TRAITEMENT DU MODELE
C
         NFOR=FORMOD(/2)
         NMAT=MATMOD(/2)
C
C     NATURE DU MATERIAU
C
         CALL NOMATE(FORMOD,NFOR,MATMOD,NMAT,CMATE,MATE,INFIBR)
         IF (CMATE.EQ.' ')THEN
            CALL ERREUR(251)
            SEGDES IMODEL,MMODEL
            RETURN
         ENDIF
         IF(MATE.NE.1)THEN
            CALL ERREUR(635)
            SEGDES IMODEL,MMODEL
            RETURN
         ENDIF
         CALL TEMANF(INFIBR,NIFIBR)
         IF((NIFIBR.EQ.0).AND.(INFIBR.NE.0))THEN
            CALL ERREUR(636)
            SEGDES IMODEL,MMODEL
            RETURN
         ENDIF
*
         SEGACT MELEME
         NBNN=NUM(/1)
         NBELEM=NUM(/2)
C____________________________________________________________________
C
C     INFORMATION SUR L'ELEMENT FINI
C____________________________________________________________________
C
*         CALL ELQUOI(MELE,0,5,IPINF,IMODEL)
*         IF (IERR.NE.0) THEN
*            SEGDES IMODEL,MMODEL
*            RETURN
*         ENDIF
*         INFO=IPINF
         MFR  =INFELE(13)
         IF (MFR.NE.47)THEN
            CALL ERREUR(637)
            SEGDES IMODEL,MMODEL
            RETURN
         ENDIF
         NBG  =INFELE(6)
         NBGS =INFELE(4)
         LRE  =INFELE(9)
*         MINTE=INFELE(11)
         minte=infmod(7)
         IPPORE=0
         IF(MFR.EQ.33) IPPORE=NBNN
C
C     CREATION DU TABLEAU INFOS
C
         CALL IDENT(IPMAIL,CONM,IPCAR,IPCAR,INFOS,IRTD)
         IF (IRTD.EQ.0)THEN
            SEGDES IMODEL,MMODEL
*            INFO=IPINF
*            SEGSUP INFO
            RETURN
         ENDIF
         IPMINT=MINTE
         SEGACT,MINTE
*
*   TRAITEMENT DU CHAMP DE CARACTERISTIQUES MATERIELLES
*
        if(lnomid(6).ne.0) then
         nomid=lnomid(6)
         segact nomid
         momatr=nomid
         nmatr=lesobl(/2)
         nmatf=lesfac(/2)
         lsupma=.false.
        else 
         lsupma=.true.
         CALL IDMATR(MFR,IMODEL,MOMATR,NMATR,NMATF)
        endif
        IF (MOMATR.EQ.0) THEN
           MOTERR(1:4)='MATE'
           MOTERR(5:8)=NOMTP(MELE)
           CALL ERREUR (76)
           GOTO 9990
        ENDIF
*
        IF (NIFIBR.NE.8) THEN
         NBTYPE=1
         SEGINI NOTYPE
         MOTYPE=NOTYPE
         TYPE(1)='REAL*8'
*
        ELSE
          NBTYPE=13
          SEGINI NOTYPE
          MOTYPE=NOTYPE
          DO I=1,NBTYPE
            TYPE(I)='REAL*8'
          ENDDO
          TYPE(10)='POINTEUREVOLUTIO'
          TYPE(11)='POINTEUREVOLUTIO'
*
        ENDIF
*
        CALL KOMCHA(IPCAR,IPMAIL,CONM,MOMATR,MOTYPE,1,
     &                                  INFOS,3,IVAMAT)
        SEGSUP NOTYPE
        IF (IERR.NE.0) GOTO 9990
        NMATT=NMATR+NMATF
*
        IF (ISUP5.EQ.1) THEN
           CALL VALCHE(IVAMAT,NMATT,IPMINT,IPPORE)
           IF (IERR.NE.0) THEN
              ISUP5=0
              GOTO 9990
           ENDIF
        ENDIF
*
*      TRAITEMENT DU CHAMP DE CARACTERISTIQUES GEOMETRIQUES
* 
        if(lnomid(7).ne.0) then
         nomid=lnomid(7)
         segact nomid
         mocara=nomid
         ncara=lesobl(/2)
         ncarf=lesfac(/2)
         lsupca=.false.
        else 
         lsupca=.true.
         CALL IDCARB(MELE,IFOUR,MOCARA,NCARA,NCARF)
        endif
*
        NBTYPE=1
        SEGINI NOTYPE
        MOTYPE=NOTYPE
        TYPE(1)='REAL*8'
*
        CALL KOMCHA(IPCAR,IPMAIL,CONM,MOCARA,MOTYPE,1,
     &                                     INFOS,3,IVACAR)
        SEGSUP NOTYPE
        IF (IERR.NE.0) GOTO 9990
        NCARR=NCARA+NCARF
*
        IF (ISUP5.EQ.1.AND.MOCARA.NE.0) THEN
           CALL VALCHE(IVACAR,NCARR,IPMINT,IPPORE)
           IF (IERR.NE.0) THEN
              ISUP5=0
              GOTO 9990
           ENDIF
        ENDIF
*
*     APPEL AU CALCUL PROPREMENT DIT
*
         IF (IFOUR.EQ.-2.OR.IFOUR.EQ.-1.OR.IFOUR.EQ.-3) THEN
           CALL FRIG22(MELE,IPMAIL,MINTE,NBGS,
     1        IVAMAT,IVACAR,NMATT,NCARR,
     2        CRIGI,CMASS) 
         ELSE
           CALL FRIGI2(MELE,IPMAIL,MINTE,NBGS,
     3        IVAMAT,IVACAR,NMATT,NCARR,
     4        CRIGI,CMASS) 
         ENDIF
*
 9990    CONTINUE
*
*     DESACTIVATION DES SEGMENTS
*
         SEGDES,MINTE,MELEME,IMODEL
*
         IF(ISUP5.EQ.1)THEN
            CALL DTMVAL (IVAMAT,3)
            CALL DTMVAL (IVACAR,3)
         ELSE
            CALL DTMVAL (IVAMAT,1)
            CALL DTMVAL (IVACAR,1)
         ENDIF
*
         IF (MOCARA.NE.0) THEN
            NOMID=MOCARA
            if(lsupca)SEGSUP NOMID
         END IF
*
         IF (MOMATR.NE.0) THEN
            NOMID=MOMATR
            if(lsupma)SEGSUP NOMID
         END IF
*
*         IF (IPINF .NE.0) THEN
*             INFO=IPINF
*             SEGSUP INFO
*         END IF
*
         IF (IERR.NE.0) GO TO 888
*
1000  CONTINUE
*
 888  CONTINUE
      SEGDES MMODEL
*
      RETURN
      END