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