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