Télécharger indcr.eso

Retour à la liste

Numérotation des lignes :

  1. C INDCR SOURCE PV 09/03/12 21:25:16 6325
  2. SUBROUTINE INDCR(MOT,NMO,IER,IMAIL,ICHA)
  3. C=======================================================================
  4. C SUBROUTINE DE LA PROCEDURE INDIC DE QUALITE D'UN MAILLAGE
  5. C PHILIPPE BEAUMIER 90
  6. C CONTIENT LES ZONES RELATIVES AUX DIFFERENTS CHAMPS
  7. C CREATION DU CHAMELEM RESULTAT
  8. C
  9. C=======================================================================
  10. C
  11. C INPUT
  12. C
  13. C MOT : SUCCESSION DES MOTS CLES LUS
  14. C NMO : NOMBRE DE MOTS CLES LUS
  15. C IER : INDICATEUR D'ERREUR (0 SI ERREUR)
  16. C IMAIL : POINTEUR SUR LE MAILLAGE
  17. C ICHA : POINTEUR SUR LE CHAMELEM
  18. C
  19. C OUTPUT
  20. C
  21. C ICHA : POINTEUR SUR LE CHAMELEM
  22. C
  23. IMPLICIT INTEGER(I-N)
  24. IMPLICIT REAL*8(A-H,O-Z)
  25. -INC CCOPTIO
  26. -INC SMCHAML
  27. -INC SMELEME
  28. -INC SMCOORD
  29. C
  30. CHARACTER*(*) MOT(*)
  31. SEGMENT/WRK1/(XE(3,NBNO))
  32. C
  33. IER = 1
  34. MELEME = IMAIL
  35. SEGACT MELEME
  36. IPT1 = MELEME
  37. IF(NMO.EQ.0) IER=0
  38. IF(IER.EQ.0) GOTO 666
  39. L1=7
  40. NSOUS = LISOUS(/1)
  41. N1=NSOUS
  42. IF(N1.EQ.0) N1=1
  43. N3=5
  44. SEGINI MCHELM
  45. ICHA = MCHELM
  46. IFOCHE = IFOUR
  47. C
  48. C BOUCLE SUR LES DIFFERENTS MOTS CLES
  49. C
  50. DO 1 IMOT=1,NMO
  51. IF (MOT(IMOT).EQ.'PLAN') THEN
  52. C
  53. C======================================================================
  54. C
  55. C ZONE RELATIVE AU CALCUL DE LA PLANEARITE DU MAILLAGE
  56. C
  57. C======================================================================
  58. C
  59. C ON CREE UN CHAMELEM INDIQUANT LA PLANEARITE D'UN MAILLAGE
  60. C
  61. TITCHE='QUALITE'
  62. DO 10 ISOUS=1,MAX(1,NSOUS)
  63. IF(NSOUS.NE.0) THEN
  64. IPT1=LISOUS(ISOUS)
  65. SEGACT IPT1
  66. ENDIF
  67. IMACHE(ISOUS)=IPT1
  68. CONCHE(ISOUS)=' '
  69. INFCHE(ISOUS,1)=0
  70. INFCHE(ISOUS,2)=0
  71. INFCHE(ISOUS,3)=NIFOUR
  72. INFCHE(ISOUS,4)=0
  73. INFCHE(ISOUS,5)=0
  74. N2 = NMO
  75. SEGINI MCHAML
  76. NOMCHE(IMOT)='PLAN'
  77. TYPCHE(IMOT)='REAL*8'
  78. ICHAML(ISOUS)=MCHAML
  79. IF(((IPT1.ITYPEL).NE.8).AND.((IPT1.ITYPEL).NE.10).AND.
  80. 1 ((IPT1.ITYPEL).NE.4).AND.((IPT1.ITYPEL).NE.6)) THEN
  81. C
  82. C LES ELEMENTS NE SONT PAS DES QUA4,QUA8,TRI3,TRI6
  83. C
  84. N1PTEL=0
  85. N2PTEL=0
  86. N1EL=0
  87. N2EL=0
  88. SEGINI MELVAL
  89. IELVAL(IMOT)=MELVAL
  90. ELSE
  91. C
  92. C ELEMENT QUA4,QUA8,TRI3,TRI6
  93. C
  94. N1PTEL=1
  95. C NB DE NOEUDS PAR ELEMENT DANS LE MELEME
  96. N2PTEL=0
  97. N1EL=IPT1.NUM(/2)
  98. C NB D'ELEMENTS DANS LE MELEME
  99. N2EL=0
  100. SEGINI MELVAL
  101. IELVAL(IMOT)=MELVAL
  102. C
  103. C CALCUL DES VALEURS DU CHAMP
  104. C
  105. NBNO = IPT1.NUM(/1)
  106. SEGINI WRK1
  107. CALL NORCOS(VELCHE,IPT1.NUM(/1),N1EL,XCOOR,IDIM,IPT1.NUM,
  108. 1 XE,IPT1.ITYPEL)
  109. SEGDES WRK1
  110. ENDIF
  111. SEGDES MELVAL
  112. IF(NSOUS.NE.0) THEN
  113. SEGDES IPT1
  114. ENDIF
  115. SEGDES MCHAML
  116. 10 CONTINUE
  117. C
  118. ELSE
  119. C
  120. C AUTRES MOTS CLES
  121. C
  122. ENDIF
  123. C
  124. 1 CONTINUE
  125. MCHELM = ICHA
  126. SEGDES MCHELM
  127. MELEME=IMAIL
  128. SEGDES MELEME
  129. 666 RETURN
  130. END
  131.  
  132.  
  133.  
  134.  
  135.  
  136.  

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