Télécharger depdpg.eso

Retour à la liste

Numérotation des lignes :

  1. C DEPDPG SOURCE CHAT 11/03/16 21:19:05 6902
  2.  
  3. C=======================================================================
  4. C= D E P D P G =
  5. C= ----------- =
  6. C= Extraction du chpoint MCHPOI des deplacements (UZDPG,RXDPG,RYDPG) =
  7. C= du noeud IPDPGE support des deformations planes generalisees =
  8. C=======================================================================
  9.  
  10. SUBROUTINE DEPDPG (MCHPOI,UZDPG,RXDPG,RYDPG,IPDPGE)
  11.  
  12. IMPLICIT INTEGER(I-N)
  13. IMPLICIT REAL*8 (A-H,O-Z)
  14.  
  15. -INC CCOPTIO
  16. -INC CCREEL
  17. -INC SMCHPOI
  18. -INC SMELEME
  19.  
  20. CHARACTER*4 NOCO
  21.  
  22. C 1 - Controle de la presence du noeud IPDPGE dans le chpoint MCHPOI
  23. C ERREUR si le noeud n'est pas present sauf si tout nul
  24. C ===
  25. SEGACT,MCHPOI
  26. NSOUPO=IPCHP(/1)
  27. DO i=1,NSOUPO
  28. MSOUPO=IPCHP(i)
  29. SEGACT,MSOUPO
  30. MELEME=IGEOC
  31. SEGACT,MELEME
  32. DO j=1,NUM(/2)
  33. IF (NUM(1,j).EQ.IPDPGE) GOTO 10
  34. ENDDO
  35. SEGDES,MELEME,MSOUPO
  36. ENDDO
  37. * rattrapage si champ nul
  38. xma=0.d0
  39. do i=1,NSOUPO
  40. MSOUPO=IPCHP(i)
  41. SEGACT,MSOUPO
  42. mpoval=ipoval
  43. if(mpoval.ne.0) then
  44. segact mpoval
  45. do iou=1,vpocha(/2)
  46. do iyu=1,vpocha(/1)
  47. if(abs(vpocha(iyu,iou)).gt.xma)xma=abs(vpocha(iyu,iou))
  48. enddo
  49. enddo
  50. segdes mpoval
  51. endif
  52. segdes msoupo
  53. enddo
  54. segdes MCHPOI
  55. if(xma.lt.1.d-30) then
  56. UZDPG=0.d0
  57. RXDPG=0.D0
  58. RYDPG=0.D0
  59. RETURN
  60. endif
  61. CALL ERREUR(621)
  62. RETURN
  63.  
  64. C 2 - Extraction des deplacements generalises suivant le mode de calcul
  65. C Les composantes generalisees sont rangees dans l'ordre UZDPG,
  66. C RXDPG et RYDPG quelque soit le mode de calcul.
  67. C ERREUR si le nombre de composantes lues n'est pas correct
  68. C ===
  69. 10 SEGDES,MELEME
  70. MPOVAL=IPOVAL
  71. SEGACT,MPOVAL
  72. ICOCO=0
  73. C =====
  74. C 2.1 - Mode PLAN GENE (2D)
  75. C =====
  76. IF (IFOUR.EQ.-3) THEN
  77. DO i=1,NOCOMP(/2)
  78. NOCO=NOCOMP(i)
  79. IF (NOCO.EQ.'UZ ') THEN
  80. ICOCO=ICOCO+1
  81. UZDPG=VPOCHA(j,i)
  82. ELSE IF (NOCO.EQ.'RX ') THEN
  83. ICOCO=ICOCO+10
  84. RXDPG=VPOCHA(j,i)
  85. ELSE IF (NOCO.EQ.'RY ') THEN
  86. ICOCO=ICOCO+100
  87. RYDPG=VPOCHA(j,i)
  88. ENDIF
  89. ENDDO
  90. IF (ICOCO.NE.111) CALL ERREUR(621)
  91. C =====
  92. C 2.2 - Modes UNIDIMENSIONNELS (1D)
  93. C =====
  94. ELSE IF (IFOUR.EQ.7.OR.IFOUR.EQ.8) THEN
  95. RXDPG=XZero
  96. RYDPG=XZero
  97. DO i=1,NOCOMP(/2)
  98. NOCO=NOCOMP(i)
  99. IF (NOCO.EQ.'UY ') THEN
  100. ICOCO=ICOCO+1
  101. UZDPG=VPOCHA(j,i)
  102. ENDIF
  103. ENDDO
  104. IF (ICOCO.NE.1) CALL ERREUR(621)
  105. ELSE IF (IFOUR.EQ.9.OR.IFOUR.EQ.10.OR.IFOUR.EQ.14) THEN
  106. RXDPG=XZero
  107. RYDPG=XZero
  108. DO i=1,NOCOMP(/2)
  109. NOCO=NOCOMP(i)
  110. IF (NOCO.EQ.'UZ ') THEN
  111. ICOCO=ICOCO+1
  112. UZDPG=VPOCHA(j,i)
  113. ENDIF
  114. ENDDO
  115. IF (ICOCO.NE.1) CALL ERREUR(621)
  116. ELSE IF (IFOUR.EQ.11) THEN
  117. RYDPG=XZero
  118. DO i=1,NOCOMP(/2)
  119. NOCO=NOCOMP(i)
  120. IF (NOCO.EQ.'UZ ') THEN
  121. ICOCO=ICOCO+1
  122. UZDPG=VPOCHA(j,i)
  123. ELSE IF (NOCO.EQ.'UY ') THEN
  124. ICOCO=ICOCO+10
  125. RXDPG=VPOCHA(j,i)
  126. ENDIF
  127. ENDDO
  128. IF (ICOCO.NE.11) CALL ERREUR(621)
  129. ENDIF
  130. SEGDES,MPOVAL,MSOUPO,MCHPOI
  131.  
  132. RETURN
  133. END
  134.  
  135.  
  136.  
  137.  
  138.  

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