C CALCGA    SOURCE    GOUNAND   07/07/05    21:15:00     5784           
      SUBROUTINE CALCGA(IVCOM,IICOM,JMAJAC,JMIJAC,JDTJAC,JMAREG,JDIAMA,
     $     JPC,
     $     METRIQ,
     $     TATRAV,
     $     FC,
     $     IMPR,IRET)
      IMPLICIT REAL*8 (A-H,O-Z)
      IMPLICIT INTEGER (I-N)
C***********************************************************************
C NOM         : CALCGA
C DESCRIPTION : Calcul de la loi de comportement aux points de Gauss
C     
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       :
C***********************************************************************
C ENTREES            :
C ENTREES/SORTIES    :
C SORTIES            : -
C TRAVAIL            :
C***********************************************************************
C VERSION    : v3.1, 30/07/04, possiblité de travailler
C                  dans l'espace de référence et d'avoir les comp. de la
C                  matrice jacobienne.
C VERSION    : v1, 11/05/04, version initiale
C HISTORIQUE : v1, 11/05/04, 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
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 NBLIG,NBCOL,N2LIG,N2COL,NBPOI,NBELM,N1
      POINTEUR FC.MCHEVA
      POINTEUR LCOF.LCHEVA
      POINTEUR MYCOF.MCHEVA
      POINTEUR JMAJAC.MCHEVA
      POINTEUR JMIJAC.MCHEVA
      POINTEUR JDTJAC.MCHEVA
      POINTEUR JMAREG.MCHEVA
      POINTEUR JDIAMA.MCHEVA
      POINTEUR JPC.MCHEVA
* les MCHEVA des coefficient
CBEGININCLUDE SLCOMP
      SEGMENT COMP
      CHARACTER*8 NOMCOM
      INTEGER DERCOF(NCOCOF)
      LOGICAL LTREF
      ENDSEGMENT
      SEGMENT COMPS
      POINTEUR LISCOM(NBCOMP).COMP
      ENDSEGMENT
CENDINCLUDE SLCOMP
      POINTEUR IVCOM.COMP
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
-INC SMLENTI
      POINTEUR IICOM.MLENTI
CBEGININCLUDE TMPREC
      SEGMENT MPREC
      POINTEUR DAT(NDAT).MCHEVA
      POINTEUR PREC(NPREC).MCHEVA
      ENDSEGMENT
CENDINCLUDE TMPREC
      POINTEUR METRIQ.MPREC
* Segments où l'on stocke les nombres d'éléments et nombre de points de
* Gauss pour chaque champ à fin de vérification
      POINTEUR LNELEM.MLENTI
      POINTEUR LNPOGA.MLENTI
*     
      REAL*8 XFCOM
* Si IPRDU=1, on va chercher les coeffs dans VCOFPR
* Si IPRDU=2, on va chercher les coeffs dans VCOFDU
      INTEGER IPRDU
      INTEGER IMPR,IRET
      CHARACTER*8 NOMLOI
      LOGICAL LREF
      LOGICAL LJACO
*     
* Executable statements
*     
      IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans calcga'
*      IESREL=IDIM
*     
      NBCHE=0
      SEGINI LCOF
      JG=0 
      SEGINI LNELEM
      JG=0 
      SEGINI LNPOGA
