Sources Esope | Cast3M

rlexf3
C RLEXF3    SOURCE    OF166741  24/12/13    21:17:31     12097          
      SUBROUTINE RLEXF3(MCHCEN,MCHLI1,MCHLI2,MCHNOR,MCHELM,MCHGRA)
C************************************************************************
C
C PROJET            :  CASTEM 2000
C
C NOM               :  RLEXF3
C
C DESCRIPTION       :  Appelle par PENDI3
C
C LANGAGE           :  FORTRAN 77 + ESOPE 2000 (avec extensions CISI)
C
C AUTEUR            :  A. BECCANTINI
C
C************************************************************************
C
C Inputs:
C
C MCHGRA : CHAMPOINT we want to compute the gradient of which
C
C MCHLI1 : CHAMPOINT Dirichlet BC
C
C MCHLI2 : CHAMPOINT: VN BC
C
C MCHNOR : CHAMPOINT: interfaces normales
C
C MCHELM : MCHAML which contains the coeff. to coppute the gradient
C
C Output:
C
C MCHGRA : CHAMPOINT, gradient of MCHGRA
C
      IMPLICIT INTEGER(I-N)
 
-INC PPARAM
-INC CCOPTIO
      INTEGER NBNN, NBELEM
-INC SMELEME
-INC SMCHAML
C
-INC SMCHPOI
      POINTEUR MCHCEN.MCHPOI, MCHLI1.MCHPOI, MCHLI2.MCHPOI
     &     ,MCHGRA.MCHPOI, MCHNOR.MCHPOI
      POINTEUR MPOCEN.MPOVAL, MPOLI1.MPOVAL, MPOLI2.MPOVAL,MPOGRA.MPOVAL
     &     ,MPONOR.MPOVAL
C
-INC SMLENTI
      POINTEUR MLECEN.MLENTI, MLELI1.MLENTI,MLELI2.MLENTI,MLEGRA.MLENTI
C
      INTEGER IGEOM, NCOM, ISOUS, NBSOUS, IELEM, IVOI, NGV, NLF
     &     ,NLV,NLL1,NLL2,ICOM,I2,NLNO
      REAL*8 VAL
      CHARACTER*(LOCOMP) NOM1
C
C**** We read MCHCEN, MPOCEN (its MPOVAL)
C     and we create MLECEN
C
      CALL LICHT(MCHCEN,MPOCEN,NOM1,IGEOM)
      IF(IERR.NE.0)GOTO 9999
      NCOM=MPOCEN.VPOCHA(/2)
C     En LICHT SEGACT*MOD MPOCEN
      CALL KRIPAD(IGEOM,MLECEN)
      IF(IERR.NE.0)GOTO 9999
C     SEGACT IGEOM
C     SEGINI MLECEN
      MELEME=IGEOM
      SEGDES MELEME
C
C**** For the boundary conditions
C
C     MPOLI1, MLELI1,
C     MPOLI2, MLELI2
C
      IF(MCHLI1.GT.0)THEN
         CALL LICHT(MCHLI1,MPOLI1,NOM1,IGEOM)
         IF(IERR.NE.0)GOTO 9999
C     En LICHT SEGACT*MOD MPOLI1
         CALL KRIPAD(IGEOM,MLELI1)
         IF(IERR.NE.0)GOTO 9999
C        SEGACT IGEOM
C        SEGINI MLELI1
         MELEME=IGEOM
         SEGDES MELEME
      ELSE
         MPOLI1=0
         CALL KRIPAD(0,MLELI1)
      ENDIF
C
      IF(MCHLI2.GT.0)THEN
         CALL LICHT(MCHLI2,MPOLI2,NOM1,IGEOM)
         IF(IERR.NE.0)GOTO 9999
C     En LICHT SEGACT*MOD MPOLI2
         CALL KRIPAD(IGEOM,MLELI2)
         IF(IERR.NE.0)GOTO 9999
C        SEGACT IGEOM
C        SEGINI MLELI2
         MELEME=IGEOM
         SEGDES MELEME
      ELSE
         MPOLI2=0
         CALL KRIPAD(0,MLELI2)
      ENDIF
C
C**** The gradient
C
C     MPOGRA, MLEGRA
C
      CALL LICHT(MCHGRA,MPOGRA,NOM1,IGEOM)
      IF(IERR.NE.0)GOTO 9999
C     En LICHT SEGACT*MOD MPOGRA
      CALL KRIPAD(IGEOM,MLEGRA)
      IF(IERR.NE.0)GOTO 9999
C     En KRIPAD
C     SEGACT IGEOM
C     SEGINI MLEGRA
C
      MELEME=IGEOM
      SEGDES MELEME
C
C**** The normals
C
C     MPONOR (same order as MPOGRA)
C
      CALL LICHT(MCHNOR,MPONOR,NOM1,IGEOM)
      IF(IERR.NE.0)GOTO 9999
C     En LICHT SEGACT*MOD MPONOR
C
C**** Computation
C
      SEGACT MCHELM
      NBSOUS=MCHELM.IMACHE(/1)
C
      DO ISOUS=1,NBSOUS,1
         MELEME=MCHELM.IMACHE(ISOUS)
         MCHAM1=MCHELM.ICHAML(ISOUS)
         SEGACT MELEME
         SEGACT MCHAM1
         MELVA1=MCHAM1.IELVAL(1)
         MELVA2=MCHAM1.IELVAL(2)
         SEGACT MELVA1
         SEGACT MELVA2
         NOM1=MCHAM1.NOMCHE(1)
         IF(NOM1 .NE. 'alphax  ')THEN
            WRITE(IOIMP,*)  NOM1, '!=',  'alphax  '
