Télécharger bnqore.eso

Retour à la liste

Numérotation des lignes :

  1. C BNQORE SOURCE AM 15/08/21 21:15:02 8599
  2. SUBROUTINE BNQORE(IGAU,NBNO,NBBB,LRE,IFOU,NSTB,NSTN,NN,
  3. . DIM3,XEL,SHPTOT,SHP,BGENE,XGENE,DJAC,IDECAP,LHOOK,ICLE)
  4. C-----------------------------------------------------------------------
  5. C
  6. C CALCULE LES MATRICES B ET N DU MILIEU POREUX
  7. C
  8. C LE RESULTAT EST DANS BGENE ET / OU XGENE
  9. C
  10. C BGENE(NSTB,LRE) XGENE(NSTN,LRN)
  11. C
  12. C-----------------------------------------------------------------------
  13. C ENTREE :
  14. C IGAU=NUMERO DU POINT DE GAUSS
  15. C NBNO=NOMBRE DE FONCTIONS DE FORME
  16. C NBBB=NOMBRE DE NOEUDS
  17. C LRE =NOMBRE DE COLONNES DE LA MATRICE B
  18. C IFOU=IFOUR DE CCOPTIO
  19. C NSTB=NOMBRE DE LIGNES DE LA MATRICE B
  20. C NSTN=NOMBRE DE LIGNES DE LA MATRICE N
  21. C DIM3=EPAISSEUR DE L'ELEMENT (CONTRAINTES PLANES)
  22. C NN =NUMERO DU MODE DE FOURIER
  23. C XEL =COORDONNEES DE L ELEMENT
  24. C SHPTOT(6,NBNO,NBGAU)=FONCTIONS DE FORMES ET DERIVEES
  25. C ICLE INDICATEUR DE CALCUL
  26. C = 1 ON CALCULE B ET NP
  27. C = 2 ON CALCULE BP
  28. C = 3 ON CALCULE B
  29. C = 4 ON CALCULE N
  30. C = 5 ON CALCULE N ET NP
  31. C ON MET ALORS N DANS BGENE ET NP DANS XGENE
  32. C AUTRES VALEURS : COMBINAISONS DES CAS PRECEDENTS
  33. C SHP(6,NBNO)=TABLEAU DE TRAVAIL
  34. C SORTIE :
  35. C DJAC=JACOBIEN
  36. C BGENE(LHOOK,LRE)=MATRICE B
  37. C XGENE(NSTN,LRN)=MATRICE N
  38. C-----------------------------------------------------------------------
  39. IMPLICIT INTEGER(I-N)
  40. IMPLICIT REAL*8(A-H,O-Z)
  41. DIMENSION XEL(3,*),BGENE(LHOOK,*),SHP(6,*),SHPTOT(6,NBNO,*)
  42. DIMENSION XGENE(NSTN,*)
  43. DIMENSION BB(3,9),GEOM(20),XX(3),YY(3)
  44. DATA XX/.5D0,.0D0,.5D0/
  45. DATA YY/.0D0,.5D0,.5D0/
  46. C
  47. JCLE1=0
  48. JCLE2=0
  49. JCLE3=0
  50. JCLE4=0
  51.  
  52. LPP = NBNO-NBBB
  53. LRN=IDECAP*LPP
  54. NB1=NBBB+1
  55. IF(ICLE.EQ.1) THEN
  56. JCLE1=1
  57. JCLE4=1
  58. ENDIF
  59. IF(ICLE.EQ.2) THEN
  60. JCLE3=1
  61. ENDIF
  62. IF(ICLE.EQ.3) THEN
  63. JCLE1=1
  64. ENDIF
  65. IF(ICLE.EQ.4) THEN
  66. JCLE2=1
  67. ENDIF
  68. IF(ICLE.EQ.5) THEN
  69. JCLE2=1
  70. JCLE4=1
  71. ENDIF
  72.  
  73. CALL ZERO(BGENE,LHOOK,LRE)
  74. CALL ZERO(XGENE,NSTN,LRN)
  75. C
  76. IFR=IFOU+4
  77. GOTO (666,10,10,20,30,40) ,IFR
  78. GOTO 666
  79. C
  80. C ELEMENTS MASSIFS BIDIM CONT OU DEF PLANES
  81. C
  82. 10 CONTINUE
  83. DO 101 NP=1,NBNO
  84. SHP(1,NP)=SHPTOT(1,NP,IGAU)
  85. SHP(2,NP)=SHPTOT(2,NP,IGAU)
  86. SHP(3,NP)=SHPTOT(3,NP,IGAU)
  87. 101 CONTINUE
  88. CALL DEVOLP(XEL,SHP,MFR,NBBB,NBNO,IFOU,NN,DIM3,RR,DJAC)
  89. C
  90. IF(JCLE1.NE.0) THEN
  91. K=1
  92. DO 102 NP=1,NBBB
  93. BGENE(1,K )=SHP(2,NP)
  94. BGENE(2,K+1)=SHP(3,NP)
  95. BGENE(4,K+1)=SHP(2,NP)
  96. BGENE(4,K )=SHP(3,NP)
  97. 102 K=K+2
  98. ENDIF
  99. C
  100. IF(JCLE2.NE.0) THEN
  101. K=0
  102. DO 1102 NP=1,NBBB
  103. DO 1103 INST=1,NSTB
  104. BGENE(INST,K+INST)=SHP(1,NP)
  105. 1103 CONTINUE
  106. 1102 K=K+NSTB
  107. ENDIF
  108. C
  109. IF(JCLE3.NE.0) THEN
  110. DO 3122 IPR=1,IDECAP
  111. K=(IPR-1)*NBBB +1
  112. IPR2=2*IPR
  113. DO 3102 NP=NB1,NBNO
  114. BGENE(IPR2-1,K)=SHP(2,NP)
  115. BGENE(IPR2 ,K)=SHP(3,NP)
  116. 3102 K=K+1
  117. 3122 CONTINUE
  118. ENDIF
  119. C
  120. IF(JCLE4.NE.0) THEN
  121. K=1
  122. DO 4122 IPR=1,IDECAP
  123. DO 4102 NP=NB1,NBNO
  124. XGENE(IPR,K)=SHP(1,NP)
  125. 4102 K=K+1
  126. 4122 CONTINUE
  127. ENDIF
  128. GOTO 666
  129. C
  130. C ELEMENTS MASSIFS BIDIM AXISYMETRIQUE
  131. C
  132. 20 CONTINUE
  133. DO 201 NP=1,NBNO
  134. SHP(1,NP)=SHPTOT(1,NP,IGAU)
  135. SHP(2,NP)=SHPTOT(2,NP,IGAU)
  136. SHP(3,NP)=SHPTOT(3,NP,IGAU)
  137. 201 CONTINUE
  138. CALL DEVOLP(XEL,SHP,MFR,NBBB,NBNO,IFOU,NN,DIM3,RR,DJAC)
  139. C
  140. IF(JCLE1.NE.0) THEN
  141. K=1
  142. DO 202 NP=1,NBBB
  143. BGENE(1,K )=SHP(2,NP)
  144. BGENE(2,K+1)=SHP(3,NP)
  145. BGENE(3,K )=SHP(1,NP)/RR
  146. BGENE(4,K+1)=SHP(2,NP)
  147. BGENE(4,K )=SHP(3,NP)
  148. 202 K=K+2
  149. ENDIF
  150. C
  151. IF(JCLE2.NE.0) THEN
  152. K=0
  153. DO 1202 NP=1,NBBB
  154. DO 1203 INST=1,NSTB
  155. BGENE(INST,K+INST)=SHP(1,NP)
  156. 1203 CONTINUE
  157. 1202 K=K+NSTB
  158. ENDIF
  159. C
  160. IF(JCLE3.NE.0) THEN
  161. DO 3222 IPR=1,IDECAP
  162. K=(IPR-1)*NBBB +1
  163. IPR2=2*IPR
  164. DO 3202 NP=NB1,NBNO
  165. BGENE(IPR2-1,K)=SHP(2,NP)
  166. BGENE(IPR2 ,K)=SHP(3,NP)
  167. 3202 K=K+1
  168. 3222 CONTINUE
  169. ENDIF
  170. C
  171. IF(JCLE4.NE.0) THEN
  172. K=1
  173. DO 4222 IPR=1,IDECAP
  174. DO 4202 NP=NB1,NBNO
  175. XGENE(IPR,K)=SHP(1,NP)
  176. 4202 K=K+1
  177. 4222 CONTINUE
  178. ENDIF
  179. GOTO 666
  180. C
  181. C ELEMENTS MASSIFS BIDIM FOURIER
  182. C
  183. 30 CONTINUE
  184. DO 301 NP=1,NBNO
  185. SHP(1,NP)=SHPTOT(1,NP,IGAU)
  186. SHP(2,NP)=SHPTOT(2,NP,IGAU)
  187. SHP(3,NP)=SHPTOT(3,NP,IGAU)
  188. 301 CONTINUE
  189. CALL DEVOLP(XEL,SHP,MFR,NBBB,NBNO,IFOU,NN,DIM3,RR,DJAC)
  190. C
  191. IF(JCLE1.NE.0) THEN
  192. XNSUR=DBLE(NN)/RR
  193. K=1
  194. DO 302 NP=1,NBBB
  195. BGENE(1,K )= SHP(2,NP)
  196. BGENE(2,K+1)= SHP(3,NP)
  197. BGENE(3,K )= SHP(1,NP)/RR
  198. BGENE(3,K+2)=-SHP(1,NP)*XNSUR
  199. BGENE(4,K )= SHP(3,NP)
  200. BGENE(4,K+1)= SHP(2,NP)
  201. BGENE(5,K )= SHP(1,NP)*XNSUR
  202. BGENE(5,K+2)= SHP(2,NP)-SHP(1,NP)/RR
  203. BGENE(6,K+1)= SHP(1,NP)*XNSUR
  204. BGENE(6,K+2)= SHP(3,NP)
  205. 302 K=K+3
  206. ENDIF
  207. C
  208. IF(JCLE2.NE.0) THEN
  209. K=0
  210. DO 1302 NP=1,NBBB
  211. DO 1303 INST=1,NSTB
  212. BGENE(INST,K+INST)=SHP(1,NP)
  213. 1303 CONTINUE
  214. 1302 K=K+NSTB
  215. ENDIF
  216. C
  217. IF(JCLE3.NE.0) THEN
  218. XNSUR=DBLE(NN)/RR
  219. DO 3322 IPR=1,IDECAP
  220. K=(IPR-1)*NBBB +1
  221. IPR3=3*IPR
  222. DO 3302 NP=NB1,NBNO
  223. BGENE(IPR3-2,K)= SHP(2,NP)
  224. BGENE(IPR3-1,K)= SHP(3,NP)
  225. BGENE(IPR3 ,K)=-SHP(1,NP)*XNSUR
  226. 3302 K=K+1
  227. 3322 CONTINUE
  228. ENDIF
  229. C
  230. IF(JCLE4.NE.0) THEN
  231. K=1
  232. DO 4322 IPR=1,IDECAP
  233. DO 4302 NP=NB1,NBNO
  234. XGENE(IPR,K)=SHP(1,NP)
  235. 4302 K=K+1
  236. 4322 CONTINUE
  237. ENDIF
  238. GOTO 666
  239. C
  240. C ELEMENTS MASSIFS TRIDIM
  241. C
  242. 40 CONTINUE
  243. DO 401 NP=1,NBNO
  244. SHP(1,NP)=SHPTOT(1,NP,IGAU)
  245. SHP(2,NP)=SHPTOT(2,NP,IGAU)
  246. SHP(3,NP)=SHPTOT(3,NP,IGAU)
  247. SHP(4,NP)=SHPTOT(4,NP,IGAU)
  248. 401 CONTINUE
  249. CALL DEVOLP(XEL,SHP,MFR,NBBB,NBNO,IFOU,NN,DIM3,RR,DJAC)
  250. C
  251. IF(JCLE1.NE.0) THEN
  252. K=1
  253. DO 402 NP=1,NBBB
  254. BGENE(1,K )=SHP(2,NP)
  255. BGENE(2,K+1)=SHP(3,NP)
  256. BGENE(3,K+2)=SHP(4,NP)
  257. BGENE(4,K )=SHP(3,NP)
  258. BGENE(4,K+1)=SHP(2,NP)
  259. BGENE(5,K )=SHP(4,NP)
  260. BGENE(5,K+2)=SHP(2,NP)
  261. BGENE(6,K+1)=SHP(4,NP)
  262. BGENE(6,K+2)=SHP(3,NP)
  263. 402 K=K+3
  264. ENDIF
  265. C
  266. IF(JCLE2.NE.0) THEN
  267. K=0
  268. DO 1402 NP=1,NBBB
  269. DO 1403 INST=1,NSTB
  270. BGENE(INST,K+INST)=SHP(1,NP)
  271. 1403 CONTINUE
  272. 1402 K=K+NSTB
  273. ENDIF
  274. C
  275. IF(JCLE3.NE.0) THEN
  276. DO 3422 IPR=1,IDECAP
  277. K=(IPR-1)*NBBB +1
  278. IPR3=3*IPR
  279. DO 3402 NP=NB1,NBNO
  280. BGENE(IPR3-2,K)=SHP(2,NP)
  281. BGENE(IPR3-1,K)=SHP(3,NP)
  282. BGENE(IPR3 ,K)=SHP(4,NP)
  283. 3402 K=K+1
  284. 3422 CONTINUE
  285. ENDIF
  286. C
  287. IF(JCLE4.NE.0) THEN
  288. K=1
  289. DO 4422 IPR=1,IDECAP
  290. DO 4402 NP=NB1,NBNO
  291. XGENE(IPR,K)=SHP(1,NP)
  292. 4402 K=K+1
  293. 4422 CONTINUE
  294. ENDIF
  295. GO TO 666
  296. C
  297. 666 RETURN
  298. END
  299.  
  300.  
  301.  
  302.  
  303.  
  304.  

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