Télécharger la plaquette Cast3M


fr en

Télécharger kopdir.eso

Retour à la liste

Numérotation des lignes : 

kopdir

  1. C KOPDIR    SOURCE    FANDEUR   22/01/19    21:15:08     11256          
  2.       SUBROUTINE KOPDIR(MCHPOI,MRIGID)
  3.       IMPLICIT REAL*8 (A-H,O-Z)
  4.       IMPLICIT INTEGER (I-N)
  5. C***********************************************************************
  6. C NOM         : KOPDIR
  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            : MCHPOI
  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 SMCHPOI
  30. -INC SMELEME
  31. -INC CCHAMP
  32.  
  33.       CHARACTER*4 MOMOT(1)
  34.       CHARACTER*8 LETYPE
  35.       DATA MOMOT(1) /'TYPE'/
  36.  
  37. * BP 01/04/2014 ajout d'un type a la rigidite (recopie de manuri.eso)
  38. *     -- LECTURE DU SOUS-TYPE DE LA "RIGIDITE" A CREER --
  39.       ITYP = 0
  40.       CALL LIRMOT(MOMOT,1,ITYP,0)
  41.       IF(ITYP.EQ.1) THEN
  42.          ICODE = 1
  43.          CALL LIRCHA (LETYPE,ICODE,IRETOU)
  44. C        write(ioimp,*) 'lecture de TYPE et du type:',LETYPE,':'
  45.          IF (IERR .NE. 0) RETURN
  46.       ELSE
  47. C ... Si on n'a rien trouvé, on met DIAGONAL dedans,
  48. C     sinon il y a des cochonneries ...
  49.          LETYPE='DIAGONAL'
  50.       ENDIF
  51. C Pour le mode de calcul, on prend celui du CHPOINT
  52. *
  53. * Executable statements
  54. *
  55.       SEGACT MCHPOI
  56.       NSOUPO = IPCHP(/1)
  57. C On compte le nombre de matrices à générer
  58.       NRIGEL=0
  59.       DO ISOUPO = 1, NSOUPO
  60.          MSOUPO = IPCHP(ISOUPO)
  61.          SEGACT MSOUPO
  62.          NC=NOCOMP(/2)
  63.          NRIGEL=NRIGEL+NC
  64. c*         SEGDES MSOUPO
  65.       ENDDO
  66.       SEGINI MRIGID
  67.       MTYMAT=LETYPE
  68.       IFORIG=IFOPOI
  69.  
  70.       IRIG=0
  71. C
  72.       DO ISOUPO = 1, NSOUPO
  73.          MSOUPO = IPCHP(ISOUPO)
  74. c*         SEGACT MSOUPO
  75.          NC=NOCOMP(/2)
  76.          MELEME=IGEOC
  77.          SEGACT MELEME
  78.          NBEL=NUM(/2)
  79.          SEGDES MELEME
  80.          MPOVAL=IPOVAL
  81.          SEGACT MPOVAL
  82.          DO IC=1,NC
  83.             IRIG=IRIG+1
  84.             COERIG(IRIG)=1.D0
  85.             IRIGEL(1,IRIG)=MELEME
  86.             NLIGRP=1
  87.             NLIGRD=1
  88.             SEGINI DESCR
  89.             LISINC(1)=NOCOMP(IC)
  90.             CALL PLACE(NOMDD,LNOMDD,idx,NOCOMP(IC))
  91.             IF (idx.NE.0) THEN
  92.                LISDUA(1)=NOMDU(idx)
  93.             ELSE
  94.                LISDUA(1)=NOCOMP(IC)
  95.             ENDIF
  96.             NOELEP(1)=1
  97.             NOELED(1)=1
  98.             SEGDES DESCR
  99.             IRIGEL(3,IRIG)=DESCR
  100.             NELRIG=NBEL
  101.             SEGINI XMATRI
  102.             DO IBEL=1,NBEL
  103.                RE(1,1,IBEL)=VPOCHA(IBEL,IC)
  104.             ENDDO
  105.             SEGDES XMATRI
  106.             IRIGEL(4,IRIG)=XMATRI
  107.          ENDDO
  108.          SEGDES MPOVAL
  109.          SEGDES MSOUPO
  110.       ENDDO
  111.       SEGDES MRIGID
  112.       SEGDES MCHPOI
  113. *
  114. * Normal termination
  115. *
  116.       RETURN
  117. *
  118. * End of subroutine KOPDIR
  119. *
  120.       END
  121.  
  122.  
  123.  

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