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

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