Télécharger reduic.eso

Retour à la liste

Numérotation des lignes :

  1. C REDUIC SOURCE PV 20/03/26 21:16:19 10563
  2. SUBROUTINE REDUIC ( IPCHE,IMEL,IRET)
  3. *______________________________________________________________________
  4. *
  5. * redu d'un chamelem sur meleme (appele par redu)
  6. *
  7. * entrees :
  8. * ---------
  9. * ipche chamelem a reduire (type mchaml)
  10. * imel maillage sur lequel on doit reduire (type meleme)
  11. *
  12. *
  13. * sortie :
  14. * --------
  15. * iret chamelem reduit
  16. * = 0 si pb
  17. *
  18. *
  19. *
  20. *______________________________________________________________________
  21. *
  22. * declarations
  23. *
  24. IMPLICIT INTEGER(I-N)
  25. IMPLICIT REAL*8(A-H,O-Z)
  26.  
  27. -INC PPARAM
  28. -INC CCOPTIO
  29.  
  30. -INC SMCHAML
  31. -INC SMELEME
  32. *
  33. CHARACTER*(NCONCH) CONST
  34. *
  35. * executable
  36. *
  37. IRET = 0
  38. CONST = ' '
  39.  
  40. MCHELM = IPCHE
  41. SEGACT,MCHELM
  42.  
  43. * Cas particulier du MCHAML vide :
  44. NZ = IMACHE(/1)
  45. IF (NZ.EQ.0) THEN
  46. SEGINI,MCHEL1=MCHELM
  47. ** SEGDES MCHELM,MCHEL1
  48. IRET = MCHEL1
  49. RETURN
  50. ENDIF
  51.  
  52. MELEME = IMEL
  53. SEGACT MELEME
  54. NBSOUS = LISOUS(/1)
  55. IPT1 = IMEL
  56. *
  57. * boucle sur les maillages elementaires
  58. *
  59. DO 100 I=1,(MAX(1,NBSOUS))
  60. IF (NBSOUS .NE. 0) THEN
  61. IPT1 = LISOUS(I)
  62. ENDIF
  63. CALL TESTMA(IPCHE,IPT1,.FALSE.,CONST,IRETOU,IMODI)
  64. *
  65. IF(IRETOU.EQ.0.AND.IERR.EQ.0) THEN
  66. CALL ERREUR(472)
  67. ENDIF
  68. MCHEL1 = IRETOU
  69. IF (IERR .NE. 0) THEN
  70. IF (IRETOU .NE. 0) THEN
  71. SEGSUP MCHEL1
  72. ENDIF
  73. GOTO 990
  74. ENDIF
  75. *
  76. * concatenation du resultat
  77. *
  78. IF (I .EQ. 1) THEN
  79. MCHELM = IRETOU
  80. N1 = IMACHE(/1)
  81. N3 = INFCHE(/2)
  82. L1 = TITCHE(/1)
  83. ELSE
  84. MCHEL1 = IRETOU
  85. NN1 = MCHEL1.IMACHE(/1)
  86. N1 = N1 + NN1
  87. N3 = MAX(N3,MCHEL1.INFCHE(/2))
  88. SEGADJ MCHELM
  89. DO 10 J=1,NN1
  90. CONCHE(J+N1-NN1) = MCHEL1.CONCHE(J)
  91. IMACHE(J+N1-NN1) = MCHEL1.IMACHE(J)
  92. ICHAML(J+N1-NN1) = MCHEL1.ICHAML(J)
  93. DO 20 K=1,MCHEL1.INFCHE(/2)
  94. INFCHE(J+N1-NN1,K)=MCHEL1.INFCHE(J,K)
  95. 20 CONTINUE
  96. 10 CONTINUE
  97. SEGSUP MCHEL1
  98. ENDIF
  99. *
  100. 100 CONTINUE
  101. *
  102. IRET = MCHELM
  103. ** SEGDES,MCHELM
  104. *
  105. 990 CONTINUE
  106. C MELEME = IMEL
  107. C MCHEL1 = IPCHE
  108. C SEGDES,MELEME,MCHEL1
  109. *
  110. RETURN
  111. END
  112.  
  113.  
  114.  
  115.  
  116.  

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