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

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