Télécharger la plaquette Cast3M


fr en

Télécharger melext.eso

Retour à la liste

Numérotation des lignes : 

melext

  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