*     
*      SEGPRT,TABVC
*      WRITE(IOIMP,*) 'IPRDU=',IPRDU
      SEGACT IVCOM
      SEGACT IICOM
      NCOCOF=IVCOM.DERCOF(/1)
      LJACO=IVCOM.LTREF
      DO ICOCOF=1,NCOCOF
         IJGVD=IICOM.LECT(ICOCOF)
         LDER=IVCOM.DERCOF(ICOCOF)
         IF (LDER.EQ.0) THEN
            MYCOF=TATRAV.VD(IJGVD)
            SEGACT MYCOF
            NEL=MYCOF.VELCHE(/6)
            NPG=MYCOF.VELCHE(/5)
            SEGDES MYCOF
            LCOF.LISCHE(**)=MYCOF
            LNELEM.LECT(**)=NEL
            LNPOGA.LECT(**)=NPG
         ELSEIF (LDER.EQ.1) THEN
            MYCOF=TATRAV.DVD(IJGVD)
            SEGACT MYCOF
            NEL=MYCOF.VELCHE(/6)
            NPG=MYCOF.VELCHE(/5)
            SEGDES MYCOF
            LCOF.LISCHE(**)=MYCOF
            LNELEM.LECT(**)=NEL
            LNPOGA.LECT(**)=NPG
         ELSEIF (LDER.EQ.2) THEN
            MYCOF=TATRAV.VD(IJGVD)
            SEGACT MYCOF
            NEL=MYCOF.VELCHE(/6)
            NPG=MYCOF.VELCHE(/5)
            SEGDES MYCOF
            LCOF.LISCHE(**)=MYCOF
            LNELEM.LECT(**)=NEL
            LNPOGA.LECT(**)=NPG
            MYCOF=TATRAV.DVD(IJGVD)
            SEGACT MYCOF
            NEL=MYCOF.VELCHE(/6)
            NPG=MYCOF.VELCHE(/5)
            SEGDES MYCOF
            LCOF.LISCHE(**)=MYCOF
            LNELEM.LECT(**)=NEL
            LNPOGA.LECT(**)=NPG
         ELSE
            WRITE(IOIMP,*) 'Erreur Grave 2' 
            GOTO 9999
         ENDIF
      ENDDO
      SEGDES IICOM
*     
* Cas particulier des coeffs dépendant de la matrice
* jacobienne
*     
      IF (LJACO) THEN
         SEGACT JMAJAC
         NEL=JMAJAC.VELCHE(/6)
         NPG=JMAJAC.VELCHE(/5)
         SEGDES JMAJAC
         LCOF.LISCHE(**)=JMAJAC
         LNELEM.LECT(**)=NEL
         LNPOGA.LECT(**)=NPG
         IF (JMIJAC.NE.0) THEN
            SEGACT JMIJAC
            NEL=JMIJAC.VELCHE(/6)
            NPG=JMIJAC.VELCHE(/5)
            SEGDES JMIJAC
         ELSE
            NEL=0
            NPG=0
         ENDIF
         LCOF.LISCHE(**)=JMIJAC
         LNELEM.LECT(**)=NEL
         LNPOGA.LECT(**)=NPG
         SEGACT JDTJAC
         NEL=JDTJAC.VELCHE(/6)
         NPG=JDTJAC.VELCHE(/5)
         SEGDES JDTJAC
         LCOF.LISCHE(**)=JDTJAC
         LNELEM.LECT(**)=NEL
         LNPOGA.LECT(**)=NPG
         IF (JMAREG.NE.0) THEN
            SEGACT JMAREG
            NEL=JMAREG.VELCHE(/6)
            NPG=JMAREG.VELCHE(/5)
            SEGDES JMAREG
            LCOF.LISCHE(**)=JMAREG
            LNELEM.LECT(**)=NEL
            LNPOGA.LECT(**)=NPG
         ENDIF
         IF (JDIAMA.NE.0) THEN
            SEGACT JDIAMA
            NEL=JDIAMA.VELCHE(/6)
            NPG=JDIAMA.VELCHE(/5)
            SEGDES JDIAMA
            LCOF.LISCHE(**)=JDIAMA
            LNELEM.LECT(**)=NEL
            LNPOGA.LECT(**)=NPG
         ENDIF
         IF (JPC.NE.0) THEN
            SEGACT JPC
            NEL=JPC.VELCHE(/6)
            NPG=JPC.VELCHE(/5)
            SEGDES JPC
            LCOF.LISCHE(**)=JPC
            LNELEM.LECT(**)=NEL
            LNPOGA.LECT(**)=NPG
         ENDIF
      ENDIF
* Vérifications des dimensions
*   Calcul des max
      JG=LNELEM.LECT(/1)
      NELMAX=1
      NPGMAX=1
      DO IG=1,JG
         NELMAX=MAX(NELMAX,LNELEM.LECT(IG))
         NPGMAX=MAX(NPGMAX,LNPOGA.LECT(IG))
      ENDDO
      SEGSUP LNELEM
      SEGSUP LNPOGA
