Télécharger rleord.eso

Retour à la liste

Numérotation des lignes :

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

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