Télécharger gnfl1.eso

Retour à la liste

Numérotation des lignes :

  1. C GNFL1 SOURCE BP208322 16/11/18 21:17:24 9177
  2. SUBROUTINE GNFL1(IPMAIL,NDDL,NBPGAU,MELE,MFR,IVAVCO,IPMINT,
  3. & IVACAR,IPORE,NCOMP,IVAFOR,IIPDPG,IDECAP)
  4. *---------------------------------------------------------------------*
  5. * *
  6. * ENTREES : *
  7. * ________ *
  8. * *
  9. * IPMAIL Pointeur sur un segment MELEME *
  10. * LRE Nombre de ddl dans la matrice de rigidite *
  11. * NDDL Nombre de degré de liberté *
  12. * NBPGAU Nombre de points d'integration *
  13. * MELE Numero de l'element fini *
  14. * MFR Numero de la formulation *
  15. * IVAVCO pointeur sur un segment MPTVAL contenant les *
  16. * les melvals de FORCES VOLUMIQUES *
  17. * IPMINT Pointeur sur un segment MINTE *
  18. * IVACAR Pointeur sur un melval de caractéristiques *
  19. * IPORE Nombre de fonctions de forme *
  20. * NCOMP Nombre de composantes de forces *
  21. * *
  22. * SORTIES : *
  23. * ________ *
  24. * *
  25. * IVAFOR pointeur sur un segment MPTVAL contenant les *
  26. * melvals *
  27. * *
  28. *---------------------------------------------------------------------*
  29. IMPLICIT INTEGER(I-N)
  30. IMPLICIT REAL*8(A-H,O-Z)
  31. *
  32. -INC CCOPTIO
  33. -INC CCHAMP
  34. -INC SMCHAML
  35. -INC SMCHPOI
  36. -INC SMELEME
  37. -INC SMCOORD
  38. -INC SMMODEL
  39. -INC SMINTE
  40. -INC CCGEOME
  41. -INC CCREEL
  42. -INC SMRIGID
  43. *
  44. SEGMENT WRK1
  45. REAL*8 XFORC(LRN),VECO(NDDL),XE(3,NBBB)
  46. ENDSEGMENT
  47. *
  48. SEGMENT WRK2
  49. REAL*8 SHPWRK(6,NBNO),BGENE(NSTB,LRE)
  50. ENDSEGMENT
  51. *
  52. SEGMENT WRK3
  53. REAL*8 BPSS(3,3),XEL(3,NBBB)
  54. REAL*8 XNTH(LRN,LRN),XNTB(LRN,LRN),XNTT(LRN)
  55. ENDSEGMENT
  56. *
  57. SEGMENT WRK5
  58. REAL*8 XGENE(NSTN,LRN)
  59. ENDSEGMENT
  60. *
  61. SEGMENT MPTVAL
  62. INTEGER IPOS(NS) , NSOF(NS)
  63. INTEGER IVAL(NCOSOU)
  64. CHARACTER*16 TYVAL(NCOSOU)
  65. ENDSEGMENT
  66. *
  67. * INTRODUCTION DU POINT AUTOUR DUQUEL SE FAIT LE MOUVEMENT
  68. * DE LA SECTION EN DEFO PLANE GENERALISEE
  69. *
  70. IF (IFOUR.EQ.-3)THEN
  71. IP=IIPDPG
  72. SEGACT MCOORD
  73. IREF=(IP-1)*(IDIM+1)
  74. XDPGE=XCOOR(IREF+1)
  75. YDPGE=XCOOR(IREF+2)
  76. ELSE
  77. XDPGE=0.D0
  78. YDPGE=0.D0
  79. ENDIF
  80. *
  81. MELEME=IPMAIL
  82. NBNN=NUM(/1)
  83. NBELEM=NUM(/2)
  84. NHRM=NIFOUR
  85. MINTE=IPMINT
  86. IELE=NUMGEO(MELE)
  87. *
  88. IF(MELE.GE.79.AND.MELE.LE.83) GO TO 79
  89. IF(MELE.GE.173.AND.MELE.LE.182) GO TO 79
  90. IF(MELE.GE.108.AND.MELE.LE.110) GO TO 80
  91. IF(MELE.GE.185.AND.MELE.LE.190) GO TO 80
  92. *
  93. *
  94. GOTO 99
  95. *
  96. *
  97. C_______________________________________________________________________
  98. C
  99. C MILIEUX POREUX
  100. C_______________________________________________________________________
  101. C
  102. 79 CONTINUE
  103. C
  104. C POUR CES ELEMENTS NBBB = NOMBRE DE NOEUDS
  105. C NBNO = NOMBRE DE FONCTIONS DE FORME
  106. C
  107. DIM3=1.D0
  108. NBNO=IPORE
  109. NBBB=NBNN
  110. LPP=NBNO-NBBB
  111. LRN =IDECAP*LPP
  112. LRE=NBNN*IDECAP
  113. NSTBE=2
  114. IF(IFOUR.GT.0) NSTBE=3
  115. NSTB=NSTBE*IDECAP
  116. NSTN=1
  117.  
  118. * PRINT *,'NSTBE=',NSTBE
  119. * PRINT *,'NSTB=',NSTB
  120. * PRINT *,'IDECAP=',IDECAP
  121. * PRINT *,'LRN =',LRN
  122. * PRINT *,'LRE =',LRE
  123. * PRINT *,'NDDL =',NDDL
  124. * PRINT *,'NBNO =',NBNO
  125. * PRINT *,'NSTN =',NSTN
  126. * PRINT *,'IFOUR =',IFOUR
  127.  
  128. SEGINI WRK1,WRK2,WRK5
  129. I195=0
  130. I259=0
  131. C
  132. DO 3079 IB=1,NBELEM
  133. C
  134. C ON CHERCHE LES COORDONNEES DES NOEUDS DE L ELEMENT IB
  135. C
  136. CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  137. C
  138. C MISE A 0 DES FORCES NODALES
  139. C
  140. CALL ZERO(XFORC,1,LRN)
  141. C
  142. C BOUCLE SUR LES POINTS DE GAUSS
  143. C
  144. ISDJC=0
  145. DO 5079 IGAU=1,NBPGAU
  146. C
  147. C RECUPERATION DE L'EPAISSEUR
  148. C
  149. IF (IFOUR.EQ.-2)THEN
  150. MPTVAL=IVACAR
  151. IF (IVACAR.NE.0) THEN
  152. MELVAL=IVAL(1)
  153. IF (MELVAL.NE.0) THEN
  154. IGMN=MIN(IGAU,VELCHE(/1))
  155. IBMN=MIN(IB,VELCHE(/2))
  156. DIM3=VELCHE(IGMN,IBMN)
  157. ELSE
  158. DIM3=1.D0
  159. ENDIF
  160. ENDIF
  161. ENDIF
  162. C
  163. LHOO = NSTB
  164. CALL BNQORE(IGAU,NBNO,NBNN,LRE,IFOUR,NSTB,NSTN,NHRM,DIM3,
  165. . XE,SHPTOT,SHPWRK,BGENE,XGENE,DJAC,IDECAP,LHOO,2)
  166.  
  167. IF(DJAC.LT.0.D0) ISDJC=ISDJC+1
  168. IF(DJAC.EQ.0.D0) I259=IB
  169. DJAC=ABS(DJAC)*POIGAU(IGAU)
  170. C
  171. C ON RECUPERE LES VE_CO
  172. C
  173. MPTVAL=IVAVCO
  174. NCOSOU=IVAL(/1)
  175.  
  176. DO 8079 I=1,NCOSOU
  177. IF (IVAL(I).NE.0) THEN
  178. MELVAL=IVAL(I)
  179. IGMN=MIN(IGAU,VELCHE(/1))
  180. IBMN=MIN(IB ,VELCHE(/2))
  181. VECO(I)=VELCHE(IGMN,IBMN)
  182. ELSE
  183. VECO(I)=0.D0
  184. ENDIF
  185. 8079 CONTINUE
  186.  
  187. *
  188. * CALCUL DES FORCES NODALES EQUIVALENTES
  189. *
  190. DO 9179 IPR=1,IDECAP
  191. LPPDEC=(IPR-1)*LPP
  192. NSTDEC=(IPR-1)*NSTBE
  193. NBBDEC=(IPR-1)*NBBB
  194. DO 9079 J=1,LPP
  195. JX = J + LPPDEC
  196. JB = J + NBBDEC
  197. DO 9079 K=1,NSTBE
  198. KB = K + NSTDEC
  199. XFORC(JX)=XFORC(JX)+ DJAC*BGENE(KB,JB)*VECO(KB)
  200. 9079 CONTINUE
  201. 9179 CONTINUE
  202. *
  203. 5079 CONTINUE
  204. *
  205. IF(ISDJC.NE.0.AND.ISDJC.NE.NBPGAU) I195=IB
  206. *
  207. C
  208. C ON RANGE XFORC DANS MELVAL
  209. C
  210. IE=0
  211. MPTVAL=IVAFOR
  212. C
  213. DO 4179 IPR=1,IDECAP
  214. MELVAL=IVAL(IPR)
  215. DO 4079 IGAU=1,NBSOM(IELE)
  216. IE=IE+1
  217. IGAV = IBSOM(NSPOS(IELE)+IGAU-1)
  218. VELCHE(IGAV,IB)=XFORC(IE)
  219. 4079 CONTINUE
  220. 4179 CONTINUE
  221. C
  222. 3079 CONTINUE
  223. IF(I195.NE.0) INTERR(1)=I195
  224. IF(I195.NE.0) CALL ERREUR(195)
  225. IF(I259.NE.0) INTERR(1)=I259
  226. IF(I259.NE.0) CALL ERREUR(259)
  227. SEGSUP WRK1,WRK2,WRK5
  228. GOTO 510
  229. C
  230. C_______________________________________________________________________
  231. C
  232. C JOINTS POREUX
  233. C_______________________________________________________________________
  234. C
  235. 80 CONTINUE
  236. C
  237. C POUR CES ELEMENTS NBBB = NOMBRE DE NOEUDS
  238. C NBNO = NOMBRE DE FONCTIONS DE FORME
  239. C
  240. DIM3=1.D0
  241. NBNO=IPORE
  242. NBBB=NBNN
  243. LPP=(NBNO-NBBB)*3/2
  244. LRN =LPP*IDECAP
  245. LRE=LRN
  246. NSTBE=3
  247. IF(IFOUR.EQ.2) NSTBE=4
  248. NSTB=NSTBE*IDECAP
  249. NSTN=1
  250. NMIL=LPP-NBSOM(IELE)
  251.  
  252. * PRINT *,'NSTBE=',NSTBE
  253. * PRINT *,'NSTB=',NSTB
  254. * PRINT *,'IDECAP=',IDECAP
  255. * PRINT *,'LPP =',LPP
  256. * PRINT *,'LRN =',LRN
  257. * PRINT *,'LRE =',LRE
  258. * PRINT *,'NDDL =',NDDL
  259. * PRINT *,'NBNO =',NBNO
  260. * PRINT *,'NBBB =',NBBB
  261. * PRINT *,'NSTN =',NSTN
  262. * PRINT *,'IFOUR =',IFOUR
  263. * PRINT *,'NMIL =',NMIL
  264.  
  265. SEGINI WRK1,WRK2,WRK3,WRK5
  266. I195=0
  267. I259=0
  268. C
  269. DO 3080 IB=1,NBELEM
  270. C
  271. C ON CHERCHE LES COORDONNEES DES NOEUDS DE L ELEMENT IB
  272. C
  273. CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  274. C
  275. C CALCUL DES AXES LOCAUX ET DES CORDONNES LOCALES
  276. C
  277. CALL JOPLOC(XE,SHPTOT,NBBB,NBNO,IFOUR,XEL,BPSS)
  278. C
  279. C MISE A 0 DES FORCES NODALES
  280. C
  281. CALL ZERO(XFORC,1,LRN)
  282. C
  283. C BOUCLE SUR LES POINTS DE GAUSS
  284. C
  285. ISDJC=0
  286. DO 5080 IGAU=1,NBPGAU
  287. C
  288. C RECUPERATION DE L'EPAISSEUR
  289. C
  290. * IF (IFOUR.EQ.-2)THEN
  291. * MPTVAL=IVACAR
  292. * IF (IVACAR.NE.0) THEN
  293. * MELVAL=IVAL(1)
  294. * IF (MELVAL.NE.0) THEN
  295. * IGMN=MIN(IGAU,VELCHE(/1))
  296. * IBMN=MIN(IB,VELCHE(/2))
  297. * DIM3=VELCHE(IGMN,IBMN)
  298. * ELSE
  299. * DIM3=1.D0
  300. * ENDIF
  301. * ENDIF
  302. * ENDIF
  303. C
  304. CALL BNQORJ(IGAU,NBNO,NBBB,LRE,IFOUR,NSTB,NSTN,XE,XEL,
  305. . SHPTOT,SHPWRK,BPSS,BGENE,XGENE,DJAC,IDECAP,1)
  306.  
  307. IF(DJAC.LT.0.D0) ISDJC=ISDJC+1
  308. IF(DJAC.EQ.0.D0) I259=IB
  309. DJAC=ABS(DJAC)*POIGAU(IGAU)
  310.  
  311. C
  312. C ON RECUPERE LES VE_CO
  313. C
  314. MPTVAL=IVAVCO
  315. NCOSOU=IVAL(/1)
  316.  
  317. DO 8080 I=1,NCOSOU
  318. IF (IVAL(I).NE.0) THEN
  319. MELVAL=IVAL(I)
  320. IGMN=MIN(IGAU,VELCHE(/1))
  321. IBMN=MIN(IB ,VELCHE(/2))
  322. VECO(I)=VELCHE(IGMN,IBMN)
  323. ELSE
  324. VECO(I)=0.D0
  325. ENDIF
  326. 8080 CONTINUE
  327.  
  328. *
  329. * CALCUL DES FORCES NODALES EQUIVALENTES
  330. *
  331. DO 9180 IPR=1,IDECAP
  332. LPPDEC=(IPR-1)*LPP
  333. NSTDEC=(IPR-1)*NSTBE
  334. DO 9080 J=1,LPP
  335. JJ = J + LPPDEC
  336. DO 9080 K=1,NSTBE
  337. KB = K + NSTDEC
  338. XFORC(JJ)=XFORC(JJ)+ DJAC*BGENE(KB,JJ)*VECO(KB)
  339. 9080 CONTINUE
  340. 9180 CONTINUE
  341. *
  342. 5080 CONTINUE
  343. *
  344.  
  345. * WRITE(6,78655) (VECO(IE),IE=1,NSTBE)
  346. *78655 FORMAT( 2X, 'VECTEUR VECO' /(4(1X,1PE12.5)/))
  347.  
  348. * WRITE(6,78654) (XFORC(IE),IE=1,LPP)
  349. *78654 FORMAT( 2X, 'VECTEUR XFORC' /(4(1X,1PE12.5)/))
  350.  
  351.  
  352.  
  353.  
  354.  
  355. IF(ISDJC.NE.0.AND.ISDJC.NE.NBPGAU) I195=IB
  356. *
  357. C
  358. C ON RANGE XFORC DANS MELVAL
  359. C
  360. IE=0
  361. MPTVAL=IVAFOR
  362. C
  363.  
  364. * PRINT *, 'NBSOM(IELE) =', NBSOM(IELE)
  365.  
  366. DO 4180 IPR=1,IDECAP
  367. MELVAL=IVAL(IPR)
  368. DO 4080 I=1,NBSOM(IELE)
  369. IE=IE+1
  370. IGAV = IBSOM(NSPOS(IELE)+I-1)
  371. VELCHE(IGAV,IB)=XFORC(IE)
  372. 4080 CONTINUE
  373. *
  374. DO 4081 IGAU=1,NMIL
  375. IE=IE+1
  376. IGAV = NBBB - NMIL + IGAU
  377. VELCHE(IGAV,IB)=XFORC(IE)
  378. 4081 CONTINUE
  379. *
  380. 4180 CONTINUE
  381. C
  382. 3080 CONTINUE
  383. IF(I195.NE.0) INTERR(1)=I195
  384. IF(I195.NE.0) CALL ERREUR(195)
  385. IF(I259.NE.0) INTERR(1)=I259
  386. IF(I259.NE.0) CALL ERREUR(259)
  387. SEGSUP WRK1,WRK2,WRK3,WRK5
  388. GOTO 510
  389. C
  390. C_______________________________________________________________________
  391. C
  392. C
  393. 99 CONTINUE
  394. MOTERR(1:4)=NOMTP(MELE)
  395. MOTERR(5:8)='GNFL'
  396. CALL ERREUR(86)
  397. C
  398. 510 CONTINUE
  399. RETURN
  400. END
  401.  
  402.  
  403.  
  404.  
  405.  
  406.  
  407.  
  408.  
  409.  
  410.  
  411.  
  412.  
  413.  
  414.  
  415.  
  416.  
  417.  
  418.  
  419.  
  420.  
  421.  
  422.  
  423.  
  424.  
  425.  
  426.  
  427.  
  428.  
  429.  
  430.  

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