Télécharger reshpx.eso

Retour à la liste

Numérotation des lignes :

  1. C RESHPX SOURCE BP208322 16/11/18 21:20:58 9177
  2. C 20.04.2005
  3. C
  4. SUBROUTINE RESHPX(NBG,NBSH,IELE,MELE,NPINT,IPT,IRT)
  5. C
  6. C=====================================================================
  7. C MET LES VALEURS DES FONCTIONS DE FORMES DANS SHPTOT
  8. C ET LES COORDOONEES REDUITES+LES POIDS D INTEGRATION
  9. C DANS QSIGAU ETAGAU DZEGAU POIGAU ; LE TOUT EST
  10. C MIS DANS LE POINTEUR MINTE SON POINTEUR EST IPT
  11. C NNN =NOMBRE DE POINTS DE GAUSS
  12. C NBSH =NOMBRE DE FONCTIONS D'INTERPOLATION
  13. C IELE =NUMERO DE L ELEMENT DANS NOMS (VOIR CCGEOME )
  14. C MELE =NUMERO DE L ELEMENT DANS NOMTP
  15. C NPINT=NOMBRE DE POINTS D'INTEGRATION DONS LE CAS DES
  16. C ELEMENTS COQUES INTEGRES
  17. C IPT = POINTEUR SUR MINTE
  18. C IRET=1 OU 0 SUIVANT QUE MINTE A ETE CREEE OU PAS
  19. C
  20. C CETTE ROUTINE GERE LES MESSAGES D ERREURS
  21. C PROVENANT DE L INCOMPATIBILTE ENTRE NOMS
  22. C D ELEMENTS,NOMBRE DE POINTS DE GAUSS,ET FONCTIONS DE FORME
  23. C=====================================================================
  24. C
  25. IMPLICIT REAL*8(A-H,O-Z)
  26. C
  27. -INC CCREEL
  28. -INC CCGEOME
  29. -INC SMINTE
  30. -INC CCOPTIO
  31. c
  32. c
  33. INTEGER NBG,NBSH,IELE,MELE,NPINT,IRET
  34. INTEGER NBNN,NBPGAU,NBNO,II,JJ,KK,KGAU,IENR,NBENR,INI
  35. c REAL*8 DELTAQSI,QSI0,ETA0
  36. C
  37. PARAMETER (XZER=0.D0,UNDEMI=.5D0,UN=1.D0,DEUX=2.D0)
  38. PARAMETER (TROIS=3.D0,QUATRE=4.D0,HUIT=8.D0)
  39. C
  40. PARAMETER (NGAUMAX=8)
  41. C
  42. REAL*8 QSIREF(NGAUMAX),ETAREF(NGAUMAX),POIREF(NGAUMAX)
  43. REAL*8 DZEREF(NGAUMAX)
  44. REAL*8 QSI,ETA,DELTAQSI,QSI0,ETA0
  45. REAL*8 DZE,DZE0
  46. REAL*8 SHP1,SHP2,SHP3,SHP4,SHP1Q,SHP2Q,SHP3Q,SHP4Q
  47. REAL*8 SHP5,SHP6,SHP7,SHP8,SHP5Q,SHP6Q,SHP7Q,SHP8Q
  48. REAL*8 SHP1E,SHP2E,SHP3E,SHP4E
  49. REAL*8 SHP5E,SHP6E,SHP7E,SHP8E
  50. REAL*8 SHP1D,SHP2D,SHP3D,SHP4D
  51. REAL*8 SHP5D,SHP6D,SHP7D,SHP8D
  52. C
  53. C
  54.  
  55. DATA X577/.577350269189626D0/
  56.  
  57. C
  58. IF (IDIM.EQ.2) THEN
  59. c
  60. if (MELE.eq.263) then
  61. C++++++++ QUADRANGLE A 4 NOEUDS
  62. NBNN = 4
  63. NGAU = 4
  64. QSIREF(1)=-X577
  65. QSIREF(2)= X577
  66. QSIREF(3)= X577
  67. QSIREF(4)=-X577
  68. ETAREF(1)=-X577
  69. ETAREF(2)=-X577
  70. ETAREF(3)= X577
  71. ETAREF(4)= X577
  72. POIREF(1)= UN
  73. POIREF(2)= UN
  74. POIREF(3)= UN
  75. POIREF(4)= UN
  76. endif
  77. c
  78. ENDIF
  79. c
  80. C
  81. IF (IDIM.EQ.3) THEN
  82. c
  83. if (MELE.eq.264) then
  84. C++++++++ CUBE A 8 NOEUDS
  85. NBNN = 8
  86. NGAU = 8
  87. QSIREF(1)=-X577
  88. QSIREF(2)= X577
  89. QSIREF(3)= X577
  90. QSIREF(4)=-X577
  91. QSIREF(5)=-X577
  92. QSIREF(6)= X577
  93. QSIREF(7)= X577
  94. QSIREF(8)=-X577
  95. ETAREF(1)=-X577
  96. ETAREF(2)=-X577
  97. ETAREF(3)= X577
  98. ETAREF(4)= X577
  99. ETAREF(5)=-X577
  100. ETAREF(6)=-X577
  101. ETAREF(7)= X577
  102. ETAREF(8)= X577
  103. DZEREF(1)=-X577
  104. DZEREF(2)=-X577
  105. DZEREF(3)=-X577
  106. DZEREF(4)=-X577
  107. DZEREF(5)= X577
  108. DZEREF(6)= X577
  109. DZEREF(7)= X577
  110. DZEREF(8)= X577
  111. POIREF(1)= UN
  112. POIREF(2)= UN
  113. POIREF(3)= UN
  114. POIREF(4)= UN
  115. POIREF(5)= UN
  116. POIREF(6)= UN
  117. POIREF(7)= UN
  118. POIREF(8)= UN
  119. c
  120. endif
  121. c
  122. ENDIF
  123.  
  124. C
  125. C=====================================================================
  126. C INITIALISATIONS
  127. C
  128. NBPGAU= NBG
  129. NBNO = NBSH
  130. SEGINI,MINTE
  131. IPT = MINTE
  132. IRET=1
  133. C
  134. NBENR = NBSH/NBNN
  135. C
  136. C=====================================================================
  137. C EN 2D SOUS DECOUPAGE EN NBSSEF Q4 A 4 POINT DE GAUSS
  138. C EN 3D SOUS DECOUPAGE EN NBSSEF CUB8 A 8 POINT DE GAUSS
  139. IF(MOD(NBG,NBNN).NE.0)
  140. $ WRITE(*,*) 'NOMBRE DE PT DE GAUSS INDIVISIBLE PAR 4(2D) ou 8(3D)'
  141. XDIM = 1./IDIM
  142. NBSSEF = NINT( (NBG / NBNN)**(XDIM) )
  143. C NBSSEF = NINT( (NBG / NBNN)**(1/IDIM) )
  144. C WRITE(*,*) 'TY',IDIM,XDIM,NBG,NBNN,NBSSEF
  145. IF((NBNN*(NBSSEF**IDIM)).NE.NBG)
  146. $ WRITE(*,*) 'NOMBRE DE PT DE GAUSS INCORRECT'
  147. C
  148. KGAU = 0
  149. C write(*,*) '--->boucle sur',NBSSEF,'^2 elements *',
  150. C $ NGAU,' pt de G'
  151. C
  152. DELTAQSI = DEUX/(FLOAT(NBSSEF))
  153. C write(*,*) 'deltaqsi',deltaqsi
  154. C
  155. C=====================================================================
  156. C EN 2D SOUS DECOUPAGE EN NBSSEF Q4 A 4 POINT DE GAUSS
  157. IF (IDIM.EQ.2) THEN
  158.  
  159. C********* boucle sur les lignes *********
  160. DO JJ=1,NBSSEF
  161. C********* boucle sur les colonnes *********
  162. DO II=1,NBSSEF
  163. C
  164. C coordonnees au centre du sous element
  165. QSI0 = DELTAQSI*(FLOAT(II)-UNDEMI) - UN
  166. ETA0 = DELTAQSI*(FLOAT(JJ)-UNDEMI) - UN
  167. C
  168. C***** boucle sur les pts de gauss du Pseudo-sous element *****
  169. DO KK=1,NGAU
  170. KGAU = KGAU + 1
  171. C calcul des coordonnees + poids
  172. QSIGAU(KGAU) = (UNDEMI*DELTAQSI*QSIREF(KK)) + QSI0
  173. ETAGAU(KGAU) = (UNDEMI*DELTAQSI*ETAREF(KK)) + ETA0
  174. POIGAU(KGAU) = POIREF(KK) / (FLOAT(NBSSEF**IDIM))
  175. c WRITE(*,*) KGAU,QSIGAU(KGAU),ETAGAU(KGAU),POIGAU(KGAU)
  176. ENDDO
  177. C** fin de boucle sur les points de gauss du sous element **
  178. ENDDO
  179. C***** fin de boucle sur les colonnes ******
  180. ENDDO
  181. C*******fin de boucle sur les lignes ******
  182.  
  183. C=====================================================================
  184. C EN 3D SOUS DECOUPAGE EN NBSSEF CUB8 A 8 POINT DE GAUSS
  185. ELSE
  186. c (IDIM.EQ.3)
  187.  
  188. JZMAX= NBSSEF
  189. C********* boucle sur la 3eme direction *********
  190. DO JZ=1,JZMAX
  191. C********* boucle sur les lignes *********
  192. DO JJ=1,NBSSEF
  193. C********* boucle sur les colonnes *********
  194. DO II=1,NBSSEF
  195. C
  196. C coordonnees au centre du sous element
  197. QSI0 = DELTAQSI*(FLOAT(II)-UNDEMI) - UN
  198. ETA0 = DELTAQSI*(FLOAT(JJ)-UNDEMI) - UN
  199. DZE0 = DELTAQSI*(FLOAT(JZ)-UNDEMI) - UN
  200. C
  201. C***** boucle sur les pts de gauss du Pseudo-sous element *****
  202. DO KK=1,NGAU
  203. KGAU = KGAU + 1
  204. C calcul des coordonnees + poids
  205. QSIGAU(KGAU) = (UNDEMI*DELTAQSI*QSIREF(KK)) + QSI0
  206. ETAGAU(KGAU) = (UNDEMI*DELTAQSI*ETAREF(KK)) + ETA0
  207. DZEGAU(KGAU) = (UNDEMI*DELTAQSI*DZEREF(KK)) + DZE0
  208. POIGAU(KGAU) = POIREF(KK) / (FLOAT(NBSSEF**IDIM))
  209. c WRITE(*,*) KGAU,QSIGAU(KGAU),ETAGAU(KGAU),POIGAU(KGAU)
  210. ENDDO
  211. C** fin de boucle sur les points de gauss du sous element **
  212. ENDDO
  213. C***** fin de boucle sur les colonnes ******
  214. ENDDO
  215. C*******fin de boucle sur les lignes ******
  216. ENDDO
  217. C*******fin de boucle sur la 3eme direction ******
  218.  
  219. ENDIF
  220. C
  221. C=====================================================================
  222.  
  223. C
  224. C=======================================================
  225. C ON MET LES Ni STD PARTOUT
  226. C
  227. C***** boucle sur les points de gauss *****
  228. DO 2001 KGAU=1,NBPGAU
  229.  
  230. QSI = QSIGAU(KGAU)
  231. ETA = ETAGAU(KGAU)
  232.  
  233. IF (IDIM.EQ.2) THEN
  234.  
  235. C fonctions standards : Ni
  236. SHP1 = (UN-QSI)*(UN-ETA)/QUATRE
  237. SHP2 = (UN+QSI)*(UN-ETA)/QUATRE
  238. SHP3 = (UN+QSI)*(UN+ETA)/QUATRE
  239. SHP4 = (UN-QSI)*(UN+ETA)/QUATRE
  240. C dérivée des fonctions standards : Ni,qsi
  241. SHP1Q = (ETA-UN)/QUATRE
  242. SHP2Q = -SHP1Q
  243. SHP3Q = (ETA+UN)/QUATRE
  244. SHP4Q = -SHP3Q
  245. C dérivée des fonctions standards : Ni,eta
  246. SHP1E = (QSI-UN)/QUATRE
  247. SHP2E = -(UN+QSI)/QUATRE
  248. SHP3E = -SHP2E
  249. SHP4E = -SHP1E
  250. C
  251. ELSE
  252.  
  253. DZE = DZEGAU(KGAU)
  254. C fonctions standards : Ni
  255. SHP1 = (UN-QSI)*(UN-ETA)*(UN-DZE)/HUIT
  256. SHP2 = (UN+QSI)*(UN-ETA)*(UN-DZE)/HUIT
  257. SHP3 = (UN+QSI)*(UN+ETA)*(UN-DZE)/HUIT
  258. SHP4 = (UN-QSI)*(UN+ETA)*(UN-DZE)/HUIT
  259. SHP5 = (UN-QSI)*(UN-ETA)*(UN+DZE)/HUIT
  260. SHP6 = (UN+QSI)*(UN-ETA)*(UN+DZE)/HUIT
  261. SHP7 = (UN+QSI)*(UN+ETA)*(UN+DZE)/HUIT
  262. SHP8 = (UN-QSI)*(UN+ETA)*(UN+DZE)/HUIT
  263. C dérivée des fonctions standards : Ni,qsi
  264. SHP1Q = (ETA-UN)*(UN-DZE)/HUIT
  265. SHP2Q = -SHP1Q
  266. SHP3Q = (ETA+UN)*(UN-DZE)/HUIT
  267. SHP4Q = -SHP3Q
  268. SHP5Q = (ETA-UN)*(UN+DZE)/HUIT
  269. SHP6Q = -SHP5Q
  270. SHP7Q = (ETA+UN)*(UN+DZE)/HUIT
  271. SHP8Q = -SHP7Q
  272. C dérivée des fonctions standards : Ni,eta
  273. SHP1E = (QSI-UN)*(UN-DZE)/HUIT
  274. SHP2E = -(UN+QSI)*(UN-DZE)/HUIT
  275. SHP3E = -SHP2E
  276. SHP4E = -SHP1E
  277. SHP5E = (QSI-UN)*(UN+DZE)/HUIT
  278. SHP6E = -(UN+QSI)*(UN+DZE)/HUIT
  279. SHP7E = -SHP6E
  280. SHP8E = -SHP5E
  281. C dérivée des fonctions standards : Ni,dze
  282. SHP1D = (UN-QSI)*(ETA-UN)/HUIT
  283. SHP2D = (UN+QSI)*(ETA-UN)/HUIT
  284. SHP3D = -(UN+QSI)*(UN+ETA)/HUIT
  285. SHP4D = (QSI-UN)*(UN+ETA)/HUIT
  286. SHP5D = -SHP1D
  287. SHP6D = -SHP2D
  288. SHP7D = -SHP3D
  289. SHP8D = -SHP4D
  290. ENDIF
  291.  
  292.  
  293. C***** boucle sur les enrichissements *****
  294. DO 2002 IENR=1,NBENR
  295.  
  296. II = (IENR-1)*NBNN + 1
  297. C fonctions standards : Ni
  298. SHPTOT(1,II,KGAU) = SHP1
  299. SHPTOT(1,II+1,KGAU) = SHP2
  300. SHPTOT(1,II+2,KGAU) = SHP3
  301. SHPTOT(1,II+3,KGAU) = SHP4
  302. C dérivée des fonctions standards : Ni,qsi
  303. SHPTOT(2,II,KGAU) = SHP1Q
  304. SHPTOT(2,II+1,KGAU) = SHP2Q
  305. SHPTOT(2,II+2,KGAU) = SHP3Q
  306. SHPTOT(2,II+3,KGAU) = SHP4Q
  307. C dérivée des fonctions standards : Ni,eta
  308. SHPTOT(3,II,KGAU) = SHP1E
  309. SHPTOT(3,II+1,KGAU) = SHP2E
  310. SHPTOT(3,II+2,KGAU) = SHP3E
  311. SHPTOT(3,II+3,KGAU) = SHP4E
  312. C
  313. IF (IDIM.EQ.3) THEN
  314. C fonctions standards : Ni
  315. SHPTOT(1,II+4,KGAU) = SHP5
  316. SHPTOT(1,II+5,KGAU) = SHP6
  317. SHPTOT(1,II+6,KGAU) = SHP7
  318. SHPTOT(1,II+7,KGAU) = SHP8
  319. C dérivée des fonctions standards : Ni,qsi
  320. SHPTOT(2,II+4,KGAU) = SHP5Q
  321. SHPTOT(2,II+5,KGAU) = SHP6Q
  322. SHPTOT(2,II+6,KGAU) = SHP7Q
  323. SHPTOT(2,II+7,KGAU) = SHP8Q
  324. C dérivée des fonctions standards : Ni,eta
  325. SHPTOT(3,II+4,KGAU) = SHP5E
  326. SHPTOT(3,II+5,KGAU) = SHP6E
  327. SHPTOT(3,II+6,KGAU) = SHP7E
  328. SHPTOT(3,II+7,KGAU) = SHP8E
  329. C dérivée des fonctions standards : Ni,dze
  330. SHPTOT(4,II,KGAU) = SHP1D
  331. SHPTOT(4,II+1,KGAU) = SHP2D
  332. SHPTOT(4,II+2,KGAU) = SHP3D
  333. SHPTOT(4,II+3,KGAU) = SHP4D
  334. SHPTOT(4,II+4,KGAU) = SHP5D
  335. SHPTOT(4,II+5,KGAU) = SHP6D
  336. SHPTOT(4,II+6,KGAU) = SHP7D
  337. SHPTOT(4,II+7,KGAU) = SHP8D
  338. ENDIF
  339. C
  340. C
  341. 2002 CONTINUE
  342. 2001 CONTINUE
  343. C
  344.  
  345. C=======================================================
  346. C ON CALCULE LES FONCTIONS D EXTRAPOLATIONS
  347. C
  348. C CALL EXTRAP(SHPTOT,NNN,NBBB,NBNO)
  349. C
  350. C
  351.  
  352. C=======================================================
  353. C ON DESACTIVE LES SEGMENTS
  354. SEGDES MINTE
  355. C
  356. RETURN
  357. END
  358.  
  359.  
  360.  
  361.  
  362.  
  363.  
  364.  
  365.  
  366.  
  367.  
  368.  
  369.  
  370.  
  371.  

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