Sources Esope | Cast3M

rlexco
C RLEXCO    SOURCE    OF166741  24/10/03    21:15:40     12022          
      SUBROUTINE RLEXCO(MLEFC,MACOE2,MCHELM)
C
C**** Definition de MCHAML qui contient les coefficients
C     pour le calcul du gradient
C
      IMPLICIT INTEGER(I-N)
 
-INC PPARAM
-INC CCOPTIO
      INTEGER NBL, NBTPOI
      SEGMENT MLELEM
      INTEGER INDEX(NBL+1)
      INTEGER LESPOI(NBTPOI)
      ENDSEGMENT
      POINTEUR MLEFC.MLELEM
C
      INTEGER N1,N2
      SEGMENT MATRIX
      REAL*8 MAT(N1,N2)
      ENDSEGMENT
      POINTEUR MACOE2.MATRIX
C
      INTEGER N3,L1,N1PTEL,N1EL,N2PTEL,N2EL
-INC SMCHAML
      INTEGER NBNN,NBELEM,NBSOUS,NBREF
-INC SMELEME
      INTEGER JG
-INC SMLENTI
      POINTEUR MLELAS.MLENTI, MLECON.MLENTI, MLEELT.MLENTI
C
      INTEGER NMAX, IELEM, IPOS, IPOS1, ISOUS, NTSOUS, NG
     &       , I1, I2, I3, IPOS2
C
      SEGACT MLEFC
      SEGACT MACOE2
      NBL=MLEFC.INDEX(/1)-1
C
      NMAX=0
      IPOS1=MLEFC.INDEX(1)
      DO IELEM = 1, NBL
         IPOS=IPOS1
         IPOS1=MLEFC.INDEX(1+IELEM)
         NMAX=MAX(NMAX,IPOS1-IPOS)
      ENDDO
C
C**** L'elt le plus grand a NMAX point
C
      JG=NMAX
      SEGINI MLELAS
      SEGINI MLECON
      JG=NBL
      SEGINI MLEELT
C
C**** Les MLENTI ici initialisé
C
C     MLELAS+MLEELT = structure pour definir les MAILLAGEs
C                     du MCHELM
C
C     NELT1=MLELAS.LECT(I) = 0 -> il n'y a pas d'elts avec I points
C                          > 0 -> NELT1 a I points
C                                 Les autres elts avec I points sont
C                                 dedans MLEELT (liste chaînée qui
C                                 est lié à MLEELT)
C
C     MLECON.LECT(I) = nombre de elts avec I points
C
C     N.B: MLECON.LECT(I) est une information redondantemais pratique
C
C
      IPOS1=MLEFC.INDEX(1)
      DO IELEM = 1, NBL, 1
         IPOS=IPOS1
         IPOS1=MLEFC.INDEX(1+IELEM)
         NBNN=IPOS1-IPOS
         MLECON.LECT(NBNN)=MLECON.LECT(NBNN)+1
         MLEELT.LECT(IELEM)= MLELAS.LECT(NBNN)
         MLELAS.LECT(NBNN)=IELEM
      ENDDO
C
C**** Les supports
C
      NTSOUS=0
      DO ISOUS=1,NMAX,1
         IF(MLECON.LECT(ISOUS).NE.0) NTSOUS=NTSOUS+1
      ENDDO
C
C**** Initialisation du MCHELM
C
      N1=NTSOUS
      N2=IDIM
      N3=6
      L1=8
      SEGINI MCHELM
      MCHELM.TITCHE='Gradient'
      MCHELM.IFOCHE=IFOUR
C
      ISOUS=0
      NBSOUS=0
      NBREF=0
      DO I1 = 1, NMAX, 1
         NBELEM=MLECON.LECT(I1)
         IF(NBELEM .GT. 0)THEN
            ISOUS=ISOUS+1
            NBNN=I1
            SEGINI MELEME
C           ITYPEL=32 -> 'POLY'
            ITYPEL=32
            MCHELM.IMACHE(ISOUS)=MELEME
            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          '
            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
            IELEM=MLELAS.LECT(I1)
            IPOS=MLEFC.INDEX(IELEM)
            IPOS1=MLEFC.INDEX(IELEM+1)
            IF((IPOS1-IPOS).NE.NBNN)THEN
               WRITE(IOIMP,*) 'subroutine rlexco.eso'
               CALL ERREUR(5)
               GOTO 9999
            ENDIF
C
C********** MELEME.NUM(1,*) est le point face
C
            DO I3=1,NBNN,1
               IPOS2=IPOS+I3-1
               NG=MLEFC.LESPOI(IPOS2)
               MELEME.NUM(I3,1)=NG
               MELVA1.VELCHE(I3,1)=MACOE2.MAT(1,IPOS2)
               MELVA2.VELCHE(I3,1)=MACOE2.MAT(2,IPOS2)
               IF(IDIM.EQ.3)  MELVA3.VELCHE(I3,1)=MACOE2.MAT(3,IPOS2)
            ENDDO
C
            DO I2=2,NBELEM,1
               IELEM=MLEELT.LECT(IELEM)
               IPOS=MLEFC.INDEX(IELEM)
               IPOS1=MLEFC.INDEX(IELEM+1)
               IF((IPOS1-IPOS).NE.NBNN)THEN
                  WRITE(IOIMP,*) 'subroutine rlexco.eso'
                  CALL ERREUR(5)
                  GOTO 9999
               ENDIF
C
               DO I3=1,NBNN,1
                  IPOS2=IPOS+I3-1
                  NG=MLEFC.LESPOI(IPOS2)
                  MELEME.NUM(I3,I2)=NG
                  MELVA1.VELCHE(I3,I2)=MACOE2.MAT(1,IPOS2)
                  MELVA2.VELCHE(I3,I2)=MACOE2.MAT(2,IPOS2)
                  IF(IDIM.EQ.3) MELVA3.VELCHE(I3,I2)=MACOE2.MAT(3,IPOS2)
               ENDDO
            ENDDO
C
            IELEM=MLEELT.LECT(IELEM)
            IF(IELEM.NE.0)THEN
               WRITE(IOIMP,*) 'subroutine rlexco.eso'
               CALL ERREUR(5)
               GOTO 9999
            ENDIF
            SEGDES MCHAML
            SEGDES MELEME
            SEGDES MELVA1
            SEGDES MELVA2
            IF(IDIM.EQ.3) SEGDES MELVA3
         ENDIF
      ENDDO
C
      SEGDES MCHELM
C
      SEGSUP MLEFC
      SEGSUP MACOE2
      SEGSUP MLEELT
      SEGSUP MLECON
      SEGSUP MLELAS
C
 9999 RETURN
      END