Télécharger depdpg.eso

Retour à la liste

Numérotation des lignes :

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

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