C           21 2
C           Données incompatibles
            CALL ERREUR(21)
            GOTO 9999
         ENDIF
         NOM1=MCHAM1.NOMCHE(2)
         IF(NOM1 .NE. 'alphay  ')THEN
            WRITE(IOIMP,*)  NOM1, '!=',  'alphay  '
C           21 2
C           Données incompatibles
            CALL ERREUR(21)
            GOTO 9999
         ENDIF
         IF(IDIM.EQ.3)THEN
            MELVA3=MCHAM1.IELVAL(3)
            SEGACT MELVA3
            NOM1=MCHAM1.NOMCHE(3)
            IF(NOM1 .NE. 'alphaz  ')THEN
               WRITE(IOIMP,*)  NOM1, '!=',  'alphaz  '
C              21 2
C              Données incompatibles
               CALL ERREUR(21)
               GOTO 9999
            ENDIF
         ENDIF
C
         NBNN=MELEME.NUM(/1)
         NBELEM=MELEME.NUM(/2)
C
         DO IELEM=1,NBELEM,1
            DO IVOI=1,NBNN,1
               NGV=MELEME.NUM(IVOI,IELEM)
               IF(IVOI .EQ. 1)THEN
                  NLF=MLEGRA.LECT(NGV)
C                  write(*,*) 'NGF=',ngv
                  IF(NLF.EQ.0)THEN
                     WRITE (IOIMP,*) 'MCHAML of coefficients???'
C                     21 2
C                     Données incompatibles
                     CALL ERREUR(21)
                     GOTO 9999
                  ENDIF
                  NLV=0
                  NLL1=MLELI1.LECT(NGV)
                  NLL2=MLELI2.LECT(NGV)
               ELSE
                  NLV=MLECEN.LECT(NGV)
                  NLL1=MLELI1.LECT(NGV)
                  NLL2=MLELI2.LECT(NGV)
               ENDIF
C               write(*,*) 'NGV=',ngv
               IF((NLL1*NLL2) .NE. 0)THEN
                  WRITE(IOIMP,*) 'Boundary conditions.'
C                  21 2
C                  Données incompatibles
                  CALL ERREUR(21)
                  GOTO 9999
               ENDIF
C
               DO ICOM = 1, NCOM, 1
                  IF(NLV.NE.0)THEN
                     VAL=MPOCEN.VPOCHA(NLV,ICOM)
                  ELSEIF(NLL1.NE.0)THEN
                     VAL=MPOLI1.VPOCHA(NLL1,ICOM)
                  ELSEIF(NLL2.NE.0)THEN
                     NLNO=MLEGRA.LECT(NGV)
                     I2=(ICOM-1)*IDIM+1
                     VAL=(MPOLI2.VPOCHA(NLL2,I2)*MPONOR.VPOCHA(NLNO,1))+
     &                  (MPOLI2.VPOCHA(NLL2,I2+1)*MPONOR.VPOCHA(NLNO,2))
                     IF(IDIM .EQ. 3) VAL=VAL+
     &                  (MPOLI2.VPOCHA(NLL2,I2+2)*MPONOR.VPOCHA(NLNO,3))
                  ELSEIF(IVOI .EQ. 1)THEN
                     VAL=0.0D0
C                    They can be all equal to 0 just at the first
C                    iteration (internal FACE point not belonging to BC)
C                    We chack that the MELVAL are 0
C
                     IF((MELVA1.VELCHE(IVOI,IELEM) .NE. 0) .OR.
     &                  (MELVA2.VELCHE(IVOI,IELEM) .NE. 0))THEN
                        WRITE(IOIMP,*) 'Boundary conditions'
C                       21 2
C                       Données incompatibles
                        CALL ERREUR(21)
                        GOTO 9999
                     ELSEIF(IDIM .EQ.3)THEN
                        IF(MELVA3.VELCHE(IVOI,IELEM) .NE. 0)THEN
                           WRITE(IOIMP,*) 'Boundary conditions'
C                          21 2
C                          Données incompatibles
                           CALL ERREUR(21)
                           GOTO 9999
                        ENDIF
                     ENDIF
                  ELSE
                     WRITE(IOIMP,*) 'Boundary conditions'
C                    21 2
C                     Données incompatibles
                     CALL ERREUR(21)
                     GOTO 9999
                  ENDIF
C                  write(*,*) 'VAL =',VAL
                  I2=(ICOM-1)*IDIM+1
                  MPOGRA.VPOCHA(NLF,I2)=MPOGRA.VPOCHA(NLF,I2)+
     &                 (MELVA1.VELCHE(IVOI,IELEM)*VAL)
                  MPOGRA.VPOCHA(NLF,I2+1)=MPOGRA.VPOCHA(NLF,I2+1)+
     &                 (MELVA2.VELCHE(IVOI,IELEM)*VAL)
                  IF(IDIM.EQ.3)
     &                 MPOGRA.VPOCHA(NLF,I2+2)=MPOGRA.VPOCHA(NLF,I2+2)+
     &                 (MELVA3.VELCHE(IVOI,IELEM)*VAL)
               ENDDO
            ENDDO
         ENDDO
         SEGDES MELEME
         SEGDES MCHAM1
         SEGDES MELVA1
         SEGDES MELVA2
         IF(IDIM.EQ.3) SEGDES MELVA3
      ENDDO
C
      SEGDES MCHELM
      IF(MPOLI1 .NE. 0) SEGDES MPOLI1
      SEGSUP MLELI1
      IF(MPOLI2 .NE. 0) SEGDES MPOLI2
      SEGSUP MLELI2
      SEGDES MPOGRA
      SEGDES MPOCEN
      SEGSUP MLECEN
      SEGSUP MLEGRA
      SEGDES MPONOR
C
 9999 RETURN
      END