Télécharger chelco.eso

Retour à la liste

Numérotation des lignes :

  1. C CHELCO SOURCE CB215821 19/10/25 21:15:00 10352
  2. SUBROUTINE CHELCO(IVAL,IPCHEL,IPCHE1,IPCHE2,IPCHE3)
  3.  
  4. C=======================================================================
  5. C ENTREES
  6. C IVAL = 0 SI ON VEUT IDIM CHAMELEM CONTENANT CHACUN UNE COMPOSA
  7. C IVAL = 1 SI ON VEUT LA PREMIERE COMPOSANTE
  8. C IVAL = 2 SI ON VEUT LA DEUXIEME COMPOSANTE
  9. C IVAL = 3 SI ON VEUT LA TROISIEME COMPOSANTE
  10. C IPCHEL = POINTEUR SUR UN CHAMP PAR ELEMENT (TYPE MCHAML)
  11.  
  12. C SORTIES
  13. C IPCHE1 =POINTEURS SUR LES CHAMP/ELEMENT CONTENANT LES COORDONNEES
  14. C IPCHE2
  15. C IPCHE3
  16. C
  17. C EBERSOLT OCT 85
  18. C NOUVEAUX CHAMELEMS P DOWLATYARI OCT 91
  19. C=======================================================================
  20. IMPLICIT INTEGER(I-N)
  21. IMPLICIT REAL*8(A-H,O-Z)
  22. -INC SMCHAML
  23. -INC SMELEME
  24. -INC SMINTE
  25. -INC SMCOORD
  26. -INC CCOPTIO
  27. -INC CCGEOME
  28. CHARACTER*4 NOMEL
  29. C
  30. SEGMENT MTRA
  31. REAL*8 XE(3,NBNN)
  32. ENDSEGMENT
  33. C
  34. DATA XZER/0.D0/
  35. C
  36. MCHEL1=IPCHEL
  37. N1=MCHEL1.INFCHE(/1)
  38. N3=MCHEL1.INFCHE(/2)
  39. L1=8
  40. NSOUS=N1
  41. C
  42. IF(IVAL.EQ.0)THEN
  43. IDEB=IDIM
  44. IFIN=1
  45. ELSE
  46. IDEB=IVAL
  47. IFIN=IVAL
  48. ENDIF
  49. C
  50. NCHE=0
  51. C
  52. C BOUCLE SUR LES COMPOSANTES
  53. C
  54. DO 1000 ICO=IDEB,IFIN,-1
  55. C
  56. C ON INITIALISE LE MCHAML CONTENANT LA COORDONNEE ICO
  57. C
  58. SEGINI,MCHELM
  59. NCHE=NCHE+1
  60. IF(NCHE.EQ.1)IPCHE1=MCHELM
  61. IF(NCHE.EQ.2)IPCHE2=MCHELM
  62. IF(NCHE.EQ.3)IPCHE3=MCHELM
  63. IFOCHE=MCHEL1.IFOCHE
  64. TITCHE='SCALAIRE'
  65. C
  66. C BOUCLE SUR LES SOUS-ZONES
  67. C
  68. DO 100 ISOUS=1,NSOUS
  69. C
  70. CONCHE(ISOUS)=MCHEL1.CONCHE(ISOUS)
  71. IMACHE(ISOUS)=MCHEL1.IMACHE(ISOUS)
  72. C
  73. DO 10 IO=1,N3
  74. INFCHE(ISOUS,IO)=MCHEL1.INFCHE(ISOUS,IO)
  75. 10 CONTINUE
  76. N2=1
  77. SEGINI MCHAML
  78. ICHAML(ISOUS)=MCHAML
  79. NOMCHE(1)='SCAL'
  80. TYPCHE(1)='REAL*8'
  81. C
  82. MELEME=IMACHE(ISOUS)
  83. NBELEM=NUM(/2)
  84. NBNN=NUM(/1)
  85. NOMEL=NOMS(ITYPEL)
  86. C
  87. ISUP=INFCHE(ISOUS,6)
  88. IF(ISUP.NE.1)THEN
  89. MINTE=INFCHE(ISOUS,4)
  90. NBPGAU=SHPTOT(/3)
  91. ELSE
  92. NBPGAU=NBNN
  93. ENDIF
  94. C
  95. N1EL =NBELEM
  96. N1PTEL=NBPGAU
  97. N2EL =0
  98. N2PTEL=0
  99. SEGINI MELVAL
  100. IELVAL(1)=MELVAL
  101. SEGINI MTRA
  102. C
  103. NBOUC=NBNN
  104. IF(NOMEL.EQ.'RAP3'.AND.ISUP.NE.1) NBOUC=6
  105. IF(NOMEL.EQ.'LIP6'.AND.ISUP.NE.1) NBOUC=12
  106. IF(NOMEL.EQ.'LIP8'.AND.ISUP.NE.1) NBOUC=16
  107.  
  108. DO 200 IB=1,NBELEM
  109. C
  110. CALL ZERO(XE,3,NBNN)
  111. CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  112. C
  113. DO 200 IGAU=1,NBPGAU
  114. C
  115. IF(ISUP.NE.1)THEN
  116. XX=XZER
  117. DO 220 ID=1,NBOUC
  118. XX=XX+SHPTOT(1,ID,IGAU)*XE(ICO,ID)
  119. 220 CONTINUE
  120. ELSE
  121. XX=XE(ICO,IGAU)
  122. ENDIF
  123. C+PPj
  124. C ON DIVISE PAR 2 LE RESULTAT POUR CERTAINS ELEMENTS DE JOINTS
  125. C AM 29/3/16 UNIQUEMENT SI LE SUPPORT EST DIFFERENT DE 1
  126. IF(ISUP.NE.1) THEN
  127. IF((NOMEL.EQ.'RAC2').OR.(NOMEL.EQ.'LIA3')
  128. . .OR.(NOMEL.EQ.'LIA4').OR.(NOMEL.EQ.'LIA6').OR.(NOMEL.EQ.'LIA8')
  129. . .OR.(NOMEL.EQ.'RAP3').OR.(NOMEL.EQ.'LIP6').OR.(NOMEL.EQ.'LIP8'))
  130. . XX=XX/2
  131. ENDIF
  132. C+PPj
  133. C
  134. VELCHE(IGAU,IB)=XX
  135. C
  136. 200 CONTINUE
  137. SEGSUP MTRA
  138. C
  139. 100 CONTINUE
  140.  
  141. C
  142. 1000 CONTINUE
  143.  
  144. END
  145.  
  146.  
  147.  
  148.  
  149.  
  150.  
  151.  
  152.  
  153.  
  154.  
  155.  
  156.  
  157.  
  158.  
  159.  

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