Télécharger indcr.eso

Retour à la liste

Numérotation des lignes :

  1. C INDCR SOURCE FD218221 20/06/17 21:15:05 10630
  2. SUBROUTINE INDCR(MOT,NMO,IPT1,MCHEL1)
  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 IPT1 : POINTEUR SUR LE MAILLAGE
  16. C
  17. C OUTPUT
  18. C
  19. C MCHEL1 : POINTEUR SUR LE CHAMELEM RESULTAT
  20. C
  21. IMPLICIT INTEGER(I-N)
  22. IMPLICIT REAL*8(A-H,O-Z)
  23. -INC PPARAM
  24. -INC CCOPTIO
  25. -INC SMCHAML
  26. -INC SMELEME
  27. -INC SMCOORD
  28. C
  29. CHARACTER*4 MOT(*)
  30. SEGMENT/WRK1/(XE(3,NBNO))
  31. C
  32. C Activation du maillage
  33. SEGACT IPT1
  34. C Erreur si aucun mot lu
  35. IF(NMO.EQ.0) GOTO 666
  36. C Preparation du MCHAML (titre, nbr sous zones, options)
  37. L1=7
  38. NSOUS=IPT1.LISOUS(/1)
  39. N1=NSOUS
  40. IF(N1.EQ.0) N1=1
  41. N3=5
  42. SEGINI MCHEL1
  43. MCHEL1.TITCHE='QUALITE'
  44. MCHEL1.CONCHE(1)=' '
  45. MCHEL1.IFOCHE=IFOUR
  46. C
  47. C Boucle sur les sous zones du maillage (et donc celles du champ resulat)
  48. N2=NMO
  49. DO ISOUS=1,MAX(1,NSOUS)
  50. C Recuperation de la sous zone
  51. IF(NSOUS.NE.0) THEN
  52. IPT2=IPT1.LISOUS(ISOUS)
  53. SEGACT IPT2
  54. ELSE
  55. IPT2=IPT1
  56. ENDIF
  57. C Remplissage du MCHAML (maillage sous zone, options)
  58. MCHEL1.IMACHE(ISOUS)=IPT2
  59. MCHEL1.INFCHE(ISOUS,1)=0
  60. MCHEL1.INFCHE(ISOUS,2)=0
  61. MCHEL1.INFCHE(ISOUS,3)=NIFOUR
  62. MCHEL1.INFCHE(ISOUS,4)=0
  63. MCHEL1.INFCHE(ISOUS,5)=0
  64. C Remplissage du MCHAML (creation des composantes)
  65. SEGINI MCHAM1
  66. MCHEL1.ICHAML(ISOUS)=MCHAM1
  67. C Boucle sur les composantes du champ
  68. DO ICOMP=1,NMO
  69. C Remplissage du MCHAML (nom de la composante)
  70. MCHAM1.TYPCHE(ICOMP)='REAL*8'
  71. MCHAM1.NOMCHE(ICOMP)=MOT(ICOMP)
  72. C Preparation du tableau de valeurs du champ : MELVAL
  73. N2PTEL=0
  74. N2EL=0
  75. C---------> Indicateur 'PLAN'
  76. IF (MOT(ICOMP).EQ.'PLAN') THEN
  77. C Cas des elements prevus (QUA4,QUA8,TRI3,TRI6)
  78. IF (((IPT2.ITYPEL).EQ.8).OR.((IPT2.ITYPEL).EQ.10).OR.
  79. & ((IPT2.ITYPEL).EQ.4).OR.((IPT2.ITYPEL).EQ.6)) THEN
  80. C Initialisation et remplissage du MELVAL
  81. N1PTEL=1
  82. N1EL=IPT2.NUM(/2)
  83. SEGINI MELVA1
  84. NBNO=IPT2.NUM(/1)
  85. SEGINI WRK1
  86. CALL NORCOS(MELVA1.VELCHE,IPT2.NUM(/1),N1EL,XCOOR,
  87. & IDIM,IPT2.NUM,XE,IPT2.ITYPEL)
  88. SEGDES WRK1
  89. C Pour les autres elements : champ vide
  90. ELSE
  91. C Initialisation et remplissage du MELVAL
  92. N1PTEL=0
  93. N1EL=0
  94. SEGINI MELVA1
  95. ENDIF
  96. C---------> Indicateur 'ASPE'
  97. ELSEIF (MOT(ICOMP).EQ.'ASPE') THEN
  98. C Cas des elements prevus (TRI3,TET4)
  99. IF (((IPT2.ITYPEL).EQ.4).OR.((IPT2.ITYPEL.EQ.23))) THEN
  100. C Initialisation et remplissage du MELVAL
  101. N1PTEL=1
  102. N1EL=IPT2.NUM(/2)
  103. SEGINI MELVA1
  104. CALL ASPERT(MELVA1.VELCHE,IPT2.NUM,IPT2.NUM(/1),N1EL,
  105. & IPT2.ITYPEL)
  106. C Pour les autres elements : champ vide
  107. ELSE
  108. C Initialisation et remplissage du MELVAL
  109. N1PTEL=0
  110. N1EL=0
  111. SEGINI MELVA1
  112. ENDIF
  113. C---------> Indicateur 'SKEW'
  114. ELSEIF (MOT(ICOMP).EQ.'SKEW') THEN
  115. C Cas des elements prevus (TRI3,TET4)
  116. IF (((IPT2.ITYPEL).EQ.4).OR.((IPT2.ITYPEL.EQ.23))) THEN
  117. C Initialisation et remplissage du MELVAL
  118. N1PTEL=1
  119. N1EL=IPT2.NUM(/2)
  120. SEGINI MELVA1
  121. CALL SKEWNS(MELVA1.VELCHE,IPT2.NUM,IPT2.NUM(/1),N1EL,
  122. & IPT2.ITYPEL)
  123. C Pour les autres elements : champ vide
  124. ELSE
  125. C Initialisation et remplissage du MELVAL
  126. N1PTEL=0
  127. N1EL=0
  128. SEGINI MELVA1
  129. ENDIF
  130. C---------> Autres mots (normalement impossible de passer ici !)
  131. ELSE
  132. MOTERR(1:4)=MOT(ICOMP)
  133. CALL ERREUR(7)
  134. ENDIF
  135. C Lien vers le MELVAL
  136. MCHAM1.IELVAL(ICOMP)=MELVA1
  137. C Travail termine : desactivation du MELVAL
  138. SEGDES MELVA1
  139. ENDDO
  140. C Travail termine : desactivation du maillage de la sous zone
  141. IF(NSOUS.NE.0) THEN
  142. SEGDES IPT2
  143. ENDIF
  144. C Travail termine : desactivation de la composante
  145. SEGDES MCHAM1
  146. ENDDO
  147. C Travail termine : desactivation du champ et du maillage
  148. SEGDES MCHEL1
  149. SEGDES IPT1
  150. 666 RETURN
  151. END
  152.  
  153.  
  154.  

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