*   Vérif proprement dite
* Inutilisable car JMIJAC peut être nul...
*      SEGACT LCOF.LISCHE(*)
      NL=LCOF.LISCHE(/1)
      DO IL=1,NL
         MYCOF=LCOF.LISCHE(IL)
         IF (MYCOF.NE.0) THEN 
            SEGACT MYCOF
         ENDIF
      ENDDO
      IG=0
      DO ICOCOF=1,NCOCOF
         LDER=IVCOM.DERCOF(ICOCOF)
         IF (LDER.EQ.0) THEN
            IG=IG+1
            MYCOF=LCOF.LISCHE(IG)
            NDLIG =MYCOF.VELCHE(/1)
            NDCOL =MYCOF.VELCHE(/2)
            N2DLIG=MYCOF.VELCHE(/3)
            N2DCOL=MYCOF.VELCHE(/4)
            NDNOEU=MYCOF.VELCHE(/5)
            NDELM =MYCOF.VELCHE(/6)
            IF (NDLIG.NE.1.OR.NDCOL.NE.1.OR.N2DLIG.NE.1.OR.
     $           N2DCOL.NE.1
     $           .OR.(NDNOEU.NE.1.AND.NDNOEU.NE.NPGMAX)
     $           .OR.(NDELM.NE.1.AND.NDELM.NE.NELMAX)) THEN
               WRITE(IOIMP,*) 'Erreur dims MYCOF'
               WRITE(IOIMP,*) 'ICOCOF=',ICOCOF
               WRITE(IOIMP,*) 'NDLIG=',NDLIG
               WRITE(IOIMP,*) 'NDCOL=',NDCOL
               WRITE(IOIMP,*) 'N2DLIG=',N2DLIG
               WRITE(IOIMP,*) 'N2DCOL=',N2DCOL
               WRITE(IOIMP,*) 'NDNOEU=',NDNOEU
               WRITE(IOIMP,*) 'NDELM =',NDELM
               WRITE(IOIMP,*) 'NPGMAX=',NPGMAX
               WRITE(IOIMP,*) 'NELMAX=',NELMAX
               GOTO 9999
            ENDIF
         ELSEIF (LDER.EQ.1) THEN
            IG=IG+1
            MYCOF=LCOF.LISCHE(IG)
            NDLIG =MYCOF.VELCHE(/1)
            NDCOL =MYCOF.VELCHE(/2)
            N2DLIG=MYCOF.VELCHE(/3)
            N2DCOL=MYCOF.VELCHE(/4)
            NDNOEU=MYCOF.VELCHE(/5)
            NDELM =MYCOF.VELCHE(/6)
            IF (NDLIG.NE.1.OR.NDCOL.NE.1.OR.N2DLIG.NE.1.OR.
* Test faux si utilisation de 'EREF'
*     $           N2DCOL.NE.IESREL.OR.
     $           (NDNOEU.NE.1.AND.NDNOEU.NE.NPGMAX)
     $           .OR.(NDELM.NE.1.AND.NDELM.NE.NELMAX)) THEN
               WRITE(IOIMP,*) 'Erreur dims MYCOF'
               WRITE(IOIMP,*) 'ICOCOF=',ICOCOF
               GOTO 9999
            ENDIF
         ELSEIF (LDER.EQ.2) THEN
            IG=IG+1
            MYCOF=LCOF.LISCHE(IG)
            NDLIG =MYCOF.VELCHE(/1)
            NDCOL =MYCOF.VELCHE(/2)
            N2DLIG=MYCOF.VELCHE(/3)
            N2DCOL=MYCOF.VELCHE(/4)
            NDNOEU=MYCOF.VELCHE(/5)
            NDELM =MYCOF.VELCHE(/6)
            IF (NDLIG.NE.1.OR.NDCOL.NE.1.OR.N2DLIG.NE.1.OR.
     $           N2DCOL.NE.1
     $           .OR.(NDNOEU.NE.1.AND.NDNOEU.NE.NPGMAX)
     $           .OR.(NDELM.NE.1.AND.NDELM.NE.NELMAX)) THEN
               WRITE(IOIMP,*) 'Erreur dims MYCOF'
               WRITE(IOIMP,*) 'ICOCOF=',ICOCOF
               GOTO 9999
            ENDIF
            IG=IG+1
            MYCOF=LCOF.LISCHE(IG)
            NDLIG =MYCOF.VELCHE(/1)
            NDCOL =MYCOF.VELCHE(/2)
            N2DLIG=MYCOF.VELCHE(/3)
            N2DCOL=MYCOF.VELCHE(/4)
            NDNOEU=MYCOF.VELCHE(/5)
            NDELM =MYCOF.VELCHE(/6)
            IF (NDLIG.NE.1.OR.NDCOL.NE.1.OR.N2DLIG.NE.1.OR.
* Test faux si utilisation de 'EREF'
*     $           N2DCOL.NE.IESREL.OR.
     $           (NDNOEU.NE.1.AND.NDNOEU.NE.NPGMAX)
     $           .OR.(NDELM.NE.1.AND.NDELM.NE.NELMAX)) THEN
               WRITE(IOIMP,*) 'Erreur dims MYCOF'
               WRITE(IOIMP,*) 'ICOCOF=',ICOCOF
               GOTO 9999
            ENDIF
         ENDIF
      ENDDO
