Télécharger cneq2.eso

Retour à la liste

Numérotation des lignes :

cneq2
  1. C CNEQ2 SOURCE CB215821 20/11/25 13:21:30 10792
  2. SUBROUTINE CNEQ2(IPMAIL,LRE,NDDD,IVAFVO,LW,NBPGAU,IVACAR,
  3. & CMATE,NBPTEL,MELE,IPMINT,IPMIN1,IVAMAT,NMATT,NBGMAT,NELMAT,
  4. & IMAT,IVAFOR)
  5. *----------------------------------------------------------------------
  6. * _______________________________ *
  7. * | | *
  8. * | CALCUL DES FORCES AUX NOEUDS| *
  9. * |______________________________| *
  10. * *
  11. * dkt,coq4 *
  12. * *
  13. *---------------------------------------------------------------------*
  14. * *
  15. * ENTREES : *
  16. * ________ *
  17. * *
  18. * IPMAIL Pointeur sur un segment MELEME *
  19. * LRE Nombre de ddl dans la matrice de rigidite *
  20. * NDDD Nombre de degrE de libertE PAR NOEUD *
  21. * IVAFVO pointeur sur un segment MPTVAL contenant les *
  22. * les melvals de forces volumiques *
  23. * LW Dimension du tableau de travail de l'element *
  24. * NBPGAU Nombre de points d'integration *
  25. * IVACAR Pointeur sur les chamelems de caracteristiques *
  26. * NBPTEL Nombre de points par element *
  27. * MELE Numero de l'element fini *
  28. * IPMINT Pointeur sur un segment MINTE *
  29. * IPMIN1 Pointeur sur un segment MINTE (aux noeuds) *
  30. * *
  31. * SORTIES : *
  32. * ________ *
  33. * *
  34. * IVAFOR pointeur sur un segment MPTVAL contenant les *
  35. * les melvals de forces *
  36. * *
  37. *---------------------------------------------------------------------*
  38. IMPLICIT INTEGER(I-N)
  39. IMPLICIT REAL*8(A-H,O-Z)
  40. *
  41. *
  42.  
  43. -INC PPARAM
  44. -INC CCOPTIO
  45. -INC CCHAMP
  46. -INC CCREEL
  47. -INC SMCHAML
  48. -INC SMCHPOI
  49. -INC SMELEME
  50. -INC SMCOORD
  51. -INC SMMODEL
  52. -INC SMINTE
  53. -INC SMLREEL
  54. -INC SMRIGID
  55. *
  56. SEGMENT WRK1
  57. REAL*8 XFORC(LRE), FOVOL(NDDD), XE(3,NBBB)
  58. ENDSEGMENT
  59. *
  60. SEGMENT WRK2
  61. REAL*8 SHPWRK(6,NBNO), BGENE(NDDL,LRE)
  62. ENDSEGMENT
  63. *
  64. SEGMENT WRK3
  65. REAL*8 WORK(LW)
  66. ENDSEGMENT
  67. *
  68. SEGMENT WRK4
  69. REAL*8 BPSS(3,3), XEL(3,NBBB), XFOLO(LRE)
  70. ENDSEGMENT
  71. *
  72. SEGMENT MPTVAL
  73. INTEGER IPOS(NS) ,NSOF(NS)
  74. INTEGER IVAL(NCOSOU)
  75. CHARACTER*16 TYVAL(NCOSOU)
  76. ENDSEGMENT
  77. *
  78. CHARACTER*8 CMATE
  79. *
  80. *
  81. MELEME=IPMAIL
  82. NDDL=NDDD
  83. NBNN=NUM(/1)
  84. NBELEM=NUM(/2)
  85. NHRM=NIFOUR
  86. MINTE=IPMINT
  87. C_______________________________________________________________________
  88. C
  89. C NUMERO DES ETIQUETTES :
  90. C ETIQUETTES DE 1 A 98 POUR TRAITEMENT SPECIFIQUE A L ELEMENT
  91. C DANS LA ZONE SPECIFIQUE A CHAQUE ELEMENT COMMENCANT PAR :
  92. C 5 CONTINUE
  93. C ELEMENT 5 ETIQUETTES 1005 2005 3005 4005 ...
  94. C 44 CONTINUE
  95. C ELEMENT 44 ETIQUETTES 1044 2044 3044 4044 ...
  96. C_______________________________________________________________________
  97. C
  98. GOTO(99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,
  99. 1 99,99,99,99,99,99,27,28,99,99,99,99,99,99,99,99,99,99,99,99,
  100. 2 41,99,99,44,99,99,99,99,49,99,99,99,99,99,99,41,99,99,99,99,
  101. 3 99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,99,
  102. 4 99,99,99,99,99,99,99,88,99,99,99,99,93,99,99,99,99),MELE
  103. GOTO 99
  104. C_______________________________________________________________________
  105. C_______________________________________________________________________
  106. C
  107. C ELEMENT COQ3
  108. C_______________________________________________________________________
  109. C
  110. 27 CONTINUE
  111. C
  112. C CAS NON PREVU
  113. GO TO 99
  114. C_______________________________________________________________________
  115. C
  116. C ELEMENT DKT
  117. C_______________________________________________________________________
  118. C
  119. 28 CONTINUE
  120. NBNO=NBNN
  121. NBBB=NBNN
  122. NDDL=3
  123. SEGINI WRK1,WRK2,WRK3,WRK4
  124. C
  125. DO 3028 IB=1,NBELEM
  126. C
  127. C ON CHERCHE LES COORDONNEES DES NOEUDS DE L ELEMENT IB
  128. C
  129. CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  130. C
  131. C MISE A ZERO DES FORCES NODALES
  132. C
  133. CALL ZERO(XFORC,1,LRE)
  134. C
  135. CALL VPAST(XE,BPSS)
  136. CALL VCORLC (XE,XEL,BPSS)
  137. C
  138. C BOUCLE SUR LES POINTS DE GAUSS
  139. C
  140. DO 6028 IGAU=1,NBPGAU
  141. MPTVAL=IVACAR
  142. MELVAL=IVAL(1)
  143. IGMN=MIN(IGAU,VELCHE(/1))
  144. IBMN=MIN(IB ,VELCHE(/2))
  145. EPAIST=VELCHE(IGMN,IBMN)
  146. IF (IVAL(2).NE.0) THEN
  147. MELVAL=IVAL(2)
  148. IGMN=MIN(IGAU,VELCHE(/1))
  149. IBMN=MIN(IB ,VELCHE(/2))
  150. EXCENT=VELCHE(IGMN,IBMN)
  151. ELSE
  152. EXCENT=0.D0
  153. ENDIF
  154. *
  155. CALL NDKT (IGAU,XEL,EXCENT,SHPTOT,SHPWRK,BGENE,DJAC)
  156. DJAC=DJAC*POIGAU(IGAU)*EPAIST
  157. *
  158. * ON RECUPERE LES FORCES VOLUMIQUES DANS LE REPERE GLOBAL
  159. *
  160. MPTVAL=IVAFVO
  161. ICOSOU=IVAL(/1)
  162. DO 8028 I=1,ICOSOU
  163. IF (IVAL(I).NE.0) THEN
  164. MELVAL=IVAL(I)
  165. IGMN=MIN(IGAU,VELCHE(/1))
  166. IBMN=MIN(IB ,VELCHE(/2))
  167. FOVOL(I)=VELCHE(IGMN,IBMN)
  168. ELSE
  169. FOVOL(I)=0.D0
  170. ENDIF
  171. 8028 CONTINUE
  172. *
  173. * ON LES PASSE DANS LE REPERE LOCAL
  174. *
  175. CALL MATVEC(FOVOL,XFOLO,BPSS,1)
  176. C
  177. C CALCUL DES FORCES NODALES
  178. C
  179. DO 7028 J=1,LRE
  180. DO 7028 I=1,NDDL
  181. XFORC(J)=XFORC(J)+BGENE(I,J)*XFOLO(I)*DJAC
  182. 7028 CONTINUE
  183. 6028 CONTINUE
  184. C
  185. C TRAITEMENT DE XFORC ET RANGEMENT DANS MELVAL
  186. C
  187. CALL TRPOSE(BPSS)
  188. CALL MATVEC(XFORC,XFOLO,BPSS,6)
  189. IE=0
  190. MPTVAL=IVAFOR
  191. DO 9028 IGAU=1,NBNN
  192. DO 9028 ICOMP=1,6
  193. IE=IE+1
  194. MELVAL=IVAL(ICOMP)
  195. VELCHE(IGAU,IB)=XFOLO(IE)
  196. 9028 CONTINUE
  197. 3028 CONTINUE
  198. SEGSUP WRK1,WRK2,WRK3,WRK4
  199. GOTO 510
  200. C_______________________________________________________________________
  201. C_______________________________________________________________________
  202. C
  203. C ELEMENTS COQ6 ET COQ8
  204. C_______________________________________________________________________
  205. C
  206. 41 CONTINUE
  207. C
  208. C CAS NON PREVU
  209. GO TO 99
  210. C
  211. C_______________________________________________________________________
  212. C_______________________________________________________________________
  213. C
  214. C ELEMENT COQ2
  215. C_______________________________________________________________________
  216. C
  217. 44 CONTINUE
  218. C
  219. C CAS NON PREVU
  220. GO TO 99
  221. C
  222. C_______________________________________________________________________
  223. C_______________________________________________________________________
  224. C
  225. C ELEMENT COQ4
  226. C_______________________________________________________________________
  227. C
  228. C
  229. 49 CONTINUE
  230. IG1=0
  231. NBNO=NBNN
  232. NBBB=NBNN
  233. SEGINI WRK1,WRK2,WRK4
  234. C
  235. DO 3049 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 ZERO DES FORCES NODALES
  242. C
  243. CALL ZERO(XFORC,1,LRE)
  244. C
  245. C CALCUL DE LA MATRICE DE PASSAGE EN REPERE LOCAL
  246. C
  247. CALL CQ4LOC(XE,XEL,BPSS,IERT,1)
  248. C
  249. IF (IERT .EQ. 3) THEN
  250. NOPLAN = 1
  251. ELSE
  252. NOPLAN = 0
  253. END IF
  254. C
  255. MPTVAL=IVACAR
  256. MELVAL=IVAL(1)
  257. IBMN=MIN(IB,VELCHE(/2))
  258. EP=VELCHE(1,IBMN)
  259. MELVAL=IVAL(2)
  260. IF (MELVAL.NE.0) THEN
  261. IBMN=MIN(IB,VELCHE(/2))
  262. EXCEN =VELCHE(1,IBMN)
  263. ELSE
  264. EXCEN=0.D0
  265. ENDIF
  266. C
  267. C BOUCLE SUR LES POINTS DE GAUSS
  268. C
  269. NBPGAM=NBPGAU-1
  270. DO 4049 IGAU=1,NBPGAM
  271. CALL NCOQ4(IGAU,XEL,SHPTOT,SHPWRK,BGENE,DJAC,IERT)
  272. *
  273. * IERT=1 JACOBIANO=<0
  274. IF (IERT.NE.0) IG1=IB
  275. *
  276. DJAC=DJAC*POIGAU(IGAU)*EP
  277. *
  278. * ON RECUPERE LES FORCES VOLUMIQUES DANS LE REPERE GLOBAL
  279. *
  280. MPTVAL=IVAFVO
  281. ICOSOU=IVAL(/1)
  282. DO 3549 I=1,ICOSOU
  283. IF (IVAL(I).NE.0) THEN
  284. MELVAL=IVAL(I)
  285. IGMN=MIN(IGAU,VELCHE(/1))
  286. IBMN=MIN(IB ,VELCHE(/2))
  287. FOVOL(I)=VELCHE(IGMN,IBMN)
  288. ELSE
  289. FOVOL(I)=0.D0
  290. ENDIF
  291. 3549 CONTINUE
  292. *
  293. * ON LES PASSE DANS LE REPERE LOCAL
  294. *
  295. CALL MATVEC(FOVOL,XFOLO,BPSS,1)
  296. C
  297. C ON CALCULE LES FORCES NODALES
  298. C
  299. DO 3649 J=1,LRE
  300. DO 3649 I=1,3
  301. XFORC(J)=XFORC(J)+BGENE(I,J)*XFOLO(I)*DJAC
  302. 3649 CONTINUE
  303. 4049 CONTINUE
  304. C
  305. C TRAITEMENT DE XFORC ET RANGEMENT DANS MELVAL
  306. C
  307. CALL TRPOSE(BPSS)
  308. CALL MATVEC(XFORC,XFOLO,BPSS,8)
  309. IE=0
  310. MPTVAL=IVAFOR
  311. DO 9049 NODE=1,4
  312. DO 9049 ICOMP=1,6
  313. IE=IE+1
  314. MELVAL=IVAL(ICOMP)
  315. VELCHE(NODE,IB)=XFOLO(IE)
  316. 9049 CONTINUE
  317. 3049 CONTINUE
  318. C
  319. C IMPRESSION D'UN EVENTUEL MESSAGE D'ERREUR...
  320. C
  321. IF(IG1.NE.0) THEN
  322. INTERR(1)=IG1
  323. CALL ERREUR(323)
  324. ENDIF
  325. SEGSUP WRK1,WRK2,WRK4
  326. GOTO 510
  327. C_______________________________________________________________________
  328. C
  329. C ELEMENT JOINT JOI4
  330. C_______________________________________________________________________
  331. C
  332. 88 CONTINUE
  333. C
  334. C CAS NON PREVU
  335. GO TO 99
  336. C
  337. C_______________________________________________________________________
  338. C
  339. C ELEMENT DST
  340. C_______________________________________________________________________
  341. C
  342. 93 CONTINUE
  343. C
  344. C CAS NON PREVU
  345. GO TO 99
  346. C
  347. C_______________________________________________________________________
  348. *
  349. 99 CONTINUE
  350. MOTERR(1:4)=NOMTP(MELE)
  351. MOTERR(5:9)='CNEQ2'
  352. CALL ERREUR(86)
  353. *
  354. 510 CONTINUE
  355. RETURN
  356. END
  357.  
  358.  
  359.  
  360.  
  361.  
  362.  
  363.  
  364.  
  365.  
  366.  
  367.  
  368.  
  369.  
  370.  
  371.  
  372.  
  373.  
  374.  
  375.  
  376.  
  377.  
  378.  

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