Télécharger rlexf2.eso

Retour à la liste

rlexf2
C RLEXF2    SOURCE    CB215821  20/11/25    13:39:28     10792          
      SUBROUTINE RLEXF2(MCHCEN,MCHLIM,MCHELM,MCHFAC)
C
C**** Variables de COOPTIO
C
C      INTEGER IPLLB, IERPER, IERMAX, IERR, INTERR
C     &        ,IOTER,   IOLEC,  IOIMP,     IOCAR,  IOACQ
C     &        ,IOPER,   IOSGB,  IOGRA,     IOSAU,  IORES
C     &        ,IECHO,   IIMPI,  IOSPI
C     &        ,IDIM
C     &        ,MCOORD
C     &        ,IFOMOD, NIFOUR, IFOUR, NSDPGE, IONIVE
C     &        ,NGMAXY, IZROSF, ISOTYP, IOSCR,LTEXLU
C     &        ,NORINC,NORVAL,NORIND,NORVAD
C     &        ,NUCROU, IPSAUV
C
      IMPLICIT INTEGER(I-N)
 
-INC PPARAM
-INC CCOPTIO
      INTEGER NBNN, NBELEM
-INC SMELEME
-INC SMCHAML
C
-INC SMCHPOI
      POINTEUR MCHCEN.MCHPOI, MCHLIM.MCHPOI, MCHFAC.MCHPOI
      POINTEUR MPOCEN.MPOVAL, MPOLIM.MPOVAL, MPOFAC.MPOVAL
C
-INC SMLENTI
      POINTEUR MLECEN.MLENTI, MLELIM.MLENTI, MLEFAC.MLENTI
C
      INTEGER IGEOM, NCOM, NBSOUS, ISOUS, IELEM, NGF, NLF, NGV, NLV
     &     ,IVOI, ICOM, I2
      REAL*8 VAL
      CHARACTER*(LOCOMP) NOM1
C
      LOGICAL LOGCEN
      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
C**** En KRIPAD
C     SEGACT IGEOM
C     SEGINI MLECEN
C
      MELEME=IGEOM
      SEGDES MELEME
C
      IF(MCHLIM.GT.0)THEN
         CALL LICHT(MCHLIM,MPOLIM,NOM1,IGEOM)
         IF(IERR.NE.0)GOTO 9999
C     En LICHT SEGACT*MOD MPOLIM
         CALL KRIPAD(IGEOM,MLELIM)
         IF(IERR.NE.0)GOTO 9999
C
C**** En KRIPAD
C     SEGACT IGEOM
C     SEGINI MLELIM
C
         MELEME=IGEOM
         SEGDES MELEME
      ELSE
         MPOLIM=0
         MLELIM=0
      ENDIF
C
      CALL LICHT(MCHFAC,MPOFAC,NOM1,IGEOM)
      IF(IERR.NE.0)GOTO 9999
C     En LICHT SEGACT*MOD MPOFAC
      CALL KRIPAD(IGEOM,MLEFAC)
      IF(IERR.NE.0)GOTO 9999
C
C**** En KRIPAD
C     SEGACT IGEOM
C     SEGINI MLEFAC
C
      MELEME=IGEOM
      SEGDES MELEME
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
            NGF=MELEME.NUM(1,IELEM)
            NLF=MLEFAC.LECT(NGF)
            IF(NLF.EQ.0)THEN
               WRITE (IOIMP,*) 'subroutine rlexf2.eso'
               CALL ERREUR(5)
               GOTO 9999
            ENDIF
            DO IVOI=2,NBNN,1
               NGV=MELEME.NUM(IVOI,IELEM)
               NLV=MLECEN.LECT(NGV)
               IF(NLV.NE.0)THEN
                  LOGCEN=.TRUE.
               ELSE
                  LOGCEN=.FALSE.
                  NLV=MLELIM.LECT(NGV)
                  IF(NLV.EQ.0)THEN
                     WRITE(IOIMP,*) 'subroutine rlexf2.eso'
                     CALL ERREUR(5)
                     GOTO 9999
                  ENDIF
               ENDIF
               DO ICOM = 1, NCOM, 1
                  IF(LOGCEN)THEN
                     VAL=MPOCEN.VPOCHA(NLV,ICOM)
                  ELSE
                     VAL=MPOLIM.VPOCHA(NLV,ICOM)
                  ENDIF
                  I2=(ICOM-1)*IDIM+1
                  MPOFAC.VPOCHA(NLF,I2)=MPOFAC.VPOCHA(NLF,I2)+
     &                 (MELVA1.VELCHE(IVOI,IELEM)*VAL)
                  MPOFAC.VPOCHA(NLF,I2+1)=MPOFAC.VPOCHA(NLF,I2+1)+
     &                 (MELVA2.VELCHE(IVOI,IELEM)*VAL)
                  IF(IDIM.EQ.3)
     &                 MPOFAC.VPOCHA(NLF,I2+2)=MPOFAC.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(MPOLIM .NE. 0) THEN
         SEGDES MPOLIM
         SEGSUP MLELIM
      ENDIF
      SEGDES MPOFAC
      SEGDES MPOCEN
      SEGSUP MLECEN
      SEGSUP MLEFAC
C
 9999 RETURN
      END
 
 
 
 
 
 
 
 

© Cast3M 2003 - Tous droits réservés.
Mentions légales