Télécharger reduic.eso

Retour à la liste

Numérotation des lignes :

  1. C REDUIC SOURCE FANDEUR 13/01/30 21:15:05 7686
  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. -INC CCOPTIO
  27.  
  28. -INC SMCHAML
  29. -INC SMELEME
  30. *
  31. CHARACTER*(NCONCH) CONST
  32. *
  33. * executable
  34. *
  35. IRET = 0
  36. CONST = ' '
  37.  
  38. MCHELM = IPCHE
  39. SEGACT,MCHELM
  40.  
  41. * Cas particulier du MCHAML vide :
  42. NZ = IMACHE(/1)
  43. IF (NZ.EQ.0) THEN
  44. SEGINI,MCHEL1=MCHELM
  45. SEGDES MCHELM,MCHEL1
  46. IRET = MCHEL1
  47. RETURN
  48. ENDIF
  49.  
  50. MELEME = IMEL
  51. SEGACT MELEME
  52. NBSOUS = LISOUS(/1)
  53. IPT1 = IMEL
  54. *
  55. * boucle sur les maillages elementaires
  56. *
  57. DO 100 I=1,(MAX(1,NBSOUS))
  58. IF (NBSOUS .NE. 0) THEN
  59. IPT1 = LISOUS(I)
  60. ENDIF
  61. CALL TESTMA(IPCHE,IPT1,.FALSE.,CONST,IRETOU,IMODI)
  62. *
  63. IF(IRETOU.EQ.0.AND.IERR.EQ.0) THEN
  64. CALL ERREUR(472)
  65. ENDIF
  66. MCHEL1 = IRETOU
  67. IF (IERR .NE. 0) THEN
  68. IF (IRETOU .NE. 0) THEN
  69. SEGSUP MCHEL1
  70. ENDIF
  71. GOTO 990
  72. ENDIF
  73. *
  74. * concatenation du resultat
  75. *
  76. IF (I .EQ. 1) THEN
  77. MCHELM = IRETOU
  78. N1 = IMACHE(/1)
  79. N3 = INFCHE(/2)
  80. L1 = TITCHE(/1)
  81. ELSE
  82. MCHEL1 = IRETOU
  83. NN1 = MCHEL1.IMACHE(/1)
  84. N1 = N1 + NN1
  85. N3 = MAX(N3,MCHEL1.INFCHE(/2))
  86. SEGADJ MCHELM
  87. DO 10 J=1,NN1
  88. CONCHE(J+N1-NN1) = MCHEL1.CONCHE(J)
  89. IMACHE(J+N1-NN1) = MCHEL1.IMACHE(J)
  90. ICHAML(J+N1-NN1) = MCHEL1.ICHAML(J)
  91. DO 20 K=1,MCHEL1.INFCHE(/2)
  92. INFCHE(J+N1-NN1,K)=MCHEL1.INFCHE(J,K)
  93. 20 CONTINUE
  94. 10 CONTINUE
  95. SEGSUP MCHEL1
  96. ENDIF
  97. *
  98. 100 CONTINUE
  99. *
  100. IRET = MCHELM
  101. SEGDES,MCHELM
  102. *
  103. 990 CONTINUE
  104. MELEME = IMEL
  105. MCHEL1 = IPCHE
  106. SEGDES,MELEME,MCHEL1
  107. *
  108. RETURN
  109. END
  110.  
  111.  
  112.  

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