Télécharger kopdir.eso

Retour à la liste

Numérotation des lignes :

  1. C KOPDIR SOURCE CB215821 19/07/30 21:17:07 10273
  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. *
  52. * Executable statements
  53. *
  54. SEGACT MCHPOI
  55. NSOUPO = IPCHP(/1)
  56. C On compte le nombre de matrices à générer
  57. NRIGEL=0
  58. DO ISOUPO = 1, NSOUPO
  59. MSOUPO = IPCHP(ISOUPO)
  60. SEGACT MSOUPO
  61. NC=NOCOMP(/2)
  62. NRIGEL=NRIGEL+NC
  63. SEGDES MSOUPO
  64. ENDDO
  65. SEGINI MRIGID
  66. MTYMAT=LETYPE
  67. IRIG=0
  68. C
  69. DO ISOUPO = 1, NSOUPO
  70. MSOUPO = IPCHP(ISOUPO)
  71. SEGACT MSOUPO
  72. NC=NOCOMP(/2)
  73. MELEME=IGEOC
  74. SEGACT MELEME
  75. NBEL=NUM(/2)
  76. SEGDES MELEME
  77. MPOVAL=IPOVAL
  78. SEGACT MPOVAL
  79. DO IC=1,NC
  80. IRIG=IRIG+1
  81. COERIG(IRIG)=1.D0
  82. IRIGEL(1,IRIG)=MELEME
  83. NLIGRP=1
  84. NLIGRD=1
  85. SEGINI DESCR
  86. LISINC(1)=NOCOMP(IC)
  87. CALL PLACE(NOMDD,LNOMDD,idx,NOCOMP(IC))
  88. IF (idx.NE.0) THEN
  89. LISDUA(1)=NOMDU(idx)
  90. ELSE
  91. LISDUA(1)=NOCOMP(IC)
  92. ENDIF
  93. NOELEP(1)=1
  94. NOELED(1)=1
  95. SEGDES DESCR
  96. IRIGEL(3,IRIG)=DESCR
  97. NELRIG=NBEL
  98. SEGINI XMATRI
  99. DO IBEL=1,NBEL
  100. RE(1,1,IBEL)=VPOCHA(IBEL,IC)
  101. ENDDO
  102. SEGDES XMATRI
  103. IRIGEL(4,IRIG)=XMATRI
  104. ENDDO
  105. SEGDES MPOVAL
  106. SEGDES MSOUPO
  107. ENDDO
  108. SEGDES MRIGID
  109. SEGDES MCHPOI
  110. *
  111. * Normal termination
  112. *
  113. RETURN
  114. *
  115. * End of subroutine KOPDIR
  116. *
  117. END
  118.  
  119.  
  120.  
  121.  
  122.  
  123.  
  124.  

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