Télécharger melext.eso

Retour à la liste

Numérotation des lignes :

  1. C MELEXT SOURCE FANDEUR 16/02/12 21:15:08 8823
  2.  
  3. C-----------------------------------------------------------------------
  4. C EXTension/Accroissement des dimensions d'un MELVAL
  5. C
  6. C ich1 segment de type MELVAL (ACTIF en MODification en E/S)
  7. C segment modifie par ajustement si necessaire
  8. C nbpi2 nombre de points supports cible
  9. C nel2 nombre d'elements cible
  10. C
  11. C La modification du nombre de points support (resp. d'elements) n'a
  12. C lieu que si ce nombre est superieur a celui du melval fourni
  13. C
  14. C L'operation inverse de REDuction/compactage du MELVAL est effectuee
  15. C dans le sous-programme COMRED (comred.eso).
  16. C-----------------------------------------------------------------------
  17.  
  18. SUBROUTINE MELEXT(ich1,nbpi2,nbel2)
  19.  
  20. IMPLICIT REAL*8(A-H,O-Z)
  21. IMPLICIT INTEGER (I-N)
  22.  
  23. -INC CCOPTIO
  24.  
  25. -INC SMCHAML
  26.  
  27. melva1 = ich1
  28. C* SEGACT,melva1*MOD <- suppose ACTIF en MODification en Entree
  29.  
  30. * 1---------------------------1
  31. * 1. MELVAL a valeurs reelles :
  32. * 1---------------------------1
  33. nbpi1 = melva1.velche(/1)
  34. nbel1 = melva1.velche(/2)
  35. C* if (nbel1.ge.1) then <- Ce test devrait suffire...
  36. IF (nbel1.GT.0 .OR. nbpi1.GT.0) THEN
  37. n2ptel = 0
  38. n2el = 0
  39. * ---
  40. * 1.1 Le champ final aura plus d'elements qu'initialement :
  41. * ---
  42. IF (nbel1.LT.nbel2) THEN
  43. n1el = nbel2
  44. * - - -
  45. * 1.1.1 Augmentation du nombre de points d'integration (1 a nbpi2)
  46. * - - -
  47. IF (nbpi1.EQ.1 .AND. nbpi1.LT.nbpi2) then
  48. n1ptel = nbpi2
  49. SEGADJ,melva1
  50. * Cas d'un champ uniforme :
  51. IF (nbel1.EQ.1) THEN
  52. vale1 = melva1.velche(1,1)
  53. IF (vale1.NE.0.D0) THEN
  54. DO iel = 1, nbel1
  55. DO inn = 1, n1ptel
  56. melva1.velche(inn,iel) = vale1
  57. ENDDO
  58. ENDDO
  59. ENDIF
  60. * Cas d'un champ constant par element
  61. ELSE
  62. DO iel = 1, nbel1
  63. vale1 = melva1.velche(1,iel)
  64. IF (vale1.NE.0.D0) THEN
  65. DO inn = 2, n1ptel
  66. melva1.velche(inn,iel) = vale1
  67. ENDDO
  68. ENDIF
  69. ENDDO
  70. ENDIF
  71. * - - -
  72. * 1.1.2 Augmentation du nombre d'elements a meme nombre de points d'integration
  73. * - - -
  74. ELSE IF (nbpi1.EQ.nbpi2) THEN
  75. n1ptel = nbpi2
  76. SEGADJ,melva1
  77. * Cas d'un champ uniforme :
  78. IF (nbel1.EQ.1 .AND. nbpi1.EQ.1) THEN
  79. vale1 = melva1.velche(1,1)
  80. IF (vale1.NE.0.D0) THEN
  81. DO iel = 2, n1el
  82. melva1.velche(1,iel) = vale1
  83. ENDDO
  84. ENDIF
  85. ENDIF
  86. * - - -
  87. * 1.1.3 On ne diminue pas le nombre de points d'integration (qui est > 1)
  88. * - - -
  89. ELSE
  90. n1ptel = nbpi1
  91. SEGADJ,melva1
  92. ENDIF
  93. * ---
  94. * 1.2 On conserve le meme nombre d'elements du champ :
  95. * ---
  96. ELSE
  97. n1el = nbel1
  98. * - - -
  99. * 1.2.1 Augmentation du nombre de points d'integration (1 a nbpi2)
  100. * - - -
  101. IF (nbpi1.EQ.1 .AND. nbpi1.LT.nbpi2) THEN
  102. n1ptel = nbpi2
  103. SEGADJ,melva1
  104. DO iel = 1, nbel1
  105. vale1 = melva1.velche(1,iel)
  106. IF (vale1.NE.0.D0) THEN
  107. DO inn = 2, n1ptel
  108. melva1.velche(inn,iel) = vale1
  109. ENDDO
  110. ENDIF
  111. ENDDO
  112. ELSE
  113. * - - -
  114. * 1.2.2 Pas de modification du nombre de points d'integration
  115. * - - -
  116. n1ptel = nbpi1
  117. ENDIF
  118. ENDIF
  119. * 1----------------------------
  120. ENDIF
  121. * 1----------------------------
  122.  
  123. * 2------------------------------------2
  124. * 2. MELVAL a valeurs de type pointeur :
  125. * 2------------------------------------2
  126. nbpi1 = melva1.ielche(/1)
  127. nbel1 = melva1.ielche(/2)
  128. C* if (nbel1.ge.1) then <- Ce test devrait suffire...
  129. IF (nbel1.GT.0 .OR. nbpi1.GT.0) THEN
  130. n1ptel = 0
  131. n1el = 0
  132. * ---
  133. * 2.1 Le champ final aura plus d'elements qu'initialement :
  134. * ---
  135. IF (nbel1.LT.nbel2) THEN
  136. n2el = nbel2
  137. * - - -
  138. * 2.1.1 Augmentation du nombre de points d'integration (1 a nbpi2)
  139. * - - -
  140. IF (nbpi1.EQ.1 .AND. nbpi1.LT.nbpi2) then
  141. n2ptel = nbpi2
  142. SEGADJ,melva1
  143. * Cas d'un champ uniforme :
  144. IF (nbel1.EQ.1) THEN
  145. jale1 = melva1.ielche(1,1)
  146. IF (jale1.NE.0) THEN
  147. DO iel = 1, nbel1
  148. DO inn = 1, n2ptel
  149. melva1.ielche(inn,iel) = jale1
  150. ENDDO
  151. ENDDO
  152. ENDIF
  153. * Cas d'un champ constant par element
  154. ELSE
  155. DO iel = 1, nbel1
  156. jale1 = melva1.ielche(1,iel)
  157. IF (jale1.NE.0) THEN
  158. DO inn = 2, n2ptel
  159. melva1.ielche(inn,iel) = jale1
  160. ENDDO
  161. ENDIF
  162. ENDDO
  163. ENDIF
  164. * - - -
  165. * 2.1.2 Augmentation du nombre d'elements a meme nombre de points d'integration
  166. * - - -
  167. ELSE IF (nbpi1.EQ.nbpi2) THEN
  168. n2ptel = nbpi2
  169. SEGADJ,melva1
  170. * Cas d'un champ uniforme :
  171. IF (nbel1.EQ.1 .AND. nbpi1.EQ.1) THEN
  172. jale1 = melva1.ielche(1,1)
  173. IF (jale1.NE.0) THEN
  174. DO iel = 2, n2el
  175. melva1.ielche(1,iel) = jale1
  176. ENDDO
  177. ENDIF
  178. ENDIF
  179. * - - -
  180. * 1.1.3 On ne diminue pas le nombre de points d'integration (qui est > 1)
  181. * - - -
  182. ELSE
  183. n2ptel = nbpi1
  184. SEGADJ,melva1
  185. ENDIF
  186. * ---
  187. * 2.2 On conserve le meme nombre d'elements du champ :
  188. * ---
  189. ELSE
  190. n2el = nbel1
  191. * - - -
  192. * 2.2.1 Augmentation du nombre de points d'integration (1 a nbpi2)
  193. * - - -
  194. IF (nbpi1.EQ.1 .AND. nbpi1.LT.nbpi2) THEN
  195. n2ptel = nbpi2
  196. SEGADJ,melva1
  197. DO iel = 1, nbel1
  198. jale1 = melva1.ielche(1,iel)
  199. IF (jale1.NE.0) THEN
  200. DO inn = 2, n1ptel
  201. melva1.ielche(inn,iel) = jale1
  202. ENDDO
  203. ENDIF
  204. ENDDO
  205. ELSE
  206. * - - -
  207. * 2.2.2 Pas de modification du nombre de points d'integration
  208. * - - -
  209. n2ptel = nbpi1
  210. ENDIF
  211. ENDIF
  212. * 2-------------------------------------
  213. ENDIF
  214. * 2-------------------------------------
  215.  
  216. ich1 = melva1
  217.  
  218. C** On reactive le segment pour enlever le statut *mod suite au segadj
  219. C* SEGACT,melva1 <- suppose ACTIF en MODification en SORTIE
  220.  
  221. RETURN
  222. END
  223.  
  224.  
  225.  

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