Télécharger cneq1.eso

Retour à la liste

Numérotation des lignes :

  1. C CNEQ1 SOURCE BP208322 16/11/18 21:15:35 9177
  2. SUBROUTINE CNEQ1(IPMAIL,LRE,NDDL,NBPGAU,MELE,MFR,IVAFVO,IPMINT,
  3. & IVACAR,IPORE,NCOMP,IVAFOR,IIPDPG)
  4. *----------------------------------------------------------------------
  5. * _______________________________ *
  6. * | | *
  7. * | CALCUL DES FORCES AUX NOEUDS| *
  8. * |______________________________| *
  9. * *
  10. * massif *
  11. * *
  12. *---------------------------------------------------------------------*
  13. * *
  14. * ENTREES : *
  15. * ________ *
  16. * *
  17. * IPMAIL Pointeur sur un segment MELEME *
  18. * LRE Nombre de ddl dans la matrice de rigidite *
  19. * NDDL Nombre de degré de liberté *
  20. * NBPGAU Nombre de points d'integration pour les contraintes *
  21. * MELE Numero de l'element fini *
  22. * MFR Numero de la formulation *
  23. * IVAFVO pointeur sur un segment MPTVAL contenant les *
  24. * les melvals de FORCES VOLUMIQUES *
  25. * IPMINT Pointeur sur un segment MINTE *
  26. * IVACAR Pointeur sur un melval de caractéristiques *
  27. * IPORE Nombre de fonctions de forme * *
  28. * NCOMP Nombre de composantes de forces *
  29. * *
  30.  
  31. * SORTIES : *
  32. * ________ *
  33. * *
  34. * IVAFOR pointeur sur un segment MPTVAL contenant les *
  35. * les melvals de forces NODALES *
  36. * *
  37. *---------------------------------------------------------------------*
  38. * F CAFFIN INSPIRE DE BSIGM1
  39. *---------------------------------------------------------------------*
  40. IMPLICIT INTEGER(I-N)
  41. IMPLICIT REAL*8(A-H,O-Z)
  42. *
  43. -INC CCOPTIO
  44. -INC CCHAMP
  45. -INC SMCHAML
  46. -INC SMCHPOI
  47. -INC SMELEME
  48. -INC SMCOORD
  49. -INC SMMODEL
  50. -INC SMINTE
  51. -INC CCGEOME
  52. -INC CCREEL
  53. -INC SMRIGID
  54. *
  55. SEGMENT WRK1
  56. REAL*8 XFORC(LRE),FOVOL(NDDL),XE(3,NBBB)
  57. ENDSEGMENT
  58. *
  59. SEGMENT WRK2
  60. REAL*8 SHPWRK(6,NBNO),BGENE(NSTB,LRE)
  61. ENDSEGMENT
  62. *
  63. SEGMENT WRK5
  64. REAL*8 XGENE(NSTN,LRN)
  65. ENDSEGMENT
  66. *
  67. SEGMENT MPTVAL
  68. INTEGER IPOS(NS) , NSOF(NS)
  69. INTEGER IVAL(NCOSOU)
  70. CHARACTER*16 TYVAL(NCOSOU)
  71. ENDSEGMENT
  72. *
  73. * INTRODUCTION DU POINT AUTOUR DUQUEL SE FAIT LE MOUVEMENT
  74. * DE LA SECTION EN DEFO PLANE GENERALISEE
  75. * Pas de rotation en modes 1D generalises
  76. IF (IFOUR.EQ.-3)THEN
  77. IP=IIPDPG
  78. SEGACT MCOORD
  79. IREF=(IP-1)*(IDIM+1)
  80. XDPGE=XCOOR(IREF+1)
  81. YDPGE=XCOOR(IREF+2)
  82. ELSE
  83. XDPGE=0.D0
  84. YDPGE=0.D0
  85. ENDIF
  86. *
  87. MELEME=IPMAIL
  88. NBNN=NUM(/1)
  89. NBELEM=NUM(/2)
  90. NHRM=NIFOUR
  91. MINTE=IPMINT
  92. IELE=NUMGEO(MELE)
  93. *
  94. C_______________________________________________________________________
  95. C
  96. C NUMERO DES ETIQUETTES :
  97. C ETIQUETTES DE 1 A 98 POUR TRAITEMENT SPECIFIQUE A L ELEMENT
  98. C DANS LA ZONE SPECIFIQUE A CHAQUE ELEMENT COMMENCANT PAR :
  99. C 5 CONTINUE
  100. C ELEMENT 5 ETIQUETTES 1005 2005 3005 4005 ...
  101. C 44 CONTINUE
  102. C ELEMENT 44 ETIQUETTES 1044 2044 3044 4044 ...
  103. C_______________________________________________________________________
  104. C
  105. GOTO (99,99,99, 4,99, 4,99, 4,99, 4,99,99,99, 4, 4, 4, 4,99,99,99,
  106. 1 99,99, 4, 4, 4, 4,99,99,99,99,99,99,99,99,99,99,99,99,99,99,
  107. 2 99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,
  108. 3 99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,79,79,
  109. 4 79,79,79,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,
  110. 5 99,99,99,99,99,99,99,99,99,99, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4,
  111. 6 4, 4),MELE
  112. IF (MELE.EQ.193.OR.MELE.EQ.194) GOTO 4
  113. GOTO 99
  114. C_______________________________________________________________________
  115. C_______________________________________________________________________
  116. C
  117. C SECTEUR DE CALCUL POUR LES ELEMENTS MASSIFS
  118. C_______________________________________________________________________
  119. C
  120. 4 CONTINUE
  121. C
  122. DIM3=1.D0
  123. NBNO=NBNN
  124. NBBB=NBNN
  125. NSTB=NDDL
  126. SEGINI WRK1,WRK2
  127. I195=0
  128. I259=0
  129. *
  130. C
  131. DO 3004 IB=1,NBELEM
  132. C
  133. C ON CHERCHE LES COORDONNEES DES NOEUDS DE L ELEMENT IB
  134. C
  135. CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  136. C
  137. C MISE A 0 DES FORCES NODALES
  138. C
  139. CALL ZERO(XFORC,1,LRE)
  140. C
  141. C BOUCLE SUR LES POINTS DE GAUSS
  142. C
  143. ISDJC=0
  144. DO 5004 IGAU=1,NBPGAU
  145. C
  146. C RECUPERATION DE L'EPAISSEUR
  147. C
  148. IF (IFOUR.EQ.-2)THEN
  149. MPTVAL=IVACAR
  150. IF (IVACAR.NE.0) THEN
  151. MELVAL=IVAL(1)
  152. IF (MELVAL.NE.0) THEN
  153. IGMN=MIN(IGAU,VELCHE(/1))
  154. IBMN=MIN(IB,VELCHE(/2))
  155. DIM3=VELCHE(IGMN,IBMN)
  156. ELSE
  157. DIM3=1.D0
  158. ENDIF
  159. ENDIF
  160. ENDIF
  161. C
  162. CALL NMATST(IGAU,MELE,MFR,NBNN,LRE,IFOUR,NIFOUR,NDDL,DIM3,
  163. 1 XE,SHPTOT,SHPWRK,BGENE,DJAC,XDPGE,YDPGE)
  164. *
  165. IF(DJAC.LT.0.D0) ISDJC=ISDJC+1
  166. IF(DJAC.EQ.0.D0) I259=IB
  167. DJAC=ABS(DJAC)*POIGAU(IGAU)
  168. C
  169. C ON RECUPERE LES FORCES VOLUMIQUES
  170. C
  171. MPTVAL=IVAFVO
  172. ICOSOU=IVAL(/1)
  173. DO 8004 I=1,ICOSOU
  174. IF (IVAL(I).NE.0) THEN
  175. MELVAL=IVAL(I)
  176. IGMN=MIN(IGAU,VELCHE(/1))
  177. IBMN=MIN(IB ,VELCHE(/2))
  178. FOVOL(I)=VELCHE(IGMN,IBMN)
  179. ELSE
  180. FOVOL(I)=0.D0
  181. ENDIF
  182. 8004 CONTINUE
  183. *
  184. * CALCUL DES FORCES NODALES EQUIVALENTES
  185. *
  186. DO 9004 J=1,LRE
  187. DO 9004 I=1,NDDL
  188. XFORC(J)=XFORC(J)+BGENE(I,J)*FOVOL(I)*DJAC
  189. 9004 CONTINUE
  190. *
  191. 5004 CONTINUE
  192. *
  193. IF(ISDJC.NE.0.AND.ISDJC.NE.NBPGAU) I195=IB
  194. *
  195. C
  196. C ON RANGE XFORC DANS MELVAL
  197. C
  198. IE=0
  199. MPTVAL=IVAFOR
  200. DO 7004 IGAU=1,NBNN
  201. DO 7004 ICOMP=1,NCOMP
  202. IE=IE+1
  203. MELVAL=IVAL(ICOMP)
  204. VELCHE(IGAU,IB)=XFORC(IE)
  205. 7004 CONTINUE
  206. C
  207. 3004 CONTINUE
  208. IF(I195.NE.0) INTERR(1)=I195
  209. IF(I195.NE.0) CALL ERREUR(195)
  210. IF(I259.NE.0) INTERR(1)=I259
  211. IF(I259.NE.0) CALL ERREUR(259)
  212. SEGSUP WRK1,WRK2
  213. GOTO 510
  214. C_______________________________________________________________________
  215. C
  216. C MILIEUX POREUX
  217. C_______________________________________________________________________
  218. C
  219. 79 CONTINUE
  220. C
  221. C POUR CES ELEMENTS NBBB = NOMBRE DE NOEUDS
  222. C NBNO = NOMBRE DE FONCTIONS DE FORME
  223. C
  224. DIM3=1.D0
  225. NBNO=IPORE
  226. NBBB=NBNN
  227. LRN = NBNO-NBBB
  228. LRB=LRE-LRN
  229. NSTN=1
  230. NSTB=NDDL-1
  231. SEGINI WRK1,WRK2,WRK5
  232. I195=0
  233. I259=0
  234. C
  235. DO 3079 IB=1,NBELEM
  236. C
  237. C ON CHERCHE LES COORDONNEES DES NOEUDS DE L ELEMENT IB
  238. C
  239. CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  240. C
  241. C MISE A 0 DES FORCES NODALES
  242. C
  243. CALL ZERO(XFORC,1,LRE)
  244. C
  245. C BOUCLE SUR LES POINTS DE GAUSS
  246. C
  247. ISDJC=0
  248. DO 5079 IGAU=1,NBPGAU
  249. C
  250. C RECUPERATION DE L'EPAISSEUR
  251. C
  252. IF (IFOUR.EQ.-2)THEN
  253. MPTVAL=IVACAR
  254. IF (IVACAR.NE.0) THEN
  255. MELVAL=IVAL(1)
  256. IF (MELVAL.NE.0) THEN
  257. IGMN=MIN(IGAU,VELCHE(/1))
  258. IBMN=MIN(IB,VELCHE(/2))
  259. DIM3=VELCHE(IGMN,IBMN)
  260. ELSE
  261. DIM3=1.D0
  262. ENDIF
  263. ENDIF
  264. ENDIF
  265. C
  266. CALL BNPORE(IGAU,NBNO,NBNN,LRE,IFOUR,NSTB,NSTN,NHRM,DIM3,
  267. . XE,SHPTOT,SHPWRK,BGENE,XGENE,DJAC,5)
  268. IF(DJAC.LT.0.D0) ISDJC=ISDJC+1
  269. IF(DJAC.EQ.0.D0) I259=IB
  270. DJAC=ABS(DJAC)*POIGAU(IGAU)
  271. C
  272. C ON RECUPERE LES FORCES VOLUMIQUES
  273. C
  274. MPTVAL=IVAFVO
  275. ICOSOU=IVAL(/1)
  276. DO 8079 I=1,ICOSOU
  277. IF (IVAL(I).NE.0) THEN
  278. MELVAL=IVAL(I)
  279. IGMN=MIN(IGAU,VELCHE(/1))
  280. IBMN=MIN(IB ,VELCHE(/2))
  281. FOVOL(I)=VELCHE(IGMN,IBMN)
  282. ELSE
  283. FOVOL(I)=0.D0
  284. ENDIF
  285. 8079 CONTINUE
  286. *
  287. * CALCUL DES FORCES NODALES EQUIVALENTES
  288. * D'ABORD LA MECANIQUE
  289. *
  290. DO 9079 J=1,LRB
  291. DO 9079 I=1,NSTB
  292. XFORC(J)=XFORC(J)+BGENE(I,J)*FOVOL(I)*DJAC
  293. 9079 CONTINUE
  294. *
  295. * PUIS LA PRESSION
  296. *
  297. DO 6079 J=1,LRN
  298. JJ=LRB+J
  299. XFORC(JJ)=XFORC(JJ)+XGENE(1,J)*FOVOL(NDDL)*DJAC
  300. 6079 CONTINUE
  301. *
  302. 5079 CONTINUE
  303. *
  304. IF(ISDJC.NE.0.AND.ISDJC.NE.NBPGAU) I195=IB
  305. *
  306. C
  307. C ON RANGE XFORC DANS MELVAL
  308. C D'ABORD LES FORCES
  309. C
  310. IE=0
  311. MPTVAL=IVAFOR
  312. DO 7079 IGAU=1,NBNN
  313. DO 7079 ICOMP=1,NCOMP-1
  314. IE=IE+1
  315. MELVAL=IVAL(ICOMP)
  316. VELCHE(IGAU,IB)=XFORC(IE)
  317. 7079 CONTINUE
  318. C
  319. C PUIS LES DEBITS
  320. C
  321. DO 4079 IGAU=1,NBSOM(IELE)
  322. IE=IE+1
  323. MELVAL=IVAL(NCOMP)
  324. IGAV = IBSOM(NSPOS(IELE)+IGAU-1)
  325. VELCHE(IGAV,IB)=XFORC(IE)
  326. 4079 CONTINUE
  327. C
  328. 3079 CONTINUE
  329. IF(I195.NE.0) INTERR(1)=I195
  330. IF(I195.NE.0) CALL ERREUR(195)
  331. IF(I259.NE.0) INTERR(1)=I259
  332. IF(I259.NE.0) CALL ERREUR(259)
  333. SEGSUP WRK1,WRK2,WRK5
  334. GOTO 510
  335. C
  336. C_______________________________________________________________________
  337. C
  338. C
  339. 99 CONTINUE
  340. MOTERR(1:4)=NOMTP(MELE)
  341. MOTERR(5:8)='CNEQ'
  342. CALL ERREUR(86)
  343. C
  344. 510 CONTINUE
  345. RETURN
  346. END
  347.  
  348.  
  349.  
  350.  
  351.  
  352.  
  353.  
  354.  
  355.  
  356.  
  357.  
  358.  
  359.  
  360.  
  361.  
  362.  
  363.  
  364.  
  365.  
  366.  
  367.  
  368.  
  369.  
  370.  
  371.  
  372.  
  373.  
  374.  
  375.  
  376.  
  377.  

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