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    OF166741  24/12/13    21:17:26     12097          
  2.       SUBROUTINE RLEORD(MELFL,MELFP,MELF1,MELFL1)
  3. C
  4.       IMPLICIT INTEGER(I-N)
  5.  
  6. -INC PPARAM
  7. -INC CCOPTIO
  8. -INC SMCOORD
  9. -INC SMELEME
  10.       INTEGER NBSOUS,NBNN,NBELEM,NBREF
  11.       POINTEUR MELF1.MELEME,MELFL.MELEME,MELFP.MELEME,
  12.      &     MELFL1.MELEME,MELFP1.MELEME
  13. C
  14.       INTEGER JG
  15. -INC SMLENTI
  16.       POINTEUR MLEFL.MLENTI,MLEFP.MLENTI
  17.       INTEGER IELEM,NGF,NLF,ISOUS,INF,I1,IELEMF
  18. C
  19.       SEGACT MELFL
  20.       NBSOUS=MELFL.LISOUS(/1)
  21.       IF(NBSOUS .NE. 0)THEN
  22.          WRITE(IOIMP,*) 'subroutine rleord.eso'
  23.          WRITE(IOIMP,*) 'FACEL???'
  24.          CALL ERREUR(5)
  25.          GOTO 9999
  26.       ENDIF
  27. C
  28.       SEGINI, MELFL1=MELFL
  29. C
  30.       NBELEM=MELFL.NUM(/2)
  31.       NBNN=1
  32.       NBSOUS=0
  33.       NBREF=0
  34.       SEGINI MELF1
  35. C
  36.       JG=nbpts
  37.       SEGINI MLEFL
  38.       DO IELEM = 1, NBELEM, 1
  39.          NGF=MELFL.NUM(2,IELEM)
  40.          MLEFL.LECT(NGF)=IELEM
  41.       ENDDO
  42. C
  43.       SEGACT MELFP
  44.       NBSOUS=MELFP.LISOUS(/1)
  45. C     NBSOUS=0 fais un peux chier!
  46.       JG=MAX(NBSOUS,1)
  47.       SEGINI MLEFP
  48.       IF(NBSOUS .EQ. 0)THEN
  49.          MLEFP.LECT(1)=MELFP
  50.       ELSE
  51.          DO ISOUS=1,NBSOUS,1
  52.             MLEFP.LECT(ISOUS)=MELFP.LISOUS(ISOUS)
  53.          ENDDO
  54.       ENDIF
  55.       SEGDES MELFP
  56.       NBSOUS=JG
  57. C
  58.       IELEMF=0
  59.       DO ISOUS=1,NBSOUS,1
  60.          MELFP1=MLEFP.LECT(ISOUS)
  61.          SEGACT MELFP1
  62.          NBELEM=MELFP1.NUM(/2)
  63.          INF=MELFP1.NUM(/1)
  64.          DO IELEM=1,NBELEM,1
  65.             IELEMF=IELEMF+1
  66.             NGF=MELFP1.NUM(INF,IELEM)
  67.             NLF=MLEFL.LECT(NGF)
  68.             IF(NLF .EQ. 0)THEN
  69.                WRITE(IOIMP,*) 'subroutine rleord.eso'
  70.                WRITE(IOIMP,*) 'FACEL???'
  71.                CALL ERREUR(5)
  72.                GOTO 9999
  73.             ENDIF
  74.             MELF1.NUM(1,IELEMF)=NGF
  75.             DO I1 = 1, 3 , 1
  76.                MELFL1.NUM(I1,IELEMF)=MELFL.NUM(I1,NLF)
  77.             ENDDO
  78.          ENDDO
  79.          SEGDES MELFP1
  80.       ENDDO
  81. C
  82.       SEGDES MELF1
  83.       SEGDES MELFL1
  84.       SEGDES MELFL
  85. C
  86.       SEGSUP MLEFP
  87.       SEGSUP MLEFL
  88. C
  89.  9999 RETURN
  90.       END
  91.  
  92.  
  93.  
  94.  
  95.  
  96.  
  97.  
  98.  
  99.  

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