Télécharger la plaquette Cast3M


fr en

Télécharger kopidr.eso

Retour à la liste

Numérotation des lignes : 

kopidr

  1. C KOPIDR    SOURCE    PV090527  26/04/30    21:15:46     12529          
  2.       SUBROUTINE KOPIDR(IGEOM,LPRIM,MRIGID)
  3.       IMPLICIT REAL*8 (A-H,O-Z)
  4.       IMPLICIT INTEGER (I-N)
  5. C***********************************************************************
  6. C NOM         : KOPIDR
  7. C DESCRIPTION : Transforme un CHPOINt MCHPOI en matrice
  8. C               diagonale MRIGID
  9. C
  10. C
  11. C
  12. C LANGAGE     : ESOPE
  13. C AUTEUR      : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
  14. C               mél : gounand@semt2.smts.cea.fr
  15. C***********************************************************************
  16. C ENTREES            : IGEOM,LPRIM
  17. C ENTREES/SORTIES    :
  18. C SORTIES            : MRIGID
  19. C***********************************************************************
  20. C VERSION    : v1, 10/05/2011, version initiale
  21. C HISTORIQUE : v1, 10/05/2011, création
  22. C HISTORIQUE :
  23. C HISTORIQUE :
  24. C***********************************************************************
  25.  
  26. -INC PPARAM
  27. -INC CCOPTIO
  28. -INC SMRIGID
  29. -INC SMCOORD
  30. -INC SMELEME
  31. -INC SMLMOTS
  32. -INC CCHAMP
  33. *
  34. * Executable statements
  35. *
  36. C
  37. C
  38. C**** On controle que le MELEME soit de type POI1
  39. C     Si non changer
  40. C
  41.       MELEME = IGEOM
  42.       SEGACT MELEME
  43.       NBSOUS = MELEME.LISOUS(/1)
  44.       NTYP = MELEME.ITYPEL
  45. C
  46.       IF ((NBSOUS.NE.0).OR.(NTYP.NE.1)) THEN
  47. * In CHANGE : SEGINI MELEME
  48.          CALL CHANGE(MELEME,1)
  49.          IPT1 = IGEOM
  50.          SEGDES IPT1
  51.          IF (IERR.NE.0) RETURN
  52.       ENDIF
  53. *
  54.       MLMOTS=LPRIM
  55.       SEGACT MLMOTS
  56.       NRIGEL=MOTS(/2)
  57.       SEGINI MRIGID
  58.       MTYMAT='DIAGONAL'
  59.       IFORIG=IFOUR
  60. C
  61.       NBEL=NUM(/2)
  62.       DO I=1,NRIGEL
  63.          COERIG(I)=1.D0
  64.          IRIGEL(1,I)=MELEME
  65.          NLIGRP=1
  66.          NLIGRD=1
  67.          SEGINI DESCR
  68.          LISINC(1)=MOTS(I)
  69.          CALL PLACE(NOMDD,LNOMDD,idx,MOTS(I))
  70.          IF (idx.NE.0) THEN
  71.             LISDUA(1)=NOMDU(idx)
  72.          ELSE
  73.             LISDUA(1)=MOTS(I)
  74.          ENDIF
  75.          NOELEP(1)=1
  76.          NOELED(1)=1
  77.          SEGDES DESCR
  78.          IRIGEL(3,I)=DESCR
  79.          NELRIG=NBEL
  80.          RIGREL=0
  81.          SEGINI XMATRI
  82.          DO IBEL=1,NBEL
  83.             RE(1,1,IBEL)=1.D0
  84.          ENDDO
  85.          SEGDES XMATRI
  86.          IRIGEL(4,I)=XMATRI
  87.       ENDDO
  88.       SEGDES MRIGID
  89.       SEGDES MLMOTS
  90.       SEGDES MELEME
  91. *
  92. * Normal termination
  93. *
  94.       RETURN
  95. *
  96. * End of subroutine KOPIDR
  97. *
  98.       END
  99.  
  100.  
  101.  
  102.  
  103.  
  104.  

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