Télécharger elkonv.eso

Retour à la liste

Numérotation des lignes :

  1. C ELKONV SOURCE CHAT 05/01/12 23:33:25 5004
  2. SUBROUTINE ELKONV(ELTFA,FACEL,MELEMF,MELEMC,MELEME)
  3. IMPLICIT INTEGER(I-N)
  4. IMPLICIT REAL*8 (A-H,O-Z)
  5.  
  6. -INC SMLENTI
  7. -INC SMELEME
  8. POINTEUR ELTFA.MELEME,FACEL.MELEME,MELEMC.MELEME
  9. DIMENSION NTYP(7)
  10. C SEG2,TRI3,QUA4,TET4,PYR5,PRI6,CUB8
  11. DATA NTYP/3 ,8 ,9 ,25 ,16 ,7 ,11 /
  12. C SEG3,QUA4,QUA5,PYR5,PRI6,TRI7,QUA9
  13.  
  14.  
  15.  
  16. CALL KRIPAD(MELEMF,MLENTI)
  17. SEGACT ELTFA,FACEL,MELEMC
  18. NBSOUS=ELTFA.LISOUS(/1)
  19.  
  20. IF(NBSOUS.EQ.0)THEN
  21. NBNN=ELTFA.NUM(/1)+1
  22. NBELEM=ELTFA.NUM(/2)
  23. NBREF=0
  24. SEGINI MELEME
  25. ITYPEL=NTYP(NBNN)
  26.  
  27. K0=0
  28. DO 1 K=1,NBELEM
  29. K0=K0+1
  30. I0=MELEMC.NUM(1,K0)
  31. NUM(NBNN,K)=I0
  32. DO 1 I=1,NBNN-1
  33. I1=ELTFA.NUM(I,K)
  34. I2=LECT(I1)
  35. I3=FACEL.NUM(1,I2)
  36. NUM(I,K)=I3
  37. IF(I3.EQ.I0)NUM(I,K)=FACEL.NUM(3,I2)
  38. C write(6,*)K,I0,I1,I2,FACEL.NUM(1,I2),FACEL.NUM(3,I2)
  39. 1 CONTINUE
  40. SEGDES MELEME,MELEMC,ELTFA,FACEL
  41. SEGSUP MLENTI
  42. C call ecrobj('MAILLAGE',meleme)
  43. C call prlist
  44.  
  45.  
  46. ELSEIF(NBSOUS.NE.0)THEN
  47. NBREF=0
  48. NBNN=0
  49. NBELEM=0
  50. SEGINI MELEME
  51. NBS=NBSOUS
  52. K0=0
  53. DO 2 L=1,NBS
  54. NBSOUS=0
  55. IPT2=ELTFA.LISOUS(L)
  56. SEGACT IPT2
  57. NBELEM=IPT2.NUM(/2)
  58. NBREF=0
  59. NBNN=IPT2.NUM(/1)+1
  60. SEGINI IPT1
  61. IPT1.ITYPEL=NTYP(NBNN)
  62. LISOUS(L)=IPT1
  63. DO 3 K=1,NBELEM
  64. K0=K0+1
  65. I0=MELEMC.NUM(1,K0)
  66. IPT1.NUM(NBNN,K)=I0
  67. DO 3 I=1,NBNN-1
  68. I1=IPT2.NUM(I,K)
  69. I2=LECT(I1)
  70. I3=FACEL.NUM(1,I2)
  71. IPT1.NUM(I,K)=I3
  72. IF(I3.EQ.I0)IPT1.NUM(I,K)=FACEL.NUM(3,I2)
  73. C write(6,*)K,I0,I1,I2,FACEL.NUM(1,I2),FACEL.NUM(3,I2)
  74. 3 CONTINUE
  75. SEGDES IPT1,IPT2
  76. 2 CONTINUE
  77.  
  78. C call ecrobj('MAILLAGE',meleme)
  79. C call prlist
  80.  
  81.  
  82. SEGDES MELEME,MELEMC,ELTFA,FACEL
  83. SEGSUP MLENTI
  84. ENDIF
  85. RETURN
  86. END
  87.  
  88.  

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