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

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