Sources Esope | Cast3M

rlex
C RLEX      SOURCE    CB215821  20/11/25    13:39:25     10792          
      SUBROUTINE RLEX(MCHPOI,MCHPO1,MCHPO2,MCHPO3,MTABD)
C
C     Subroutine de reconstruction lineaire exacte d'un
C     Champoint centre au sommet des elements.
C
C*********************************************************
C
C    Cette subroutine est appelee par KLNO
C
C*********************************************************
C
C    Date : 27/11/98
C
C    Auteur : R. MOREL DRN/DMT/SEMT/TTMF
C    21.01.04 : A. Beccantini correction E/S
C                             correction 3D
C
C*********************************************************
C
C  ENTREES : MCHPO1 : CHPOINT centre contenant la fonction
C
C            MCHPO2 : CHPOINT centre contenant le gradient
C
C            MCHPO3 : CHPOINT centre contenant le limiteur
C
C            MTABD  : Table domaine
C
C  SORTIE  : MCHPOI : CHPOINT sommet contenant la fonction
C
C*********************************************************
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
 
 
-INC PPARAM
-INC CCOPTIO
-INC SMCOORD
-INC SMELEME
      POINTEUR MELEMS.MELEME,MELEMC.MELEME
-INC SMCHPOI
-INC SMLENTI
-INC SMLMOTS
C
C Declaration
C
      INTEGER MTABD, INDIC, NBCOMP, IGEOMB
     &     , JGN, JGM, NSOM, NBSOUS, L, NP, NEL, J, K
     &     , ISOM, LSOM, NCENT, NK
      REAL*8 XC, YC, ZC, FC, GX, GY, GZ, GLIM, XS, YS, ZS
     &     , DX, DY, DZ, DF, FS
      CHARACTER*4 MOT
      CHARACTER*8 TYPC
C
C Lecture des maillages de la table domaine
C Verification que les maillages correspondent
C
      CALL LEKTAB(MTABD,'SOMMET',MELEMS)
      IF(IERR.NE.0)RETURN
      CALL LEKTAB(MTABD,'MAILLAGE',MELEME)
      IF(IERR.NE.0)RETURN
      CALL LEKTAB(MTABD,'CENTRE',MELEMC)
      IF(IERR.NE.0)RETURN
C
C**** We chech the geom. support of MCHPOi
C
      INDIC = 1
      NBCOMP = 1
      MOT = 'SCAL'
      CALL QUEPOI(MCHPO1, MELEMC, INDIC, NBCOMP, MOT)
      IF(IERR.NE.0)RETURN
C
      JGN = 4
      JGM = IDIM
      SEGINI MLMOTS
      MLMOTS.MOTS(1) = 'P1DX'
      MLMOTS.MOTS(2) = 'P1DY'
      IF(IDIM .EQ. 3) MLMOTS.MOTS(3) = 'P1DZ'
      CALL QUEPO1(MCHPO2, MELEMC, MLMOTS)
      IF(IERR.NE.0)RETURN
      SEGSUP MLMOTS
C
      INDIC = 1
      NBCOMP = 1
      MOT = 'P1'
      CALL QUEPOI(MCHPO3, MELEMC, INDIC, NBCOMP, MOT)
      IF(IERR.NE.0)RETURN
C
C**** We read the function
C
      CALL LICHT(MCHPO1,MPOVA1,TYPC,IGEOMB)
C     In LICHT, SEGACT MPOVA1
      IF(IERR.NE.0)RETURN
C
      CALL KRIPAD(MELEMS,MLENTI)
      IF(IERR.NE.0)RETURN
C     In KRIPAD, SEGINI MLENTI
C
C Lecture du gradient
C
      CALL LICHT(MCHPO2,MPOVA2,TYPC,IGEOMB)
C     In LICHT, SEGACT MPOVA2
      IF(IERR.NE.0) RETURN
C
C Lecture du limiteur
C
      CALL LICHT(MCHPO3,MPOVA3,TYPC,IGEOMB)
C     In LICHT, SEGACT MPOVA3
C
C Creation du chpoint sommet
C
      JGN = 4
      JGM = 1
      SEGINI MLMOTS
      MLMOTS.MOTS(1) = 'SCAL'
      TYPC = 'CHPOINT '
      CALL KRCHP1(TYPC, MELEMS, MCHPOI, MLMOTS)
      IF(IERR.NE.0) RETURN
      SEGSUP MLMOTS
      CALL LICHT(MCHPOI,MPOVAL,TYPC,IGEOMB)
C     In LICHT, SEGACT MPOVAL
      IF(IERR.NE.0) RETURN
 
      NSOM=MPOVAL.VPOCHA(/1)
C MPOVA4 contient le nombre de centre contribuant a un sommet
      SEGINI, MPOVA4=MPOVAL
C
CC
C On fait une boucle sur les elements du maillage
C A chaque sommet on ajoute la contribution du centre de
C l'element
C
      SEGACT MELEME
      SEGACT MELEMC
      SEGACT MELEMS
      NBSOUS=MELEME.LISOUS(/1)
      IF(NBSOUS.EQ.0)NBSOUS=1
C
      NK=0
      IPT1=MELEME
      DO L=1,NBSOUS,1
         IF(NBSOUS.NE.1)IPT1=LISOUS(L)
         SEGACT IPT1
         NP=IPT1.NUM(/1)
         NEL=IPT1.NUM(/2)
C
         DO J=1,NEL,1
            NK=NK+1
            NCENT=MELEMC.NUM(1,NK)
C Coordonnee du centre
            XC=XCOOR((NCENT-1)*(IDIM+1)+1)
            YC=XCOOR((NCENT-1)*(IDIM+1)+2)
            ZC=0.0D0
            IF (IDIM .EQ. 3) ZC=XCOOR((NCENT-1)*(IDIM+1)+3)
C Valeurs de la fonction sur l'element
            FC=MPOVA1.VPOCHA(NK,1)
            GX=MPOVA2.VPOCHA(NK,1)
            GY=MPOVA2.VPOCHA(NK,2)
            GZ=0.0D0
            IF (IDIM .EQ. 3) GZ=MPOVA2.VPOCHA(NK,3)
            GLIM=MPOVA3.VPOCHA(NK,1)
            DO K=1,NP,1
               ISOM=IPT1.NUM(K,J)
               LSOM=MLENTI.LECT(ISOM)
               MPOVA4.VPOCHA(LSOM,1)=MPOVA4.VPOCHA(LSOM,1)+1.0D0
               XS=XCOOR((ISOM-1)*(IDIM+1)+1)
               YS=XCOOR((ISOM-1)*(IDIM+1)+2)
               ZS=0.0D0
               IF (IDIM .EQ. 3) ZS=XCOOR((ISOM-1)*(IDIM+1)+3)
               DX=XS-XC
               DY=YS-YC
               DZ=ZS-ZC
               DF=(DX*GX+DY*GY+DZ*GZ)*GLIM
               FS=FC+DF
               MPOVAL.VPOCHA(LSOM,1)=MPOVAL.VPOCHA(LSOM,1)+FS
            ENDDO
         ENDDO
      ENDDO
C
      DO J=1,NSOM,1
         MPOVAL.VPOCHA(J,1)=MPOVAL.VPOCHA(J,1)/MPOVA4.VPOCHA(J,1)
      ENDDO
C
      SEGSUP MLENTI
      SEGSUP MPOVA4
C
      END