Télécharger msomet.eso

Retour à la liste

Numérotation des lignes :

  1. C MSOMET SOURCE BP208322 16/11/18 21:19:30 9177
  2. SUBROUTINE MSOMET(MELEME,MELEMM,MELEMS,TYPE)
  3. IMPLICIT INTEGER(I-N)
  4. IMPLICIT REAL*8 (A-H,O-Z)
  5.  
  6. CHARACTER*8 TYPE
  7. PARAMETER (NBTYP=7)
  8. DIMENSION LISTN(4,NBTYP),ITAB(8,7)
  9. -INC CCOPTIO
  10. -INC CCGEOME
  11. -INC SMELEME
  12. POINTEUR MELEMM.MELEME
  13. DATA LISTN/
  14. C seg3 qua9 tri7
  15. &3,2,3,2, 11,8,8,4, 7,4,6,3,
  16. C seg2 qua4 tri3
  17. C cu27 pr21 te15 py19
  18. &33,14,20,8, 34,16,18,6, 35,23,10,4, 36,25,13,5/
  19. C cub8 pri6 tet4 pyr5
  20. DATA ITAB/
  21. & 1,3,6*0, 1,3,5,7,4*0, 1,3,5,5*0,
  22. & 1,3,5,7,13,15,17,19, 1,3,5,10,12,14,2*0,
  23. & 1,3,5,10,4*0, 1,3,5,7,13,3*0 /
  24.  
  25. TYPE=' '
  26. SEGACT MELEME
  27. NBSOUS=MAX(1,LISOUS(/1))
  28. NBREF=0
  29. NBELEM=0
  30. NBNN=0
  31. SEGINI MELEMM
  32.  
  33. DO 1 L=1,MAX(1,LISOUS(/1))
  34. IPT1=MELEME
  35. IF(LISOUS(/1).NE.0)IPT1=LISOUS(L)
  36. SEGACT IPT1
  37. DO 2 M=1,NBTYP
  38. C write(6,*)' MSOMET : IPT1.ITYPEL=',IPT1.ITYPEL
  39. IF(IPT1.ITYPEL.EQ.LISTN(1,M))GO TO 21
  40. 2 CONTINUE
  41. C write(6,*)' MSOMET :echec 1 '
  42. RETURN
  43. 21 CONTINUE
  44. NBSOUS=0
  45. NBELEM=IPT1.NUM(/2)
  46. NBNN=LISTN(4,M)
  47. SEGINI IPT2
  48. IPT2.ITYPEL=LISTN(2,M)
  49. MELEMM.LISOUS(L)=IPT2
  50. NP=LISTN(3,M)
  51. C write(6,*)'NBNN NBELEM=',NBNN,NBELEM,' M=',M
  52.  
  53.  
  54.  
  55. IF(M.LE.7)THEN
  56. DO 101 K=1,NBELEM
  57. DO 101 I=1,NBNN
  58. I1=ITAB(I,M)
  59. IPT2.NUM(I,K)=IPT1.NUM(I1,K)
  60. 101 CONTINUE
  61.  
  62. ELSE
  63. RETURN
  64. ENDIF
  65. 1 CONTINUE
  66. IPT3=MELEMM
  67. IF(MELEMM.LISOUS(/1).EQ.1)THEN
  68. MELEMM=MELEMM.LISOUS(1)
  69. SEGSUP IPT3
  70. ENDIF
  71. MELEMS=MELEMM
  72. ITY=1
  73. CALL CHANGE(MELEMS,ITY)
  74. IF (IERR.NE.0) RETURN
  75. TYPE='MAILLAGE'
  76.  
  77. RETURN
  78. END
  79.  
  80.  
  81.  
  82.  
  83.  
  84.  
  85.  
  86.  
  87.  
  88.  
  89.  
  90.  
  91.  

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