Télécharger cneq2.eso

Retour à la liste

Numérotation des lignes :

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

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