Télécharger la plaquette Cast3M


fr en

Télécharger rlexf2.eso

Retour à la liste

Numérotation des lignes : 

rlexf2

  1. C RLEXF2    SOURCE    OF166741  24/12/13    21:17:30     12097          
  2.       SUBROUTINE RLEXF2(MCHCEN,MCHLIM,MCHELM,MCHFAC)
  3.  
  4.       IMPLICIT INTEGER(I-N)
  5.  
  6. -INC PPARAM
  7. -INC CCOPTIO
  8.       INTEGER NBNN, NBELEM
  9. -INC SMELEME
  10. -INC SMCHAML
  11. C
  12. -INC SMCHPOI
  13.       POINTEUR MCHCEN.MCHPOI, MCHLIM.MCHPOI, MCHFAC.MCHPOI
  14.       POINTEUR MPOCEN.MPOVAL, MPOLIM.MPOVAL, MPOFAC.MPOVAL
  15. C
  16. -INC SMLENTI
  17.       POINTEUR MLECEN.MLENTI, MLELIM.MLENTI, MLEFAC.MLENTI
  18. C
  19.       INTEGER IGEOM, NCOM, NBSOUS, ISOUS, IELEM, NGF, NLF, NGV, NLV
  20.      &     ,IVOI, ICOM, I2
  21.       REAL*8 VAL
  22.       CHARACTER*(LOCOMP) NOM1
  23. C
  24.       LOGICAL LOGCEN
  25.       CALL LICHT(MCHCEN,MPOCEN,NOM1,IGEOM)
  26.       IF(IERR.NE.0)GOTO 9999
  27.       NCOM=MPOCEN.VPOCHA(/2)
  28. C     En LICHT SEGACT*MOD MPOCEN
  29.       CALL KRIPAD(IGEOM,MLECEN)
  30.       IF(IERR.NE.0)GOTO 9999
  31. C
  32. C**** En KRIPAD
  33. C     SEGACT IGEOM
  34. C     SEGINI MLECEN
  35. C
  36.       MELEME=IGEOM
  37.       SEGDES MELEME
  38. C
  39.       IF(MCHLIM.GT.0)THEN
  40.          CALL LICHT(MCHLIM,MPOLIM,NOM1,IGEOM)
  41.          IF(IERR.NE.0)GOTO 9999
  42. C     En LICHT SEGACT*MOD MPOLIM
  43.          CALL KRIPAD(IGEOM,MLELIM)
  44.          IF(IERR.NE.0)GOTO 9999
  45. C
  46. C**** En KRIPAD
  47. C     SEGACT IGEOM
  48. C     SEGINI MLELIM
  49. C
  50.          MELEME=IGEOM
  51.          SEGDES MELEME
  52.       ELSE
  53.          MPOLIM=0
  54.          MLELIM=0
  55.       ENDIF
  56. C
  57.       CALL LICHT(MCHFAC,MPOFAC,NOM1,IGEOM)
  58.       IF(IERR.NE.0)GOTO 9999
  59. C     En LICHT SEGACT*MOD MPOFAC
  60.       CALL KRIPAD(IGEOM,MLEFAC)
  61.       IF(IERR.NE.0)GOTO 9999
  62. C
  63. C**** En KRIPAD
  64. C     SEGACT IGEOM
  65. C     SEGINI MLEFAC
  66. C
  67.       MELEME=IGEOM
  68.       SEGDES MELEME
  69. C
  70.       SEGACT MCHELM
  71.       NBSOUS=MCHELM.IMACHE(/1)
  72. C
  73.       DO ISOUS=1,NBSOUS,1
  74.          MELEME=MCHELM.IMACHE(ISOUS)
  75.          MCHAM1=MCHELM.ICHAML(ISOUS)
  76.          SEGACT MELEME
  77.          SEGACT MCHAM1
  78.          MELVA1=MCHAM1.IELVAL(1)
  79.          MELVA2=MCHAM1.IELVAL(2)
  80.          SEGACT MELVA1
  81.          SEGACT MELVA2
  82.          NOM1=MCHAM1.NOMCHE(1)
  83.          IF(NOM1 .NE. 'alphax')THEN
  84.             WRITE(IOIMP,*)  NOM1, '!=',  'alphax  '
  85. C           21 2
  86. C           Données incompatibles
  87.             CALL ERREUR(21)
  88.             GOTO 9999
  89.          ENDIF
  90.          NOM1=MCHAM1.NOMCHE(2)
  91.          IF(NOM1 .NE. 'alphay')THEN
  92.             WRITE(IOIMP,*)  NOM1, '!=',  'alphay  '
  93. C           21 2
  94. C           Données incompatibles
  95.             CALL ERREUR(21)
  96.             GOTO 9999
  97.          ENDIF
  98.          IF(IDIM.EQ.3)THEN
  99.             MELVA3=MCHAM1.IELVAL(3)
  100.             SEGACT MELVA3
  101.             NOM1=MCHAM1.NOMCHE(3)
  102.             IF(NOM1 .NE. 'alphaz')THEN
  103.                WRITE(IOIMP,*)  NOM1, '!=',  'alphaz  '
  104. C              21 2
  105. C              Données incompatibles
  106.                CALL ERREUR(21)
  107.                GOTO 9999
  108.             ENDIF
  109.          ENDIF
  110. C
  111.          NBNN=MELEME.NUM(/1)
  112.          NBELEM=MELEME.NUM(/2)
  113. C
  114.          DO IELEM=1,NBELEM,1
  115.             NGF=MELEME.NUM(1,IELEM)
  116.             NLF=MLEFAC.LECT(NGF)
  117.             IF(NLF.EQ.0)THEN
  118.                WRITE (IOIMP,*) 'subroutine rlexf2.eso'
  119.                CALL ERREUR(5)
  120.                GOTO 9999
  121.             ENDIF
  122.             DO IVOI=2,NBNN,1
  123.                NGV=MELEME.NUM(IVOI,IELEM)
  124.                NLV=MLECEN.LECT(NGV)
  125.                IF(NLV.NE.0)THEN
  126.                   LOGCEN=.TRUE.
  127.                ELSE
  128.                   LOGCEN=.FALSE.
  129.                   NLV=MLELIM.LECT(NGV)
  130.                   IF(NLV.EQ.0)THEN
  131.                      WRITE(IOIMP,*) 'subroutine rlexf2.eso'
  132.                      CALL ERREUR(5)
  133.                      GOTO 9999
  134.                   ENDIF
  135.                ENDIF
  136.                DO ICOM = 1, NCOM, 1
  137.                   IF(LOGCEN)THEN
  138.                      VAL=MPOCEN.VPOCHA(NLV,ICOM)
  139.                   ELSE
  140.                      VAL=MPOLIM.VPOCHA(NLV,ICOM)
  141.                   ENDIF
  142.                   I2=(ICOM-1)*IDIM+1
  143.                   MPOFAC.VPOCHA(NLF,I2)=MPOFAC.VPOCHA(NLF,I2)+
  144.      &                 (MELVA1.VELCHE(IVOI,IELEM)*VAL)
  145.                   MPOFAC.VPOCHA(NLF,I2+1)=MPOFAC.VPOCHA(NLF,I2+1)+
  146.      &                 (MELVA2.VELCHE(IVOI,IELEM)*VAL)
  147.                   IF(IDIM.EQ.3)
  148.      &                 MPOFAC.VPOCHA(NLF,I2+2)=MPOFAC.VPOCHA(NLF,I2+2)+
  149.      &                 (MELVA3.VELCHE(IVOI,IELEM)*VAL)
  150.                ENDDO
  151.             ENDDO
  152.          ENDDO
  153.          SEGDES MELEME
  154.          SEGDES MCHAM1
  155.          SEGDES MELVA1
  156.          SEGDES MELVA2
  157.          IF(IDIM.EQ.3) SEGDES MELVA3
  158.       ENDDO
  159. C
  160.       SEGDES MCHELM
  161.       IF(MPOLIM .NE. 0) THEN
  162.          SEGDES MPOLIM
  163.          SEGSUP MLELIM
  164.       ENDIF
  165.       SEGDES MPOFAC
  166.       SEGDES MPOCEN
  167.       SEGSUP MLECEN
  168.       SEGSUP MLEFAC
  169. C
  170.  9999 RETURN
  171.       END
  172.  
  173.  
  174.  
  175.  
  176.  
  177.  
  178.  
  179.  
  180.  

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