Télécharger la plaquette Cast3M


fr en

Télécharger rleord.eso

Retour à la liste

Numérotation des lignes : 

rleord

  1. C RLEORD    SOURCE    PV        20/03/30    21:24:14     10567          
  2.       SUBROUTINE RLEORD(MELFL,MELFP,MELF1,MELFL1)
  3. C
  4. C
  5. C**** Variables de COOPTIO
  6. C
  7. C      INTEGER IPLLB, IERPER, IERMAX, IERR, INTERR
  8. C     &        ,IOTER,   IOLEC,  IOIMP,     IOCAR,  IOACQ
  9. C     &        ,IOPER,   IOSGB,  IOGRA,     IOSAU,  IORES
  10. C     &        ,IECHO,   IIMPI,  IOSPI
  11. C     &        ,IDIM
  12. CC     &        ,MCOORD
  13. C     &        ,IFOMOD, NIFOUR, IFOUR, NSDPGE, IONIVE
  14. C     &        ,NGMAXY, IZROSF, ISOTYP, IOSCR,LTEXLU
  15. C     &        ,NORINC,NORVAL,NORIND,NORVAD
  16. C     &        ,NUCROU, IPSAUV
  17. C
  18.       IMPLICIT INTEGER(I-N)
  19.  
  20. -INC PPARAM
  21. -INC CCOPTIO
  22. -INC SMCOORD
  23. -INC SMELEME
  24.       INTEGER NBSOUS,NBNN,NBELEM,NBREF
  25.       POINTEUR MELF1.MELEME,MELFL.MELEME,MELFP.MELEME,
  26.      &     MELFL1.MELEME,MELFP1.MELEME
  27. C
  28.       INTEGER JG
  29. -INC SMLENTI
  30.       POINTEUR MLEFL.MLENTI,MLEFP.MLENTI
  31.       INTEGER IELEM,NGF,NLF,ISOUS,INF,I1,IELEMF
  32. C
  33.       SEGACT MELFL
  34.       NBSOUS=MELFL.LISOUS(/1)
  35.       IF(NBSOUS .NE. 0)THEN
  36.          WRITE(IOIMP,*) 'subroutine rleord.eso'
  37.          WRITE(IOIMP,*) 'FACEL???'
  38.          CALL ERREUR(5)
  39.          GOTO 9999
  40.       ENDIF
  41. C
  42.       SEGINI, MELFL1=MELFL
  43. C
  44.       NBELEM=MELFL.NUM(/2)
  45.       NBNN=1
  46.       NBSOUS=0
  47.       NBREF=0
  48.       SEGINI MELF1
  49. C
  50.       JG=nbpts
  51.       SEGINI MLEFL
  52.       DO IELEM = 1, NBELEM, 1
  53.          NGF=MELFL.NUM(2,IELEM)
  54.          MLEFL.LECT(NGF)=IELEM
  55.       ENDDO
  56. C
  57.       SEGACT MELFP
  58.       NBSOUS=MELFP.LISOUS(/1)
  59. C     NBSOUS=0 fais un peux chier!
  60.       JG=MAX(NBSOUS,1)
  61.       SEGINI MLEFP
  62.       IF(NBSOUS .EQ. 0)THEN
  63.          MLEFP.LECT(1)=MELFP
  64.       ELSE
  65.          DO ISOUS=1,NBSOUS,1
  66.             MLEFP.LECT(ISOUS)=MELFP.LISOUS(ISOUS)
  67.          ENDDO
  68.       ENDIF
  69.       SEGDES MELFP
  70.       NBSOUS=JG
  71. C
  72.       IELEMF=0
  73.       DO ISOUS=1,NBSOUS,1
  74.          MELFP1=MLEFP.LECT(ISOUS)
  75.          SEGACT MELFP1
  76.          NBELEM=MELFP1.NUM(/2)
  77.          INF=MELFP1.NUM(/1)
  78.          DO IELEM=1,NBELEM,1
  79.             IELEMF=IELEMF+1
  80.             NGF=MELFP1.NUM(INF,IELEM)
  81.             NLF=MLEFL.LECT(NGF)
  82.             IF(NLF .EQ. 0)THEN
  83.                WRITE(IOIMP,*) 'subroutine rleord.eso'
  84.                WRITE(IOIMP,*) 'FACEL???'
  85.                CALL ERREUR(5)
  86.                GOTO 9999
  87.             ENDIF
  88.             MELF1.NUM(1,IELEMF)=NGF
  89.             DO I1 = 1, 3 , 1
  90.                MELFL1.NUM(I1,IELEMF)=MELFL.NUM(I1,NLF)
  91.             ENDDO
  92.          ENDDO
  93.          SEGDES MELFP1
  94.       ENDDO
  95. C
  96.       SEGDES MELF1
  97.       SEGDES MELFL1
  98.       SEGDES MELFL
  99. C
  100.       SEGSUP MLEFP
  101.       SEGSUP MLEFL
  102. C
  103.  9999 RETURN
  104.       END
  105.  
  106.  
  107.  
  108.  
  109.  
  110.  
  111.  
  112.  

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