Sources Esope | Cast3M

ccgmmd
C CCGMMD    SOURCE    GOUNAND   21/06/02    21:15:13     11022          
      SUBROUTINE CCGMMD(LCOF,NOMLOI,
     $     FC,
     $     IMPR,IRET)
      IMPLICIT REAL*8 (A-H,O-Z)
      IMPLICIT INTEGER (I-N)
C***********************************************************************
C NOM         : CCGMMD
C DESCRIPTION : Calcul de la loi de comportement aux points de Gauss :
C                max |d|/min|d| où d=det J
C                avec un signe moins si d change de signe
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    : v1, 04/08/04, version initiale
C HISTORIQUE : v1, 04/08/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 PPARAM
-INC CCOPTIO
-INC CCREEL
-INC TNLIN      
*-INC SMCHAEL
      INTEGER NBLIG,NBCOL,N2LIG,N2COL,NBPOI,NBELM,N1
      POINTEUR FC.MCHEVA
      POINTEUR LCOF.LCHEVA
      POINTEUR JMAJAC.MCHEVA
      POINTEUR JMIJAC.MCHEVA
      POINTEUR JDTJAC.MCHEVA
      POINTEUR JMAREG.MCHEVA
      POINTEUR JMET.MCHEVA
      CHARACTER*8 NOMLOI
      INTEGER ICOF
*
      SEGMENT MCOF
      POINTEUR COEF(IDIM,IDIM).MCHEVA
      ENDSEGMENT
      POINTEUR MET.MCOF
*
      LOGICAL LBID
*
      INTEGER IMPR,IRET
*
* Executable statements
*
      IF (IMPR.GT.1) WRITE(IOIMP,*) 'Entrée dans ccgmmd'
C      IF (.NOT.(IDIM.EQ.1)) THEN
C         WRITE(IOIMP,*) 'IDIM=',IDIM,' ?'
C         GOTO 9999
C      ENDIF
      NLFC=FC.WELCHE(/6)
      NPFC=FC.WELCHE(/5)
      ICOF=0
*
*     Récupération des coefficients de la metrique
*
C      SEGINJ MET
C      DO IIDIM=1,IDIM
C         ICOF=ICOF+1
C         JMET=LCOF.LISCHE(ICOF)
C         IF (ICOF.EQ.1) THEN
C            NLJM=JMET.WELCHE(/6)
C            NPJM=JMET.WELCHE(/5)
C         ELSE
C            NLJM2=JMET.WELCHE(/6)
C            NPJM2=JMET.WELCHE(/5)
C            IF (NLJM2.NE.NLJM.OR.NPJM2.NE.NPJM) THEN
C               WRITE(IOIMP,*) 'Erreur grave dims JMET'
C               GOTO 9999
C            ENDIF
C         ENDIF
C         MET.COEF(IIDIM,IIDIM)=JMET
C      ENDDO
C      DO IIDIM=1,IDIM
C         NJ=IDIM-IIDIM
C         IF (NJ.GE.1) THEN
C            DO JIDIM=IIDIM+1,IDIM
C               ICOF=ICOF+1
C               JMET=LCOF.LISCHE(ICOF)
C               NLJM2=JMET.WELCHE(/6)
C               NPJM2=JMET.WELCHE(/5)
C               IF (NLJM2.NE.NLJM.OR.NPJM2.NE.NPJM) THEN
C                  WRITE(IOIMP,*) 'Erreur grave dims JMET2'
C                  GOTO 9999
C               ENDIF
C               MET.COEF(IIDIM,JIDIM)=JMET
C            ENDDO
C         ENDIF
C      ENDDO
*
      ICOF=ICOF+1
      JMAJAC=LCOF.LISCHE(ICOF)
C      NLJA=JMAJAC.WELCHE(/6)
C      NPJA=JMAJAC.WELCHE(/5)
C      IREF=JMAJAC.WELCHE(/4)
C      IREL=JMAJAC.WELCHE(/3)
C*
C      IF (IREL.NE.IDIM) THEN
C         WRITE(IOIMP,*) 'Erreur dims JMAJAC'
C         GOTO 9999
C      ENDIF
*
      ICOF=ICOF+1
      JMIJAC=LCOF.LISCHE(ICOF)
      ICOF=ICOF+1
      JDTJAC=LCOF.LISCHE(ICOF)
      NLJD=JDTJAC.WELCHE(/6)
      NPJD=JDTJAC.WELCHE(/5)
      ICOF=ICOF+1
      JMAREG=LCOF.LISCHE(ICOF)
C      NLJR=JMAREG.WELCHE(/6)
C      NPJR=JMAREG.WELCHE(/5)
C      I1  =JMAREG.WELCHE(/4)
C      I2  =JMAREG.WELCHE(/3)
C      IF ((NLJR.NE.1).OR.(NPJR.NE.1).OR.(I1.NE.IREF).OR.(I2.NE.IREF))
C     $     THEN
C         WRITE(IOIMP,*) 'Erreur dims JMAREG'
C         GOTO 9999
C      ENDIF
*
      DO ILFC=1,NLFC
         IF (NLJD.EQ.1) THEN
            ILJD=1
         ELSE
            ILJD=ILFC
         ENDIF
         XMADA=-XGRAND
         XMIDA=XGRAND
         XMAD=-XGRAND
         XMID=XGRAND
         DO IPJD=1,NPJD
C         DO IPFC=1,NPFC
C            IF (NPJD.EQ.1) THEN
C               IPJD=1
C            ELSE
C               IPJD=IPFC
C            ENDIF
            XDET=JDTJAC.WELCHE(1,1,1,1,IPJD,ILJD)
            AXDET=ABS(XDET)
            XMADA=MAX(XMADA,AXDET)
            XMIDA=MIN(XMIDA,AXDET)
            XMAD=MAX(XMAD,XDET)
            XMID=MIN(XMID,XDET)
         ENDDO
*
* Les déterminants nuls ou petit ou changeant de signe ont déjà été
* capturés dans geoli2 (normalement !)
*
         CONTRI=SIGN(1.D0,XMAD*XMID)*(XMADA/XMIDA)
*         WRITE(IOIMP,*) 'CONTRI=',CONTRI
*
         DO IPFC=1,NPFC
            FC.WELCHE(1,1,1,1,IPFC,ILFC)=
     $           FC.WELCHE(1,1,1,1,IPFC,ILFC)+CONTRI
         ENDDO
      ENDDO
*
* Normal termination
*
      IRET=0
      RETURN
*
* Format handling
*
*
* Error handling
*
 9999 CONTINUE
      IRET=1
      WRITE(IOIMP,*) 'An error was detected in subroutine ccgmmd'
      RETURN
*
* End of subroutine CCGMMD
*
      END