*     
* Cas particulier matrice jacobienne
*     
      IF (LJACO) THEN 
         IG=IG+1
         MYCOF=LCOF.LISCHE(IG)
         NDLIG =MYCOF.VELCHE(/1)
         NDCOL =MYCOF.VELCHE(/2)
         N2DLIG=MYCOF.VELCHE(/3)
*         N2DCOL=MYCOF.VELCHE(/4)
         IESREF=MYCOF.VELCHE(/4)
         NDNOEU=MYCOF.VELCHE(/5)
         NDELM =MYCOF.VELCHE(/6)
         IF (NDLIG.NE.1.OR.NDCOL.NE.1.OR.
     $        N2DLIG.NE.IDIM.OR.
*     $        N2DCOL.NE.IDIM.OR.
     $        (NDNOEU.NE.1.AND.NDNOEU.NE.NPGMAX)
     $        .OR.(NDELM.NE.1.AND.NDELM.NE.NELMAX)) THEN
         WRITE(IOIMP,*) 'Erreur dims JMAJAC'
         GOTO 9999
      ENDIF
      IG=IG+1
      MYCOF=LCOF.LISCHE(IG)
      IF (MYCOF.NE.0) THEN
         NDLIG =MYCOF.VELCHE(/1)
         NDCOL =MYCOF.VELCHE(/2)
         N2DLIG=MYCOF.VELCHE(/3)
         N2DCOL=MYCOF.VELCHE(/4)
         NDNOEU=MYCOF.VELCHE(/5)
         NDELM =MYCOF.VELCHE(/6)
         IF (NDLIG.NE.1.OR.NDCOL.NE.1.OR.
*     $           N2DLIG.NE.IDIM.OR.N2DCOL.NE.IDIM.OR.
     $        N2DCOL.NE.IDIM.OR.
     $        (NDNOEU.NE.1.AND.NDNOEU.NE.NPGMAX)
     $        .OR.(NDELM.NE.1.AND.NDELM.NE.NELMAX)) THEN
            WRITE(IOIMP,*) 'Erreur dims JMIJAC'
            GOTO 9999
         ENDIF
      ENDIF
      IG=IG+1
      MYCOF=LCOF.LISCHE(IG)
      NDLIG =MYCOF.VELCHE(/1)
      NDCOL =MYCOF.VELCHE(/2)
      N2DLIG=MYCOF.VELCHE(/3)
      N2DCOL=MYCOF.VELCHE(/4)
      NDNOEU=MYCOF.VELCHE(/5)
      NDELM =MYCOF.VELCHE(/6)
      IF (NDLIG.NE.1.OR.NDCOL.NE.1.OR.
     $     N2DLIG.NE.1.OR.N2DCOL.NE.1.OR.
     $     (NDNOEU.NE.1.AND.NDNOEU.NE.NPGMAX)
     $     .OR.(NDELM.NE.1.AND.NDELM.NE.NELMAX)) THEN
         WRITE(IOIMP,*) 'Erreur dims JDTJAC'
         GOTO 9999
      ENDIF
      IF (JMAREG.NE.0) THEN
         IG=IG+1
         MYCOF=LCOF.LISCHE(IG)
         NDLIG =MYCOF.VELCHE(/1)
         NDCOL =MYCOF.VELCHE(/2)
         N2DLIG=MYCOF.VELCHE(/3)
         N2DCOL=MYCOF.VELCHE(/4)
         NDNOEU=MYCOF.VELCHE(/5)
         NDELM =MYCOF.VELCHE(/6)
         IF (NDLIG.NE.1.OR.NDCOL.NE.1.OR.
     $        N2DLIG.NE.IESREF.OR.N2DCOL.NE.IESREF.OR.
     $        (NDNOEU.NE.1.AND.NDNOEU.NE.NPGMAX)
     $        .OR.(NDELM.NE.1.AND.NDELM.NE.NELMAX)) THEN
            WRITE(IOIMP,*) 'Erreur dims JMAREG'
            GOTO 9999
         ENDIF
      ENDIF
      IF (JDIAMA.NE.0) THEN
         IG=IG+1
         MYCOF=LCOF.LISCHE(IG)
         NDLIG =MYCOF.VELCHE(/1)
         NDCOL =MYCOF.VELCHE(/2)
         N2DLIG=MYCOF.VELCHE(/3)
         N2DCOL=MYCOF.VELCHE(/4)
         NDNOEU=MYCOF.VELCHE(/5)
         NDELM =MYCOF.VELCHE(/6)
         IF (NDLIG.NE.1.OR.NDCOL.NE.1.OR.
     $        N2DLIG.NE.1.OR.N2DCOL.NE.1.OR.
     $        NDNOEU.NE.1.OR.NDELM.NE.1) THEN
            WRITE(IOIMP,*) 'Erreur dims JDIAMA'
            GOTO 9999
         ENDIF
      ENDIF
      IF (JPC.NE.0) THEN
         IG=IG+1
         MYCOF=LCOF.LISCHE(IG)
         NDLIG =MYCOF.VELCHE(/1)
         NDCOL =MYCOF.VELCHE(/2)
         N2DLIG=MYCOF.VELCHE(/3)
         N2DCOL=MYCOF.VELCHE(/4)
         NDNOEU=MYCOF.VELCHE(/5)
         NDELM =MYCOF.VELCHE(/6)
         IF (NDLIG.NE.1.OR.NDCOL.NE.1.OR.
     $        N2DLIG.NE.1.OR.N2DCOL.NE.1.OR.
     $        (NDNOEU.NE.1.AND.NDNOEU.NE.NPGMAX)
     $        .OR.(NDELM.NE.1.AND.NDELM.NE.NELMAX)) THEN
            WRITE(IOIMP,*) 'Erreur dims JPC'
            GOTO 9999
         ENDIF
      ENDIF
      ENDIF
*     
* Initialisation du segment contenant la valeur de la loi de
* comportement
      NBLIG=1
      NBCOL=1
      N2LIG=1
      N2COL=1
      NBPOI=NPGMAX
      NBELM=NELMAX
      SEGINI FC
*     
* Calcul proprement dit
*     
      CALL CALCGB(IVCOM,LCOF,METRIQ,
     $     FC,
     $     IMPR,IRET)
      IF (IRET.NE.0) GOTO 9999
*     
* Fin 
*     
      SEGDES FC
* Inutilisable car JMIJAC peut être nul...
*      SEGDES LCOF.LISCHE(*)
      NL=LCOF.LISCHE(/1)
      DO IL=1,NL
         MYCOF=LCOF.LISCHE(IL)
         IF (MYCOF.NE.0) THEN 
            SEGDES MYCOF
         ENDIF
      ENDDO
      SEGSUP LCOF
      SEGDES IVCOM

*     
* Normal termination
*     
      IRET=0
      RETURN
*     
* Format handling
*     
*     
* Error handling
*     
 9999 CONTINUE
      IRET=1
      WRITE(IOIMP,*) 'An error was detected in subroutine calcga'
      RETURN
*     
* End of subroutine CALCGA
*     
      END