Sources Esope | Cast3M

rlxce1
C RLXCE1    SOURCE    PV090527  25/01/03    21:15:29     12111          
      SUBROUTINE RLXCE1(MELEME,MLECOE,MCHELM)
C************************************************************************
C
C PROJET            :  CASTEM 2000
C
C NOM               :  RLXCE1
C
C DESCRIPTION       :  Appelle par GRADGE
C
C LANGAGE           :  FORTRAN 77 + ESOPE 2000 (avec extensions CISI)
C
C AUTEUR            :  A. BECCANTINI
C
C************************************************************************
C
C Input
C
C MELEME : SPG of MCHELM (CNETRE + neighbors)
C
C MLECOE : pointers of the list of coeff
C
C Output
C
C MCHELM : MCHAML which contains the coeff. to compute gradients
C
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
 
-INC PPARAM
-INC CCOPTIO
-INC SMCOORD
 
-INC SMCHAML
-INC SMLENTI
      POINTEUR MLESOU.MLENTI, MLECOE.MLENTI
-INC SMELEME
 
      SEGMENT MATRIX
        REAL*8 MAT(N1,N2)
      ENDSEGMENT
 
      INTEGER NSOU, JG, N3, L1, NBNN, NBELEM, ICEN, ISOUS
     &     , N1PTEL, N1EL, N2PTEL, N2EL, IELEM, IVOI
 
      INTEGER N1,N2
C
C**** We recover the elemenary mesh of MELEME
C
      SEGACT MELEME
      SEGACT MLECOE
      NSOU=MAX(MELEME.LISOUS(/1),1)
      JG=NSOU
      SEGINI MLESOU
      IF (NSOU.EQ.1)THEN
         MLESOU.LECT(1)=MELEME
      ELSE
         DO ISOUS=1,NSOU,1
            IPT1=MELEME.LISOUS(ISOUS)
            MLESOU.LECT(ISOUS)=IPT1
         ENDDO
      ENDIF
C
C**** Initialisation du MCHELM
C
      N1=NSOU
      N2=IDIM
      N3=6
      L1=8
      SEGINI MCHELM
      MCHELM.TITCHE='Gradient'
      MCHELM.IFOCHE=IFOUR
C
      ICEN=0
      DO ISOUS = 1, NSOU, 1
         IPT1=MLESOU.LECT(ISOUS)
         MCHELM.IMACHE(ISOUS)=IPT1
         MCHELM.CONCHE(ISOUS)='        '
         MCHELM.INFCHE(ISOUS,6)=1
         SEGINI MCHAML
         MCHELM.ICHAML(ISOUS)=MCHAML
         MCHAML.NOMCHE(1)='alphax'
         MCHAML.NOMCHE(2)='alphay'
         MCHAML.TYPCHE(1)='REAL*8          '
         MCHAML.TYPCHE(2)='REAL*8          '
         SEGACT IPT1
         NBNN=IPT1.NUM(/1)
         NBELEM=IPT1.NUM(/2)
         SEGDES IPT1
         N1PTEL=NBNN
         N1EL=NBELEM
         N2PTEL=0
         N2EL=0
         SEGINI MELVA1
         SEGINI MELVA2
         MCHAML.IELVAL(1)=MELVA1
         MCHAML.IELVAL(2)=MELVA2
         IF(IDIM.EQ.3)THEN
            MCHAML.NOMCHE(3)='alphaz'
            MCHAML.TYPCHE(3)='REAL*8          '
            SEGINI MELVA3
            MCHAML.IELVAL(3)=MELVA3
         ENDIF
         DO IELEM=1,NBELEM,1
            ICEN=ICEN+1
            MATRIX=MLECOE.LECT(ICEN)
            SEGACT MATRIX
            DO IVOI=1,NBNN,1
               MELVA1.VELCHE(IVOI,IELEM)=MATRIX.MAT(2,IVOI)
               MELVA2.VELCHE(IVOI,IELEM)=MATRIX.MAT(3,IVOI)
               IF(IDIM.EQ.3) MELVA3.VELCHE(IVOI,IELEM)=
     $              MATRIX.MAT(4,IVOI)
            ENDDO
            SEGSUP MATRIX
         ENDDO
         SEGDES MCHAML
         SEGDES MELEME
         SEGDES MELVA1
         SEGDES MELVA2
         IF(IDIM.EQ.3) SEGDES MELVA3
      ENDDO
C
      SEGDES MCHELM
C
      SEGSUP MLECOE
      SEGSUP MLESOU
      IF(NSOU .GT. 1) SEGSUP MELEME
C
      RETURN
      END