Télécharger la plaquette Cast3M


fr en

Télécharger jpmm.eso

Retour à la liste

Numérotation des lignes : 

jpmm

  1. C JPMM      SOURCE    CB215821  24/04/12    21:16:28     11897          
  2.       SUBROUTINE JPMM
  3.  
  4. * ---------------------------------------------------------------------
  5. * 
  6. *                               ROUTINE JPMT
  7. * 
  8. * ---------------------------------------------------------------------
  9. * Auteur : Nikola JERANCE
  10. * 
  11. * Historique : 
  12. * 
  13. *       20/09/2022 - Première écriture (N. Jerance)
  14. *     
  15. * 
  16. * Descriptif :
  17. * 
  18. *  Le produit d'un MCHAML à une seule composante et des LIGNES d'une matrice, 
  19. * la matrice est une LISTREEL normalement obtenue par MPMAGV. 
  20. * Le résultat est une matrice représentée par une LISTREEL
  21. *  
  22. *  
  23. * ENTREES/SORTIES :
  24. * 
  25. *       (E)     ILREE1 = Pointeur sur la liste de réels (matrice obtenue par MPMA)
  26. *       (E)     ICHAMJ = Pointeur sur J(x,y) en tant que MCHAML
  27. *       (E)     IMOD1 = Pointeur sur le modèle
  28. *       (S)     ILREE2 = Pointeur sur la nouvelle matrice
  29. * 
  30. * ---------------------------------------------------------------------
  31.  
  32. * ----------------------------------------------------------------------
  33. * 
  34. *                         0 - DECLARATIONS ET IMPORTS
  35. * 
  36. * ----------------------------------------------------------------------
  37.  
  38.       IMPLICIT INTEGER(I-N)
  39.       IMPLICIT REAL*8(A-H,O-Z)
  40.  
  41. -INC PPARAM
  42. -INC CCOPTIO
  43. -INC CCGEOME
  44. -INC CCREEL
  45. -INC SMCOORD
  46. -INC SMELEME
  47. -INC SMLREEL
  48. -INC SMCHAML
  49. -INC SMMODEL
  50. -INC SMINTE
  51.  
  52.  
  53.  
  54.       SEGMENT INFO
  55.         INTEGER INFELL(JG)
  56.       ENDSEGMENT
  57.  
  58.  
  59. *      WRITE(IOIMP,*) '    PARTIE 00 : LECTURE'
  60.  
  61.       CALL LIROBJ('MCHAML',ICHAMJ,1,IRETOU)
  62.  
  63.       IF (IERR.NE.0) RETURN
  64.  
  65.  
  66.       CALL LIROBJ('MMODEL',IPMODL,1,IRETOU)
  67.  
  68.       IF (IERR.NE.0) RETURN
  69.  
  70. * Ouverture du segment MMODEL
  71.       MMODE1 = IPMODL
  72.       SEGACT,MMODE1
  73.  
  74. * Contrôle du nombre de IMODEL : MODELE ELEMENTAIRE. On veut un modèle
  75. * simple, i.e. avec un seul IMODEL
  76.       NBMOD = MMODE1.KMODEL(/1)
  77.       IF (NBMOD .GT. 1) THEN
  78.         SEGDES,MMODE1
  79.         CALL ERREUR(21)
  80.         RETURN
  81.       ENDIF
  82.  
  83. * Ouverture du segment IMODEL : MODELE ELEMENTAIRE
  84.       IMODE1 = MMODE1.KMODEL(1)
  85.       SEGACT,IMODE1
  86.  
  87. * Ouverture du segment MELEME
  88.       IPT1 = IMODE1.IMAMOD
  89.       SEGACT,IPT1
  90.  
  91. * Vérification que le maillage est un maillage simple, c-à-d avec un
  92. * seul type d'éléments
  93.       IF (IPT1.LISOUS(/1) .NE. 0) THEN
  94.         SEGDES,IPT1
  95.          SEGDES,IMODE1,MMODE1
  96.          CALL ERREUR(426)
  97.          RETURN
  98.       ENDIF
  99.  
  100.       NBNN = IPT1.NUM(/1)
  101.       NBELEM = IPT1.NUM(/2)
  102.  
  103. * Récupération du segment SMINTE pour un MCHAML aux centres de
  104. * gravité et constants par éléments sur le type TRI3
  105.       IELTYP = IPT1.ITYPEL
  106.       CALL ELQUOI(IELTYP,0,2,IPINF,IMODE1)
  107.       IF (IERR .NE. 0) THEN
  108.         SEGDES,IPT1
  109.          SEGDES,IMODE1,MMODE1
  110.         RETURN
  111.       ENDIF
  112.       INFO = IPINF
  113.       MINTE1 = INFO.INFELL(11)
  114.  
  115.       SEGACT,MINTE1
  116.       SEGSUP,INFO
  117.  
  118.  
  119.       CALL LIROBJ('LISTREEL',ILREE,1,IRETOU)
  120.  
  121.       IF (IERR.NE.0) RETURN
  122.  
  123.  
  124.       ICHAMA = 0
  125.  
  126.       CALL JPMM1(ILREE,ICHAMJ,ILREE2,IMODE1,MINTE1,NBELEM)
  127.  
  128.  
  129. * On calcule les valeurs du champ par élément 
  130. *      WRITE(IOIMP,*) '    PARTIE FF : ECRITURE'
  131.  
  132.       CALL ECROBJ('LISTREEL',ILREE2)
  133.  
  134.  
  135.       RETURN
  136.       END 
  137.  
  138.  

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