Télécharger kopdir.eso

Retour à la liste

Numérotation des lignes :

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

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